#! /usr/bin/env wish
# -*- tcl-indent-level: 2; tcl-tab-always-indent: nil; eval: (superword-mode) -*-
package provide app-AppMain 1.0

package require Tk 8.6-

set startup_status 0

####
####
# Copyright and Disclaimer
# This software is copyright 2003-2025 by M. Wayne Davis.
#
# All copies are not for redistribution and should be obtained from the author.
# The author hereby grants permission to use and copy this software for any purpose. 
# Modifications to this software may only be used by their authors and may not be re-distributed in any form. 
# No written agreement, license, or royalty fee is required for any of the authorized uses.

# IN NO EVENT SHALL THE AUTHOR OR DISTRIBUTOR BE LIABLE TO ANY PARTY
# FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES
# ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY
# DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE
# POSSIBILITY OF SUCH DAMAGE.

# THE AUTHOR AND DISTRIBUTOR SPECIFICALLY DISCLAIM ANY WARRANTIES,
# INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY,
# FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT.  THIS SOFTWARE
# IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHOR AND DISTRIBUTOR HAVE
# NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR
# MODIFICATIONS.

#windows printing and metafile extensions
#Original Author: Michael I. Schwartz, mschwart@nyx.net

##feather icons
#The MIT License (MIT)
#Copyright (c) 2013-2017 Cole Bemis
#Permission is hereby granted, free of charge, to any person obtaining a copy
#of this software and associated documentation files (the "Software"), to deal
#in the Software without restriction, including without limitation the rights
#to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
#copies of the Software, and to permit persons to whom the Software is
#furnished to do so, subject to the following conditions:
#The above copyright notice and this permission notice shall be included in all
#copies or substantial portions of the Software.


## Tcllib
#This software is copyrighted by Ajuba Solutions and other parties. The following terms apply to all files associated with the software unless explicitly disclaimed in individual files.
#The authors hereby grant permission to use, copy, modify, distribute, and license this software and its documentation for any purpose, provided that existing copyright notices are retained in all copies and that this notice is included verbatim in any distributions. No written agreement, license, or royalty fee is required for any of the authorized uses. Modifications to this software may be copyrighted by their authors and need not follow the licensing terms described here, provided that the new terms are clearly indicated on the first page of each file where they apply.
#IN NO EVENT SHALL THE AUTHORS OR DISTRIBUTORS BE LIABLE TO ANY PARTY FOR DIRECT, INDIRECT, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OF THIS SOFTWARE, ITS DOCUMENTATION, OR ANY DERIVATIVES THEREOF, EVEN IF THE AUTHORS HAVE BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#THE AUTHORS AND DISTRIBUTORS SPECIFICALLY DISCLAIM ANY WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE, AND NON-INFRINGEMENT. THIS SOFTWARE IS PROVIDED ON AN "AS IS" BASIS, AND THE AUTHORS AND DISTRIBUTORS HAVE NO OBLIGATION TO PROVIDE MAINTENANCE, SUPPORT, UPDATES, ENHANCEMENTS, OR MODIFICATIONS.
#GOVERNMENT USE: If you are acquiring this software on behalf of the U.S. government, the Government shall have only "Restricted Rights" in the software and related documentation as defined in the Federal Acquisition Regulations (FARs) in Clause 52.227.19 (c) (2). If you are acquiring the software on behalf of the Department of Defense, the software shall be classified as "Commercial Computer Software" and the Government shall have only "Restricted Rights" as defined in Clause 252.227-7013 (c) (1) of DFARs. Notwithstanding the foregoing, the authors grant the U.S. Government and others acting in its behalf permission to use and distribute the software in accordance with the terms specified in this license.
# Encode/Decode base64 for a string
# Stephen Uhler / Brent Welch (c) 1997 Sun Microsystems
# The decoder was done for exmh by Chris Garrigues
# sha1.tcl - 
# Copyright (C) 2001 Don Libes <libes@nist.gov>
# Copyright (C) 2003 Pat Thoyts <patthoyts@users.sourceforge.net>

# 9.0 bugs- 
# sequence window width not set in reline correctly (big right-side gap) text window grid managemet isn't happening anymore
# find lines: set width [expr {int(([winfo width $w.textarea]-4)/[lindex [wm grid $w] 2])}]
# mousewheel events in sequence window isn't triggering?


#set version number here
if {[tk windowingsystem] ne "aqua" || [catch {set version [exec defaults read [file join [::tk::mac::GetAppPath] Contents Info] CFBundleShortVersionString]}]} {
  set version 3.1.8.1
}

## New feature libraries with aa CDS features
## Make FASTA file into feature library

## Add sequence features to current feature library <<new_from_sequence_selected>> <<new_from_sequence_all>>. 
## make proc feature_to_library_element {w tag} {}; 

## save cdseguid in file 
## selecting a feature in graphic map and digest dialog selects the feature table item


############ to do: show primer tails on primer features?
#use procedure- add_primer_bind_before_after_data
## new feature- primer_bind: button to add sequence qualifier, 5' extension
## function to convert Benchling features ("primer" types to primer_bind, with sequence notes to PCR_conditions qualifiers)



  
#################inline:
# bug: feature split around origin meeting its tail on the same line doesn't stop the last exon and start the next
# bug: linear map from middle of circular sequence (broken left and right linear features) don't draw the arrow in the correct places, labels are in wrong places, etc.
# to do: right click on feature to hide/ delete etc.
# to do: right click on canvas to turn on/off tracks, set spacing, set dynamic sizing (inline_canvas_fixed_height), set selection on top

# to do: show selection translate (1, 3, 6 frame) - select in the frame of the selection
# ok: to do: selection should skip a bit at the bottom
# ok: to do: show find highlight
# ok: to do: inline canvas spacing as multiple of text size - 
# ok: text_select_xy for B1-Motion in canvases
# ok: text_select_xy for B1-Motion in bottom strand in canvases
# ok: bug: zoom canvas set to 0 width
# ok: bug: right side canvas- don't show hidden features
# ok: bug: insert at end of a line doesn't show, insert a start of a line then left arrow doesn't set one char in from right textkeyselect
# ok: bug textarea_insert with index at end leaves the insert after the last canvas
# ok: bug: insert into blank sequence has features off by 1 char

############### Todo Primer Commands:
## bug- select best scoring pair doesn't ignore non-compatible pairs??
## Buttons (L/R/C): save/ append to text file
## Buttons (C): name (if not named) and make feature pair
## show entry field to edit the composition filter texts
## filter for off target primer binding with minimum alignment score xx, within xx bp of the target (local repeats)
## add asterisk labels for each incompatible parameter and use it to indicate which incompatibility is present in the selected pair
## right click pair incompatibilities for a text alignment of the incompatibilities
## change to optional Tm calculations
## ok: Use values: info(primer_next_number), info(primer_name_string) in Gibson and GG settings - look for primer_generate_name
############ do to primer selection
## ok: "primer full length" instead of 5' or 3' (with possibility of 5' or 3')
## ok: show max number of best primers
## ok: make score positive (0 best)
## ok: make score the defalt show, filter is advaced
## check box instead of weights in basic mode
## dialog yes or no to set values to dvanced or basic defaults when switching between advanced and basic
## store left and right column headings order to make it persistent

##########
## Gibson- button for finding next fragment automatically for linear fragments- set to no primers
## Look at Gibson primer ends. Use new primer alignment proc to check for out of phase alignment and alignment to incorrect ends.
## Look at Gibson and Golden Gate primers for off target primer binding with minimum alignment score xx, within xx bp of the target (local repeats)

#########
# sequence print
# set t $w.textarea; set filename [tk_getSaveFile]
 #  ::pdf4tcl::new pdf; pdf configure -margin {36 36} -paper letter; add_window_to_pdf pdf $t textarea; pdf write -file  $filename; pdf destroy
 # mac can print pdf if inline mode/ print text map if not, windows needs to do text map print and save to pdf from sequence
# update windows canvases in add_window_to_pdf
# add_window_to_pdf- if textarea check for odd/even at endline calulation, back up a line if odd


############# Pieces (think of a different name- Benchling has "Parts" that are not this)
## make a function to make a new part from selected region
## dict of parts list name and file path
## part list is dict of part name and list of sequence and put_tags data - save as tab delimited text
## menu items: open parts file (file open dialog), new blank parts file (file save dialog), edit (editor dialog)
## submenu items: add selection as a part (open editor dialog part name), close, open in editor dialog
## editor (autosave): move parts between lists (left right up down arrows between two listboxes), double-click rename part , checkbox load on startup,  entry: name of part list (for submenu label),  filename (menubutton for new file, open file, save copy as, close file, radio button list of open files, files that open on startup )
## insert part forward, reverse
## procs: save tab delimited text from dict element, load, load list of files into a dict, editor dialog, fill editor list, 
## OR- folder of sequence files that can be added (see feature library cascade menu)
## ok: open_file $filename 2-- will return genbank data without opening the file
##
## ok: insert restriction site (fwd/ rev if available)

##Linux main menu hotkeys
## Better Linux lpr printing dialog

#################
## Graphic map configuration
# ok: Graphic map- draw intron features not working?
## Configure Linear map Enzymes to match circular:  BIU, label text+substitutions, tick  color, width, tick length, show connector. 
## Configure Linear map Set enzyme tick to below baseline if label is moved below baseline.
## Configure Linear map  button to set enzyme labels above or below baseline and re-bump (-1 +1)
## Configure Linear map enzyme bump proc needs to send labels down on overlap if below baseline 
## Configure Linear map buttons to set features on baseline, above/ below baseline (< -1 0 +1 >)- fix feature bump proc to send up if above the baseline?
## Configure Linear map Feature to match circular: BIU, label text+substitutions,  Set label x position: left outside, left inside center, right inside, right outside. Button to move label y position: above, centered, below (< -1 0 +1 >)
## Configure Linear map baseline fg, bg thickness and color
## Configure Circular map Enzyme tick radius from circle buttons (< 0 >) or slider -20% to +50%
## Configure Circular map  Feature tick radius from circle buttons (->,  < 0 >) or slider -20% to +50% (or on feature - blank value) #circular_config_enz_treeview_apply_move e_list c value obj  obj=t#circular_config_fea_treeview_apply_move e_list c value obj mode obj=t
## Configure Circular map Enzyme: text angle horizontal, radial, radial45, radial90, radial90_CCW

## ok: Configure Feature text_font bold, underline, italic
## ok: Configure Feature text_subst (free text with: name, start position, end position, length, direction arrow)
## ok: Configure box item-  graphic_map_redraw_label_box adds xy_offset to <<Box>>  dict to do the recenter. graphic_map_recenter_label_box proc needs to use that or just always call graphic_map_redraw_label_box to make box coords

## configure intron  
## ok: Configure Feature linear intron height vs exon (+.5 to -.5), dip vs exon (+2 to -2),, fill color (set to fill, set to outline), outline color (set to outline), line width, outline width (possibly 0) (2 colors, 4 sliders)
## ok: Configure Feature circular intron height vs exon (+.5 to -.5), fill color (set to fill, set to outline), outline color (set to outline), line width, outline width (possibly 0) (2 colors, 3 sliders)

## ok: Configure linear and circular map- background color (fix pdf, eps, svg and pptx output to make a colored box background?)
## ok: arrow points list can be dict of pts min_x_scale and smooth
## arrow points data dict options to add: outline_width 
## change to raw polygon data, convert the arrow_list.txt file to bezier points with smooth option and min_x_scale option


#################
## apply Theme_engine_V2 procs: circular_fea_config etc.
## theme apply needs to update the feature treeview tag backgrounds to match the new background (why doesn't treeview apply do this?)
## linear graphic map theme

# ok: theme engine code- if treeviews exist, unset all selections, then reset selections after the edits are made. This should unset all of the temp array values and update them with the new values after the theme engine changes

# ok: Graphic map- changing exon fill and outline also applies to intron fill and outline (can be selected seperately in theme engine)
# ok: snapgene theme- change index radius and line length slightly



##############
# Golden Gate oligos- add features for oligo inserts


###############
## phred find dialog, make features (color)

########### Font scanner- find system font PDF and PS names and build PDF font dict
## Font usage and PDF generation
## ***needs to be added from Font_scanner code: canvas_to_pdf text: bold, italic, underline, unicode
# ****needs to be added from Font_scanner code: canvas_to_ps  ps fonts: bold, italic, underline



######
## PDF report - scripted analysis? Can at least combine manually made windows into a report.

######
## Qualifiers
## edit qualifiers needs a function to calculate value when a translation qualifier is added- Don't allow edit of the translation qualifier, only add or remove
## Recalculate translation for features with a translation in features_to_tree_view- needs a fast translation function for broken features/ features around the origin
## for PCR product, source key can include /PCR_primers="fwd_name: CO1P1, fwd_seq: ttgattttttggtcayccwgaagt, rev_name: CO1R4, rev_seq: ccwvytardcctarraartgttg"
## need to deal with qualifier values that have mutiple sequences?
## need to deal with primer_bind features that are BOTH primer sites joined with order(): "since PCR reactions most often involve pairs of primers,a single primer_bind key may use the order() operator with two locations, or a pair of primer_bind keys may be used."


############
## History
## Generate and add source tags whenever using cut/copy/paste, GG, Gibson, Recombination, Restriction/Ligation or PCR tools (minimum rotation to set position origin+ strand)
## view history via nested YAML info 
## save seguid by default in ApE header- allows a search of a disk folder for a matching seguid file
## 


## supercoiled gel
##https://www.sciencedirect.com/science/article/pii/S0003269710000357?via%3Dihub

############# Gibson Designer
## "work here for gibson deletion"
##  work here for gibson linker
## ok: check for >=15 match in the last 200 (not just the ends)- needs to have left and right side deletion lengths (last_adjust and foward_adjust) shown somewhere (at top and bottom labels where sequence name and range are displayed? Template overlap Tm location?) Design PCR primers to the overlap sequence instead of the stated sequences??
### ok: If no tails and no overlap- Add a ssDNA bridge (bottom strand) at junctions with no overlap and neither side having PCR tails set. **Can add additional sequence when joining a junction with no PCR tails and no overlap. Display the two overlap Tms and total bridging oligo length in the overlap Tm label. Display the oligo sequence in between the two primer rows.
## ok: Give warning if making a tail-PCR that has a non-end match >15 (accidental gibson deletion) in the last 200. 
## ** https://www.neb.com/en-us/nebinspired-blog/four-alternative-and-powerful-cloning-applications-of-nebuilder-hifi-dna-assembly
## ok: addtional sequence- "add restriction site sequence" submenu that can add a restriction site sequence into the text entry  




### ok:use tk_getSaveFile -typevariable option

###################
## dark mode
## ok: Make graphic background and foreground color options (for dark mode canvases)- gell bands and texts, map backgrounds and baselines text_fg_color,dark text_fg_color
###ok: canvases that need to use graphic_bg_color, graphic_fg_color:
###proc seq_tooltip_post   proc enz_digest   proc enz_digest2   proc digest_peel_bands   proc orf_map   proc enz_graphic_map   proc new_abi_window   proc abi_drag   proc abi_to_canvases   proc abi_tooltip_create   proc pcr_dialog   proc re_cloning_wizard_dialog   seq side maps





############# Toolbar Settings
## ok: add/ remove reorder toolbar buttons (double listview in configure)
## ok: or treeview with checkbox column to add to toolbar and select row to move up/down
## ok: icon color (affects all icons)
## ok: tool bar button text option (show, font size, top/bottom)
## ?recent tools button?


## Graphic map feature draw
## ok: use same arrow scaling algorthm in linear map for short features.  proc linear_feature_draw_arrow  "  set center_long_arrows 0"
## ok:  Configure Feature- some way to specify the arrow needs to scale or stay fixed length (minimum scaling factor- 1 means no scaling). arrow property dict as 1st list element- (keys: smooth and min_x_scale), or make arrow data a dict with points as another key. Look for points key and if not present assume it's a flat points list.
## ok:look for ## bezier arrow data change here



## Recombination assembler
## ok: bug: proc fill_recomb_reation_frame  if {$site2 ne "end"} needs to loop through all index_list1 (odd elements only) rather than just taking element 1, particularly if the fragment contains another of the same site-- can't do a aaaaaaFRTbbbbbbbFRTccccc >> aaaaaaFRTccccc because it finds the same FRT in both cases.

### ok: bug: abi_tooltip_create and abi_tooltip_update uses hard coded colors, not the user-defined colors  $abi_info(colors,[string index $abi_info($w,filter_wheel) $track])


## ok: configure Feaure use arc text minus orientation (OUTSIDE the feature with edge matching the feature edge) (CCW, CW, 5' 3')
## ok: Configure Index use horizontal, radial, radial45, radial90, radial90_CCW, 
## ok: Configure Enzyme connector+tick color, width, tick length, show connector, 
## ok: Configure Enzyme text_subst (free text with: menubutton pulldown to insert subst: name, position 5', position cut, number of cuts, unicode dingbats, number of cuts as unicode substitutions)


# Gibson bugs
# ok: bug: back a step then forward doesn't use the forward/reverse setting for each junction
# bug: reverse feature that spans the origin in a product has an inton around the rest of the sequence

# bug: rename feature in feature table isn't represented in the inline features until redrawing the textarea

## ok: recomb_add_new_site_tags
## 

## ok: BUG: 5' extra bases in Golden Gate designer can accidentally make a new restriction site for the enzyme- check and edit if so.

## ok: fix arrow minimum fwd_adjust and rev_adjust to be the center of the arrow, including negative x values

##############
## ok: molecular calculator- lookup compounds for molecular weight
##     to do:can download a png image of the compound
##     https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/tetracycline/PNG?image_size=small
##     use save_png_from_url
##     image create photo mol_png 
##     toplevel .t
##     grid [label t.l -image mol_png]
##     if {[set f [save_png_from_url $url] ne ""} {mol_png read $f} else {mol_png blank}
##   ttk::combobox $f.compound_lookup -width 30 -textvaiable mol_calc_info(lookup_text)
##   bind $f.compound_lookup <Key> "after 1 {sputs k \$mol_calc_info(lookup_text)}"
##   bind $f.compound_lookup <<ComboboxSelected>> "after 1 {sputs k \$mol_calc_info(lookup_text)}"
##   mol calculator- get autocomplete compound name, get mol weight and png of compoud name
##   https://pubchem.ncbi.nlm.nih.gov/docs/autocomplete
##   get_html https://pubchem.ncbi.nlm.nih.gov/rest/autocomplete/compound/tetrac/jsonp
##   regexp  {"compound": \[(.*)\]} [get_html https://pubchem.ncbi.nlm.nih.gov/rest/autocomplete/compound/tetrac/jsonp] -- res
##   regsub -all {\"|\n\s+} $res "" res2
##   split $res2 ,
##   https://pubchem.ncbi.nlm.nih.gov/docs/pug-rest
##   get_html https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/tetracycline/property/MolecularWeight/TXT
# ok:pause on molar lookup


## genolib feature libraries using translated feature scan



## ok: Gibson designer- add **NOTE** if overlap Tm is less than default overlap Tm, and error if no overlap

## ok: PCR tool: click on primer icon highlights primer in sequence


## ok: Golden Gate assembler- allow annealed oligo pairs from oligo text file

## ok: Golden Gate assembler- allow linear products
## ok: Golden Gate assembler- allow annealed oligo pairs to be fragments
## ok: bug: proc golden_gate_fill_calculator  needs to work with end or oligo sites (check for enzymedata exists)
## ok: bug: GG assembler- fix file comment and menubutton text when using an oligo
## ok: bug: gg fragments needs to look at all oligo combinations and figure out how to keep an oligo from using the reverse (the overhang sequence isn't correct if the oligo is reversed)


## ok:Golden Gate designer- allow selecting existing restriction fragments- needs to check each fragment for compatibility with previous/ subsequent fragment for every edit.
## ok: work here GG fragment input



## bug: sometimes change feature color in feature table doesn't recolor side map?

## ok: bug: adding intron by minus_sel doesn't add fntag at start or end??
# ok: click on feature in graphic map selects configure table feature


#######
# ok: fix windows pref red text, 
# ok: fix file type association 
# Potts- show wider traces? show traces on mismatch highlight?  align_dialog_highlight_mismatch set to tooltip or parent window select
# ok: reading primers- option to save fixed primers file with commented out error lines
# ok:reading primers- oligo length,overlap array. search each new against database



##########
## bug- graphic map highlight features hangs
##########



## read and use enzyme data for buffer and temperature, use it for quick add, use it for comment info or mouseover info?
## ok: New feature scan- do 6 frame translation and search for translated features. Build better default feature library.

## bug- re_cloning_wizard_gel_lane_click - enzyme name can have spaces if the enzyme name is overlapping cut sites of multiple enzymes 



proc sputs {args} {
global info tcl_platform
  if {$info(suppress_output)} return
  if {($tcl_platform(platform) == "windows") || ([tk windowingsystem] == "aqua") || $info(android)} {
    puts $args
  } else {
    puts stdout "ApE:$args"
    puts stderr "ApE:$args"
  }
}

proc cls {} {
 console eval {.console delete 1.0 end}
}

if {0} {
### use this code to echo all procas as they are defined
  rename proc real_proc
  real_proc proc {args} {
    sputs [lindex $args 0]
    real_proc {*}$args
  }
}

## Don't use Tclspeech library, just use system "exec say "

if {0} {
  ## pretend to be windows
rename tk tk_real
proc tk {args} {
global env
  puts "tk $args"
  if {$args eq "windowingsystem"} {
   return win32
  } else {
    return [eval tk_real $args]
  }
}
set info(user_defaults_dir) [file join $env(HOME) "Library/Preferences/ApE/"]
}


## ok: Gibson cloning
## Reverse Gibson cloning
## ok: PCR from primer seqs (primer seq (PCR_conditions=" sequence:**********) qualifier on primer features)

## ok: key event- keypress: store the tags on the first base of the selection before deleting the text and tags, then add those tags back to the inserted base (don't use tag_splt2)







## OK:
## need to make feature type include the class for three types that have sub-classes
## ex.: regulatory:promoter
## then save/open convert to/from base type with qualifier
## edit feature- edit via qualifier or type list?
##misc_recomb:recombination_class {meiotic mitotic non_allelic_homologous chromosome_breakpoint other}
#http://www.insdc.org/controlled-vocabulary-recombination-class
##regulatory:regulatory_class  {attenuator CAAT_signal DNase_I_hypersensitive_site enhancer enhancer_blocking_element GC_signal imprinting_control_region insulator locus_control_region matrix_attachment_region minus_35_signal minus_10_signal polyA_signal_sequence promoter recoding_stimulatory_region replication_regulatory_region response_element ribosome_binding_site riboswitch silencer TATA_box terminator transcriptional_cis_regulatory_region other}
#http://www.insdc.org/controlled-vocabulary-regulatoryclass
##ncRNA:ncRNA_class {antisense_RNA autocatalytically_spliced_intron ribozyme hammerhead_ribozyme lncRNA RNase_P_RNA RNase_MRP_RNA telomerase_RNA guide_RNA sgRNA rasiRNA scRNA scaRNA siRNA pre_miRNA miRNA piRNA snoRNA snRNA SRP_RNA vault_RNA Y_RNA circRNA other}
#http://www.insdc.org/documents/ncrna-vocabulary


## Copy all but selected- use clip_cut_copy. Change to copy_start and copy_end, set that based on single or double selection region plus "copy" or "copy_inverted" function, use get_tags2 to get tags around the circle



## ok:install pdf4tcl 0.92

## (need to convert most procs to get_tags2)


##  CDS change case to 3-up-3-down
## Next ORF start codons
## selecting/ shift selecting a feature in graphic map selects the feature in the feature table, and thus in the sequence.
## ok: selecting two primer_bind in the feature table lets you do a PCR with those primers (how to activate? right click on feature?)


## circular map bug:  tags through origin are labeled 180 degrees off


## ok: auto-apply configure
## ok: apply configure saves to $c f# tag <<Gformat>> dict circular_config_fea_treeview_apply
## apply configure saves to file- gformat, colors,  $w.textarea tag bind f1# <<Revcolors>>,gformat= lindex [$w.textarea tag bind f1# <<Metadata>>]
## apply Gformat data to new maps
## ok: re-apply window scaling when applying configure
## ok: add arrow dropdown to feature configure
## ok: add offset scale to feature configure (+/- 2x width up to current offset, if greater magnitude on either side)
## arc texts default to 0 offset
## ok: click on feature/ enzyme selects the feature/enzyme in the treeview of the configure window



#########################################
## Pretty maps
###########
# store and use graphicformat: circular and linear: outline_color, outline_width, width, graphic_label_font, graphic_label_color (blank is feature), arrow points, text_subst (free text with: name, start pos, end pos, size substitutions) 
# store and use graphicformat: linear: linear_label_position, linear_map_y,  linear_map_hidden
# store and use graphicformat: circular: use_arc_label, arc_text_offset (relative to feature), linear_text_position (angle and radial offset as percent of circle), feature_offset_position (as percent added to feature_line), circular_map_hidden, 
# 
# arrow styles menubutton instead of points
# intron gdata, linear bg thickness, bg color, thickness, color, height, dip, circular (0 to 1 relative offset) bg thickness, bg color, thickness, color, height

### save base gformat data: enzymes, info texts format, baseline, index ring/line:
## Enzymes
# general and per enzyme



## Descriptive Texts:
#ok: circular_map_comment_hidden, circular_map_comment_font, circular_map_comment_color,circular_map_seqlength_hidden, circular_map_seqlength_font, circular_map_seqlength_color,
# no?:circular_map_enzlist_hidden, circular_map_enzlist_font, circular_map_enzlist_color,circular_map_featurelist_hidden, circular_map_featurelist_font, circular_map_featurelist_color,

## Baseline/ crosshairs:
# circular_baseline_bg_width 1 circular_baseline_fg_width 1 circular_baseline_bg_color black circular_baseline_fg_color white circular_crosshair_length 0.016 circular_crosshair_bg_width 1 circular_crosshair_bg_color black circular_crosshair_fg_width 1 circular_crosshair_fg_color white
## Index:
#circular_map_index_radius, circular_map_index_max_tick_spacing, circular_map_index_max_tick_color, circular_map_index_max_tick_font, circular_map_index_max_tick_width, #circular_map_index_min_tick_per_max, circular_map_index_min_tick_color, circular_map_index_min_tick_width
## Offsets:
#circular_map_features_offset, 


# edit and save graphic data in feature libraries
# edit features from treeview- graphic data

#linear map: new <Configure> proc that doesn't require aspect ratio, and that adjusts labelbox items to their texts
#linear map: bup all texts proc, moves labels to their features then bumps them all
# linear map: move feature proc, bumps label after each move- sets current label to the first bumped

#pretty graphic maps- arrow types, define each feature type to have a default arrow type at each end, default color, default thickness. Can set that value for each feature in edit feature. can right click on a feature to edit the feature. color code feature labels.
#preferences: window size (linear and circular), features in/on/out of circle (fwd/rev, short/long), width of circle, color of circle, feature numbers and lines on/off,  default feature text color (option of feature color), feature text highlight color, unique and selected enz text color, show enz coord, show enz numbers.
#features (library, edit features): width, fwd/rev arrow type (no arrow, block, narrow, half)
#features (live): move in/out
# map (live- right click, menu item): all lines on/off; feature indices on/off; enz indices on/off; enz counts on/off; (show/ hide texts- how?); unhide items (submenu); show comment; show feature table; make current format default.
# map (live- right click on feature, menu item): fwd, rev arrow; width; show label, indices, line; hide; hide all of type
# map (live- right click on text, menu item): points, color, bold, underline, show label, indices, line
# texts (live- right click, menu item): format text item (font, size, color, on/off, numbers on/off, text hidden), same format options for their group (unique enzyme, selected enzyme, same enzyme, features)
# live drag of texts- respace all other texts, change anchor point based on position of text relative to feature line.
# potential feature metadata (circular): radius position (-1, 0 ,1), direction (0,1), angle indices, arrow data (fwd+rev), tick angle, feature bp, default color
# non-arrow features- circle, triangle (up down left right), 5, 6, 8 sided, start arrow. height, width, justification (centered start end)
# procs:  move feature in and out (move coords of all arcs and arrows, including backgrounds), change arrow coord points to change arrow type (also background coords), change feature width, move texts and their lines, bump texts (and their lines) (bump features first, only relative to feature labels, then bump enzyme labels), turn lines on/off, turn coords on/off, turn enz counts on/off, dialog to change text formatting (font, points, color, bold, underline). 
#######################################################



### Android####################
# <<Terminating>> <<WillEnterBackground>> <<DidEnterBackground>> <<WillEnterForeground>> <<DidEnterForeground>>
# save files in internal backup on <<willenterbackground>>, save serailized canvas and text?; save window order (with backup files) on background; reload from backups; clear cache on startup

## save files (To external as default for new files, or where they reside for opened files)
## Rename file dialog
## move file: directory select with a "Select this one" at the top of the file hamburger menu
## file locations in preferences

## font size, tk scaling??

## color dialog
## textinput as number on all entries??

# <Key-Break>: return to parent for analysis, go to next window in the stackorder for sequences,  borg withdraw if only one in stackorder

# dialog- new_window proc?
# pinch on abi? button-1/ -3? y scale, pinch x-scale
# pinch on canvas- ORF_map, digest, linear_map, circular_map
# graphic map adjust  abi basecalls * tk_scaling

# file browser (open and save to SD card)

## color dialog raises the . window?
## feture edit box: set initial color of the boxes?
#################




## Silent sgRNA analysis
#show features
#all sgRNAs "DNGG"
#dropdown for 6 frames (CDS features)
#check box make restriction site with mutation
#click on sgRNAs, show sequence, show silent mutations that hit NGG, or 3bp within the next 8bp 



set info(android) [expr {![catch {sdltk android}]}]
#set info(android)  1

if {$info(android) && [catch {sdltk android}]} {
  ## define these to allow emulaitng android on other systems
  set env(EXTERNAL_STORAGE) [file join $env(HOME) "Desktop"]
  proc borg {args} {
   sputs borg: $args
  }
  proc sdltk {args} {
    sputs sdltk: $args
  }
}





#bug: feature anotations are wrong for a GG reaction with a fragment spanning the origin.

#bug abi_tooltip_post needs to deal with rev-com abi window and rev-com alignment
#cocoa bug: regexp >500 with a paren
#cocoa bug: wm deiconify doesn't activate
#cocoa bug: font configure labelfont, dnafont with an edit menu in a window?- delete the edit menu temporarily as workaround change_app_font_size
#cocoa bug: mouse events are sent to a lower window when a window first is mapped (color picker, for example)
#cocoa bug: shift ctrl characters are reported to menus and to bindings as the unshifted character
#https://github.com/tcltk/tk/tree/master/macosx

#golden gate- keep dialog open


#concat has a perfomace advantage over lappend - particularly sped up the abi rendering, could help elsewhere

#how to read some system defaults:
# exec defaults read "Apple Global Domain" AppleScrollBarVariant
# exec defaults read "Apple Global Domain" AppleShowScrollBars (Lion and later)

#multiple_digest- make each row with a menubutton containing all ladders and sequence files, delete image button (circle-x)- needs to turn on and off checkboxes depending on ladder or sequence, Action menu- add all open sequences, select all, duplicate row?, delete row?

# recombination tool- set width of menubuttons to be wider

# copy and copy-rc from abi trace window
# mousewheel on aa info

set info(suppress_output) 0

#multi digest- take out show percents, add column
# add cascade to all enzyme menus- Actions> Select All, Deselect All, Add New Enzyme Column, Do Partial Digests


set errorInfo ""

set errorCode ""


if {[string first "AppKit" [winfo server .] ] > -1} {
  set info(use_cocoa) 1
} else {
  set info(use_cocoa) 0
}



#to do:

#### infinite undo
# register unlink analysis windows in the undo stack- call unlink_analysis_window from register_undo_separator- add parameter to unlink_analysis_window to add the list of operations to the undo stack (doesn't do it for closing window)
# delete_text check for needing to delete the fn tag, test adding and deleting exons and edges of features (split and not split) on features through and not through the origin

## use get_feature_exons_indexes in place of fn tags- add f mark at the left side of the tags instead of fn tag- search for "get_feature_exons_indexes" and "f mark" to spot code that needs fixing


## fix alignment
#ok:   generate alignment score to decide to use fwd or reverse alignment
#ok:   circular alignments
#### alignment- add tag to accept or reject differences beween ref and aligned (bold w/ no background for rejected or accepted, red text with black background for unchecked). 
## Buttons to go to next or previous difference. Button to generate new sequence from accepted changes. 
## Use get seq and get tags like duplicate sequence to make a new sequence window, then go through all accepted changes and change the text. Change the feature extents for accepted indels.

# ok: feature_from_found- needs be converted into a dialog (add in to the find dialog) to get the name, type, colors and gformat, then pass this to the find dialog to add the feature instead of foundf and foundr (finds can be overlapping in the same orientation), can also pass this to feature_from_selection function to clean it up.

# theme editor- set default colors and gformats for types.


# bug: align forward/ best?






# cocoa printing: rewrite page_setup_dialog


# feature treeview- deal with enzyme features - show/hide, rightclick (find features?)- show as a tree (--- in the dir box, individual sites in the dropdown with actual site in the feature column, prototype in the type column), or show individuals each with an entry (dropdown- actual site in the feature column, prototype in the type column)
# ??: feature treeview- found highlighting features- show in treeview


## feature find mismatches


# search directory for sequence matches (AND, OR, NOT with multiple boxes)- return list of files to open
# add feature to library (single and multiple from list)

# com.apple.recentitems.plist to get recent items global value

##link canvas data: COMMENT image {base64 data} (jpg, gif, tiff)


# make feature library from genbank file (read file, parse, create_window separately


## primer library file- add status note to qualifiers (virtual, to order, on order, have, custom), [samples (multiple):quantity, conc, location]


## mismatch in feature definitions: postfix number indicating mismatches allowed in the previous range. "+" and "#" break ranges.

### do_find_mm needs find prev updating for wrapped lines.
## ok: add hide feature to popup menu
## ok: hide feature- make bg color transparent- linear draw, printing, save svg, save eps, copy wmf
## ok: save svg/eps- cascade menu on aqua
## ??: read gff3 file: ask for fasta or clipboard sequence
## ok: save keynote
## ok: graphic map- configure features, enzymes, circles/lines


## translate feature with right click or in edit.
## make new sequence from feature (right click, edit features)
## metafile export- make blank background centered on circle



#use raise/lower list for edit ladders, enzyme groups (see delete groups for dialog), edit feature library, see text map for example
# change the way ladders are stored in info array - store a number as info(current_ladder), store list of info(ladder_names) and list of info(ladder_bands), or maybe a dict of info(ladder_dict)
# edit ladders dialog- "Load more...", "Load New...", "Save As...", "Save As Default"

# edit library, edit features: do get_tags or store library list, do changes live, restore from stored copy on cancel
# change from mem array to mem list
# write a mover proc using mem array for drag and drop on these lists
# sort by size

# multi-gel digest window drag (digest_move_lane)
#   $modifier KeyPress to activate the plusarrow cursor


# graphic map
# make graphic map theme files (sets default values)

# features
# see above for list updates (mem)
# add arrow data to libraries and features
# add group data to features
# change find to use linear scan for exons (allows mismatch), find best combination of exons to generate feature (pick second exon, find next closest first and third, then closest fourth etc., until max mismatch is exceeded, find best combinations that use each exon.
# this should fix the bug that takes so long in regexp search for features in long texts


# next orf: highlight all.
# ORF start and stop uses codon table

# add features to translation window (above, below or none)

# features, enzyme sites, index line as boxdrawing characters in text map (and translation), or underline
# color feature text 


# copy special- uppercase only, cds only??

# shift select features to select range including feature (forward or reverse)
# feature list: live link to subranges
# shift select exons and introns on graphic map


#vista
#   cmd.exe /c echo %APPDATA%
#   registry get {HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders} {Appdata}


# install option on Windows- if not in program files and no user preferences
# xp shortcuts: http://ss64.com/nt/shortcut.html
#vista shortcuts: runas administrator mklink
#   Set oWS = WScript.CreateObject("WScript.Shell")
#   sLinkFile = "C:\Documents and Settings\Wayne\Desktop\sht.lnk"
#   Set oLink = oWS.CreateShortcut(sLinkFile)
#  
#   oLink.TargetPath = "C:\Program Files\ApE\ApE.exe"
#   '    oLink.Arguments = ""
#   '    oLink.Description = "MyProgram"
#   '    oLink.HotKey = "ALT+CTRL+F"
#   '    oLink.IconLocation = "C:\Program Files\MyApp\MyProgram.EXE, 2"
#   '    oLink.WindowStyle = "1"
#   '    oLink.WorkingDirectory = "C:\Program Files\MyApp"
#   oLink.Save
#exec CSCRIPT //H:CScript {C:\Documents and Settings\Wayne\Desktop\Document.vbs}
#install wizard pages- Intro, license, install location, file associations, shortcut on desktop/ shortcut in start menu, install

# file type associations (Xp, Vista??) http://ss64.com/nt/ftype.html
# uninstal option on all platforms
#need to set the HKLM\\Software\\Classes\\.ape, HKEY_LOCAL_MACHINE\\Software\\Classes\\ApE.DNA.file\\shell\\open\\command etc. OR HKEY_CURRENT_USER (needs admin privledge on Vista+ to write to HKLM, should go to HKCU. Add option to set for current user or machine.)



# select_region (also textarea_get, get_tags, put_tags, copy_tags?) needs to do bp2ix in the proc

# close all, close orphan analysis, dialog option to close all when quitting,

# delete all in selected region in abi files

# aa feature definitions

####bigger projects:
#project files: 
#  manage project files dialog: 
# file list: 
#     above each slot: filename of project; menu button: open project file,  open recent project file, save as, create new blank project file (save as dialog); open second project file (becomes close second after open)
#     below each slot: remove selected files; add folder to project file (folder dialog); add open file to project file (menu button); add file (file dialog)
#     select all, select none, toggle selected absolute directory references
#     between: copy (left and right), move (left and right)
# autosave project files while dialog open
# proc open_project_file
# project files: (1)magic number; folder fields; file fields; feature libraries, ladder files, enzyme files


#########need to update these to include graphic formatting:
##metadata here
#ok: adding features:   proc feature_scan {w} {
#ok: proc add_sel_feature_file {w} {
#ok: proc edit_feature_dialog {parent w feature} {
#ok: reading genbank:   proc feature_table_to_taglist {table {circular 0} {dna_length 0}} {
#ok: writing genbank:   proc genbank_text {w} {

##feature library
#>>proc read_feature_library {filename} {
#proc edit_feature_in_library {w feature_number} {
#proc save_feature_library {{filename ""}} {
#proc add_sel_feature_library {w} {

##link back to sequence metadata when edited in the graphic map
##set up a formatting file that contains default formatting and colors for features by type (fonts, flip offset?), enzymes by count (fonts, colors)
##apply/edit defaults in edit features
##apply defaults in edit configure graphic map
 
##############
# <<Metadata>> (1) dict: arrow_data (list: fwd, rev, flip), width, offset (show as symbol?, flip offset?)
#<<Metadata>>:(0)name, (1)format_info, (2)type, (3)fwd/rev, (4)annotations_string (qualifiers data)
#<<Revcolors>>: binding used for the color if the sequence is reversed
#file format(tab sep): (0)name (1)plain_text_def (2)type (3)fwd_color (4)rev_color (5)graphic_format (6)dna/prot search (7)annotations_string (qualifiers data)
#library list: (0)name (1)regexp_fwd(flanked by paren) (2)regexp_rev (3)preseq (4)postseq (5)plain_text_def (6)type (7)fwd_color (8)rev_color (9)graphic_format (10)dna/prot search (11)annotations_string (qualifiers data)
 ## use lindex 10 (previously bold) to search type (0=dna 1=protein)
#set info(feature_default_type_gformat)

# all popup menus have disabled line at top showing what is being edited
# right click on background to show/hide center label, center bp count, feature list, enzyme list, comment, unhide hidden features or enzymes
# right click on circle to configure width and color
# right click on any text to change color, point size, underline, bold, italic
# right click on enzyme texts adds show/hide index, show/hide count, show/hide line
# ctrl-right click on enz text applies changes to all of that enzyme, and adds hide all
# shift-right click on enzyme text applies to all enzyme texts, and adds hide all
# right click on feature text adds show/hide index, show/hide line, tick length, edit arrow points
# ctrl-right on feature text applies to all text of that feature type
# shift-right on feature text applies to all feature texts
# right click on feature to change width, show/hide label, configure arrow dialog, hide
# ctrl-right on feature applies to all of that feature type
# features can be dragged in and out, all texts can be dragged (with lines following them)

# <<metadata>> in enz_text: label, bp, count, color (dict used for %substitutions in labels, finding associated elements, <Leave> events)
# <<metadata>> in feature_text: label, bp_start, bp_end, feature_fg_color, text_color, (dict used for % substitution, unhiding, <Leave> events)
# ok: modifier-click move
# right-click to bring up edit text/ feature/ class dialog, include checkbox option to apply to all of type and all of class
# put show/hide items into main menu and popup menu- dialog with checkboxes for texts (center label, center bp count, feature list, enzyme list, comment), enzymes (list), features (list)
# ok: arrow redraw function that can be called for changing feature width, initial setup, arrow edits- sets coord values for both arrow polygons (and arrow_bg polygons)
# ok: tags: label, type (exon, intron, arrow_f, arrow_r, foreground, outline, feature_text, feature_text_line, feature_text_tick, enz_text, enz_text_line, enz_text_tick), 
# ok: use -state hidden rather than visible tag 
# make feature text line just point to nearest point on feature (change anchor point if feature text is inside arc)
# enzyme and feature label %substitutions (string map {%% % %l 200 %s 500} "d is %s %l%%")

# background color for texts
# circles (width, color, bg color): set radius of features circle relative to enz circle, boolean: flip rev features; tick circle; %GC circle; 



# use NCBI primer blast


# features unsupprewrite (see file for starting point) to tag each feature with group, so you can turn them on and off as sets
# new feature library from file (might be part of feature reorganization)

# dialog to change the gateway recombination reactions in drop down, include all known possibilities in software, still add on the user specified (or have a dialog to add new user specified)

# Modify start index in display (updates all output to add the start base in) use a modified ix2bp proc

# ok(see **): enzymes cut sites index, instead of site start. change the readenzymes proc (and addhexarray and delete_enzyme proc) to add 0 or 1 to the last character of the name in hexlist and longnme list. make a new array value that has the distance to the cut site for forward and reverse (using pat info). take the character off when extracting and save new element (a list as long as the sites list) in enzinfo that has the distance to the cut site.** check the distance to make sure it's still in the sequence. Distances will be updated by rescanning. **Use distance info in graphic map and in text map.
#may need to update save_enzymes- either take the direction info out (hexlist and longnames) when saving, or read a new format file in read_enzymes, and save the direction info.



set time0 [clock clicks -milliseconds]
if {$info(android)} {
  wm geometry . 1x1+0+0
} elseif {[tk windowingsystem] == "aqua"} {
  wm geometry . 1x1+0-10
  wm title . "ApE"
  wm withdraw .
} else {
  wm withdraw .
}

#if {[winfo exists .]} {
#  if {[tk windowingsystem] != "aqua"} {
#    wm withdraw .
#  } else {
#    wm geometry . 1x1+0+0
#  }
#}


if {0} {
proc bgerror {msg} {
  global errorInfo dialogblock my_debug
  sputs $errorInfo
  if {[tk windowingsystem] == "win32"} {
    set mail_program [registry get {HKEY_CURRENT_USER\Software\Clients\Mail} {}]
    if {![catch {set mail_command [registry get "HKEY_LOCAL_MACHINE\\Software\\Clients\\Mail\\$mail_program\\Protocols\\mailto\\shell\\open\\command" {}]}]} { 
      regsub "%1" $mail_command "" mail_command
      regsub -all {\\} $mail_command {\\\\} mail_command
    } else {
      set mail_command ""
    }
  } elseif {[tk windowingsystem] == "aqua"} {
    set mail_command "open"
  } else {
    set mail_command ""
  }
  if {($mail_command != "") && (![info exists my_debug])} {
    if {[tk_messageBox -message "Sorry, ApE has encountered an internal error.\nWould you like to email an error log to assist in preventing this problem in the future?\n(Include any info you can about what was happening at the time of the error)" -type yesno -default yes] =="yes"} {
      if {[catch {eval exec $mail_command {"mailto:wdavis@biology.utah.edu?subject=ApE error&body=$errorInfo"} &}]} {
        bgerror2 $msg
      }
    }
  } elseif {[info exists my_debug]} {
    console show
    set info(suppress_output) 0
  } else {
    tk_messageBox -message "Sorry, ApE has encountered an internal error.\n[string range $errorInfo 0 50]" -type ok
  }
  set dialogblock 0
  if {[ bind . <<RaiseDialogs>>] != {}} {bind . <<RaiseDialogs>> {}}  
}
}


proc canvas_test {} {
 toplevel .t
 grid [canvas .t.c -bg $info(graphic_bg_color)] -sticky nsew
  grid rowconfigure .t 0 -weight 1
  grid columnconfigure .t 0 -weight 1
}


package require msgcat
namespace import msgcat::mc
##set ::msgcat::Loclist to get a list of loaded locales
set needs_translation [list]
proc ::msgcat::mcunknown {args} {
  if {[llength $args] > 2} {
    if {[string first % $args] == -1} {
      sputs "msgcat error (too many args): $args"
      set text [lrange $args 1 end]
    } else {
      set text [format {*}[lrange $args 1 end]]
    }
  } else {
    set text [lindex $args 1]
  }
  set locale [lindex $args 0]
  global ::needs_translation
  if {[lsearch -exact $::needs_translation [lindex $args 1]] == -1} {
    lappend ::needs_translation [lindex $args 1]
  }
  return $text
}

############
## DNA edit window creator
############
proc create_window {{newdna ""} {filename ""} {filecomment ""} {circular linear} {methylated -1} {startindex 1} {title "New_DNA"} {tags ""} {genbank_header_list {}} {filetype "None"} {abi_data {}} {gformat_data {}} {seguid_data {}} {phred_string {}}} {
  global info
  global fea_info
  global winum
  global modifier modifier2
  global modstring tk_patchLevel
  global toolbar_images
  set reuse_startup 0

  if {($newdna == -1)} {
    if {$winum > 0} {
      #trying to open a blank startup window after a window is already open
      return 
    } else {
      set newdna ""
    }
  } else {
    if {[winfo exists .dna_window0] && (![winfo exists .dna_window0.comframe.comtextframe.text] || [.dna_window0.comframe.comtextframe.text get 1.0 end-1char] == "") && (![winfo exists .dna_window0.textarea] || [.dna_window0.textarea get 1.0 end-1char] == "") && ([info exists info(.dna_window0,saved)]) &&($info(.dna_window0,saved) == 1) && ($info(.dna_window0,filename) == "")} {
      #first window is still blank - reuse it
      set reuse_startup 1
    }
    incr winum
  }
  
  if {[tk windowingsystem] == "aqua"} {
    wm withdraw .
  }
  
  set w .dna_window$winum

  set info($w,saved) 0
# variables refering to the DNA
  set info($w,startindex) $startindex
  if {$genbank_header_list != [list]} {
    set info($w,genbank_header_list) $genbank_header_list
  } else {
    set info($w,genbank_header_list) $info(empty_genbank_header)
  }
  set info($w,linked_abi_list) $abi_data
  set info($w,gformat_data) $gformat_data
  
  if {$circular eq "circular" || $circular eq "circular_RNA"} {
    set info($w,circular) "circular"
  } else {
    set info($w,circular) "linear"
  }
  if {$circular eq "RNA" || $circular eq "circular_RNA"} {
    set info($w,mol_type) "RNA"
  } else {
    set info($w,mol_type) "DNA"
  }

  if {$methylated > -1} {
    set info($w,Dam_Dcm_methylated) $methylated
  } else {
    set info($w,Dam_Dcm_methylated) $info(methylated_default)
  }

  ## to do: should check that the sguid is valid here

  if {[dict exists $seguid_data stored_seguid]} {
     set info($w,SEGUID) [dict get $seguid_data stored_seguid]
     if {$info($w,SEGUID) ne [calculate_seguid [string toupper $newdna] [expr {$info($w,circular)== "circular"}]]} {
     sputs seguid $info($w,SEGUID) [calculate_seguid [string toupper $newdna] [expr {$info($w,circular)== "circular"}]]
       tk_messageBox  -message [mc "The stored (I/c)dseguid data is invalid. The (I/c)dseguid should be reset to a correct value."] -type ok
     }
  } else {
    set info($w,SEGUID) {}
  }

  set info($w,phred_string) $phred_string

  set info($w,filename) $filename
  set info($w,filetype) $filetype


  if {$title == "New_DNA"} {set title [mc $title]}
  set dnatitles_list [list]
  foreach element [dnawindows_list] {
    lappend dnatitles_list [wm title $element]
  }
  if {[lsearch -exact $dnatitles_list $title] > -1 } {
    set i 1
    while {[lsearch -exact $dnatitles_list "$title\($i\)"] > -1 } {incr i}
    set title "$title\($i\)"
  }

set info($w,locked) 0
toplevel $w 

if {[tk windowingsystem] == "aqua"} {
  #::tk::unsupported::MacWindowStyle style $w document {closeBox collapseBox horizontalZoom unifiedTitleAndToolbar resizable liveResize toolbarButton}
   #::tk::unsupported::MacWindowStyle style $w document {closeBox collapseBox horizontalZoom resizable liveResize toolbarButton}; #this one worked until the toolbar button was removed
  # ::tk::unsupported::MacWindowStyle style $w simple {noTitleBar};#to add unified menu - needs to define the file menu and the close, colapse and zoom buttons, resize handle, and the toolbar button 
  after 50 "catch \"tk::unsupported::MacWindowStyle tabbingid $w $w\""
}

wm title $w $title

set info($w,insert_loc) ""
set info($w,sel_start) ""
set info($w,sel_end) ""
set info($w,sel_start2) ""
set info($w,sel_end2) ""

wm protocol $w WM_DELETE_WINDOW "if {!\$dialogblock} {closewindow $w}"

if {!$info(use_cocoa)} {
  set bugdelay 1
} else {
  set bugdelay 1
}

menu $w.menubar


#define file menu
menu  $w.menubar.filemenu 
$w.menubar add cascade -menu $w.menubar.filemenu -label [mc "File"] -underline 0
$w.menubar.filemenu add command -label [mc "New"] -accelerator "$modstring+N" -command "create_window"
$w.menubar.filemenu add command -label [mc "Open..."] -accelerator "$modstring+O"  -command "open_file_dialog"
menu $w.menubar.filemenu.open_previous
$w.menubar.filemenu add cascade -label [mc "Open Recent Files"] -menu $w.menubar.filemenu.open_previous
$w.menubar.filemenu add command -label [mc "Duplicate Selection"]  -accelerator "$modstring+D"  -command "duplicate_window $w selection" 
$w.menubar.filemenu add command -label [mc "Duplicate Full Sequence"]  -accelerator "$modstring+Shift+D"  -command "duplicate_window $w all"
$w.menubar.filemenu add command -label [mc "Close"] -accelerator "$modstring+W" -command "closewindow $w"
$w.menubar.filemenu add separator
$w.menubar.filemenu add command -label [mc "Save"]  -accelerator "$modstring+S" -command "save_file $w Save"
$w.menubar.filemenu add command -label [mc "Save As..."]  -accelerator "$modstring+Shift+S" -command "save_file $w Save_as"
$w.menubar.filemenu add separator
$w.menubar.filemenu add command -label [mc "Print..."] -accelerator "$modstring+P" -command  "sputs print menu; print_textarea $w.textarea"
$w.menubar.filemenu add command -label [mc "Export as PDF..."] -accelerator "$modstring+P" -command  "sputs print menu; textarea_export $w.textarea"
$w.menubar.filemenu add separator
menu $w.menubar.filemenu.pieces_menu -postcommand "file_pieces_open_and_insert_postcommand $w $w.menubar.filemenu.pieces_menu"
$w.menubar.filemenu  add cascade -menu $w.menubar.filemenu.pieces_menu  -label [mc "Insert Piece"]
$w.menubar.filemenu add separator
menu $w.menubar.filemenu.cloud_access
$w.menubar.filemenu add cascade -label [mc "Access Cloud Services"] -menu $w.menubar.filemenu.cloud_access
  menu $w.menubar.filemenu.cloud_access.labarchives
  $w.menubar.filemenu.cloud_access add cascade -label [mc "LabArchives"] -menu $w.menubar.filemenu.cloud_access.labarchives
  $w.menubar.filemenu.cloud_access.labarchives add command -label [mc "Upload Open Files To LabArchives"] -command "labarchive_upload_dialog $w"
  $w.menubar.filemenu.cloud_access.labarchives add command -label [mc "Download Files From LabArchives"] -command "labarchive_download_dialog $w"


#exit is added below in the platform specific code

#define edit menu
menu  $w.menubar.edit  
$w.menubar add cascade -menu $w.menubar.edit  -label [mc "Edit "] -underline 0
$w.menubar.edit  add command -label [mc "Undo"] -state disabled -accelerator "$modstring+Z" -command "undo $w"
bind $w.menubar.edit <<undostate>> disabled
bind $w.menubar.edit <<undolabel>> [mc "Undo"]
$w.menubar.edit  add command -label [mc "Redo"] -state disabled -accelerator "$modstring+Shift+Z" -command "undo $w 0"
bind $w.menubar.edit <<redostate>> disabled
bind $w.menubar.edit <<redolabel>> [mc "Redo"]
$w.menubar.edit  add command -label [mc "Cut"]  -accelerator "$modstring+X" -command "clip_cut_copy $w cut"
$w.menubar.edit  add command -label [mc "Copy"]  -accelerator "$modstring+C" -command "clip_cut_copy $w copy"
$w.menubar.edit  add command -label [mc "Paste"]  -accelerator "$modstring+V" -command "clip_paste $w"
$w.menubar.edit  add separator
$w.menubar.edit  add command -label [mc "Cut Rev-Com"]  -accelerator "$modstring+Shift+X" -command "clip_cut_copy $w cut rev-com"
$w.menubar.edit  add command -label [mc "Copy Rev-Com"]  -accelerator "$modstring+Shift+C" -command "clip_cut_copy $w copy rev-com"
$w.menubar.edit  add command -label [mc "Paste Rev-Com"]  -accelerator "$modstring+Shift+V" -command "clip_paste $w rev-com"
$w.menubar.edit  add separator
  menu $w.menubar.edit.copy_special -postcommand "update_copy_features_menu $w"
  $w.menubar.edit  add cascade -menu $w.menubar.edit.copy_special -label [mc "Copy Special"]
  $w.menubar.edit.copy_special add command -label [mc "Copy All as GenBank"] -accelerator "$modstring+B" -command "clipboard clear;clipboard_append -displayof $w \[genbank_text $w\]"
  #$w.menubar.edit.copy_special add separator
  #$w.menubar.edit.copy_special add command -label [mc "Copy All But Selected"] -command "clip_copy_special $w all_but_selected"
  #$w.menubar.edit.copy_special add command -label [mc "Copy All But Selected Rev-Com"] -command "clip_copy_special $w all_but_selected"
  $w.menubar.edit.copy_special add separator
  $w.menubar.edit.copy_special add command -label [mc "Copy Uppercase"] -command "clip_copy_special $w upper"
  $w.menubar.edit.copy_special add command -label [mc "Copy Uppercase Rev-Com"] -command "clip_copy_special $w upper rev_com"
  $w.menubar.edit.copy_special add separator
  $w.menubar.edit.copy_special add command -label [mc "Copy Translated"] -command "clip_copy_special $w translated"
  $w.menubar.edit.copy_special add command -label [mc "Copy Uppercase Translated"] -command "clip_copy_special $w translated_uc"
  $w.menubar.edit.copy_special add command -label [mc "Copy Translated Rev-Com"] -command "clip_copy_special $w translated rev_com"
  $w.menubar.edit.copy_special add command -label [mc "Copy Uppercase Translated Rev-Com"] -command "clip_copy_special $w translated_uc rev_com"
  $w.menubar.edit.copy_special add separator
  $w.menubar.edit.copy_special add command -label [mc "Copy as FASTA"] -command "clip_copy_special $w fasta"
  $w.menubar.edit.copy_special add separator
  $w.menubar.edit.copy_special add command -label [mc "Copy as RNA"] -command "clip_copy_special $w rna"
  $w.menubar.edit.copy_special add separator
  $w.menubar.edit.copy_special add command -label [mc "Copy Reverse (NOT A GOOD IDEA)"] -command "clip_copy_special $w reverse"
  $w.menubar.edit.copy_special add command -label [mc "Copy Complement (NOT A GOOD IDEA)"] -command "clip_copy_special $w complement"
  $w.menubar.edit.copy_special add separator
  $w.menubar.edit.copy_special add command -label [mc "Copy Features as NCBI Bankit table"] -command "clipboard clear;clipboard_append -displayof $w \[bankit_text $w\]"
$w.menubar.edit  add separator
if {[tk windowingsystem] != "aqua"} {
  $w.menubar.edit  add command -label [mc "Preferences..."]  -command "configure_preferences $w"  -accelerator "$modstring+,"
  $w.menubar.edit  add separator
}

$w.menubar.edit  add command -label [mc "Select All"]  -accelerator "$modstring+A" -command "select_all $w"
$w.menubar.edit  add command -label [mc "Select From-To..."]  -accelerator "$modstring+Shift+A" -command "after $bugdelay select_from_to $w"
$w.menubar.edit  add command -label [mc "Jump To..."]  -accelerator "$modstring+J" -command "after $bugdelay jump_to $w"
$w.menubar.edit  add separator
$w.menubar.edit  add command -label [mc "Find..."]  -accelerator "$modstring+F" -command "after $bugdelay find_dialog $w"
$w.menubar.edit  add command -label [mc "Find Again"]  -accelerator "$modstring+G" -command "do_find $w again"
$w.menubar.edit  add command -label [mc "Clear Find Highlighting"] -accelerator "$modstring+Shift+F" -command "clear_find_highlight $w"
$w.menubar.edit  add separator
$w.menubar.edit  add command -label [mc "Convert to UPPERCASE"]  -accelerator "$modstring++" -command "change_case $w upper"
$w.menubar.edit  add command -label [mc "Convert to lowercase"]  -accelerator "$modstring+-" -command "change_case $w lower"
$w.menubar.edit  add command -label [mc "UPPER<->lower"] -accelerator "$modstring+=" -command "change_case $w exchange"
$w.menubar.edit  add separator
$w.menubar.edit  add command -label [mc "Reverse-Complement"]  -accelerator "$modstring+/" -command "rev_com_window $w"
$w.menubar.edit  add separator
$w.menubar.edit  add command -label [mc "Circular<->Linear"] -command "toggle_circ $w"
$w.menubar.edit  add command -label [mc "Set Origin"]  -accelerator "$modstring+I" -command "set_origin $w"
$w.menubar.edit  add command -label [mc "Linearize @ insert site"] -command "linearize $w"


#add enzymes menu
menu  $w.menubar.enzymes
$w.menubar add cascade -menu $w.menubar.enzymes -label [mc "Enzymes"] -underline 1
$w.menubar.enzymes add command -label [mc "Enzyme Selector..."] -accelerator "$modstring+E" -command "after $bugdelay enzyme_selection_dialog $w"
$w.menubar.enzymes add separator
$w.menubar.enzymes add checkbutton -label [mc "Selection Only"] -accelerator "$modstring+Shift+E" -onvalue "selection" -offvalue "all" -variable info(analyze_selection)

$w.menubar.enzymes add separator
$w.menubar.enzymes add command -label [mc "Graphic Map"] -accelerator "$modstring+Y" -command "after $bugdelay enz_graphic_map $w"
$w.menubar.enzymes add command -label [mc "Graphic Map +U"] -accelerator "$modstring+Shift+Y" -command "after $bugdelay enz_graphic_map $w {==1}"
$w.menubar.enzymes add separator
$w.menubar.enzymes add command -label [mc "Highlight"] -command "highlight_enzymes $w \$info(enz_currently_selected)";#uses selected
$w.menubar.enzymes add command -label [mc "Clear Highlighting"] -command "highlight_enzymes_clear $w"
$w.menubar.enzymes add separator
$w.menubar.enzymes add command -label [mc "Digestion"] -accelerator "$modstring+R" -command "after $bugdelay {enz_digest $w \$info(enz_currently_selected) \$info(analyze_selection)}"
#$w.menubar.enzymes add command -label [mc "Partial Digestion..."] -accelerator "$modstring+Shift+R" -command "after $bugdelay enz_digest_partial_dialog $w"
$w.menubar.enzymes add command -label [mc "Digestion Dialog..."] -accelerator "$modstring+Shift+R" -command "after $bugdelay enz_digest_dialog2 $w"
$w.menubar.enzymes add cascade -label [mc "Ladder"] -menu [menu $w.menubar.enzymes.ladders]
$w.menubar.enzymes add separator
$w.menubar.enzymes add command -label [mc "List Enzymes..."] -command "after $bugdelay list_enzymes_dialog $w"
menu $w.menubar.enzymes.lists
  $w.menubar.enzymes.lists add command -label [mc "Site Usage"] -command "after $bugdelay findenzymes $w; list_enzymes_window $w 1 all"
  $w.menubar.enzymes.lists add command -label [mc "Unique Sites"] -command "after $bugdelay findenzymes $w; list_enzymes_window $w 0 unique"
  $w.menubar.enzymes.lists add command -label [mc "Absent Sites"] -command "after $bugdelay findenzymes $w; list_enzymes_window $w 0 absent"
$w.menubar.enzymes add cascade -label [mc "Quick Lists"] -menu $w.menubar.enzymes.lists
$w.menubar.enzymes add separator
  menu  $w.menubar.enzymes.insert_re  -postcommand "insert_enzyme_fill_cascade $w $w.menubar.enzymes.insert_re"
$w.menubar.enzymes add cascade -label [mc "Insert Restriction Enzyme Recognition Sequence..."] -menu $w.menubar.enzymes.insert_re
$w.menubar.enzymes add separator 
$w.menubar.enzymes add command -label [mc "Silent Sites"]  -command "after $bugdelay {silent_sites $w \$info(enz_currently_selected)}"
  $w.menubar.enzymes add command -label [mc "Find Diagnostic Site"]  -command "after $bugdelay {add_daignostic_site_dialog $w}"
$w.menubar.enzymes add separator
$w.menubar.enzymes add command -label [mc "Text Map..."] -accelerator "$modstring+Shift+T" -command "after $bugdelay enz_text_map $w"

#add ORFs menu
menu  $w.menubar.orf
$w.menubar add cascade -menu $w.menubar.orf -label [mc "ORFs"] -underline 0
  $w.menubar.orf add command -label [mc "Find Next"] -accelerator "$modstring+>" -command "next_ORF $w forward"
  $w.menubar.orf add command -label [mc "Find Previous"] -accelerator "$modstring+<" -command "next_ORF $w reverse"
  #$w.menubar.orf add command  -label [mc "Highlight all"] -command "next_ORF $w all"
  menu $w.menubar.orf.start
  $w.menubar.orf add cascade -menu $w.menubar.orf.start -label [mc "ORF Starts With"]
    $w.menubar.orf.start add radiobutton -label [mc "Met"] -variable info(find_orf_starts) -value "Met"
    $w.menubar.orf.start add radiobutton -label [mc "Stop+1"] -variable info(find_orf_starts) -value "Stop+1"
  menu $w.menubar.orf.search_strand
  $w.menubar.orf add cascade -menu $w.menubar.orf.search_strand -label [mc "Search Strand"]
    $w.menubar.orf.search_strand add radiobutton -label [mc "Top"] -variable info(find_orf_strand) -value 1  -command "set info(find_orf_strand_text) [mc Top]"
    $w.menubar.orf.search_strand add radiobutton -label [mc "Bottom"] -variable info(find_orf_strand) -value -1  -command "set info(find_orf_strand_text) [mc Bottom]"
    $w.menubar.orf.search_strand add radiobutton -label [mc "Both"] -variable info(find_orf_strand) -value 0  -command "set info(find_orf_strand_text) [mc Both]"
  menu $w.menubar.orf.min_orf
    foreach min [list 0 30 60 90 180 300 600 900 1200 1500] {
      $w.menubar.orf.min_orf add radiobutton -label $min -variable info(find_orf_min) -value $min
    }
  $w.menubar.orf add cascade -menu $w.menubar.orf.min_orf -label [mc "Minimum bp"]
  $w.menubar.orf add separator
  $w.menubar.orf add command -label [mc "Translate..."] -accelerator "$modstring+T" -command "after $bugdelay translation_window $w"
  $w.menubar.orf add separator
  $w.menubar.orf add command -label [mc "ORF map"] -command "after $bugdelay orf_map $w \$info(analyze_selection)"
  $w.menubar.orf add separator
    menu $w.menubar.orf.selection_translate_dir
      $w.menubar.orf.selection_translate_dir add radiobutton -label [mc "Forward"] -variable info($w,selection_shows_Trans_dir) -value 0 -command "selection_manager $w"
      $w.menubar.orf.selection_translate_dir add radiobutton -label [mc "Reverse"] -variable info($w,selection_shows_Trans_dir) -value 1 -command "selection_manager $w"
      set info($w,selection_shows_Trans_dir) $info(selection_shows_Trans_dir)
      set info($w,selection_shows_Trans_upper) $info(selection_shows_Trans_upper)
      set info($w,selection_Trans_rev) ""
      set info($w,selection_Trans) ""
  #$w.menubar.orf add checkbutton -label [mc "Selection Translate"] -variable info(selection_shows_Trans) -onvalue 1 -offvalue 0 -command "selection_manager $w"
  $w.menubar.orf add checkbutton -label [mc "Selection Translate"] -variable info($w,selection_shows_Trans) -onvalue 1 -offvalue 0 -command "if {\$info($w,selection_shows_Trans)} {grid propagate $w.infoframe 1; grid configure $w.infoframe.trans;update idletasks; grid propagate $w.infoframe 0; selection_manager $w} else {grid propagate $w.infoframe 1; grid remove $w.infoframe.trans;update idletasks; grid propagate $w.infoframe 0}"
  $w.menubar.orf add cascade -label [mc "Selection Translate Direction"]  -menu $w.menubar.orf.selection_translate_dir
  $w.menubar.orf add checkbutton -label [mc "Selection Translate Uppercase ONLY"] -variable info($w,selection_shows_Trans_upper) -onvalue 1 -offvalue 0 -command "selection_manager $w"

  set info($w,selection_shows_Trans) $info(selection_shows_Trans)
  #$w.menubar.orf add command -label [mc "Codon Usage"] -state disabled
  #$w.menubar.orf add command -label [mc "Compare Codon Bias" ] -state disabled
  #$w.menubar.orf add command -label [mc "Open Codon Bias Table"] -state disabled
  #$w.menubar.orf add separator

#add features menu
menu  $w.menubar.features
$w.menubar add cascade -menu $w.menubar.features -label [mc "Features"] -underline 2
  $w.menubar.features add command -label [mc "New Feature..."] -accelerator "$modstring+." -command "add_sel_feature_file_dialog $w"
  $w.menubar.features add command -label [mc "List Features"] -command "after $bugdelay list_features $w"
  #$w.menubar.features add command -label [mc "Edit Features..."] -command "after $bugdelay configure_features $w"
  $w.menubar.features add command -label [mc "Edit Features..."] -command "after $bugdelay  \{grid configure $w.tvframe; grid configure $w.tvframe.buttons\}"
  $w.menubar.features add command -label [mc "Clear Features"] -accelerator "$modstring+Shift+K" -command "feature_clear $w"
  #$w.menubar.features add command -label [mc "Edit Feature Color Favorites"] -command "edit_color_favorites $w"
  $w.menubar.features add command -label [mc "Restack Features by Length"] -command "restack_features $w"
  $w.menubar.features add command -label [mc "Adjust Feature Colors for Readability"] -command  "features_adjust_color_dialog $w"
  $w.menubar.features add separator
  menu $w.menubar.features.annotate_menu -postcommand "feature_library_open_and_annotate_postcommand $w $w.menubar.features.annotate_menu"
  $w.menubar.features add cascade -label [mc "Open Feature Library and Annotate"]  -menu $w.menubar.features.annotate_menu
  $w.menubar.features add command -label [mc "Edit Feature Library..."] -command "after $bugdelay edit_feature_library $w"
  $w.menubar.features add command -label [mc "New Feature in Library..."] -command "after $bugdelay add_sel_feature_library $w"
  $w.menubar.features add command -label [mc "Open Feature Library..."] -command "after $bugdelay {open_feature_library \{\} new 1}"
  $w.menubar.features add command -label [mc "Annotate Features Using Current Library"] -accelerator "$modstring+K" -command "feature_scan $w"
  $w.menubar.features add separator
  $w.menubar.features add checkbutton -label [mc "Show X-Ray Window"] -variable info($w,seq_tooltip) -onvalue 1 -offvalue 0 -accelerator "Space"
  $w.menubar.features add separator
  $w.menubar.features add command -label [mc "Annotate Features Using FASTA Search File..."] -command "multi_search_dialog $w"
  $w.menubar.features add separator
  $w.menubar.features add command -label [mc "New Features From Found Highlighting"] -accelerator "$modstring+Shift+G" -command "feature_from_found $w"
  $w.menubar.features add separator
  $w.menubar.features add command -label [mc "Add Features from GFF3 file..."] -command "add_gff_annotations $w"


#add Tools menu
menu  $w.menubar.tools
$w.menubar add cascade -menu $w.menubar.tools -label [mc "Tools"] -underline 0
  $w.menubar.tools add command -label [mc "Align Sequences..."] -accelerator "$modstring+L" -command "after $bugdelay align_dialog2 $w"
  #$w.menubar.tools add command -label [mc "Align Two Sequences..."] -accelerator "$modstring+Shift+L" -command "after $bugdelay align_dialog $w"
  $w.menubar.tools add separator
  $w.menubar.tools add command -label [mc "Restriction-Ligation Assembler..."] -accelerator "" -command "after $bugdelay re_cloning_wizard_dialog $w"
  $w.menubar.tools add separator
  $w.menubar.tools add command -label [mc "Recombination Assembler..."] -accelerator "" -command "after $bugdelay recombination_window $w"
  $w.menubar.tools add command -label [mc "Recombination Reaction Editor..."] -accelerator "" -command "after $bugdelay recomb_dialog $w"
  $w.menubar.tools add separator
  #$w.menubar.tools add command -label [mc "Gibson Reaction"] -command "after $bugdelay gibson_dialog $w"
  $w.menubar.tools add command -label [mc "Gibson Designer..."] -command "after $bugdelay gibson_wizard_dialog $w"
  $w.menubar.tools add separator
$w.menubar.tools add command -label [mc "PCR"] -command "after $bugdelay pcr_dialog $w"
  $w.menubar.tools add command -label [mc "Find PCR Primers..."] -command "after $bugdelay primer_window $w"
  $w.menubar.tools add separator
  $w.menubar.tools add command -label [mc "Golden Gate Designer..."] -command "after $bugdelay gg_wizard_dialog $w"
  $w.menubar.tools add command -label [mc "Golden Gate Assembler..."] -command "after $bugdelay golden_gate_dialog $w"
  #$w.menubar.tools add command -label [mc "Reverse Golden Gate Reaction"] -command "after $bugdelay reverse_golden_gate_dialog $w"
  $w.menubar.tools add separator
  $w.menubar.tools add command -label [mc "dCAPS Calculator..."] -command "after $bugdelay dcaps_dialog $w"
  $w.menubar.tools add separator
  $w.menubar.tools add command -label [mc "Calculator..."] -accelerator "$modstring+1" -command "calc" 
  $w.menubar.tools add command -label [mc "Molecular Reaction Calculator..."] -accelerator "$modstring+2" -command "mol_calc" 
  $w.menubar.tools add separator
  $w.menubar.tools add command -label [mc "BLAST Sequences At NCBI..."] -accelerator "$modstring+Shift+B" -command "after $bugdelay NCBI_Blast $w"
 # $w.menubar.tools add command -label [mc "BLAST Sequences At Wormbase..."] -command "Wormbase_Blast $w"
  $w.menubar.tools add command -label [mc "Download Sequences From NCBI..."] -command "after $bugdelay entrez_dialog $w"
  $w.menubar.tools add separator
  $w.menubar.tools add command -label [mc "Random Palette Generator"] -command "after $bugdelay palette_test $w"
  $w.menubar.tools add separator
  $w.menubar.tools add command -label [mc "sgRNA Analysis"] -command "after $bugdelay sg_RNA_analysis $w" 
  $w.menubar.tools add separator
  $w.menubar.tools add command -label [mc "Insert Repeat Sequence..."] -command "after $bugdelay insert_repeat $w"
  $w.menubar.tools add separator
  $w.menubar.tools add command -label [mc "Multi-Cre Recombination..."] -command "after $bugdelay lox_recombination_window $w" 
  $w.menubar.tools add separator
  $w.menubar.tools add command -label [mc "Digest All Open Windows"] -command "after $bugdelay digest_open_windows"
  if  {[tk windowingsystem] == "aqua" || ([info commands snack::sound] != {})} {
    $w.menubar.tools add separator
    $w.menubar.tools add command -label [mc "Start/Stop Speak Text..."] -accelerator "" -command "after $bugdelay speak_dialog $w"
  }



if {!$info(android)} {
  #add Windows menu stub (menu items are maintained by update_windows_menu procedure)
  if {$info(use_aqua_system_windows_menu) && [tk windowingsystem] == "aqua"} {
    ## aqua system windows menu
    menu $w.menubar.view
    $w.menubar add cascade -menu $w.menubar.view -label [mc "View"] -underline 0
    menu  $w.menubar.view.darkmodemenu
     $w.menubar.view.darkmodemenu add radiobutton -label [mc "Dark Mode"] -variable info(user_set_dark_mode) -value 1 -command "darkmode_set -1"
     $w.menubar.view.darkmodemenu add radiobutton -label [mc "Light Mode"] -variable info(user_set_dark_mode) -value 0 -command "darkmode_set -1"
     if { [bind . <<DarkAqua>> ] ne {} } {
       $w.menubar.view.darkmodemenu add radiobutton -label [mc "Match System Mode"] -variable info(user_set_dark_mode) -value -1 -command "darkmode_set -1"
     }
     $w.menubar.view add cascade -label [mc "Dark Mode"] -menu  $w.menubar.view.darkmodemenu
     $w.menubar.view add separator

    menu $w.menubar.window
    $w.menubar add cascade -menu $w.menubar.window -label [mc "Window"]
  } else {
   ## Standard ApE windows menu
    menu $w.menubar.windows 
      $w.menubar add cascade -menu $w.menubar.windows -label [mc "Window"] -underline 0
  }
} else {
  ## Android windows menu
  menu $w.windowsmenu
}
if {[catch {update_windows_menu} err]} {tk_messageBox  -message "windows menu: $err"}
if {[catch {update_open_previous_menu} err]} {tk_messageBox  -message "open previous: $err"}
if {[catch {update_ladders_menu $w} err]} {tk_messageBox  -message "ladders menu: $err"}



set popupmenu [menu $w.popupmenu]
$popupmenu add command -label [mc "Cut"]  -accelerator "$modstring+X" -command "clip_cut_copy $w cut"
$popupmenu add command -label [mc "Copy"]  -accelerator "$modstring+C" -command "clip_cut_copy $w copy"
$popupmenu add command -label [mc "Paste"]  -accelerator "$modstring+V" -command "clip_paste $w"
$popupmenu add separator
$popupmenu add command -label [mc "Cut Rev-Com"]  -accelerator "$modstring+Shift+X" -command "clip_cut_copy $w cut rev-com"
$popupmenu add command -label [mc "Copy Rev-Com"]  -accelerator "$modstring+Shift+C" -command "clip_cut_copy $w copy rev-com"
$popupmenu add command -label [mc "Paste Rev-Com"]  -accelerator "$modstring+Shift+V" -command "clip_paste $w rev-com"
$popupmenu add separator
$popupmenu add command -label [mc "Find..."]  -accelerator "$modstring+F" -command "find_dialog $w"
$popupmenu add command -label [mc "Reverse-Complement"]  -accelerator "$modstring+/" -command "rev_com_window $w"
$popupmenu add separator
$popupmenu add command -label [mc "Graphic Map +U"] -accelerator "$modstring+Shift+Y" -command "enz_graphic_map $w {==1}"
$popupmenu add separator
$popupmenu add command -label [mc "New Feature..."] -command "add_sel_feature_file_dialog $w"
menu $popupmenu.edit_feature
$popupmenu add cascade -label [mc "Edit Feature"] -menu $popupmenu.edit_feature -state disabled
menu $popupmenu.hide_feature
$popupmenu add cascade -label [mc "Arrange Feature"] -menu $popupmenu.arrange_feature -state normal
menu $popupmenu.arrange_feature
menu $popupmenu.arrange_feature.raise
menu $popupmenu.arrange_feature.lower
$popupmenu.arrange_feature add cascade -label [mc "Raise Feature"] -menu $popupmenu.arrange_feature.raise
$popupmenu.arrange_feature add cascade -label [mc "Lower Feature"] -menu $popupmenu.arrange_feature.lower

$popupmenu add cascade -label [mc "Hide Feature"] -menu $popupmenu.hide_feature -state disabled
menu $popupmenu.delete_feature
$popupmenu add cascade -label [mc "Delete Feature"] -menu $popupmenu.delete_feature -state disabled
menu $popupmenu.copy_feature
$popupmenu add cascade -label [mc "Copy Feature"] -menu $popupmenu.copy_feature -state disabled
if {[tk windowingsystem] != "aqua" } {
  $popupmenu add separator
  $popupmenu add cascade -label [mc "Text Font Size"] -menu $popupmenu.font_size
  menu $popupmenu.font_size
  foreach fontsize [lsort -unique -integer [concat [list 8 9 10 11 12 13 14 16 18 20 24 28 32 36 40] $info(dnafontsize)]] {
      $popupmenu.font_size add radiobutton -label $fontsize -indicatoron 1 -value $fontsize -variable info(dnafontsize) -command "change_app_font_size \$info(dnafontsize)"
    }
}
$popupmenu add separator
$popupmenu add command -label [mc "BLAST Sequences at NCBI..."] -accelerator "$modstring+B" -command "NCBI_Blast $w"
#$popupmenu add command -label [mc "BLAST Sequences at Wormbase..."] -command "Wormbase_Blast $w"


#add Help menu
menu  $w.menubar.help 
  $w.menubar add cascade -menu $w.menubar.help -label [mc "Help"] -underline 0

  $w.menubar.help add command -label [mc "Standard Genetic Code"] -command "genetic_code_dialog $w"
  $w.menubar.help add command -label [mc "Amino Acid Info"] -command "aa_info_dialog $w"


  #add windows/Aqua specific items
  if {[tk windowingsystem] != "aqua" && !$info(android)} {
    #Exit is automatically on the apple menu in Aqua
    $w.menubar.filemenu add separator
    $w.menubar.filemenu add command -label [mc "Exit"] -accelerator "$modstring+Q" -command exit

    #About... goes on the apple menu in aqua
    $w.menubar.help add separator
    $w.menubar.help add command -label [mc "About ApE..."] -command "about_dialog $w"
    #$w.menubar.help add command -label [mc "Check for Updates"] -command "web_version_check 1"


  } elseif {[tk windowingsystem] == "aqua"} {
    #define the apple menu
    if {!$info(use_cocoa)} {
      menu $w.menubar.apple 
      $w.menubar add cascade -menu $w.menubar.apple
      $w.menubar.apple add command -label [mc "About ApE"] -command "about_dialog $w"
      $w.menubar.apple add separator
      #$w.menubar.apple add command -label [mc "Preferences..."]  -command "configure_preferences $w" -accelerator "$modstring+,"
    }

    #catch {.menubar.filemenu entryconfigure [mc "New"] -state disabled}
    #catch {.menubar.filemenu entryconfigure [mc "Open..."] -state disabled}
   # catch { .menubar.filemenu entryconfigure [mc "Open Recent Files"] -state disabled}
    #.menubar.apple entryconfigure [mc "Preferences..."] -state disabled
   # catch {.menubar.apple entryconfigure [mc "About ApE"] -state disabled}
    #bind . <Command-KeyPress-o> ""
    #bind . <Command-KeyPress-n> ""
    #bind . <Command-KeyPress-q> ""

    ##set the new window coordinates
    wm geometry $w "+$info(newaquax)+$info(newaquay)"
    incr info(newaquax) 20
    incr info(newaquay) 20
    if {$info(newaquax) > 100} {set info(newaquax) 20}
    if {$info(newaquay) > 100} {set info(newaquay) 20}
  }

    #add menu icons
    set iconlist [list $w.menubar.filemenu [mc New] new $w.menubar.filemenu [mc Open...] open $w.menubar.filemenu [mc Save] save $w.menubar.edit  [mc "Cut"] cut $w.menubar.edit  [mc "Copy"] copy $w.menubar.edit  [mc "Paste"] paste $w.menubar.edit  [mc "Cut Rev-Com"] cut $w.menubar.edit  [mc "Copy Rev-Com"] copy $w.menubar.edit  [mc "Paste Rev-Com"] paste $w.menubar.edit  [mc "Select From-To..."] select $w.menubar.edit  [mc "Jump To..."] jump $w.menubar.edit  [mc "Find..."] find $w.menubar.edit  [mc "Convert to UPPERCASE"] uppercase $w.menubar.edit  [mc "Convert to lowercase"] lowercase $w.menubar.edit  [mc "Reverse-Complement"] reverse_com $w.menubar.enzymes [mc "Enzyme Selector..."] enzymes $w.menubar.enzymes [mc "Graphic Map"] graphic_map $w.menubar.enzymes [mc "Graphic Map +U"] graphic_map $w.menubar.enzymes [mc "Highlight"] highlight_enzymes $w.menubar.enzymes [mc "Clear Highlighting"] highlight_enzymes $w.menubar.enzymes [mc "Digestion"] digest $w.menubar.enzymes [mc "Digestion Dialog..."] digest $w.menubar.enzymes [mc "Text Map..."] text_map $w.menubar.tools [mc "Find PCR Primers..."] pcr $w.menubar.tools [mc "Align Sequences..."] align  $w.menubar.tools [mc "PCR"] pcr $w.menubar.tools [mc "Recombination Assembler..."] gibson $w.menubar.tools [mc "Gibson Designer..."] gibson $w.menubar.tools [mc "Gibson Assembly Wizard"] gibson $w.menubar.tools [mc "Golden Gate Assembler..."] golden_gate $w.menubar.tools [mc "Golden Gate Designer..."] golden_gate]


    set text_size [expr {round([tk scaling]  * [font actual menufont -size])}]
    if {$text_size < 32} {
      set x "1x"
    } elseif {$text_size < 48} {
      set x "2x"
    } elseif {$text_size < 64} {
      set x "3x"
    } elseif {$text_size < 128} {
      set x "4x"
    } elseif {$text_size < 256} {
      set x "8x"
    } else {
      set x "16x"
    }
    if {$info(dark_mode)} {
      set dark "_dark"
    } else {
      set dark ""
    }
    foreach {menu item icon} $iconlist {
      catch {$menu entryconfigure $item  -compound left -image $toolbar_images($icon$dark,$x)} err
    }

 


###Android windows menu generated here
if {!$info(android)} {
  #add menubar to the window
  $w configure -menu $w.menubar

  #frame $w.toolbar -borderwidth 0 -height 100 -relief flat
  ttk::frame $w.toolbar  -style Toolbar.TFrame
  frame $w.sep -relief ridge -border 1 -height 2
  fill_toolbar $w
} else {
    android_main_menu $w
    android_action_bar $w
    frame $w.sep -relief flat -border 1 -height 1
    #not needed for custom menubar, but used for now
    #remove_menu_accelerators $w.menubar
    #remove_menu_accelerators $popupmenu
}

#bind $w <<ToolbarButton>> "if {\[grid info $w.toolbar\] == \"\"} {grid configure $w.toolbar} else {grid remove $w.toolbar; focus $w.textarea}"
bind $w <<ToolbarButton>> "if {\[grid info $w.toolbar\] == \"\"} {grid configure $w.toolbar; $w.toolbar configure -height 0; update idletasks; for {set i 0} {\$i <=30} {incr i 5} {$w.toolbar configure -height \$i; update}; grid configure $w.sep} else  {for {set i 30} {\$i >= 0} {incr i -5} {$w.toolbar configure -height \$i; update idletasks}; grid remove $w.toolbar; grid remove $w.sep; focus $w.textarea}"

if {[tk windowingsystem] == "aqua" || $info(android)} {
  frame $w.infoframe -borderwidth 2 -relief flat
    set over_relief solid
    set press_relief solid
    set normal_relief flat
    set over_color $info(aqua_active_bg_color); #$info(bg_color)
    set press_color [gray_color $info(bg_color)]
    set normal_color $info(bg_color);#$info(bg_color)
} else {
  frame $w.infoframe -borderwidth 2 -relief ridge 
    set over_relief solid
    set press_relief solid
    set normal_relief flat
    set over_color $info(menu_bg_color)+
    set press_color $info(menu_select_bg_color)
    set normal_color $info(bg_color)
}
#grid propagate $w.infoframe 0

  ## basic file lock checkbutton
  ttk::checkbutton $w.infoframe.locked -style Icon.MD.TCheckbutton -image [list $toolbar_images(button_unlocked) selected $toolbar_images(button_locked)] -command "toggle_locked $w" -variable info($w,locked) -onvalue 1 -offvalue 0 
  tooltip_install $w.infoframe.locked "[mc Lock/Unlock]\n[mc File]"

  ## checksum label popup
  if {[info exists info(seguid_mode)]} {
    label $w.infoframe.checksum -image $toolbar_images(fingerprint_off) -borderwidth 0 -relief flat
    if {[info exists info($w,SEGUID)] && $info($w,SEGUID) ne {}} {
      $w.infoframe.checksum configure -image $toolbar_images(fingerprint_on)
    }
    bind $w.infoframe.checksum <Enter> " tooltip_enter %W \{Click to set/copy seguid fingerprint for the file.\}"
    bind $w.infoframe.checksum <Leave> "tooltip_leave %W"

    bind $w.infoframe.checksum <Button-1> "linked_seguid_popup $w %X %Y"
    bind $w.infoframe.checksum <<RightClick>> "linked_seguid_popup $w %X %Y"
    foreach event {<Button-3> <Button-2> <Control-Button-1> <Shift-Key-F10>} {
      bind $w.infoframe.checksum $event [bind Text $event]
    }
  }


  ## linked abi icon and popup menu
  label $w.infoframe.linked_abi -image $toolbar_images(button_link) -borderwidth 0 -relief flat
  if {$info(android)} {
    $w.infoframe.linked_abi configure -image $toolbar_images(link,4x)
  }
  bind $w.infoframe.linked_abi <Enter> " tooltip_enter %W \{Right-click to see [llength $info($w,linked_abi_list)] linked abi files.\}"
  bind $w.infoframe.linked_abi <Leave> "tooltip_leave %W"

  menu $w.infoframe.linked_abi.popupmenu
  bind $w.infoframe.linked_abi <Button-1> "linked_abi_popup $w %X %Y"
  bind $w.infoframe.linked_abi <<RightClick>> "linked_abi_popup $w %X %Y"
  foreach event {<Button-3> <Button-2> <Control-Button-1> <Shift-Key-F10>} {
    bind $w.infoframe.linked_abi $event [bind Text $event]
  }

  ##Phred quality scores icon and popup menu
  label $w.infoframe.phred -image $toolbar_images(button_comment) -borderwidth 0 -relief flat
  if {$info(android)} {
    $w.infoframe.phred configure -image $toolbar_images(link,4x)
  }
  bind $w.infoframe.phred <Enter> " tooltip_enter %W \{Right-click for Phred info\}"
  bind $w.infoframe.phred <Leave> "tooltip_leave %W"

  menu $w.infoframe.phred.popupmenu
  bind $w.infoframe.phred <Button-1> "phred_popup $w %X %Y"
  bind $w.infoframe.phred <<RightClick>> "phred_popup $w %X %Y"
  foreach event {<Button-3> <Button-2> <Control-Button-1> <Shift-Key-F10>} {
    bind $w.infoframe.phred $event [bind Text $event]
  }


  #checkbutton $w.infoframe.saved -text [mc "Saved"]  -variable info($w,saved) -onvalue 1 -offvalue 0 -selectcolor white -activebackground $info(bg_color) -disabledforeground $info(label_fg_color) -state normal -command  "if {!\[save_file $w Save\]} {set info($w,saved) \[expr {!\$info($w,saved)}\]}"
  #tooltip_install $w.infoframe.saved [mc {Click to Save File}]
  ttk::label $w.infoframe.totallenlabel -text [mc "Sequence"]  -style InfoboxStyle.TLabel 
  ttk::label $w.infoframe.totallen  -style InfoboxStyle.TLabel  
  ttk::label $w.infoframe.startlabel -text [mc "Start"]  -style InfoboxStyle.TLabel  
  ttk::label $w.infoframe.start  -style InfoboxStyle.TLabel   
  ttk::label $w.infoframe.sellenlabel -text [mc "Length"] -style InfoboxStyle.TLabel  
  ttk::label $w.infoframe.sellen -style InfoboxStyle.TLabel  
  ttk::label $w.infoframe.endlabel -text [mc "End"] -style InfoboxStyle.TLabel  
  ttk::label $w.infoframe.end -style InfoboxStyle.TLabel  
  ttk::label $w.infoframe.orflabel -text [mc "ORF"] -style InfoboxStyle.TLabel  
  ttk::label $w.infoframe.orf -style InfoboxStyle.TLabel  -textvariable info($w,orf_text)
  ttk::label $w.infoframe.tmlabel -text "Tm"  -style InfoboxStyle.TLabel  
  ttk::label $w.infoframe.tm -style InfoboxStyle.TLabel  
  ttk::label $w.infoframe.gclabel -text "%GC"  -style InfoboxStyle.TLabel  
  ttk::label $w.infoframe.gc -style InfoboxStyle.TLabel  
  label $w.infoframe.trans -justify center 

  bind  $w.infoframe.start <Double-Button-1> "infoframe_entry $w %W"
  bind  $w.infoframe.sellen <Double-Button-1> "infoframe_entry $w %W"
  bind  $w.infoframe.end <Double-Button-1> "infoframe_entry $w %W"

   menu $w.infoframe.trans.selection_translate_dir
      $w.infoframe.trans.selection_translate_dir add radiobutton -label [mc "Forward"] -variable info($w,selection_shows_Trans_dir) -value 0 -command "selection_manager $w"
      $w.infoframe.trans.selection_translate_dir add radiobutton -label [mc "Reverse"] -variable info($w,selection_shows_Trans_dir) -value 1 -command "selection_manager $w"
      $w.infoframe.trans.selection_translate_dir add checkbutton -label [mc "Uppercase ONLY"] -variable info($w,selection_shows_Trans_upper) -onvalue 1 -offvalue 0 -command "selection_manager $w"

    bind $w.infoframe.trans <<RightClick>> "tk_popup $w.infoframe.trans.selection_translate_dir %X %Y"
  foreach event {<Button-3> <Button-2> <Control-Button-1> <Shift-Key-F10>} {
    bind $w.infoframe.trans $event [bind Text $event]
  }

  if {$info(android)} {
    ttk::label $w.infoframe.circular -textvariable info($w,circular_text) 
    bind $w.infoframe.circular <ButtonRelease-1>  "toggle_circ $w" 
    bind $w.infoframe.circular <ButtonRelease-2>  "toggle_circ $w" 

    label $w.infoframe.find -image $toolbar_images(button_find,4x)  -borderwidth 1
    bind $w.infoframe.find <ButtonRelease-1>  "find_dialog $w 1" 
    bind $w.infoframe.find <ButtonRelease-2>  "find_dialog $w 1" 
    label $w.infoframe.edit_features -image $toolbar_images(button_edit,4x)  -borderwidth 1
    bind $w.infoframe.edit_features <ButtonRelease-1>  "add_feature_edit_box $w" 
    bind $w.infoframe.edit_features <ButtonRelease-2>  "add_feature_edit_box $w" 
    label $w.infoframe.find_orf -image $toolbar_images(button_orf,4x)  -borderwidth 1
    bind $w.infoframe.find_orf <ButtonRelease-1>  "add_orf_search_box $w" 
    bind $w.infoframe.find_orf <ButtonRelease-2>  "add_orf_search_box $w" 
    grid $w.infoframe.edit_features -row 0 -column 1
    grid $w.infoframe.find -row 1 -column 1
    grid $w.infoframe.find_orf -row 2 -column 1
  } elseif {1} {
    ttk::button $w.infoframe.circular -textvariable info($w,circular_text) -style Chip.TButton -command "toggle_circ $w"
    #ttk::button $w.infoframe.find -style Icon.MD.TButton -image $toolbar_images(button_find) -command "find_dialog $w 1"
    #ttk::button $w.infoframe.edit_features -style Icon.MD.TButton -image $toolbar_images(button_edit) -command "add_feature_edit_box $w"
    #ttk::button $w.infoframe.find_orf -style Icon.MD.TButton -image $toolbar_images(button_orf) -command "add_orf_search_box $w"
    #grid $w.infoframe.edit_features -row 0 -column 0
    #grid $w.infoframe.find -row 1 -column 0
    #grid $w.infoframe.find_orf -row 2 -column 0
  }
  if {$info($w,circular) ne "circular"} {
    $w.menubar.edit  entryconfigure [mc "Set Origin"] -state disabled
    $w.menubar.edit  entryconfigure [mc "Linearize @ insert site"] -state disabled
    #$w.infoframe.circular configure -image $toolbar_images(circular)
  }
  if {$info($w,mol_type) eq "DNA"} {
    set info($w,circular_text) [mc $info($w,circular)]
  } else {
    set info($w,circular_text) $info($w,mol_type)
  }
  #$w.infoframe.circular configure -height 1  -pady 0 -border 2
  ttk::checkbutton $w.infoframe.methylation -text "Dam/Dcm" -onvalue 1 -offvalue 0  -variable info($w,Dam_Dcm_methylated) -command "toggle_methylation $w" -style InfoboxStyle.TCheckbutton
  tooltip_install $w.infoframe.methylation [mc "Methylation state of the DNA.\nSet for plasmids, unset for PCR."]

      ##  
  if {!$info(android)} {
    #grid $w.infoframe.saved -row 0 -column 2
    grid columnconfigure $w.infoframe 1 -minsize [font measure labelfont 9999999]
    foreach c1 [list 1 4 5 6 7 8 9 10 11] {
      grid columnconfigure $w.infoframe $c1 -uniform 1 -weight 1
    }
    # col 0 is icons for find, orf etc, col 1 is mouseindex col 2 is locked and linked_abi icons, col 3 is checksum
    foreach c1 [list 0 2 3] {
      grid columnconfigure $w.infoframe $c1 -uniform 2 -weight 0
    }
    # 
    #grid columnconfigure $w.infoframe 3 -weight 0

    grid [label $w.infoframe.mouseindexlabel -text [mc "Mouse"] -justify left] -row 0 -column 1 -sticky s
    grid [label $w.infoframe.mouseindex -text {} -justify left] -row 1 -column 1  -sticky nwe
    grid $w.infoframe.locked -row 0 -column 2
    if {[info exists info(seguid_mode)]} {
      grid $w.infoframe.checksum -row 0 -column 3
    }

    if {[info exists info($w,phred_string)]} {
      grid $w.infoframe.phred -row 1 -column 3
    }

    grid $w.infoframe.linked_abi  -row 1 -column 2

    grid $w.infoframe.totallenlabel -row 0 -column 4  -sticky s
    grid $w.infoframe.totallen  -row 1 -column 4
  } else {
    destroy $w.infoframe.locked
    grid $w.infoframe.linked_abi  -row 2 -column 2
    grid remove $w.infoframe.totallenlabel
    grid remove $w.infoframe.totallen
    grid columnconfigure $w.infoframe 1 -minsize 0
    grid columnconfigure $w.infoframe 2 -minsize 0
    grid columnconfigure $w.infoframe 4 -minsize 0
  }

  if {$info($w,linked_abi_list) == [list]} {
    grid remove $w.infoframe.linked_abi
  }
  if {$info($w,phred_string) == {}} {
    grid remove $w.infoframe.phred
  }
  grid $w.infoframe.startlabel -row 0 -column 5  -sticky s
  grid $w.infoframe.start -row 1  -column 5
  grid $w.infoframe.sellenlabel -row 0 -column 6 -sticky s
  grid $w.infoframe.sellen -row 1  -column 6
  grid $w.infoframe.endlabel  -row 0 -column 7 -sticky s
  grid $w.infoframe.end  -row 1 -column 7
  grid $w.infoframe.orflabel  -row 0 -column 8 -sticky s
  grid $w.infoframe.orf  -row 1 -column 8
  grid $w.infoframe.tmlabel  -row 0 -column 9 -sticky s
  grid $w.infoframe.tm  -row 1 -column 9
  grid $w.infoframe.gclabel  -row 0 -column 10 -sticky s
  grid $w.infoframe.gc  -row 1 -column 10
  grid $w.infoframe.circular -row 0 -column 11 -sticky n;# -ipady 2
  grid $w.infoframe.methylation -row 1 -column 11
  grid $w.infoframe.trans -row 2 -column 2 -columnspan 10 -sticky ew
  if {!$info($w,selection_shows_Trans)} {grid remove $w.infoframe.trans}



  #for {set infocol [expr {$info(android) ? 5: 3}]} {$infocol<12} {incr infocol} {
   # grid columnconfigure $w.infoframe $infocol -weight 1
  #}
#if {[tk windowingsystem] eq "aqua"} {
  #foreach j [list $w.infoframe {*}[winfo children $w.infoframe]] {
   # bind $j <Deactivate> "$j configure -background $info(bg_color)"
   # bind $j <Activate> "$j configure -background $info(aqua_active_bg_color)"
   # $j configure -background $info(aqua_active_bg_color)
  #}
#}


  label $w.infobox -width 1

  add_featuretable $w [expr {($tags != {}) && $info(show_FeatureTable)}]
  set iline ""
  set count 10
  while {[string length $iline] < $info(default_textarea_width)} {
    set iline "$iline    *[string repeat " " [expr {5-[string length $count]}]]$count"
    incr count 10
  }
#define the index windows above, below and left of the sequence
text $w.horzindex -font dnafont -width $info(default_textarea_width) -height 1 -background $info(bg_color) -fg $info(label_fg_color) -wrap none -relief flat -cursor arrow -highlightthickness 0
$w.horzindex insert 1.0 $iline
bindtags $w.horzindex "$w.horzindex"

text $w.horzindex2 -font dnafont -width $info(default_textarea_width) -height 1 -background $info(bg_color) -fg $info(label_fg_color) -wrap none -relief flat -cursor arrow -highlightthickness 0
$w.horzindex2 insert 1.0 $iline
bindtags $w.horzindex2 "$w.horzindex2"

text $w.vertindex -font dnafont -width 4 -background $info(bg_color) -fg $info(label_fg_color) -relief flat -cursor arrow -highlightthickness 0
if {$info(inline_mode)} {
  $w.vertindex configure -width 0
}
$w.vertindex insert 1.0 "1" allvertindex
$w.vertindex tag configure allvertindex -justify right
bindtags $w.vertindex "$w.vertindex"
if {$info(android)} {
  bind $w.vertindex <Button-1> "set vertindex_y %y; set vertindex_i \[lindex \[$w.vertscroll get\] 0\]"
  bind $w.vertindex <B1-Motion> "if {\[info exists vertindex_i\]} {vertscrollmanager $w moveto \[expr {\$vertindex_i + \[vertindex_touch_delta $w.vertindex \[expr {-%y + \$vertindex_y}\]\]}\]}"
  bind $w.vertindex <ButtonRelease-1> "unset -nocomplain vertindex_y vertindex_i"
  bind $w.vertindex <Button-2> "set vertindex_y %y; set vertindex_i \[lindex \[$w.vertscroll get\] 0\]"
  bind $w.vertindex <B2-Motion> "if {\[info exists vertindex_i\]} {vertscrollmanager $w moveto \[expr {\$vertindex_i + \[vertindex_touch_delta $w.vertindex \[expr {-%y + \$vertindex_y}\]\]}\]}"
  bind $w.vertindex <ButtonRelease-2> "unset -nocomplain vertindex_y vertindex_i"
  bind $w.vertindex <<RightClick>> "seq_tooltip_post $w %x %y"
}


#define textarea (sequence area) and bindings
text $w.textarea -font dnafont -width $info(default_textarea_width) -wrap char -borderwidth 1 -highlightthickness 1 -highlightcolor gray30 -padx 0 -setgrid true -inactiveselectbackground $info(text_select2_bg_color)
if {$info(android)} {
  bind $w.textarea <Button-2> "set vertindex_y %y; set vertindex_i \[lindex \[$w.vertscroll get\] 0\]"
  bind $w.textarea <B2-Motion> "if {\[info exists vertindex_i\]} {vertscrollmanager $w moveto \[expr {\$vertindex_i + \[vertindex_touch_delta $w.vertindex \[expr {-%y + \$vertindex_y}\]\]}\]}"
  bind $w.textarea <ButtonRelease-2> "unset -nocomplain vertindex_y vertindex_i"
} else {
  bind $w.textarea <Any-Motion> "mouseover_info $w \[$w.textarea index @%x,%y\]"
  bind $w.textarea <Any-Leave> "mouseover_info $w -1"
}
bind $w.textarea <KeyPress> "keyevent_manager $w None %K ; break"
bind $w.textarea <KeyPress-space> "if {\[info exists info($w,seq_tooltip)]} {set info($w,seq_tooltip) \[expr {!\$info($w,seq_tooltip)}]} else {set info($w,seq_tooltip) 1}; if {\$info($w,seq_tooltip) && (\[expr {\[winfo pointerx $w\] + %x}\] > -1) && (\[expr {\[winfo pointery $w\] + %y}\] > -1) && (\[expr {\[winfo pointerx $w\] + %x}\] < [winfo width $w.textarea]) && (\[expr {\[winfo pointery $w\] + %y}\] < [winfo height $w.textarea])} {seq_tooltip_post $w \[expr {\[winfo pointerx $w\] + %x}\] \[expr {\[winfo pointery $w\] + %y}\]} else {catch {destroy $w.seqtooltip}}"
bind $w <KeyPress-space> [bind $w.textarea <KeyPress-space>]

bind $w <KeyPress-space> [bind $w.textarea <KeyPress-space>]

if {[info exists info(text_select2_fg_color)]} {
  bind $w.textarea <FocusOut> "catch \{destroy $w.seqtooltip\}; $w.textarea tag configure sel -foreground \$info(text_select2_fg_color)"
  bind $w.textarea <Deactivate> "catch \{destroy $w.seqtooltip\}; $w.textarea tag configure sel -foreground \$info(text_select2_fg_color)"
} else {
  bind $w.textarea <FocusOut> "catch \{destroy $w.seqtooltip\}"
  bind $w.textarea <Deactivate> "catch \{destroy $w.seqtooltip\}"
}

bind $w.textarea <Alt-KeyPress> #
if {$info(use_cocoa)} {
  bind $w <$modifier-KeyPress> "keyevent_manager $w Control %K ; break"
  bind $w <Shift-$modifier-KeyPress> "keyevent_manager $w ShiftControl %K ; break"
  bind $w <$modifier2-$modifier-KeyPress> "keyevent_manager $w AltControl %K ; break"
  bind $w.textarea <$modifier-KeyPress> "keyevent_manager $w Control %K ; break"
  bind $w.textarea <Shift-$modifier-KeyPress> "keyevent_manager $w ShiftControl %K ; break"
  bind $w.textarea <$modifier2-$modifier-KeyPress> "keyevent_manager $w AltControl %K ; break"
} else {
  bind $w <$modifier-KeyPress> "keyevent_manager $w Control %K ; break"
  bind $w <Shift-$modifier-KeyPress> "keyevent_manager $w ShiftControl %K ; break"
  bind $w <$modifier2-$modifier-KeyPress> "keyevent_manager $w AltControl %K ; break"
  bind $w.textarea <$modifier-KeyPress> "keyevent_manager $w Control %K ; break"
  bind $w.textarea <Shift-$modifier-KeyPress> "keyevent_manager $w ShiftControl %K ; break"
  bind $w.textarea <$modifier2-$modifier-KeyPress> "keyevent_manager $w AltControl %K ; break"
}



bind $w.textarea <Key-Left> "textarea_move_cursor $w Left; break"
bind $w.textarea <Key-Right> "textarea_move_cursor $w Right; break"
bind $w.textarea <Key-Down> "textarea_move_cursor $w Down; break"
bind $w.textarea <Key-Up> "textarea_move_cursor $w Up; break"

bind $w.textarea <MouseWheel> "vertscrollmanager $w scroll \[expr {int(1.0 * %D/-\$info(mousewheelunits))}\] units; mouseover_info $w \[$w.textarea index @%x,%y\]; break"


bind $w.textarea <B1-MouseWheel> "vertscrollmanager $w scroll \[expr {int(1.0 * %D/-\$info(mousewheelunits))}\] units; text_select_xy $w %x %y"
bind $w.textarea <<RightClick>> "sequence_window_popup $w $popupmenu %X %Y"
## generate the right-click events for textareas
foreach event {<Button-3> <Button-2> <Control-Button-1> <Shift-Key-F10>} {
  bind $w.textarea $event [bind Text $event]
}
bind $w.textarea <Shift-Key-Left> "textkeyselect $w Left; break"
bind $w.textarea <Shift-Key-Right> "textkeyselect $w Right; break"
bind $w.textarea <Shift-Key-Down> "textkeyselect $w Down; break"
bind $w.textarea <Shift-Key-Up> "textkeyselect $w Up; break"
#need to set the cursor only if it already has the focus
bind $w.textarea <Key-Tab> "if {\[grid info $w.comframe\] == \"\"} {toggle_comment $w};focus $w.comframe.comtextframe.text; break"
#bind $w.textarea <Double-Button-1> "select_region $w 1.0 end-1c"
if {[tk windowingsystem] != "aqua"} {
  bind $w.textarea <Button-1> "if {(\[focus\] != \"$w.textarea\") && (\$dialogblock == 0)} {focus $w.textarea} else {textsetcursor $w \[text_closest_gap $w.textarea %x %y\]}"
  bind $w.textarea <Double-Button-1> "sequence_window_double_button $w %x %y" 
} else {
  bind $w.textarea <Button-1> "if {(\[focus\] != \"$w.textarea\") && (\$dialogblock == 0)} {focus $w.textarea} else {textsetcursor $w \[text_closest_gap $w.textarea %x %y\]};double_button_manager $w.textarea"
  bind $w.textarea <<Double-Button-1>> "sequence_window_double_button $w %x %y" 
  #bind $w.textarea <Double-Button-1> "sequence_window_double_button $w %x %y" 
}
#bind $w.textarea <Shift-Button-1> "[bind Text <Shift-Button-1>]; selection_manager $w"
bind $w.textarea <Shift-Button-1> "text_reset_anchor %W @%x,%y; text_select_xy $w %x %y; selection_manager $w"
#bind $w.textarea <Button1-Leave> "mouse_left_DNA $w %x %y; break"
bind $w.textarea <Button1-Enter> "cancel_scrolling_DNA"
bind $w.textarea <ButtonRelease-1> "cancel_scrolling_DNA"
bind $w.textarea <Button1-Motion> "text_select_xy $w %x %y; break"
#aqua bug: actvate doesn't focus corectly


bind $w.textarea <FocusIn> "set info($w,focuswin) textarea; update_edit_menu $w textarea"
if {[info exists info(text_select2_fg_color)]} {
  bind $w.textarea <FocusIn> "+; $w.textarea tag configure sel -foreground \$info(text_select_fg_color)"
}


# #1 sierra bug- infinite loop call- focus calls activate
#bind $w.textarea <Activate> "focus $w.\$info($w,focuswin)"

if {$info(android)} {
  bind $w.textarea <Button-1> "if {(\[focus\] != \"$w.textarea\") && (\$dialogblock == 0)} {focus $w.textarea} else {set info($w,android_sel_store) \[$w.textarea tag ranges sel\];textsetcursor $w \[text_closest_gap $w.textarea %x %y\]}; DNA_keyboard $w"

  #bind $w.textarea <Button-3> "if {\[info exists info($w,android_sel_store)\] && \$info($w,android_sel_store) != {}} {$w.textarea tag add sel {*}\$info($w,android_sel_store)}; update; sequence_window_popup $w $popupmenu %X %Y"
  bind $w.textarea <Button-3> "if {\[info exists info($w,android_sel_store)\] && \$info($w,android_sel_store) != {}} {$w.textarea tag add sel {*}\$info($w,android_sel_store)}; update; seq_tooltip_post $w %x %y;sputs  seq_tooltip_post $w %x %y"
  bind $w.textarea <Any-Motion> "mouseover_info $w \[$w.textarea index @%x,%y\]; catch {destroy $w.seqtooltip}"
  bind $w.textarea <Any-Leave> "mouseover_info $w -1; catch {destroy $w.seqtooltip}"

}

bindtags $w.textarea [list $w.textarea . all]
set info($w,focuswin) "textarea"
ttk::scrollbar $w.vertscroll -command "vertscrollmanager $w"

canvas $w.map_zoom -bg $info(text_bg_color) -width 10 -highlightthickness 0

canvas $w.map -bg $info(text_bg_color) -width 10 -highlightthickness 0


grid columnconfigure $w 1 -weight 1
grid columnconfigure $w 3 -weight 0 -minsize 17

grid rowconfigure $w 0 -weight 0
grid rowconfigure $w 1 -weight 0
grid rowconfigure $w 2  -weight 0
grid rowconfigure $w 4  -weight 0
grid rowconfigure $w 5  -weight 0
grid rowconfigure $w 6 -minsize 2c -weight 1
grid rowconfigure $w 7  -minsize 16 -weight 0
grid rowconfigure $w 8 -weight 0
grid rowconfigure $w 9 -minsize 7 -weight 0

grid $w.toolbar -row 0 -column 0 -columnspan 5 -sticky new
grid $w.sep -row 1 -column 0 -columnspan 5 -sticky nwe


grid $w.infoframe -row 2  -column 0 -columnspan 5 -sticky new
## resizes here
grid $w.infobox -row 4  -column 1  -columnspan 4  -sticky new
#grid $w.infobox -row 4  -column 0  -columnspan 4  -sticky new
if {!$info(android)} {
  grid $w.horzindex -row 5 -column 1  -sticky nwe
}
grid  $w.vertindex -row 6 -column 0 -sticky nse
grid $w.textarea -row 6 -column 1 -sticky nswe
grid $w.map_zoom -row 6 -column 2 -sticky nsw
grid $w.vertscroll -row 6 -column 3 -sticky nsw
if {$info(hide_scrollbar)} {
  grid configure $w.textarea -columnspan 2
  grid remove $w.vertscroll
}
grid $w.map -row 6 -column 4 -sticky nsw

grid $w.horzindex2 -row 7 -column 1  -sticky swe

#grid [button $w.show_header_info -height 15 -width 15 -borderwidth 0 -image $toolbar_images(button_info) -command "toggle_comment $w"] -row 3 -column 0
if {!$info(use_tile)} {
  grid [label $w.show_feature_table -borderwidth 0 -image $toolbar_images(button_table)] -row 4 -column 0 -sticky nw
} elseif {$info(android)} {
  grid [label $w.show_feature_table -borderwidth 0 -image $toolbar_images(button_table,4x)] -row 4 -column 0 -sticky nw
} else {
  grid [ttk::checkbutton $w.show_feature_table -style Disclosure.Icon.MD.TCheckbutton -image $toolbar_images(button_table) -takefocus 0 -variable info($w,show_fetauretable)] -row 4 -column 0 -sticky nw
  set info($w,show_fetauretable) 0
}

tooltip_install $w.show_feature_table [mc "Show Feature List\nShift:Edit Features"]
if {[tk windowingsystem] != "aqua"} {
  bind $w.show_feature_table <ButtonRelease-3> "toggle_features_treeview $w"
  bind $w.show_feature_table <ButtonRelease-1> "toggle_features_treeview $w"
  if {$info(android)} {
    bind $w.show_feature_table <ButtonRelease-2> "toggle_features_treeview $w"
  }
} else {
  bind $w.show_feature_table <ButtonRelease-2> "toggle_features_treeview $w"
  bind $w.show_feature_table <Control-ButtonRelease-1> "toggle_features_treeview $w"
  bind $w.show_feature_table <ButtonRelease-1> "toggle_features_treeview $w"
  bind $w.show_feature_table <Shift-ButtonRelease-1> "if {\[winfo ismapped $w.tvframe\] && \[winfo exists $w.tvframe.buttons\]} {if {\[winfo ismapped $w.tvframe.buttons\]} {grid remove $w.tvframe.buttons} else {grid configure $w.tvframe.buttons}}"
}


  if {!$info(use_tile)} {
    grid [label $w.showcomment -height 16 -width 15 -borderwidth 0 -image $toolbar_images(button_comment)] -row 7 -column 0 -ipadx 1
    bind $w.showcomment <B1-Enter> "$w.showcomment configure -bg $press_color -relief $press_relief"
    bind $w.showcomment <Enter> "$w.showcomment configure -bg $over_color -relief $over_relief; tooltip_enter $w.showcomment \"\[mc Show/Hide\]\n\[mc \{File Comment\}\]\""
    bind $w.showcomment <Leave> "$w.showcomment configure -bg $normal_color -relief $normal_relief; tooltip_leave $w.showcomment"
    bind $w.showcomment <Button-1> "$w.showcomment configure -bg $press_color -relief $press_relief"
    bind $w.showcomment <ButtonRelease-1> "if \{\[$w.showcomment cget -relief\] == \"$press_relief\"\} \{$w.showcomment configure -bg $over_color -relief $over_relief; toggle_comment $w\} else \{$w.showcomment configure -bg $normal_color -relief $normal_relief\}" 
    #bind "$w.showcomment" <B1-ButtonRelease> "toggle_comment $w"
    #tooltip_install $w.showcomment "[mc Show/Hide]\n[mc {File Comment}]"
  } elseif {$info(android)} {
    grid [label $w.showcomment -height 64 -width 64 -borderwidth 0 -image $toolbar_images(button_comment,4x)] -row 7 -column 0 -ipadx 1
    bind $w.showcomment <ButtonRelease-3> "toggle_comment $w"
    bind $w.showcomment <ButtonRelease-2> "toggle_comment $w"
    bind $w.showcomment <ButtonRelease-1> "toggle_comment $w"
  } else {
    grid [ttk::checkbutton $w.showcomment -image $toolbar_images(button_comment) -style Disclosure.Icon.MD.TCheckbutton -command "toggle_comment $w"  -variable info($w,showcomment)] -row 7 -column 0 -ipadx 1
    set info($w,showcomment) 1
    tooltip_install $w.showcomment "[mc Show/Hide]\n[mc {File Comment}]"
  }
if {!$info(android)} {
  grid [ttk::frame $w.comframe -style Roundframe] -row 8 -column 0 -columnspan 5 -sticky nwe  -padx 5
} else {
  grid [frame $w.comframe -relief flat] -row 8 -column 0 -columnspan 5 -sticky nwe
}
grid [frame  $w.comframe.comtextframe] -row 1 -column 1 -sticky nwe -padx 10 -pady 10
grid [text $w.comframe.comtextframe.text -yscrollcommand "optionscrollbar $w.comframe.comtextframe.scrolly" -wrap word -width 1  -height $info(comment_height) -font labelfont  -borderwidth 1 -highlightthickness 1 -highlightcolor gray30 -autoseparators 1 -undo 1 ] -row 0 -column 0 -sticky nswe -padx 2 -pady 3; #bug in textbox scroll calculation
if {[tk windowingsystem] == "aqua"} {
   $w.comframe.comtextframe.text configure -yscrollcommand "$w.comframe.comtextframe.scrolly set "; #bug in textbox scroll calculation
}
grid [ttk::scrollbar $w.comframe.comtextframe.scrolly -orient vertical -command "$w.comframe.comtextframe.text yview"] -row 0 -column 1 -sticky nse
  if {[tk windowingsystem] == "aqua"} {
    set resize_cursor resizeupdown
  } elseif {[tk windowingsystem] == "win32"} {
    set resize_cursor sb_v_double_arrow
  } else {
    set resize_cursor sb_v_double_arrow
  }
grid [frame  $w.comframe.comtextframe.resize -height 3 -bg $info(bg_color) -cursor $resize_cursor] -row 1 -column 0 -columnspan 2 -sticky nwe 
grid configure $w.comframe.comtextframe.text -pady 0
  bind  $w.comframe.comtextframe.resize <ButtonPress-1> "bind $w.comframe.comtextframe.text <<resizeY>> %Y; bind $w.comframe.comtextframe.text <<resizeHeight>> \[$w.comframe.comtextframe.text cget -height\]"
  bind  $w.comframe.comtextframe.resize <Button1-Motion> "comment_resize $w.comframe.comtextframe.text %Y"
if {$info(android)} {
  bind  $w.horzindex2 <ButtonPress-1> "if {\[winfo ismapped $w.comframe.comtextframe.text\]} {bind $w.comframe.comtextframe.text <<resizeY>> %Y; bind $w.comframe.comtextframe.text <<resizeHeight>> \[$w.comframe.comtextframe.text cget -height\]}"
  bind  $w.horzindex2 <Button1-Motion> "if {\[winfo ismapped $w.comframe.comtextframe.text\]} {comment_resize $w.comframe.comtextframe.text %Y -1}"
}

grid columnconfigure $w.comframe 1 -weight 1
grid rowconfigure $w.comframe 1 -weight 1
grid columnconfigure $w.comframe.comtextframe 0 -weight 1
grid columnconfigure $w.comframe.comtextframe 1 -minsize 20
grid rowconfigure $w.comframe.comtextframe 0 -weight 1
if {!$info(show_comment)} {
  grid remove $w.comframe
}


$w.comframe.comtextframe.text insert 1.0 $filecomment
$w.comframe.comtextframe.text edit reset
bind $w.comframe.comtextframe.text <$modifier-KeyPress> "comment_keyevent_manager $w Control %K ; break"
bind $w.comframe.comtextframe.text <Shift-$modifier-KeyPress> "comment_keyevent_manager $w ShiftControl %K ; break"
bind $w.comframe.comtextframe.text <Key> "if {\[string equal %A \"\"\] || \[file_lock_check $w\]} {break} else {set info($w,saved) 0;  if {\[tk windowingsystem\] == \"aqua\"} {wm attributes $w -modified 1}}" 
bind $w.comframe.comtextframe.text <Delete> "if {\[file_lock_check $w\]} {break} else {set info($w,saved) 0;if {\[tk windowingsystem\] == \"aqua\"} {wm attributes $w -modified 1}}"
bind $w.comframe.comtextframe.text <Key-BackSpace> "if {\[file_lock_check $w\]} {break} else {set info($w,saved) 0;if {\[tk windowingsystem\] == \"aqua\"} {wm attributes $w -modified 1}}"
bind $w.comframe.comtextframe.text <Key-Return> "if {\[file_lock_check $w\]} {break} else {set info($w,saved) 0;if {\[tk windowingsystem\] == \"aqua\"} {wm attributes $w -modified 1}}"
bind $w.comframe.comtextframe.text <Key-Tab> "focus $w.textarea; break"
bind $w.comframe.comtextframe.text <FocusIn> "set info($w,focuswin) comframe.comtextframe.text; update_edit_menu $w comment"
bind $w.comframe.comtextframe.text <<Cut>> "if {\[file_lock_check $w\]} {break} else {set info($w,saved) 0;if {\[tk windowingsystem\] == \"aqua\"} {wm attributes $w -modified 1}}"
bind $w.comframe.comtextframe.text <<Paste>> "if {\[file_lock_check $w\]} {break} else {set info($w,saved) 0;if {\[tk windowingsystem\] == \"aqua\"} {wm attributes $w -modified 1}}"

foreach event [list <Shift-Key-Down> <Shift-Key-Up> <Shift-Key-Right> <Shift-Key-Left> <Key-Down> <Key-Up> <Key-Right> <Key-Left>] {
  bind $w.comframe.comtextframe.text $event #
}
bindtags $w.comframe.comtextframe.text [list $w.comframe.comtextframe.text Text all]


#grid [label $w.filename -textvariable info($w,filename)  -justify right -width 1] -row 8 -column 1 -columnspan 1 -sticky nwe
#grid [label $w.mouseindex -text {} -justify left] -row 8 -column 0  -sticky nwe

# weird bug in the deiconify proc, need to raise all the windows to get the topmost activated
# bind $w <Map> "if {\[winfo class %W\]  == \"Toplevel\"} {event generate . <<RaiseDialogs>>; catch {foreach wx \[wm stackorder .\] {raise \$wx}}}"
bind $w <Map> "if {\[winfo class %W\]  == \"Toplevel\"} {event generate . <<RaiseDialogs>>}"
bind $w <FocusIn> "if {\[winfo class %W\]  == \"Toplevel\"} {after 200 event generate . <<RaiseDialogs>>}"
bind $w <Activate> "if {\[winfo class %W\]  == \"Toplevel\"} {after 200 event generate . <<RaiseDialogs>>}"

if {$reuse_startup && [winfo exists .dna_window0]} {
    catch {wm geometry $w [regexp -inline {[+-].*} [wm geometry .dna_window0]]}
}
wm deiconify $w
focus $w.textarea



if {[regexp -nocase {[^ABCDGHKMNRSTUVWYabcdghkmnrstuvwy*]} $newdna]} {
  regsub -all {[^ABCDGHKMNRSTUVWYabcdghkmnrstuvwy*]} $newdna N newdna
  tk_messageBox -message [mc "error: Bad DNA into New Window."] -type "ok"
}

#set newdna "[join [regexp -inline -all [string repeat . $info(default_textarea_width)] $newdna] \n]\n[string range $newdna end-[expr {[string length $newdna] % $info(default_textarea_width) - 1}] end]"
set info($w,textwidth) $info(default_textarea_width)

#textarea_insert $w.textarea 1.0 $newdna
# inserting directly bypasses the width check, lock_check and reline procs. setting info($w,scanned) and undo(undo,$w) is also bypassed
 regsub -all {\n} $newdna "" subtext
 $w.textarea insert 1.0 $subtext {}
 reline $w.textarea $info($w,textwidth)


#don't know why this update is necessary for large texts (Mb) with many tags
if {[string length $newdna] > 50000} {
 #update
}

#have to put the features in after recalculating the width so that the reline proc is called
set fea_info($w,count) 0
if {$tags != {}} {
  put_tags $w.textarea {1.0 end-2c} $tags forward 1
}

$w.textarea mark set insert 1.0
#textarea_width_changed $w
if {![winfo exists $w]} {return}

if {[tk windowingsystem] == "aqua"} {wm attributes $w -modified 0}
set info($w,linked_events) [list]
$w.textarea tag configure sel -background $info(text_select_bg_color) -foreground $info(text_select_fg_color) -relief flat
$w.textarea tag configure tempsel
$w.textarea tag lower tempsel

global tcl_platform
if {($tcl_platform(platform) == "unix") && ([tk windowingsystem] != "aqua")} {
    selection handle -type UTF8_STRING -selection CUT_BUFFER0 $w unix_cubuffer_handler
    selection handle -type STRING -selection CUT_BUFFER0 $w unix_cubuffer_handler
    selection handle -type UTF8_STRING -selection CLIPBOARD $w unix_cubuffer_handler
    selection handle -type STRING -selection CLIPBOARD $w unix_cubuffer_handler
} elseif {$tcl_platform(platform) == "windows"} {
    wm deiconify $w
}

if {[info procs HandleFileDrop] ne {}} {
  tkdnd::drop_target register $w CF_HDROP 
  bind $w <<Drop:DND_Files>> {HandleFileDrop  %D %T}
}

if {($tcl_platform(platform) != "unix") || ([tk windowingsystem] == "aqua")} {
    bind $w.textarea <Shift-Button-3> {
      console show
      set info(suppress_output) 0
      set w [lindex [winfo children .] 0]
    }

##bug #1- crashing in Sierra??
  #event generate $w <Activate>
}
bind $w.textarea <Configure> "textarea_width_changed $w;textarea_height_changed $w"

$w.textarea mark set insert 1.0
$w.textarea mark set anchor 1.0
$w.textarea mark set tk::anchor$w.textarea 1.0

#bug #1- crashing in Yosemite- no calls to update are permitted when coming back from the OS
if {[tk windowingsystem] != "aqua"} {
  window_on_screen $w
}


vertindexbalancer $w
selection_manager $w
textarea_height_changed $w

if {!$info(android)} {
  toolbar_extend $w
}
# have to make the info box and toolbar as narrow as possible, then turn off grid propagation, so that they don't make the window wider than the text box

if {0 && [tk windowingsystem] != "aqua" && !$info(android)} {
  update
  $w.infoframe configure -width 1 -height 100
  foreach f [winfo children $w.infoframe] {grid remove $f}
  grid propagate $w.infoframe 0
  foreach f [winfo children $w.infoframe] {grid configure $f}
}


focus -force $w.textarea
event generate $w.textarea <Button-1> -x 1 -y 1
event generate $w.textarea <ButtonRelease-1> -x 1 -y 1
if {$reuse_startup && [winfo exists .dna_window0]} {

#odd aqua bug- can't close the window too soon after it is made- problem if you start ApE by double clicking a file- opens blank, and window1 at same time, closing blank too soon and crashing
# resolved now- taking out the after
  if {[tk windowingsystem] == "aqua"} {
    if {[catch {update_windows_menu} err]} {tk_messageBox  -message "windows menu: $err"}
    wm withdraw .dna_window0
    catch {closewindow .dna_window0}
  } else {
    catch {closewindow .dna_window0}
  }
}
after 10 "if {\[winfo exists $w.textarea\]} {focus -force $w.textarea}"
set info($w,scanned) 0
if {$newdna == "" || $newdna == "\n"|| ($filename !="")} {
  set info($w,saved) 1
} else {
  set info($w,saved) 0
}

if {!$info(lock_bug)} {
  set info($w,locked) [expr {[file isfile $info($w,filename)] && ![file writable $info($w,filename)]}]
} else {
  set info($w,locked) 0
}

if {$info($w,phred_string) ne {}} {
  set info($w,locked) 1
}

if {[tk windowingsystem] == "aqua"} {
  wm attributes $w -modified [expr {!$info($w,saved)}] 
  if {[file exists $filename]} {
    wm attributes $w -titlepath $filename
  }
}
  set info($w,autosaved) $info($w,saved)
  trace add variable info($w,saved) write "info_element_cloner $w,autosaved"

initialize_undo $w
if {$info(android)} {
  if {[tk windowingsystem] != "aqua"} {
    wm attributes $w -fullscreen 1
  }
  resize_infoframe_fonts $w
}


if {$info(use_cocoa)} {
  #wm withdraw $w
  #wm deiconify $w
}
return $w
}

##############
## add the feature table treeview to a window
##############
# right-click to edit data, proc to then update feature data
# double click feature name to bring up old edit dialog
# right click popup menu in headings to set visible columns, move current column left or right (can't move feature name), set number of rows displayed
# right click popup on items: 0: edit data 1: configure graphics:  arrow names that are pre-set and editable, width, color; 2: raise, and lower to right-click popup
# "new sub-feature" row

## feature_group column
## right click menu in Feature_group column heading to apply tag to selected ("new tag..." option)
## hidden column
## can do a list, hide or add tag to selected items
## right click menu in type column heading to select all of a type- 
proc add_featuretable {w {show 1}} {
  global info
  set f [frame $w.tvframe]
  set t $f.tv
  set sc $f.sc
  ttk::treeview $t -yscrollcommand "optionscrollbar $sc" -height 5 -style Featuretable.Treeview
  ttk::scrollbar $sc -orient vertical -command "treeview_do_entry_edit $t; $t yview"
  if {[tk windowingsystem] == "aqua"} {
    set resize_cursor resizeupdown
  } elseif {[tk windowingsystem] == "win32"} {
    set resize_cursor sb_v_double_arrow
  } else {
    set resize_cursor sb_v_double_arrow
  }
  frame $w.tvframe.buttons
  grid [button $w.tvframe.buttons.raise -text [mc "Raise"] -command "if {\$dialogblock} {} elseif {\$info($w,locked)} {tk_messageBox -message \[mc {File Is Locked}\] -type ok} else  {featuretable_edit_items $w 0 raise_selected}" ] -row 0 -column 0
  grid [button $w.tvframe.buttons.lower -text [mc "Lower"]  -command "if {\$dialogblock} {} elseif {\$info($w,locked)} {tk_messageBox -message \[mc {File Is Locked}\] -type ok} else {featuretable_edit_items $w 0 lower_selected}" ] -row 0 -column 1
  grid [button $w.tvframe.buttons.delete -text [mc "Delete"] -command "if {\$dialogblock} {} elseif {\$info($w,locked)} {tk_messageBox -message \[mc {File Is Locked}\] -type ok} else {featuretable_edit_items $w 0 delete_selected}" ] -row 0 -column 2
  grid [button $w.tvframe.buttons.hide -text [mc "Hide"] -command "if {\$dialogblock} {} elseif {\$info($w,locked)} {tk_messageBox -message \[mc {File Is Locked}\] -type ok} else {featuretable_edit_items $w 0 hide_selected}" ] -row 0 -column 4
  grid [button $w.tvframe.buttons.show -text [mc "Show"] -command "if {\$dialogblock} {} elseif {\$info($w,locked)} {tk_messageBox -message \[mc {File Is Locked}\] -type ok} else {featuretable_edit_items $w 0 show_selected}" ] -row 0 -column 5 
   grid [button $w.tvframe.buttons.done -text [mc "Done"] -command "grid remove $w.tvframe.buttons" ] -row 0 -column 6
  frame $w.tvframe.resize -height 3 -cursor $resize_cursor
  bind $t <MouseWheel> "treeview_do_entry_edit $t"
  grid $f -row 3 -column 0 -columnspan 5 -sticky ew  -padx {5 0}
  grid $f.tv -row 0 -column 0  -sticky nsew
  grid $f.sc -row 0 -column 1 -sticky nsw
  grid $w.tvframe.buttons -row 2 -column 0 -columnspan 2 -sticky ew
  grid remove $w.tvframe.buttons
  grid $w.tvframe.resize -row 3 -column 0 -columnspan 2 -sticky ew
  grid columnconfigure $f 0 -weight 1
  grid columnconfigure $f 1 -minsize 17

  set column_list {Direction Type Location}
  #for {set i 0} {$i < 20} {incr i} {
  #  lappend column_list [format "g_%03u" $i]
  #}
  $t configure -columns $column_list -displaycolumns {Direction Type Location}
  $t heading #0 -text [mc "Feature"] -command "treeview_sort $t {}"
  $t column #0 -width 200 -minwidth 50 -stretch 1 -anchor e
  $t heading Direction -text Direction -command "treeview_sort $t Direction"
  $t column Direction -width 60 -minwidth 50 -stretch 0 -anchor c
  $t heading Type -text Type  -command "treeview_sort $t Type"
  $t column Type -width 150 -minwidth 50 -stretch 0 -anchor c
  $t heading Location -text [mc "Location  \u2193"]  -command "treeview_sort $t Location"
  $t column Location -minwidth 50 -stretch 1 -anchor c

  #for {set i 0} {$i < 20} {incr i} {
  #  $t column [format "g_%03u" $i] -width 16 -minwidth 12 -stretch 0 -anchor c 
  #}


  if {!$show} {
    grid remove $f
  }

  bind $t <<TreeviewSelect>> "treeview_manageselection $t; edit_box_treeviewselect $w"
  bind $t <<OldSelection>> {}
  $t tag configure sel -background $info(text_select_bg_color)
  bind $t <<Sort_column>> Location
  bind $t <<Sort_direction>> 1
  #bind $t <Button-2> "sputs button2 \[$t identify column %x %y]  \[$t identify row %x %y];# can use identify item when 8.6 is available"
  bind $t <<RightClick>> "featuretable_rightclick $w %x %y"

  if {[tk windowingsystem] != "aqua"} {
    bind $t <Double-Button-1> "featuretable_doubleclick $w %x %y; break"
  } else {
    bind $t <Button-1> "double_button_manager $t"
    bind $t <<Double-Button-1>>  "featuretable_doubleclick $w %x %y; break"
  }

  bind $w.tvframe.resize <ButtonPress-1> "bind $t <<resizeY>> %Y; bind $t <<resizeHeight>> \[$t cget -height\]"
  bind $w.tvframe.resize <Button1-Motion> "treeview_resize $t %Y"
  if {$info(android)} {
    bind $w.infobox <ButtonPress-1> "if {\[winfo ismapped $w.tvframe\]} {bind $t <<resizeY>> %Y; bind $t <<resizeHeight>> \[$t cget -height\]}"
    bind $w.infobox <Button1-Motion> "if {\[winfo ismapped $w.tvframe\]} {treeview_resize $t %Y}"
    bind $w.infobox <ButtonPress-3> "if {\[winfo ismapped $w.tvframe\]} {bind $t <<resizeY>> %Y; bind $t <<resizeHeight>> \[$t cget -height\]}"
    bind $w.infobox <Button3-Motion> "if {\[winfo ismapped $w.tvframe\]} {treeview_resize $t %Y}"
  }
}


##############
## Featuretable bug- changing styles changes the width of strechy table titles in gridded geometry
##############
rename ttk::style ttk::style_actual
proc ttk::style {args} {
  set d0 [dict create]
  set d1 [dict create]
  foreach w [dnawindows_list] {
    if {[winfo exists $w.tvframe.tv]} {
      dict set d0 $w [$w.tvframe.tv column #0 -width]
      dict set d1 $w [$w.tvframe.tv column Location -width]
      $w.tvframe.tv column #0  -width 20 -stretch 0
      $w.tvframe.tv column Location -width 20  -stretch 0 
    }
  }
  set code [catch {ttk::style_actual {*}$args} result]
update idletasks
  foreach w [dnawindows_list] {
    if {[winfo exists $w.tvframe.tv]} {
      $w.tvframe.tv column #0   -width [dict get $d0 $w] -stretch 1
      $w.tvframe.tv column Location -width  [dict get $d1 $w] -stretch 1
    }
  }
  return -code $code $result
}


##############
## Add the edit features dialog to the infobox location at the top of a sequence window
##############
proc add_feature_edit_box {w} {
  global editbox_info info toolbar_images modifier modstring genbank_typelist genbank_divided_typelist
  if {[winfo exists $w.edit_features_frame]} {
    grid configure $w.edit_features_frame
    return
  }

  set s [frame $w.edit_features_frame]
  if {$info(android)} {
      grid [frame $s.buttons_frame] -row 0 -column 0 -sticky nsew
      label  $s.buttons_frame.find -image $toolbar_images(button_find,4x)  -borderwidth 1
      bind $s.buttons_frame.find <ButtonRelease-1>  "grid remove $s; find_dialog $w 1" 
      bind $s.buttons_frame.find <ButtonRelease-2>  "grid remove $s; find_dialog $w 1" 

      label  $s.buttons_frame.seq_info -image $toolbar_images(button_info,4x)  -borderwidth 1
      bind $s.buttons_frame.seq_info <ButtonRelease-1>  "grid remove $s" 
      bind $s.buttons_frame.seq_info <ButtonRelease-2>  "grid remove $s" 

      label  $s.buttons_frame.find_orf -image $toolbar_images(button_orf,4x)  -borderwidth 1
      bind $s.buttons_frame.find_orf <ButtonRelease-1>  "grid remove $s;  add_orf_search_box $w" 
      bind $s.buttons_frame.find_orf <ButtonRelease-2>  "grid remove $s;  add_orf_search_box $w" 

      grid $s.buttons_frame.find -row 0 -column 0
      grid $s.buttons_frame.seq_info -row 1 -column 0
      grid $s.buttons_frame.find_orf -row 2 -column 0

      grid rowconfigure $s.buttons_frame 0 -minsize 30
      grid rowconfigure $s.buttons_frame 1 -minsize 30
      grid rowconfigure $s.buttons_frame 2 -minsize 30
  } else {
    grid [frame $s.buttons_frame] -row 0 -column 0 -sticky nsew
    ttk::button $s.buttons_frame.find -style Icon.MD.TButton -image $toolbar_images(button_find) -command "grid remove $s; find_dialog $w 1"
    ttk::button $s.buttons_frame.seq_info -style Icon.MD.TButton -image $toolbar_images(button_info) -command "grid remove $s"
    ttk::button $s.buttons_frame.find_orf -style Icon.MD.TButton -image $toolbar_images(button_orf) -command "grid remove $s; add_orf_search_box $w"
    grid $s.buttons_frame.seq_info -row 0 -column 0
    grid $s.buttons_frame.find -row 1 -column 0
    grid $s.buttons_frame.find_orf -row 2 -column 0
    grid rowconfigure $s.buttons_frame 0 -minsize 30
    grid rowconfigure $s.buttons_frame 1 -minsize 30
    grid rowconfigure $s.buttons_frame 2 -minsize 30
  }

  grid columnconfigure $s 1 -weight 1
  grid rowconfigure $s 0  -weight 1

  grid [frame $s.ok_frame] -row 1 -column 1 -sticky nsew
  grid [button $s.ok_frame.hide -text [mc "Hide"]] -row 0 -column 0 -sticky ns
  grid [button $s.ok_frame.hide2 -text [mc "Hide"]] -row 0 -column 1 -sticky ns
  grid [button $s.ok_frame.delete -text [mc "Delete"] -command "featuretable_edit_items $w 0 delete_selected"] -row 0 -column 2 -sticky ns
  grid [button $s.ok_frame.new -text [mc "New"] -command "add_sel_feature_file $w"] -row 0 -column 3 -sticky ns
  grid columnconfigure $s.ok_frame 0 -weight 1 -uniform 1
  grid columnconfigure $s.ok_frame 1 -weight 1 -uniform 1
  grid columnconfigure $s.ok_frame 2 -weight 1 -uniform 1
  grid columnconfigure $s.ok_frame 3 -weight 1 -uniform 1
  grid rowconfigure $s 1  -minsize 15

  grid [ttk::notebook $s.nb  -padding 4] -row 0 -column 1 -sticky nsew

####
  $s.nb add [set a [frame $s.nb.f1]] -text [mc "Properties"]
  grid columnconfigure $a 1 -weight 1
  grid rowconfigure $a 1 -weight 1
  # name type hidden delete
  ##name
  grid [frame $a.textframe -relief ridge -borderwidth 2] -row 0 -column 1 -sticky nswe
  grid columnconfigure $a.textframe 1 -weight 1

  grid [menubutton $a.textframe.type -menu $a.textframe.type.menu -textvariable editbox_info($w,fea_edit_type) -font labelfont -width 15 -indicatoron 1] -row 0 -column 0 -sticky we
  menu $a.textframe.type.menu


  foreach {header types} $genbank_divided_typelist {
    $a.textframe.type.menu add cascade -label $header -menu [menu $a.textframe.type.menu.[string tolower $header]]
    foreach type $types {
      if {[string index $type 0] eq "-"} {set typelabel " $type"} else {set typelabel $type}
      $a.textframe.type.menu.[string tolower $header] add radiobutton -label $typelabel -variable editbox_info($w,fea_edit_type) -value $type -command "edit_box_apply $w type"
    }
  }
  # non-standard types
  foreach temp_tag [lsearch -regexp -inline -all [$w.textarea tag names] {f[0-9]+#}] {
    if {[lsearch -exact $genbank_typelist [set temp_tag_type [lindex [$w.textarea tag bind $temp_tag <<Metadata>>] 2]]] == -1} {
      if {[string index $temp_tag_type 0] eq "-"} {set typelabel " $temp_tag_type"} else {set typelabel $temp_tag_type}
      $a.textframe.type.menu add radiobutton -label $typelabel -variable editbox_info($w,fea_edit_type) -value $temp_tag_type -command "edit_box_apply $w type"
    }
  }

  grid [entry $a.textframe.name -textvariable editbox_info($w,fea_edit_name) -font dnafont -width 50] -row 0 -column 1 -columnspan 4 -sticky nwe
    bind $a.textframe.name <Key> "after idle \"edit_box_apply $w name\""
    bind $a.textframe.name <$modifier-Key-c> "event generate $a.textframe.name <<Copy>>; break"
    bind $a.textframe.name <$modifier-Key-x> "event generate $a.textframe.name <<Cut>>; break"
    bind $a.textframe.name <$modifier-Key-v> "event generate $a.textframe.name <<Paste>> ; break"
    bind $a.textframe.name <$modifier-Key-a> "event generate $a.textframe.name <<SelectAll>> ; break"
    bind $a.textframe.name <Key-Tab> "focus $w.textarea; break"

    set popupmenu [menu $a.textframe.name.popupmenu]
    $popupmenu add command -label [mc "Cut"]  -accelerator "$modstring+X" -command "event generate $s.find <<Cut>>"
    $popupmenu add command -label [mc "Copy"]  -accelerator "$modstring+C" -command "event generate $s.find <<Copy>>"
    $popupmenu add command -label [mc "Paste"]  -accelerator "$modstring+V" -command "event generate $s.find <<Paste>>"
    bind $a.textframe.name <<RightClick>> "tk_popup $popupmenu %X %Y"

    #bind $a.textframe.name <FocusOut> "edit_box_apply $w name"

###
  $s.nb add [set a [frame $s.nb.f2]] -text [mc "Location"]
  grid columnconfigure $a 1 -weight 1
  grid rowconfigure $a 0  -weight 1
  # upper, plus_sel minus_sel above


  grid [frame $a.textframe -relief ridge -borderwidth 2] -row 0 -column 1 -sticky nswe
  grid columnconfigure $a.textframe 0 -weight 1
  #grid [text $a.textframe.loc -font dnafont -width 10 -height 2 -background $info(bg_color)] -row 1 -column 0 -columnspan 4 -sticky nswe
  grid [ttk::label $a.textframe.loc -textvariable editbox_info($w,fea_edit_loc) -style InfoboxStyle.TLabel] -row 1 -column 0 -columnspan 2 -sticky nswe
  grid [ttk::checkbutton $a.textframe.compl -text [mc "Rev-Com"] -variable editbox_info($w,fea_edit_dir) -onvalue 1 -offvalue 0  -command "edit_box_apply $w rev-com" -style InfoboxStyle.TCheckbutton] -row 1 -column 2 -sticky w
  grid [frame $a.textframe.buttonframe] -row 2 -column 0 -columnspan 3  -sticky we
  grid columnconfigure $a.textframe.buttonframe 0 -weight 1 -uniform 1
  grid columnconfigure $a.textframe.buttonframe 1 -weight 1 -uniform 1
  grid columnconfigure $a.textframe.buttonframe 2 -weight 1 -uniform 1
  grid [button $a.textframe.buttonframe.upper -text [mc "Uppercase Only"] -command "set editbox_info($w,fea_edit_loc) \[locations_upper $w \$editbox_info($w,fea_edit_loc)\]; edit_box_apply $w location" ] -row 2 -column 0 -sticky w
  grid [button $a.textframe.buttonframe.plus_sel -text [mc "Feature Plus Selection"] -command "set editbox_info($w,fea_edit_loc) \[locations_plus_selection $w \$editbox_info($w,fea_edit_loc) plus_sel\];  edit_box_apply $w location" ] -row 2 -column 1 -sticky w
  grid [button $a.textframe.buttonframe.minus_sel -text [mc "Feature Minus Selection"] -command "set editbox_info($w,fea_edit_loc) \[locations_plus_selection $w \$editbox_info($w,fea_edit_loc) minus_sel\]; edit_box_apply $w location" ] -row 2 -column 2 -sticky w

  ### need to make the commands here work instantly??
  grid [frame $a.infoframe -relief ridge -borderwidth 2] -row 1 -column 1 -sticky nswe
  grid columnconfigure $a.infoframe 1 -weight 1
  grid [frame $a.infoframe.stackingframe] -row 2 -column 1 -sticky nswe
  grid columnconfigure $a.infoframe.stackingframe 2 -weight 1
  grid [ttk::label $a.infoframe.stackingframe.l1 -text [mc "Place Directly Above Feature:"] -style InfoboxStyle.TLabel] -row 0 -column 1 -sticky w
  grid [menubutton $a.infoframe.stackingframe.featutres -menu $a.infoframe.stackingframe.featutres.menu -textvariable editbox_info($w,fea_edit_place_above_name) -font labelfont -width 15 -indicatoron 1] -row 0 -column 2 -sticky w
  menu $a.infoframe.stackingframe.featutres.menu
  $a.infoframe.stackingframe.featutres.menu insert 0 radiobutton -label [mc "Place on bottom"] -value "none" -variable editbox_info($w,fea_edit_place_above) -command "set editbox_info($w,fea_edit_place_above_name) \"[mc {Place on bottom}]\"; edit_box_apply $w stacking"
  set last_tag "none"
  


####
  if {0} {
  $s.nb add [set a [frame $s.nb.f3]] -text [mc "Apprearance"]
  grid columnconfigure $a 1 -weight 1
  grid rowconfigure $a 0  -weight 1
  #same arrow_f arrow_r flip width offset
  grid [frame $a.infoframe -relief ridge -borderwidth 2] -row 1 -column 1 -sticky nswe
  grid [frame $a.infoframe.gformatframe] -row 3 -column 1 -sticky nswe
  grid [label $a.infoframe.gformatframe.l1 -text [mc "Forward arrow:"]] -row 0 -column 1 -sticky w
  grid [entry $a.infoframe.gformatframe.e1 -textvariable editbox_info($w,fea_edit_f_arrow)] -row 0 -column 2 -sticky w
  grid [label $a.infoframe.gformatframe.l2 -text [mc "Reverse arrow:"]] -row 1 -column 1 -sticky w
  grid [entry $a.infoframe.gformatframe.e2 -textvariable editbox_info($w,fea_edit_r_arrow)] -row 1 -column 2 -sticky w
  grid [checkbutton $a.infoframe.gformatframe.c1 -text [mc "Flip on reverse"] -variable editbox_info($w,fea_edit_arrow_flip)]  -row 1 -column 3 -sticky w
  grid [label $a.infoframe.gformatframe.l3 -text [mc "Width:"]] -row 2 -column 1 -sticky w
  grid [entry $a.infoframe.gformatframe.e3 -textvariable editbox_info($w,fea_edit_g_width)] -row 2 -column 2 -sticky w
  grid [label $a.infoframe.gformatframe.l4 -text [mc "Offset:"]] -row 3 -column 1 -sticky w
  grid [entry $a.infoframe.gformatframe.e4 -textvariable editbox_info($w,fea_edit_g_offset)] -row 3 -column 2 -sticky w

  ## color
  grid [frame $a.infoframe.colorframe] -row 4 -column 1 -sticky nswe
  grid [ttk::label $a.infoframe.colorframe.label2 -text [mc "Forward color:"] -style InfoboxStyle.TLabel] -row 0 -column 1 -sticky w
  grid [color_button $a.infoframe.colorframe.fwdcolor editbox_info($w,fea_edit_fwd_color)  12] -sticky w -row 0 -column 2
  bind $a.infoframe.colorframe.fwdcolor <<color_picked>> "edit_box_apply $w color"
  grid [ttk::label $a.infoframe.colorframe.label3 -text [mc "Reverse color:"] -style InfoboxStyle.TLabel] -row 0 -column 3
  grid [color_button $a.infoframe.colorframe.revcolor editbox_info($w,fea_edit_rev_color)  12] -sticky w -row 0 -column 4
  bind $a.infoframe.colorframe.revcolor <<color_picked>> "edit_box_apply $w color"
  grid [button $a.infoframe.colorframe.revcolor_same -text [mc "Same"] -command "set editbox_info($w,fea_edit_rev_color) \$editbox_info($w,fea_edit_fwd_color); edit_box_apply $w color"] -sticky w -padx 5 -row 0 -column 5
  tooltip_install  $a.infoframe.colorframe.revcolor_same [mc "Make the reverse color the same as the forward color"]
  grid [menubutton $a.infoframe.colorframe.favs -menu $a.infoframe.colorframe.favs.menu -text [mc "Favorites"] -width 10 -indicatoron 1] -sticky w -padx 5 -row 0 -column 6
  menu $a.infoframe.colorframe.favs.menu
  fill_favs_menu $a $a.infoframe.colorframe.favs.menu editbox_info($w,fea_edit_fwd_color) editbox_info($w,fea_edit_rev_color)
  trace add variable info(feature_color_favorites) write "fill_favs_menu $a $a.infoframe.colorframe.favs.menu editbox_info($w,fea_edit_fwd_color)  editbox_info($w,fea_edit_rev_color) ;# "
  bind $a.infoframe.colorframe.favs <Destroy> "trace remove variable info(feature_color_favorites) write \"fill_favs_menu $a $a.infoframe.colorframe.favs.menu editbox_info($w,fea_edit_fwd_color)  editbox_info($w,fea_edit_rev_color) ;# \""
  bind $a.infoframe.colorframe.favs.menu <<color_picked>> "edit_box_apply $w color"
  ## add apply default for type
  ## add make current  default for type
  }

####
  if {0} {
  $s.nb add [set a [frame $s.nb.f4]] -text [mc "Qualifiers"]
### redo this as side-scrolling list of qualifiers
## menubutton- type
## textbox with scrollbar
## (<)  5/7 (>) (New) (Delete)
#######
  grid columnconfigure $a 1 -weight 1
  grid rowconfigure $a 1 -weight 1

  grid [ttk::scrollbar $a.s -command "treeview_do_entry_edit $a.t;$a.t yview"] -row 1 -column 2 -sticky ns
  grid [ttk::treeview $a.t -yscrollcommand "optionscrollbar $a.s" -height 3 -show {headings tree}] -row 1 -column 1 -sticky nswe
  bind $a.t <MouseWheel> "treeview_do_entry_edit $a.t"
  $a.t configure -columns {Value S} -displaycolumns {Value S}
  $a.t heading #0 -text [mc "Qualifier"] -command "#treeview_sort $a.t {}"
  $a.t column #0 -width 100 -minwidth 10 -stretch 1 -anchor e
  $a.t heading Value -text Value -command "#treeview_sort $a.t Value"
  $a.t column Value -minwidth 50 -stretch 1 -anchor w
  $a.t column S -minwidth 2 -width 2 -stretch 0 -anchor w
  bind $a.t <ButtonPress-1> "if {\[$a.t identify column %x %y\] ne \"#0\"} {treeview_edit_item $a.t \[$a.t identify item %x %y\] \[$a.t identify column %x %y\]; break}"
  bind $a.t <<CellEntryEdit>> "qualifier_table_calculate_dict "
}


####


  edit_box_treeviewselect $w
  grid $s -row 2 -column 0 -columnspan 5 -sticky snew
}

###########
##
############
proc qualifier_table_calculate_dict {treeview row column} {
  global editbox_info genbank_unquoted_qualifiers
  set w [winfo toplevel $treeview]

  set result [dict create]
  foreach e [$treeview children {}] {
    set text [$treeview set $e "#1"]
    if {[string tolower [set type [$treeview item $e -text]]] ni $genbank_unquoted_qualifiers} {
      set text [regsub -all "\"" $text "\"\""]
      set text "\"$text\""
    } else {#sputs type $type [$treeview item $e -text]}
    dict append result $type $text 
  }
  set editbox_info($w,fea_qualifiers_dict) $result

  ## redraw the treeview data from the dict, just to be sure they are aligned
  $treeview delete [$treeview children {}]
  foreach q [dict keys $editbox_info($w,fea_qualifiers_dict)] {
    set text [dict get $editbox_info($w,fea_qualifiers_dict) $q]
    regexp {\A\"(.*)\"\Z} $text - text
    set text [regsub -all {""} $text {\"} ]
    $treeview insert {} end -text $q -values [list $text]
  }
}

###########
##
############
proc edit_box_treeviewselect {w} {
  global editbox_info
  set t $w.tvframe.tv
  set s $w.edit_features_frame

  if {![winfo exists $s]} {return}
  set tags [$t selection]

  set tags [lreplace $tags [lsearch $tags "hidden"] [lsearch $tags "hidden"]]
  set hidden_count 0
  for {set i 0} {$i < [llength $tags]} {incr i} {
    if {[$t parent [set tag [lindex $tags $i]]] == "hidden"} {incr hidden_count}
    if {[regexp {f[0-9]+#} [$t parent [set tag [lindex $tags $i]]]] }  {
      set tags [lreplace $tags $i $i [$t parent $tag]]
    }
  }

  set tags [lsort -unique $tags]
  grid remove $s.ok_frame.hide2
  grid configure $s.ok_frame.hide
  grid configure $s.ok_frame.delete
  if {[llength $tags] > 1 || [llength $tags] < 1} {
    set  editbox_info($w,fea_edit_name) ""
    set editbox_info($w,fea_edit_loc) ""
    set editbox_info($w,fea_edit_dir) ""
    set editbox_info($w,fea_edit_type) ""
    set editbox_info($w,fea_edit_fwd_color) ""
    set editbox_info($w,fea_edit_rev_color) ""
    set editbox_info($w,fea_edit_place_above_name) ""
    set editbox_info($w,fea_edit_place_above) ""
    $s.nb.f2.textframe.buttonframe.upper configure -state disabled
    $s.nb.f2.textframe.buttonframe.plus_sel configure -state disabled
    $s.nb.f2.textframe.buttonframe.minus_sel configure -state disabled
    $s.nb.f2.textframe.compl configure -state disabled
    $s.nb.f2.infoframe.stackingframe.featutres configure -state disabled
    $s.nb.f1.textframe.name configure -state disabled
    $s.nb.f1.textframe.type configure -state disabled
    #$s.nb.f3.infoframe.colorframe.revcolor_same configure -state disabled
    if {[llength $tags] < 1} {
      grid remove $s.ok_frame.hide
      grid remove $s.ok_frame.delete
    }
  }
  if {[llength $tags] > 1} {
###
    # enable and fill multiple selection entries (colors, types, display_data)
    # change delete to delete #selected
    # change hide/show to hide/show #selected -add hide selected button if mixed hidden/show
    if {$hidden_count == 0} {
      $s.ok_frame.hide configure -text [mc "Hide %s" [llength $tags]] -command "featuretable_edit_items $w 0 hide_selected"
    } else {
      $s.ok_frame.hide configure -text [mc "Show %s" [llength $tags]]  -command "featuretable_edit_items $w 0 show_selected"
      if {$hidden_count != [llength $tags]} {
        grid configure $s.ok_frame.hide2 
        $s.ok_frame.hide2 configure -text [mc "Hide %s" [llength $tags]]  -command "featuretable_edit_items $w 0 hide_selected"
      }
    }


  } elseif {[llength $tags] == 1} {
    ## single tag selected
    if {$hidden_count == 0} {
      $s.ok_frame.hide configure -text [mc "Hide"] -command "featuretable_edit_items $w 0 hide_selected"
    } else {
      $s.ok_frame.hide configure -text [mc "Show"] -command "featuretable_edit_items $w 0 show_selected"
    }
    $s.nb.f2.textframe.buttonframe.upper configure -state normal
    $s.nb.f2.textframe.buttonframe.plus_sel configure -state normal
    $s.nb.f2.textframe.buttonframe.minus_sel configure -state normal
    $s.nb.f2.infoframe.stackingframe.featutres configure -state normal
    $s.nb.f2.textframe.compl configure -state normal
    $s.nb.f1.textframe.name configure -state normal
    $s.nb.f1.textframe.type configure -state normal
    #$s.nb.f3.infoframe.colorframe.revcolor_same configure -state normal
    set feature $tags
    set metadata [$w.textarea tag bind $feature <<Metadata>>]
    set  editbox_info($w,fea_edit_name) [lindex $metadata 0]
    set editbox_info($w,fea_edit_loc) [feature_coords_text $w $feature]
    set editbox_info($w,fea_edit_dir) [lindex $metadata 3]
    set editbox_info($w,fea_edit_type)  [lindex $metadata 2]
    set editbox_info($w,fea_qualifiers_dict) [lindex $metadata 4]
    set colors [$w.textarea tag bind $feature <<Revcolors>>]
    set editbox_info($w,fea_edit_fwd_color) [lindex $colors 0]
    set editbox_info($w,fea_edit_rev_color) [lindex $colors 1]
    set a $s.nb.f2
    if {[winfo exists $a.infoframe.stackingframe.featutres.menu]} {
      $a.infoframe.stackingframe.featutres.menu delete 0 end
      $a.infoframe.stackingframe.featutres.menu insert 0 radiobutton -label [mc "Place on bottom"] -value "none" -variable editbox_info($w,fea_edit_place_above) -command "set editbox_info($w,fea_edit_place_above_name) \"[mc {Place on bottom}]\"; edit_box_apply $w stacking"
      set last_tag "none"
      foreach tag [$w.textarea tag names] {
        if {$tag == $feature} {
          set editbox_info($w,fea_edit_place_above) $last_tag
          if {$last_tag != "none"} {
            set editbox_info($w,fea_edit_place_above_name) [lindex [$w.textarea tag bind $last_tag <<Metadata>>] 0]
          } else {
            set editbox_info($w,fea_edit_place_above_name) [mc {Place on bottom}]
          }
        } else {
          if {([regexp {f[0-9]+#} $tag]) && ([llength [$w.textarea tag ranges $tag]] > 1)} {
            $a.infoframe.stackingframe.featutres.menu insert 0 radiobutton -label [lindex [$w.textarea tag bind $tag <<Metadata>>] 0] -value $tag -variable editbox_info($w,fea_edit_place_above) -command "set editbox_info($w,fea_edit_place_above_name) \"[lindex [$w.textarea tag bind $tag <<Metadata>>] 0]\"; edit_box_apply $w stacking"
            set last_tag $tag
          }
        }
      }
    } 

    
    ## Fill Qualifiers frame
if {0} {
    $s.nb.f4.t delete [$s.nb.f4.t children {}]
    foreach q [dict keys $editbox_info($w,fea_qualifiers_dict)] {
      ##take off quotes
      set text [dict get $editbox_info($w,fea_qualifiers_dict) $q]
      regexp {\A\"(.*)\"\Z} $text - text
      set text [regsub -all {""} $text "\""]
      $s.nb.f4.t insert {} end -text $q -values [list $text]
    }
    #$s.nb.f4.t insert {} end -text [mc "New Value"] -values [list ]
}
    ## Fill Display frame
    set display_data  [lindex $metadata 1]
    if {[dict exists $display_data arrow_data]} {
      set editbox_info($w,fea_edit_f_arrow) [lindex [dict get $display_data arrow_data] 0]
      set editbox_info($w,fea_edit_r_arrow) [lindex [dict get $display_data arrow_data] 1]
      set editbox_info($w,fea_edit_arrow_flip) [lindex [dict get $display_data arrow_data] 2]
    }
    if {[dict exists $display_data width]} {
      set editbox_info($w,fea_edit_g_width) [dict get $display_data width]
    }
    if {[dict exists $display_data offset]} {
      set editbox_info($w,fea_edit_g_offset) [dict get $display_data offset]
    }
  }
  ## change hide to show if tag is hidden

}

###########
##
############
proc edit_box_apply {w type} {
  global editbox_info
  set t $w.tvframe.tv
  set tags [$t selection]


  set tags [lreplace $tags [lsearch $tags "hidden"] [lsearch $tags "hidden"]]
  for {set i 0} {$i < [llength $tags]} {incr i} {
    if {[regexp {f[0-9]+#} [$t parent [set tag [lindex $tags $i]]]] }  {
      set tags [lreplace $tags $i $i [$t parent $tag]]
    }
  }
  set tags [lsort -unique $tags]
  set feature [lindex $tags 0]
  switch $type {
    "location" {
       #location
      if {[llength $tags] == 1} {
        apply_loc_list $w $feature $editbox_info($w,fea_edit_loc)
      }
    }
    "qualifiers" {
      if {[llength $tags] == 1} {
        set metadata [$w.textarea tag bind $feature <<Metadata>>]
        set qual $editbox_info($w,fea_qualifiers_dict)
        lset metadata 4 $qual
        textarea_tag_bind $w.textarea $feature <<Metadata>> $metadata
        register_undo_separator $w "Configure Feature"
        features_to_tree_view $w
      }
    }
    "rev-com" {
      if {[llength $tags] == 1} {
        set metadata [$w.textarea tag bind $feature <<Metadata>>]
        set dir $editbox_info($w,fea_edit_dir)
        lset metadata 3 $dir
        textarea_tag_bind $w.textarea $feature <<Metadata>> $metadata
        set colorlist [$w.textarea tag bind $feature <<Revcolors>>]
        if {[$w.textarea tag cget $feature -background] != {}} {
          textarea_tag_configure $w.textarea $feature -background [lindex $colorlist $dir]
        }
        $t tag configure $feature -background [lindex $colorlist $dir]
        register_undo_separator $w "Reverse Feature"
        features_to_tree_view $w
      }
    }
    "stacking" {
      #stacking
      foreach feature $tags {
        if {$editbox_info($w,fea_edit_place_above) != "none"} {
          textarea_tag_raise $w.textarea $feature $editbox_info($w,fea_edit_place_above)
	  register_undo_separator $w "Raise Feature"
        } else {
          set bottomfeature [lsearch -regexp -inline [$w.textarea tag names] {f[0-9]+#}]
          if {$bottomfeature != {}} {
            textarea_tag_lower $w.textarea $feature $bottomfeature
	    register_undo_separator $w "Lower Feature"
          }
        }
      }
    }
    "name" {
      #name
      if {[llength $tags] == 1} {
        set metadata [$w.textarea tag bind $feature <<Metadata>>]
        lset metadata 0 $editbox_info($w,fea_edit_name)
        textarea_tag_bind $w.textarea $feature <<Metadata>> $metadata
        register_undo_separator $w "Edit Feature Name"
        features_to_tree_view $w

      }
    }
    "color" {
      #color
      foreach feature $tags {
        set colorlist [$w.textarea tag bind  $feature <<Revcolors>>]
        if {![catch {winfo rgb . $editbox_info($w,fea_edit_fwd_color)}]} {
          lset colorlist 0 $editbox_info($w,fea_edit_fwd_color)
        }
        if {![catch {winfo rgb . $editbox_info($w,fea_edit_rev_color)}]} {
          lset colorlist 1 $editbox_info($w,fea_edit_rev_color)
        }
        textarea_tag_bind $w.textarea $feature <<Revcolors>> $colorlist
        if {[$w.textarea tag cget $feature -background] != {}} {
          textarea_tag_configure $w.textarea $feature -background [lindex $colorlist [lindex [$w.textarea tag bind $feature <<Metadata>>] 3]]
        }
        register_undo_separator $w "Change Feature Color"
      }
      features_to_tree_view $w
    }
    "type" {
       #type
      if {[llength $tags] == 1} {
        set metadata [$w.textarea tag bind $feature <<Metadata>>]
        lset metadata 2 $editbox_info($w,fea_edit_type)
        textarea_tag_bind $w.textarea $feature <<Metadata>> $metadata
        register_undo_separator $w "Change Feature Type"
        features_to_tree_view $w
      }
    }
    default {
      sputs edit_box_apply untrapped
    }
  }

}

##############
## ORF search box in sequence window
##############
proc add_orf_search_box {w} {
  global  info toolbar_images
  if {[winfo exists $w.orf_search_frame]} {
    grid configure $w.orf_search_frame
    return
  }

  set s [frame $w.orf_search_frame]

  if {$info(android)} {
      grid [frame $s.buttons_frame] -row 0 -column 0 -rowspan 3 -sticky nsew
      label  $s.buttons_frame.edit_features -image $toolbar_images(button_edit,4x)  -borderwidth 1
      bind $s.buttons_frame.edit_features <ButtonRelease-1>  "grid remove $s; add_feature_edit_box $w" 
      bind $s.buttons_frame.edit_features <ButtonRelease-2>  "grid remove $s; add_feature_edit_box $w" 

      label  $s.buttons_frame.find -image $toolbar_images(button_find,4x)  -borderwidth 1
      bind $s.buttons_frame.find <ButtonRelease-1>  "grid remove $s; find_dialog $w 1" 
      bind $s.buttons_frame.find <ButtonRelease-2>  "grid remove $s; find_dialog $w 1" 

      label  $s.buttons_frame.seq_info -image $toolbar_images(button_info,4x)  -borderwidth 1
      bind $s.buttons_frame.seq_info <ButtonRelease-1>  "grid remove $s" 
      bind $s.buttons_frame.seq_info <ButtonRelease-2>  "grid remove $s" 

      grid $s.buttons_frame.edit_features -row 0 -column 0
      grid $s.buttons_frame.find -row 1 -column 0
      grid $s.buttons_frame.seq_info -row 2 -column 0

      grid rowconfigure $s.buttons_frame 0 -minsize 30
      grid rowconfigure $s.buttons_frame 1 -minsize 30
      grid rowconfigure $s.buttons_frame 2 -minsize 30
  } else {
    grid [frame $s.buttons_frame] -row 0 -column 0 -rowspan 3 -sticky nsew
    ttk::button $s.buttons_frame.edit_features -style Icon.MD.TButton -image $toolbar_images(button_edit) -command "grid remove $s; add_feature_edit_box $w"
    ttk::button $s.buttons_frame.find -style Icon.MD.TButton -image $toolbar_images(button_find) -command "grid remove $s; find_dialog $w 1"
    ttk::button $s.buttons_frame.seq_info -style Icon.MD.TButton -image $toolbar_images(button_info) -command "grid remove $s"
    grid $s.buttons_frame.edit_features -row 0 -column 0
    grid $s.buttons_frame.find -row 1 -column 0
    grid $s.buttons_frame.seq_info -row 2 -column 0
    grid rowconfigure $s.buttons_frame 0 -minsize 30
    grid rowconfigure $s.buttons_frame 1 -minsize 30
    grid rowconfigure $s.buttons_frame 2 -minsize 30
  }

  grid columnconfigure $s 1 -weight 1
  grid rowconfigure $s 0  -weight 1


  ## Starts with, Strand, min size
  grid [frame $s.settings_frame] -row 0 -column 1 -sticky sew

  grid [ttk::label $s.settings_frame.starts_label  -text [mc "ORF Starts With"] -style InfoboxStyle.TLabel] -row 0 -column 1 -sticky w
  grid [menubutton $s.settings_frame.starts -menu $s.settings_frame.starts.menu -textvariable info(find_orf_starts) -font labelfont -indicatoron 1] -row 0 -column 2 -sticky w
    menu $s.settings_frame.starts.menu
    $s.settings_frame.starts.menu add radiobutton -label [mc "Met"] -variable info(find_orf_starts) -value "Met"
    $s.settings_frame.starts.menu add radiobutton -label [mc "Stop+1"] -variable info(find_orf_starts) -value "Stop+1"

  grid [ttk::label $s.settings_frame.strand_label -text [mc "Search Strand"] -style InfoboxStyle.TLabel] -row 0 -column 3 -sticky w
  grid [menubutton $s.settings_frame.strand -menu $s.settings_frame.strand.menu -textvariable info(find_orf_strand_text) -font labelfont -width 9 -indicatoron 1] -row 0 -column 4 -sticky w
    menu $s.settings_frame.strand.menu
    $s.settings_frame.strand.menu add radiobutton -label [mc "Top"] -variable info(find_orf_strand) -value 1 -command "set info(find_orf_strand_text) [mc Top]"
    $s.settings_frame.strand.menu add radiobutton -label [mc "Bottom"] -variable info(find_orf_strand) -value -1 -command "set info(find_orf_strand_text) [mc Bottom]"
    $s.settings_frame.strand.menu add radiobutton -label [mc "Both"] -variable info(find_orf_strand) -value 0 -command "set info(find_orf_strand_text) [mc Both]"
    set info(find_orf_strand_text) [lindex [list [mc Bottom] [mc Both] [mc Top]] [expr {$info(find_orf_strand) +1}]]

  grid [ttk::label $s.settings_frame.min_orf_label -text [mc "Minimum bp"] -style InfoboxStyle.TLabel] -row 1 -column 1 -sticky w
  grid [menubutton $s.settings_frame.min_orf -menu $s.settings_frame.min_orf.menu -textvariable info(find_orf_min) -font labelfont -indicatoron 1] -row 1 -column 2 -sticky w
    menu $s.settings_frame.min_orf.menu
    foreach min [list 0 30 60 90 180 300 600 900 1200 1500] {
      $s.settings_frame.min_orf.menu add radiobutton -label $min -variable info(find_orf_min) -value $min
    }

  grid [ttk::label $s.settings_frame.orf -textvariable info($w,orf_text) -style InfoboxStyle.TLabel] -row 1 -column 3 -sticky w


  grid [frame $s.results_frame] -row 1 -column 1 -sticky sew
  ## Fwd, rev ORF translation
  grid [ttk::label $s.results_frame.fwd_label -text ">>>" -style InfoboxStyle.TLabel] -row 0 -column 1 -sticky w
  grid [ttk::label $s.results_frame.fwd -textvariable info($w,selection_Trans) -style InfoboxStyle.TLabel] -row 0 -column 2 -sticky w
  grid [ttk::label $s.results_frame.rev_label -style InfoboxStyle.TLabel -text "<<<"] -row 1 -column 1 -sticky w
  grid [ttk::label $s.results_frame.rev -textvariable info($w,selection_Trans_rev) -style InfoboxStyle.TLabel] -row 1 -column 2 -sticky w



  grid [frame $s.action_frame] -row 2 -column 1 -sticky sew
    grid [button $s.action_frame.next -text [mc "Find Next"] -command "next_ORF $w forward" -default active] -row 1 -column 1 -sticky n
    grid [button $s.action_frame.prev -text [mc "Find Prev"] -command "next_ORF $w reverse"] -row 1 -column 2 -sticky n
    #grid [button $s.action_frame.all -text [mc "Highlight All"] -command "set info(find_action) highlight; do_find $w highlight"] -row 1 -column 3 -sticky n

   

  grid $s -row 2 -column 0 -columnspan 5 -sticky nsew
}

##############
## toggle visiblity of the feature table treeview
##############
proc toggle_features_treeview {w} {
  if {[grid info $w.tvframe] == ""} {
    grid configure $w.tvframe
    #update
  } else {
    grid remove $w.tvframe
    #update
  }
}

##############
## add sel tag to all selections in the feature table treeview (normal selection highlight is below tag backgrounds)
##############
proc treeview_manageselection {t} {
  foreach item [bind $t <<OldSelection>>] {
    #### can use tag remove when 8.6 is available
    if {[$t exists $item] && ([set i [lsearch [$t item $item -tags] sel]] > -1)} {
      $t item $item -tags [lreplace [$t item $item -tags] $i $i]  
    }
  }
  foreach item [$t selection] {
     ####can use tag add in 8.6
     $t item $item -tags [list {*}[$t item $item -tags] sel]
  }
  bind $t <<OldSelection>> [$t selection]
}

##############
## resize feature table by dragging resize frame
##############
proc treeview_resize {t y} {
  global info
  if {[bind $t <<resizeY>>] == ""} {return}
  set deltaY [expr {$y-[bind $t <<resizeY>>]}]
  set w [winfo toplevel $t]
  set newHeight [expr {[bind $t <<resizeHeight>>] + $deltaY / [ttk::style_actual configure Featuretable.Treeview -rowheight]}]
#rowheight default=16, header =15?, 
# usually 60 pixels, can be 85 if 
# exec defaults read "Apple Global Domain" AppleScrollBarVariant
# returns DoubleBoth
  if {[$t cget -height] != $newHeight && $newHeight >= $info(feature_table_minsize)} {

    set w1 [$t column #0 -width] 
    set w2 [$t column Direction -width] 
    set w3 [$t column Type -width]
    set w4 [$t column Location -width]
    $t column #0 -width 200 -stretch 0
    $t column Location -width 200 -stretch 0 
    $t configure -height $newHeight
    #$w.tvframe configure -height [expr {[winfo $t reqheight]+4}]

    $t column Location -width $w4 
    $t column Type -width $w3
    $t column Direction -width $w2
    $t column #0 -width $w1
    $t column #0 -stretch 1
    $t column Location -stretch 1
  }
}

##############
## 
##############
proc treeview_copy {t} {
  clipboard clear 
  clipboard_append -displayof [winfo toplevel $t] [treeview_to_text $t]
}

##############
## 
##############
proc treeview_to_text {t {selected_only 1}} {
  set result [list "[$t heading #0 -text]\t[join [$t cget -columns] \t]"]
  if {[$t selection] == {} || !$selected_only} {
    set t_selection [$t children {}]
  } else {
    set t_selection [$t selection]
  }
  foreach c $t_selection {
    lappend result "[$t item $c -text]\t[join [$t item $c -values] \t]"   
  }
  return [join $result \n]
}

##############
## 
##############
proc treeview_save {t {filename {}}} {
  global info
  while { (![file isdirectory $info(default_dnadir)])} {
    set info(default_dnadir) [file dirname $info(default_dnadir)]
  }
  if {[file dirname $info(default_dnadir)] == $info(default_dnadir)} {
    set info(default_dnadir) [valid_default_dir]
  }

  if {$filename == ""} {
    set filename [tk_getSaveFile -title [mc "Save As Text File"] -initialdir $info(default_dnadir) -defaultextension ".txt"]
  }
  while {($filename != "") && ([catch {set text_file [open $filename w]}])} {
    catch {close $text_file}
    tk_messageBox -title [mc "Text File not Writable"] -message [mc "The file %s is not writable. It may be locked." $filename] -type ok -icon warning -default ok
    set filename [tk_getSaveFile -title [mc "Save As Text File"] -initialdir $info(default_dnadir) -defaultextension ".txt"]
  }
  if {$filename != ""} {
    puts $text_file [treeview_to_text $t 0]
    incr i
    close $text_file
  }
} 

##############
## 
##############
proc treeview_print {t} {

}


##############
## add all textarea features to the feature table treeview
##############
# call features_to_tree_view after: #put_tags #feature_scan #edit_feature_dialog #feature_cleanup #feature_clear #delete_feature #hide/show feature #add/remove group
    #<<Metadata>>:(0)name, (1)format_info, (2)type, (3)fwd/rev, (4)annotations_string (qualifiers data), (5) groups list
proc features_to_tree_view {w} {
  global info
  set tv $w.tvframe.tv
  set text $w.textarea
  if {[$tv exists hidden]} {
    set hidden_open_state [$tv item hidden -open]
  } else  {
    set hidden_open_state 0
  }

  set starting_selection [$tv selection]

  #remember the tree open state of all items
  set open_items_list [list]
  foreach item [$tv children {}] {
    if {[$tv item $item -open]} {
      lappend open_items_list $item
    }
  }

  #set current_groups [dict create]
  #set new_groups_count [dict create]
  #set current_groups_count [dict create]
  #set tag_group_dict [dict create]
  ## make dict of heading names and column IDs for all columns, initialize current_groups_count dict
  #for {set i 0} {$i < 20} {incr i} {
  #  if {[set heading [$tv heading [format "g_%03u" $i] -text]] != {}} {
  #    dict lappend current_groups $heading [format "g_%03u" $i]
  #    dict set current_groups_count $heading 0
  #  }
  #}

  set taglist [lsearch -inline -regexp -all -not [$text tag names] {trans[0-9]+#|fn[0-9]+#|tempsel|sel|foundf|foundr}]
  $tv delete [$tv children {}]
  set new_taglist [list]
  foreach tag $taglist {
    #<<Metadata>>:(0)name, (1)format_info, (2)type, (3)fwd/rev, (4)annotations_string (qualifiers data), (5) groups list
    set meta [$text tag bind $tag <<Metadata>>]
    if {[regexp {f[0-9]+#} $tag]} {
      lappend new_taglist [list $tag [lindex $meta 0] [lindex $meta 3] [lindex $meta 2] [feature_coords_text $w $tag]  [lindex $meta 4]]
      #initialize and count tag groups
      #dict set tag_group_dict $tag [list]
      #foreach g [lindex $meta 5] {
      #  dict lappend tag_group_dict $tag $g
      #  if {[dict exists $current_groups_count $g]} {
      #    dict incr current_groups_count $g
      #  } else {
      #    dict incr new_groups_count $g
      #  }
      #}
    } else {
      #add enzyme features here- either as a single tree feature or as multiple single features
    }
  }

  ## generate stored translation and cds data for x-ray window
  set trans_dict [dict create]
  set cds_dict [dict create]
  set end [ix2bp $w.textarea end]
  foreach cds_trans_list [cds_trans_lines $w] {
    foreach {cds_tag cds_trans cds_dna} $cds_trans_list {}
    if {[regexp {[^\s]} $cds_trans]} {
      dict set trans_dict $cds_tag  $cds_trans
      dict set cds_dict $cds_tag $cds_dna 
    }
  }
  set info($w,trans_dict) $trans_dict
  set info($w,cds_dict) $cds_dict


  foreach tag_record [lsort -dictionary -index [lsearch [list tag {} Direction Type Location subfeatures] [bind $tv <<Sort_column>>]] {*}-[expr {[bind $tv <<Sort_direction>>]?"increasing":"decreasing"}] $new_taglist] {
   set tag [lindex $tag_record 0]
    if {[$w.textarea tag ranges $tag] == {}} {continue}
    catch {$tv insert {} end -id $tag -text [lindex $tag_record 1] -tag $tag} 
    $tv set $tag Direction [expr {[lindex $tag_record 2]?"<<<":">>>"}]
    $tv set $tag Type [lindex $tag_record 3]
    $tv set $tag Location [lindex $tag_record 4]
    set start_end_ix [feature_tag_start_end_ix $w $tag]
    if {[llength $start_end_ix] > 2} {
      $tv tag bind $tag <Button-1> "select_region $w \[bp2ix $w.textarea [ix2bp $w.textarea [lindex $start_end_ix 1]]\] \[bp2ix $w.textarea [ix2bp $w.textarea [lindex $start_end_ix 0]]\]; focus .; focus $w.textarea" 
    } else {
      $tv tag bind $tag <Button-1> "select_region $w \[bp2ix $w.textarea [ix2bp $w.textarea [lindex $start_end_ix 1]]\] \[bp2ix $w.textarea [ix2bp $w.textarea [lindex $start_end_ix 0]]\] ; focus .; focus $w.textarea" 
    }

    ## set primer sequence text tags here
    if {[lindex $tag_record 3] eq "primer_bind" || [lindex $tag_record 3] eq "primer"} {
      primer_feature_update_metadata $w.textarea $tag_record
    } else {
      $w.textarea tag bind $tag <<Primer_data>> ""
    }
    
    set i 0
    ## add in the qualifiers data from Metadata index 4
    foreach {subfeature data}  [lindex $tag_record 5] {
      $tv insert $tag end -id "$tag.$i#" 
      $tv set "$tag.$i#" Type $subfeature
      $tv set "$tag.$i#" Location $data
      incr i
    }

    if {[lsearch -exact $open_items_list $tag] > -1} {
      $tv item $tag -open 1
    }

    if {[$w.textarea tag cget $tag -background] == ""} {
      if {![$tv exists hidden]} {
        $tv insert {} 0 -id hidden -text Hidden -tag hidden -open $hidden_open_state
      }
      if {$info(color_feature_table_tags)} {
        $tv tag configure $tag -foreground [lindex [$w.textarea tag bind $tag <<Revcolors>>] [lindex [$w.textarea tag bind $tag <<Metadata>>] 3]] -background gray95
      } else {
        $tv tag configure $tag -background {}  -foreground {}
      }
      $tv move $tag hidden end
    } else {
      if {$info(color_feature_table_tags)} {
        $tv tag configure $tag -background [lindex [$w.textarea tag bind $tag <<Revcolors>>] [lindex [$w.textarea tag bind $tag <<Metadata>>] 3]]  -foreground black
      } else {
        $tv tag configure $tag -background {}  -foreground {}
      }
    }
  }

  if {[$tv cget -displaycolumns] != [list Direction Type Location]} {
    #  if we are changing the display columns (adding or removing groups), we need to add up the widths of all of the displayed columns, then adjust the size of the Location column to keep the treeview with constant. The widths need to be adjusted BEFORE changing the display columns. Changing display columns immediately fires a width adjustment on the treeview, which propagates up to the toplevel window. 
    set i 0
    foreach column [list #0 Direction Type] {
      incr i [$tv column $column -width]
    }
    $tv column Location -width [expr {max (16,[winfo width $tv] - $i -4)}]
    $tv configure -displaycolumns [list Direction Type Location]
  }

  foreach tag $starting_selection {
    if {[$tv exists $tag]} {
      $tv selection add $tag
    }
  }
  textarea_fill_map $w
  if {$info(inline_mode)} {
    reline $w.textarea $info($w,textwidth)
  }
}

##############
## sort feature table treeview
##############
proc treeview_sort {t column {keep_direction 0} {mode -dictionary}} {
  global toolbar_images

  if {([bind $t <<Sort_column>>] == $column)} {
    if {!$keep_direction} {
      set direction [expr {![bind $t <<Sort_direction>>]}]
    } else {
      set direction [expr {[bind $t <<Sort_direction>>]}]
    }
  } else {
    set direction 1
  }

  set l [list]
  foreach item [$t children {}] {
    if {$item eq "hidden"} {continue}
    if {$column != {}} {
      lappend l [list $item [$t set $item $column]]
    } else {
      lappend l [list $item [$t item $item -text]]
    }
  }
  set o [list]
  foreach pair [lsort $mode -index 1 {*}-[expr {$direction?"increasing":"decreasing"}] $l] {
      lappend o [lindex $pair 0]
  }

  if {[$t exists hidden]} {
    set l [list]
    foreach item [$t children hidden] {
      if {$column != {}} {
        lappend l [list $item [$t set $item $column]]
      } else {
        lappend l [list $item [$t item $item -text]]
      }
    }
    set o2 [list]
    foreach pair [lsort $mode -index 1 {*}-[expr {$direction?"increasing":"decreasing"}] $l] {
      lappend o2 [lindex $pair 0]
    }
    $t children hidden $o2
    if {[llength $o2] > 0} {
      set o [linsert $o 0 hidden]
    } 
  }
  $t children {} $o


  #remove the arrow on the old sort column
  set ccolumn [bind $t <<Sort_column>>]
  if {[bind $t <<Sort_column>>] == {}} {
    set ctext [$t heading #0 -text]
    regsub " \u2193" $ctext "" ctext
    regsub " \u2191" $ctext "" ctext
    $t heading #0 -text $ctext  
  } else {
    $t heading $ccolumn -text [$t column $ccolumn -id]
  }

  #add the arrow to the new column
  if {$column == {}} {
    set ctext [$t heading #0 -text]
    regsub " \u2193" $ctext "" ctext
    regsub " \u2191" $ctext "" ctext
    set ccolumn #0
  } else {
    set ctext [$t column $column -id]; set ccolumn $column
  }
  if {$direction} {
   $t heading $ccolumn -text "$ctext \u2193"
  } else {
   $t heading $ccolumn -text "$ctext \u2191"
  }
  bind $t <<Sort_column>> $column
  bind $t <<Sort_direction>> $direction
}

##############
## process right-click events in the feature table treeview
##############
proc featuretable_rightclick {w x y} {
  global featuretable_popup_type info dialogblock genbank_divided_typelist
  set f $w.tvframe
  set t $w.tvframe.tv
  set column [$t identify column $x $y]  
  set row [$t identify row $x $y]
  if {($row !={}) && ([$t bbox $row] == {})} {set row {}}
  set column [$t column $column -id]
  if {($row != {}) && (![regexp {\#\.} $row])} {
    if {[winfo exists $t.popupmenu]} {
      destroy $t.popupmenu
    }
    if {$dialogblock || $info($w,locked)} {
      set popupmenu [menu $t.popupmenu]
      $t.popupmenu add command -label [mc "File is locked"]  -state disabled
      tk_popup $t.popupmenu [winfo pointerx $w] [winfo pointery $w]
      return
    }
    if {$row eq "hidden"} {
      set popupmenu [menu $t.popupmenu]
      $t.popupmenu add command -label [mc "Show All Features"]  -command "featuretable_edit_items $w $row show_all"
      tk_popup $t.popupmenu [winfo pointerx $w] [winfo pointery $w]
      return
    }
    #right click on items
    set metadata [$w.textarea tag bind $row <<Metadata>>]
    set featuretable_popup_type [lindex $metadata 2]
    set popupmenu [menu $t.popupmenu]
    $t.popupmenu add command -label [lindex $metadata 0] -state disabled

    if {($featuretable_popup_type eq "primer_bind" || $featuretable_popup_type eq "primer") && [set compatible_primers [do_pcr_get_compatible_primers $w.textarea $row $info($w,circular)]] ne {}} {
      menu $t.popupmenu.compatible_pcr_menu
      foreach primer $compatible_primers {
        lassign $primer name compatible_ftag
        $t.popupmenu.compatible_pcr_menu add command -label [mc "Do PCR with %s" $name] -command "do_pcr_from_tags $w $row $compatible_ftag"
      }
    }
    #$t.popupmenu add separator
    if {($column == {}) || $column == "#0"} {
      $t.popupmenu add command -label [mc "Edit Feature Name"] -command "treeview_edit_item $t $row #0; bind $t <<CellEntryEdit>> \"featuretable_edit_name \""
      #$t.popupmenu add cascade -label [mc "Edit Appearance"] -menu $t.popupmenu.popup1
      #  menu $t.popupmenu.popup1
        $t.popupmenu add command -label [mc "Change Color"] -command "featuretable_edit_items $w $row color"
      #  make uppercase
      #  $t.popupmenu.popup1 add cascade -label [mc "Arrow Style"] -menu $t.popupmenu.popup1.a
      #    menu $t.popupmenu.popup1.a
      $t.popupmenu add command -label [mc "Edit Feature (Dialog)"] -command "featuretable_edit_items $w $row dialog"
      $t.popupmenu add cascade -label [mc "Arrange"] -menu $t.popupmenu.popup2
        menu $t.popupmenu.popup2
        $t.popupmenu.popup2 add command -label [mc "Bring to Top"] -command "featuretable_edit_items $w $row raise"
        $t.popupmenu.popup2 add command -label [mc "Send to Bottom"] -command "featuretable_edit_items $w $row lower"
      #$t.popupmenu add command -label [mc "Add Subfeature"] -state disabled
      if {[$t parent $row] eq "hidden"} {
        $t.popupmenu add command -label [mc "Show Feature"]  -command "featuretable_edit_items $w $row show"
        $t.popupmenu add command -label [mc "Show All Features"]  -command "featuretable_edit_items $w $row show_all"
      } else {
        $t.popupmenu add command -label [mc "Hide Feature"]  -command "featuretable_edit_items $w $row hide"
        $t.popupmenu add command -label [mc "Hide All Features"]  -command "featuretable_edit_items $w $row hide_all"
      }
      if {$featuretable_popup_type eq "primer_bind" || $featuretable_popup_type eq "primer"} {
        $t.popupmenu add separator
        $t.popupmenu add command -label [mc "Copy Primer Sequence"] -command "copy_primer_feature_sequence $w $row"
      }
      if {[winfo exists $t.popupmenu.compatible_pcr_menu]} {
        $t.popupmenu add separator
        $t.popupmenu add cascade -label [mc "Do PCR"] -menu $t.popupmenu.compatible_pcr_menu
      }
      $t.popupmenu add separator
      $t.popupmenu add command -label [mc "Delete Feature"]  -command "featuretable_edit_items $w $row delete"
      #regexp -all -inline {f[0-9]+#(?:[\s]|$)} [$t selection ]
      if {[llength [regexp -all -inline {f[0-9]+#(?:[\s]|$)} [$t selection ]]] > 1} {
        #needs to deal with possible subfeatures- count how many features are in selection, or only subfeatures. What do do if selection spans main features and subfeatures?
        $t.popupmenu add separator
        set fcount  [llength [regexp -all -inline {f[0-9]+#(?:[\s]|$)} [$t selection ]]]
        set fdir ""
        set ftype ""
        foreach fsel [$t selection ] {
          set metadata [$w.textarea tag bind $fsel <<Metadata>>]
          if {$metadata eq ""} {continue}
          set dir [lindex $metadata 3]
          set feature_type [lindex $metadata 2]
          sputs dir $fsel $fdir $metadata $dir
          if {$fdir eq ""} {
            set fdir $dir
            set ftype $feature_type
          } elseif {$dir != $fdir || $ftype ne $feature_type} {
            set fdir -1
            break
          }
        }
        if {$fdir != "" && $fdir != -1} {
          $t.popupmenu add command -label [mc "Join %1$\s Selected Features" $fcount] -command "featuretable_edit_items $w $row join_selected"
        }
        $t.popupmenu add command -label [mc "Delete %1$\s Selected Features" $fcount] -command "featuretable_edit_items $w $row delete_selected"
        $t.popupmenu add command -label [mc "Raise %1$\s Selected Features to Top" $fcount] -command "featuretable_edit_items $w $row raise_selected"
        $t.popupmenu add command -label [mc "Lower %1$\s Selected Features to Bottom" $fcount] -command "featuretable_edit_items $w $row lower_selected"
        $t.popupmenu add command -label [mc "Hide %1$\s Selected Features" $fcount] -command "featuretable_edit_items $w $row hide_selected"
        $t.popupmenu add command -label [mc "Show %1$\s Selected Features" $fcount] -command "featuretable_edit_items $w $row show_selected"
       # $t.popupmenu add command -label [mc "New Group from %1$\s Selected Features" [llength [regexp -all -inline {f[0-9]+#(?:[\s]|$)} [$t selection ]]]] -command "featuretable_edit_items $w $row new_group_from_selected"
      }
    } elseif {($column == "Direction")} {
      $t.popupmenu add command -label [mc "Reverse Feature"] -command "featuretable_edit_items $w $row reverse"
    } elseif {($column == "Type")} {
      $t.popupmenu add cascade -label [mc "Change Feature Type"] -menu $t.popupmenu.popup1
        menu $t.popupmenu.popup1
          ## see http://www.insdc.org/documents/feature_table.html#3.3 for qualifiers (need to be able to edit qualifiers with - boxes, + at the end and a re-order)
        set divided_typelist $genbank_divided_typelist
        set found 0
        foreach {header types} $divided_typelist {
          $t.popupmenu.popup1 add cascade -label $header -menu [menu  $t.popupmenu.popup1.[string tolower $header]]
          foreach type $types {
            if {[string index $type 0] eq "-"} {set typelabel " $type"} else {set typelabel $type}
            $t.popupmenu.popup1.[string tolower $header] add radiobutton -label $typelabel -variable featuretable_popup_type -value $type -command "featuretable_edit_items $w $row type"
            if {$type eq $featuretable_popup_type} {set found 1}
          }
        }
        if {!$found} {
         $t.popupmenu.popup1 add radiobutton -label $featuretable_popup_type -variable featuretable_popup_type -value $featuretable_popup_type -command "featuretable_edit_items $w $row type"
        }
      $t.popupmenu add separator
      $t.popupmenu add command -label [mc "Raise All %s Features" $featuretable_popup_type]  -command "featuretable_edit_items $w $row raise_all_type"
      $t.popupmenu add command -label [mc "Lower All %s Features" $featuretable_popup_type]  -command "featuretable_edit_items $w $row lower_all_type"
      $t.popupmenu add command -label [mc "Show All %s Features" $featuretable_popup_type]  -command "featuretable_edit_items $w $row show_all_type"
      $t.popupmenu add command -label [mc "Hide All %s Features" $featuretable_popup_type]  -command "featuretable_edit_items $w $row hide_all_type"
      $t.popupmenu add command -label [mc "Show Only %s Features" $featuretable_popup_type]  -command "featuretable_edit_items $w $row show_only_type"
      $t.popupmenu add command -label [mc "Hide Only %s Features" $featuretable_popup_type]  -command "featuretable_edit_items $w $row hide_only_type"
    } elseif {($column == "Location")} {
      $t.popupmenu add command -label [mc "Uppercase Only"] -command "featuretable_change_loc $w $row upper"
      $t.popupmenu add command -label [mc "Feature Plus Selection"] -command "featuretable_change_loc $w $row plus_sel"
      $t.popupmenu add command -label [mc "Feature Minus Selection"] -command "featuretable_change_loc $w $row minus_sel"
    }
    tk_popup $t.popupmenu [winfo pointerx $w] [winfo pointery $w]
  } elseif {[regexp {\#\.} $row]} {
    #right click on subfeature
    if {[regexp {(f[0-9]+#)\.([0-9]+)#} $row - row qual_number]} {
      if {[winfo exists $t.popupmenu]} {
        destroy $t.popupmenu
      }
      set popupmenu [menu $t.popupmenu]
      $t.popupmenu add command -label [mc "Edit Qualifier (Dialog)"] -command "edit_feature_dialog $w $w $row $qual_number"
      tk_popup $t.popupmenu [winfo pointerx $w] [winfo pointery $w]
    }
  } else {
    # right click popup menu in headings to set visible columns, move current column left or right (can't move feature name), set number of rows displayed
  }
}

##############
## utility proc for editing texts in feature table callback proc for <<CellEntryEdit>> event
##############
proc featuretable_edit_name {tv feature column} {
  set w [winfo toplevel $tv]
  
  if {([$w.textarea tag ranges $feature] != {}) && ($column == "#0")} {
    set metadata [$w.textarea tag bind $feature <<Metadata>>]
    lset metadata 0 [$tv item $feature -text]
    textarea_tag_bind $w.textarea $feature <<Metadata>> $metadata
    register_undo_separator $w "Edit Feature Name"
  }
}

##############
## utility proc for editing feature locations
##############
proc featuretable_change_loc {w feature function} {
  set old_loc [feature_coords_text $w $feature]
  switch $function {
    "upper" {
      set new_loc [locations_upper $w $old_loc]
    }
    "plus_sel" {
      set new_loc [locations_plus_selection $w $old_loc plus_sel]
    }
    "minus_sel" {
      set new_loc [locations_plus_selection $w $old_loc minus_sel]
    }
  }
  apply_loc_list $w $feature $new_loc

}

##############
## process right-click events in the feature table treeview
##############
proc featuretable_doubleclick {w x y} {
  set t $w.tvframe.tv
  set row [$t identify row $x $y]
  if {($row !={}) && ([$t bbox $row] == {})} {set row {}}
  set qual_number 0
  ## feature qualifiers are formatted f0#.0#, convert to just the parent value
  regexp {(f[0-9]+#)\.([0-9]+)#} $row - row qual_number
   #sputs doubleclick $x $y $row [regexp {f[0-9]+#} $row] $qual_number
  if {[regexp {f[0-9]+#} $row]} {
    edit_feature_dialog $w $w $row $qual_number
  }
}

##############
## 
##############
proc featuretable_edit_items {w feature column args} {
  global info
  set t $w.tvframe.tv
  if {[regexp {f[0-9]+#\.[0-9]+#} $feature]} {
    edit sub-features here
  } elseif {($feature == 0) || ([regexp {f[0-9]+#} $feature]) && ([$w.textarea tag ranges $feature] != {})} {
    switch $column {
      "delete" {
        textarea_tag_delete $w.textarea $feature
        features_to_tree_view $w
        edit_box_treeviewselect $w
        register_undo_separator $w "Delete Feature"
      }
      "dialog" {
        edit_feature_dialog $w $w $feature
      }
      "hide_all" {
        foreach feature1 [$t children {}] {
          if {[regexp {f[0-9]+#$} $feature1]} {
            textarea_tag_hide $w.textarea $feature1
          }
        }
        features_to_tree_view $w
        register_undo_separator $w "Hide Features"
      }
      "show_all" {
        foreach feature1 [$t children hidden] {
          if {[regexp {f[0-9]+#$} $feature1]} {
            textarea_tag_show $w.textarea $feature1
          }
        }
        features_to_tree_view $w
        register_undo_separator $w "Show Features"
      }
      "raise_all_type" {
        set topfeature [lindex [lsearch -all -regexp -inline [$w.textarea tag names] {f[0-9]+#}] end]
        if {$topfeature != {}} {
          set feature_type [lindex [$w.textarea tag bind $feature <<Metadata>>] 2]
          foreach feature1 [expr {[$t exists hidden] ? [concat [$t children hidden] [$t children {}]] : [$t children {}]}] {
            if {[regexp {f[0-9]+#$} $feature1] && $feature_type == [lindex [$w.textarea tag bind $feature1 <<Metadata>>] 2]} {
              textarea_tag_raise $w.textarea $feature1 $topfeature
	          register_undo_separator $w "Raise Feature"
              set info($w,saved) 0
              if {[tk windowingsystem] == "aqua"} {wm attributes $w -modified 1}
            }
          }
        }
        edit_box_treeviewselect $w
      }
      "lower_all_type" {
        set bottomfeature [lsearch -regexp -inline [$w.textarea tag names] {f[0-9]+#}]
        if {$bottomfeature != {}} {
          set feature_type [lindex [$w.textarea tag bind $feature <<Metadata>>] 2]
          foreach feature1 [expr {[$t exists hidden] ? [concat [$t children hidden] [$t children {}]] : [$t children {}]}] {
            if {[regexp {f[0-9]+#$} $feature1] && $feature_type == [lindex [$w.textarea tag bind $feature1 <<Metadata>>] 2]} {
              textarea_tag_lower $w.textarea $feature1 $bottomfeature
              set info($w,saved) 0
              if {[tk windowingsystem] == "aqua"} {wm attributes $w -modified 1}
              register_undo_separator $w "Lower Feature"
            }
          }    
        }
        edit_box_treeviewselect $w
      }
      "show_all_type" {
        set feature_type [lindex [$w.textarea tag bind $feature <<Metadata>>] 2]
        foreach feature1 [$t children hidden] {
          if {[regexp {f[0-9]+#$} $feature1] && $feature_type == [lindex [$w.textarea tag bind $feature1 <<Metadata>>] 2]} {
            textarea_tag_show $w.textarea $feature1
          }
        }
        features_to_tree_view $w
        register_undo_separator $w "Show Features"
      }
      "show_only_type" {
        set feature_type [lindex [$w.textarea tag bind $feature <<Metadata>>] 2]
        foreach feature1 [expr {[$t exists hidden] ? [$t children hidden]:{}}] {
          if {[regexp {f[0-9]+#$} $feature1] && $feature_type == [lindex [$w.textarea tag bind $feature1 <<Metadata>>] 2]} {
            textarea_tag_show $w.textarea $feature1
          }
        }
        foreach feature1 [$t children {}] {
          if {[regexp {f[0-9]+#$} $feature1] && $feature_type != [lindex [$w.textarea tag bind $feature1 <<Metadata>>] 2]} {
            textarea_tag_hide $w.textarea $feature1
          }
        }
        features_to_tree_view $w
        register_undo_separator $w "Show/ Hide Features"
      }
      "hide_all_type" {
        set feature_type [lindex [$w.textarea tag bind $feature <<Metadata>>] 2]
        foreach feature1 [$t children {}] {
          if {[regexp {f[0-9]+#$} $feature1] && $feature_type == [lindex [$w.textarea tag bind $feature1 <<Metadata>>] 2]} {
            textarea_tag_hide $w.textarea $feature1
          }
        }
        features_to_tree_view $w
        register_undo_separator $w "Hide Features"
      }
      "hide_only_type" {
        set feature_type [lindex [$w.textarea tag bind $feature <<Metadata>>] 2]
        foreach feature1 [$t children {}] {
          if {[regexp {f[0-9]+#$} $feature1] && $feature_type == [lindex [$w.textarea tag bind $feature1 <<Metadata>>] 2]} {
            textarea_tag_hide $w.textarea $feature1
          }
        }
        foreach feature1 [expr {[$t exists hidden] ? [$t children hidden]:{}}] {
          if {[regexp {f[0-9]+#$} $feature1] && $feature_type != [lindex [$w.textarea tag bind $feature1 <<Metadata>>] 2]} {
            textarea_tag_show $w.textarea $feature1
          }
        }
        features_to_tree_view $w
        register_undo_separator $w "Hide/Show Features"
      }
      "hide" {
        textarea_tag_hide $w.textarea $feature
        features_to_tree_view $w
        register_undo_separator $w "Hide Feature"
      }
      "show" {
        textarea_tag_show $w.textarea $feature
        features_to_tree_view $w
        register_undo_separator $w "Show Feature"
      }
      "color" {
        set metadata [$w.textarea tag bind $feature <<Metadata>>]
        if {[set newColor [tk_chooseColor -parent $w -title [mc "Choose New Color"]]] != {}} {
          set dir [lindex $metadata 3]
          set colorlist [$w.textarea tag bind $feature <<Revcolors>>]
          lset colorlist $dir $newColor
          textarea_tag_bind $w.textarea $feature <<Revcolors>> $colorlist
          if {[$w.textarea tag cget $feature -background] != {}} {
            textarea_tag_configure $w.textarea $feature -background [lindex $colorlist $dir]
          }
         # $t tag configure $feature -background [lindex $colorlist $dir]
        }
        edit_box_treeviewselect $w
        features_to_tree_view $w
        register_undo_separator $w "Change Feature Color"
      }
      "raise" {
        set topfeature [lindex [lsearch -all -regexp -inline [$w.textarea tag names] {f[0-9]+#}] end]
        if {$topfeature != {}} {
          textarea_tag_raise $w.textarea $feature $topfeature
	  register_undo_separator $w "Raise Feature"
          set info($w,saved) 0
          if {[tk windowingsystem] == "aqua"} {wm attributes $w -modified 1}
        }
        edit_box_treeviewselect $w
      }
      "lower" {
        set bottomfeature [lsearch -regexp -inline [$w.textarea tag names] {f[0-9]+#}]
        if {$bottomfeature != {}} {
          textarea_tag_lower $w.textarea $feature $bottomfeature
	  register_undo_separator $w "Lower Feature"
          set info($w,saved) 0
          if {[tk windowingsystem] == "aqua"} {wm attributes $w -modified 1}
        }
        edit_box_treeviewselect $w
      }
      "gformat" {

      }
      "reverse" {
        set metadata [$w.textarea tag bind $feature <<Metadata>>]
        set dir [lindex $metadata 3]
        set colorlist [$w.textarea tag bind $feature <<Revcolors>>]
        set dir [expr {!$dir}]
        if {[$w.textarea tag cget $feature -background] != {}} {
          textarea_tag_configure $w.textarea $feature -background [lindex $colorlist $dir]
        }
        $t tag configure $feature -background [lindex $colorlist $dir]
        $t set $feature Direction [expr {$dir?"<<<":">>>"}]
        lset metadata 3 $dir
        textarea_tag_bind $w.textarea $feature <<Metadata>> $metadata
        edit_box_treeviewselect $w
        features_to_tree_view $w
        register_undo_separator $w "Reverse Feature"
      }
      "type" {
        global featuretable_popup_type genbank_mandatory_qualifiers
        set metadata [$w.textarea tag bind $feature <<Metadata>>]
        if {[catch {set colorlist [dict get $info(feature_default_type_colors) $featuretable_popup_type]}]} {
          set colorlist [list $info(feature_default_fcolor) $info(feature_default_rcolor)]
        }
        if {[catch {set gformatlist [dict get $info(feature_default_type_gformat) $featuretable_popup_type]}]} {
          set gformatlist $info(feature_default_gformat)
        }
        set dir [lindex $metadata 3]
        textarea_tag_bind $w.textarea $feature <<Revcolors>> $colorlist
        if {[$w.textarea tag cget $feature -background] != {}} {
          textarea_tag_configure $w.textarea $feature -background [lindex $colorlist $dir]
        }
        if {[dict exists $genbank_mandatory_qualifiers [string tolower $featuretable_popup_type]]} {
          set qual_list  [lindex $metadata 4]
          foreach req_qual [dict get $genbank_mandatory_qualifiers [string tolower $featuretable_popup_type]] {
            if {![dict exists $qual_list $req_qual]} {
              lappend qual_list $req_qual {}
            }
          }
          lset metadata 4 $qual_list
        }
        $t tag configure $feature -background [lindex $colorlist $dir]
        $t set $feature Type $featuretable_popup_type
        lset metadata 2 $featuretable_popup_type
        lset metadata 1 $gformatlist
        unset featuretable_popup_type
        textarea_tag_bind $w.textarea $feature <<Metadata>> $metadata
        edit_box_treeviewselect $w
        features_to_tree_view $w
        register_undo_separator $w "Change Feature Type"
      }
      "join_selected" {
        global fea_info
		set tagname "f$fea_info($w,count)#"
		set fntag "fn$fea_info($w,count)#"
		incr fea_info($w,count)
		textarea_tag_create $w.textarea $tagname
		foreach feature1 [$t selection] {
		  if {[regexp {f[0-9]+#$} $feature]} {
			foreach {aix bix} [$w.textarea tag ranges $feature1] {
			  textarea_tag_add $w.textarea $tagname $aix $bix
			}
		  }
		}
		if {[llength [$w.textarea tag ranges $tagname]] > 2} {
		  textarea_tag_add $w.textarea $fntag [lindex [$w.textarea tag ranges $tagname] 0] [lindex [$w.textarea tag ranges $tagname] end]
		}
		##metadata here
		textarea_tag_bind $w.textarea $tagname <<Metadata>> [$w.textarea tag bind $feature <<Metadata>>]
		textarea_tag_bind $w.textarea $tagname <<Revcolors>> [$w.textarea tag bind $feature <<Revcolors>>]
		textarea_tag_configure $w.textarea $tagname -background [$w.textarea tag cget $feature -background]
		edit_box_treeviewselect $w
		features_to_tree_view $w
		register_undo_separator $w "New Feature"
      }
      "delete_selected" {
        foreach feature [$t selection] {
          if {[regexp {f[0-9]+#$} $feature]} {
            textarea_tag_delete $w.textarea $feature
          }
        }
        features_to_tree_view $w
        edit_box_treeviewselect $w
        register_undo_separator $w "Delete Features"
      }
      "new_group_from_selected" {
        set i 0
        set j -1
        while {$i < 20} {
          set i 0
          incr j
          while {$i < 20 &&  ([$t heading [format "g_%03u" $i] -text] != $j)} {incr i}
        }
        foreach feature [$t selection] {
          if {[regexp {f[0-9]+#$} $feature]} {
            textarea_tag_change_group $w.textarea $feature 1 $j
          }
        }
        features_to_tree_view $w
        register_undo_separator $w "New Features Group"
      }
      "raise_selected" {
        set topfeature [lindex [lsearch -all -regexp -inline [$w.textarea tag names] {f[0-9]+#}] end]
        if {$topfeature != {}} {
          foreach feature [$t selection] {
            if {[regexp {f[0-9]+#$} $feature]} {
              textarea_tag_raise $w.textarea $feature $topfeature
            }
          }
          set info($w,saved) 0
          if {[tk windowingsystem] == "aqua"} {wm attributes $w -modified 1}
        }
	register_undo_separator $w "Raise Feature"
        features_to_tree_view $w
      }
      "lower_selected" {
        set bottomfeature [lsearch -regexp -inline [$w.textarea tag names] {f[0-9]+#}]
        if {$bottomfeature != {}} {
          foreach feature [$t selection] {
            if {[regexp {f[0-9]+#$} $feature]} {
              textarea_tag_lower $w.textarea $feature $bottomfeature

            }
          }
          set info($w,saved) 0
          if {[tk windowingsystem] == "aqua"} {wm attributes $w -modified 1}
        }
        features_to_tree_view $w
	register_undo_separator $w "Lower Feature"
      }
      "hide_selected" {
        foreach feature [$t selection] {
          if {[regexp {f[0-9]+#$} $feature]} {
            textarea_tag_hide $w.textarea $feature
          }
        }
        features_to_tree_view $w
        register_undo_separator $w "Hide Features"
      }
      "show_selected" {
        foreach feature [$t selection] {
          if {[regexp {f[0-9]+#$} $feature]} {
            textarea_tag_show $w.textarea $feature
          }
        }
        features_to_tree_view $w
        register_undo_separator $w "Show Features"
      }
    }
  } elseif {$feature == "hidden"} {
    switch $column {
      "show_all" {
        foreach feature1 [$t children hidden] {
          if {[regexp {f[0-9]+#$} $feature1]} {
            textarea_tag_show $w.textarea $feature1
          }
        }
        features_to_tree_view $w
        register_undo_separator $w "Show Features"
      }
    }
  }
}

##############
## utility proc for editing texts in a treeview
##############
proc treeview_edit_item {t row column} {
  if {[$t bbox $row $column] == {}} return
  if {[winfo exists $t.entry]} {
    treeview_do_entry_edit $t
    return
  }
  foreach {x0 y0 width height} [$t bbox $row $column] {}

  if {![winfo exists $t.entry]} {
    place [entry $t.entry -highlightthickness 2 -borderwidth 0 -width 40] -x $x0 -y [expr {$y0-2}] -width [expr {$width}]  ;#-relwidth [expr {1.0*($x1-$x0)/([winfo width $t]+8)}]
    bind $t.entry <Key-Return> "focus \[winfo toplevel %W\]"
    bind $t.entry <FocusOut> "treeview_do_entry_edit $t"
    bindtags $t.entry [list $t.entry Entry]
  } else {
    return
  }


  #place configure $t.entry -x $x0 -y [expr {$y0-2}] -relwidth [expr {1.0*($x1-$x0)/([winfo width $t]+8)}]
  $t.entry delete 0 end
  if {$column eq "#0"} {
    $t.entry insert 0 [$t item $row -text]
  } else {
    set text [$t set $row $column]
    $t.entry insert 0 $text
  }
  bind $t.entry <<row>> $row
  bind $t.entry <<column>> $column
  #update
  focus $t.entry
}

##############
## utility proc for editing texts in a treeview
##############
proc treeview_do_entry_edit {treeview} {
  set entry $treeview.entry
  if {[winfo exists $entry]} {
    set text [$entry get]
    set row [bind $entry <<row>>]
    set column [bind $entry <<column>>]
    destroy $entry
    if {$column == "#0" || $column == {}} {
      $treeview item $row -text $text
    } else {
      $treeview set $row $column $text
    }
    catch {{*}[bind $treeview <<CellEntryEdit>>] $treeview $row $column}
  }
}

#############
## Add <<Primer_data>> tags to primer_bind features
##############
#tag record list: tag name dir type coords qual_list
proc primer_feature_update_metadata  {t tag_record} {
  set primer_seq ""
  ## get primer sequence from qualifier data first
  lassign $tag_record tag name dir type coords qual_list
  if {[dict exists $qual_list "PCR_conditions"]} {
    set data [dict get $qual_list "PCR_conditions"]
    if {[regexp {primer sequence:\s?([A-Za-z]+)} $data -- seq]} {
      set primer_seq $seq
    }
  } elseif  {[dict exists $qual_list "note"]} {
    foreach {qtype value} $qual_list {
      if {$qtype eq "note" && [regexp {sequence:\s?([A-Za-z]+)} $value -- seq]} {
        set primer_seq $seq
        break
      }
    }
  }
  set template_seq ""
  if {[regexp {([0-9]+)\.\.([0-9]+)} $coords - loc1 loc2]} {
	incr loc1 -1
	set template_seq [textarea_get $t [bp2ix $t $loc1] [bp2ix $t $loc2]]
  } elseif {[regexp {([0-9]+)\.\.([0-9]+)\,1\.\.([0-9]+)} $coords - loc1 loc2 loc3] && $loc2 == [ix2bp $t [end_ix $t]]} {
	incr loc1 -1
	set template_seq "[textarea_get $t [bp2ix $t $loc1] [bp2ix $t $loc2]][textarea_get $t [bp2ix $t 0] [bp2ix $t $loc3]]"
  }

  if {$template_seq ne {}} {
  	if {$dir} {set template_seq [revcom $template_seq]}
	#  set primer seq from template seq if not set from qualifier data
	if {$primer_seq eq ""} {
	  set primer_seq $template_seq
	}
	if {[string toupper $primer_seq] eq [string toupper $template_seq]} {
	  set match_seq $primer_seq
	  set mismatch_seq [string repeat " " [string length $primer_seq]]
	} else {
	  set match_seq ""
	  set mismatch_seq ""
	  set primer1 [string repeat " " [expr {[string length $template_seq] - [string length $primer_seq]}]]
	  set template1 [string repeat " " [expr {[string length $primer_seq] - [string length $template_seq]}]]
	  append primer1 $primer_seq
	  append template1 $template_seq
	  foreach p [split $primer1 ""] t [split $template1 ""] {
	    if {[string toupper $p] eq [string toupper $t]} {
	      append match_seq $p
	      append mismatch_seq " "
	    } else {
	      append match_seq " "
	      append mismatch_seq $p
	    }
	  }
	}
#	$t tag bind $tag <<Primer_data>> [list $primer_seq $template_seq $match_seq $mismatch_seq]

  } else {
	  # if no template seq (not a continuous feature)
	  $t tag bind $tag <<Primer_data>> ""
  } 
}

##############
## Re-stack features based on length
##############
proc restack_features {w} {
  set flist [list]
  foreach feature [lsearch -all -regexp -inline [$w.textarea tag names] {f[0-9]+#}] {
      set ftag $feature
      set fntag [regsub f $ftag fn]
      if {[$w.textarea tag ranges $fntag] > 0} {
	  set ftag $fntag
      }
    set range [$w.textarea tag ranges $ftag]
    if {$range =={}} {continue}
      if {[llength $range] > 2} {
	  set len [expr {max([ix2bp $w.textarea [lindex $range 3]] -[ix2bp $w.textarea [lindex $range 2]], [ix2bp $w.textarea [lindex $range 1]] -[ix2bp $w.textarea [lindex $range 0]] )}]
      } else {
	  set len [expr {[ix2bp $w.textarea [lindex $range 1]] -[ix2bp $w.textarea [lindex $range 0]] }]
      }
      lappend flist [list $feature $len]
  }
  set flist [lsort -decreasing -integer -index 1 $flist]
  foreach f $flist {
      textarea_tag_raise $w.textarea [lindex $f 0]
  }
  register_undo_separator $w "Restack Features"
}

##############
## read the toolbar button images
##############
proc read_toolbar_images {} {
  global toolbar_images tooltip_after
  global info tcl_platform

  image create photo blank -height 16 -width 16
  blank blank
  set toolbar_images(blank) [image create photo -height 16 -width 16]
  $toolbar_images(blank) copy blank
  image delete blank

  set tooltip_after "not_showing"

  #set toolbar_images(separator) [image create photo -height 16 -width 3]
  #$toolbar_images(separator) put {{gray90 gray90 gray30} {gray90 gray90 gray30} {gray90 gray90 gray30} {gray90 gray90 gray30} {gray90 gray90 gray30} {gray90 gray90 gray30} {gray90 gray90 gray30} {gray90 gray90 gray30} {gray90 gray90 gray30} {gray90 gray90 gray30} {gray90 gray90 gray30} {gray90 gray90 gray30} {gray90 gray90 gray30} {gray90 gray90 gray30} {gray90 gray90 gray30} {gray90 gray90 gray30}}

  set toolbar_images(separator) [image create photo -height 16 -width 1]
  if {$tcl_platform(platform) == "unix" && [tk windowingsystem] ne "aqua"} {
    $toolbar_images(separator) put {{gray20} {gray20} {gray20} {gray20} {gray20} {gray20} {gray20} {gray20} {gray20} {gray20} {gray20} {gray20} {gray20} {gray20} {gray20} {gray20}}
  } else {
    $toolbar_images(separator) put {{gray90} {gray90} {gray90} {gray90} {gray90} {gray90} {gray90} {gray90} {gray90} {gray90} {gray90} {gray90} {gray90} {gray90} {gray90} {gray90}}
  }
  set toolbar_images(separator,1x) $toolbar_images(separator)
  set toolbar_images(separator_dark,1x) $toolbar_images(separator)
  foreach scale [list 2 3 4 8 16] {
    set toolbar_images(separator,$scale\x) [image create photo -height [expr {16*$scale}] -width 2]
    $toolbar_images(separator,$scale\x) copy $toolbar_images(separator) -zoom $scale
    set toolbar_images(separator_dark,$scale\x) [image create photo -height [expr {16*$scale}] -width 2]
    $toolbar_images(separator_dark,$scale\x) copy $toolbar_images(separator,$scale\x) 
  }
  
  if {[file exists [file join $info(Accdir) "Icons and images" $info(ui_icon_color)]]} {
      set image_dir [file join $info(Accdir) "Icons and images" $info(ui_icon_color)]
  } else {
    set image_dir [file join $info(Accdir) "Icons and images" "Green"]
  }
  if {![file isdirectory $image_dir]} {
    warning_dialog "Please put the toolbar button images in: $image_dir"
    set error 1
  } else {
    set error 0
  }

 

  foreach button [list monkey_icon] {
    if {[catch {set toolbar_images($button) [image create photo -file "$image_dir/$button.gif"]}]} {
        set toolbar_images($button) [image create photo -height 16 -width 16]
        $toolbar_images($button) copy $toolbar_images(blank)
    } 
    set toolbar_images($button,1x) $toolbar_images($button)
  }
  # jump find_again clear_find swap_case origin graphic_map_u clear_highlighting duplicate
  #find_primers ncbi wormbase select jump_to  more_vert
  foreach button [list New Open Save Cut Copy Paste Find Uppercase Lowercase Reverse_com Enzymes_all Enzymes_sonly Graphic_map Highlight_enzymes Digest Text_map Align PCR Gibson Golden_gate More_arrow Toolbar_back Toolbar_back_active Unknown] {
    foreach scale [list 1 2 3 4 8 16] {
      foreach dark [list "" "_dark"] {
        set button_name [string tolower "$button$dark,$scale\x"]
        if {[catch {set toolbar_images($button_name) [image create photo -file "$image_dir/$button$dark\_$scale\x.png"]}]} {
	       set toolbar_images($button_name) [image create photo -height [expr {20  * $scale}] -width [expr {20  * $scale}]]
           $toolbar_images($button_name) blank
           #sputs toolbar_image missing: $button_name
        }
      }
    }
    set  toolbar_images([string tolower $button]) $toolbar_images([string tolower $button],1x)
    set toolbar_images([string tolower $button]_dark) $toolbar_images([string tolower $button]_dark,1x)
  }


    foreach scale [list 1 2 3 4 8 16] {
      foreach dark [list "" "_dark"] {
        set toolbar_images([string tolower "enzymes$dark,$scale\x"]) [image create photo -height [expr {20  * $scale}] -width [expr {20  * $scale}]]
        ttk::style element create ToolbarButton.MD.TButton.hover$dark\_$scale\x image [list $toolbar_images(blank) pressed $toolbar_images(toolbar_back_active$dark\,$scale\x) active $toolbar_images(toolbar_back$dark\,$scale\x)] -border [list 0 0 0 0] -padding [list 0 0] -sticky {}
      }
    }
    set  toolbar_images(enzymes) $toolbar_images(enzymes,1x)
    set toolbar_images(enzymes_dark) $toolbar_images(enzymes_dark,1x)

  ##change the toolbar image when select only is toggled"

  trace add variable info(analyze_selection) write {
    if {$info(analyze_selection) == "selection"} {
      $toolbar_images(enzymes) blank
      $toolbar_images(enzymes) copy $toolbar_images(enzymes_sonly)
    } else {
      $toolbar_images(enzymes) blank
      $toolbar_images(enzymes) copy $toolbar_images(enzymes_all)
    }
   # needs this last comment to keep the appended trace info from coming in
    #}


  if {$info(android)} {
    set id2 [image create photo -width 3 -height 3]
    $id2 blank
    ttk::style element create Treeitem.impadding4 image [list $id2] -width [expr {int(72 * $info(pixels_per_dp))}] -padding 10
    unset id2

    ttk::style layout FileBrowser.Treeview.Item {Treeitem.padding -sticky nswe  -children {Treeitem.impadding4 -sticky nswe -side left -children {Treeitem.image -side left -sticky {}} FileBrowser.Treeitem.text -side left -sticky e}}
    ttk::style element create Menu.Treeitem.indicator image [list $toolbar_images(copy) user1 $toolbar_images(new) user2 $toolbar_images(blank) ] -width [image width $toolbar_images(new)] -padding 0
  }

  #### ttk styles for checkbuttons, radiobuttons, and sequence window button elements
  ##

  foreach dark [list "" "_dark"] {
    foreach x [list 1x 2x 3x 4x 8x 16x] {
    ## Check button
    foreach button [list Check_Alt Check_Alt_Active Check_Selected Check_Selected_Active Check_Deselected Check_Deselected_Active Check_Alt_Disabled Check_Selected_Disabled Check_Deselected_Disabled] {
       if {[catch {set toolbar_images($button$dark\_$x) [image create photo -file "$image_dir/Green_UI/$button$dark\_$x.png"]}]} {
         set toolbar_images($button$dark\_$x) $toolbar_images(blank)
         sputs "Can't read image:$button$dark\_$x"
       }
    }
    ttk::style element create MD.TCheckbutton.button$dark\_$x image [list $toolbar_images(Check_Deselected$dark\_$x) {alternate background} $toolbar_images(Check_Alt_Disabled$dark\_$x)   {alternate active} $toolbar_images(Check_Alt_Active$dark\_$x) {alternate} $toolbar_images(Check_Alt$dark\_$x) {selected background} $toolbar_images(Check_Selected_Disabled$dark\_$x) {background} $toolbar_images(Check_Deselected_Disabled$dark\_$x) {selected disabled} $toolbar_images(Check_Selected_Disabled$dark\_$x) {alternate disabled} $toolbar_images(Check_Alt_Disabled$dark\_$x) {disabled} $toolbar_images(Check_Deselected_Disabled$dark\_$x) {selected active} $toolbar_images(Check_Selected_Active$dark\_$x) {active} $toolbar_images(Check_Deselected_Active$dark\_$x) {selected} $toolbar_images(Check_Selected$dark\_$x)] -border [list 0 0 0 0] -padding {0 0} -sticky nsew


  ##
  ## Switch Check button
    foreach button [list Switch_Alt Switch_Selected Switch_Deselected Switch_Selected_Active Switch_Deselected_Active Switch_Selected_Disabled Switch_Deselected_Disabled] {
       if {[catch {set toolbar_images($button$dark\_$x) [image create photo -file "$image_dir/Green_UI/$button$dark\_$x.png"]}]} {
         set toolbar_images($button$dark\_$x) $toolbar_images(blank)
         sputs "Can't read image:$button$dark\_$x"
       }
    }
    ttk::style element create Switch.MD.TCheckbutton.button$dark\_$x image [list $toolbar_images(Switch_Deselected$dark\_$x) {alternate}  $toolbar_images(Switch_Alt$dark\_$x) {selected background} $toolbar_images(Switch_Selected_Disabled$dark\_$x) {background} $toolbar_images(Switch_Deselected_Disabled$dark\_$x) {selected disabled} $toolbar_images(Switch_Selected_Disabled$dark\_$x) {disabled} $toolbar_images(Switch_Deselected_Disabled$dark\_$x) {selected active} $toolbar_images(Switch_Selected_Active$dark\_$x) {active} $toolbar_images(Switch_Deselected_Active$dark\_$x)  {selected} $toolbar_images(Switch_Selected$dark\_$x)] -border [list 0 0 0 0] -padding {0 0} -sticky nsew

  ##
  ## Radio button
    foreach button [list Radio_Alt Radio_Selected Radio_Deselected Radio_Selected_Active Radio_Deselected_Active Radio_Selected_Disabled Radio_Deselected_Disabled] {
       if {[catch {set toolbar_images($button$dark\_$x) [image create photo -file "$image_dir/Green_UI/$button$dark\_$x.png"]}]} {
         set toolbar_images($button$dark\_$x) $toolbar_images(blank)
         sputs "Can't read image:$button$dark\_$x"
       }
    }
    ttk::style element create MD.TRadiobutton.button$dark\_$x image [list $toolbar_images(Radio_Deselected$dark\_$x) {alternate} $toolbar_images(Radio_Alt$dark\_$x) {selected background} $toolbar_images(Radio_Selected_Disabled$dark\_$x) {background} $toolbar_images(Radio_Deselected_Disabled$dark\_$x) {selected disabled} $toolbar_images(Radio_Selected_Disabled$dark\_$x) {disabled} $toolbar_images(Radio_Deselected_Disabled$dark\_$x) {selected active} $toolbar_images(Radio_Selected_Active$dark\_$x) {active} $toolbar_images(Radio_Deselected_Active$dark\_$x) {selected} $toolbar_images(Radio_Selected$dark\_$x)] -border [list 0 0 0 0] -padding {0 0} -sticky nsew

  ##
  ## Disclosure Icon Buttons
    foreach button [list button_disclose_u button_disclose_d button_hover] {
       if {[catch {set toolbar_images($button$dark\_$x) [image create photo -file "$image_dir/Green_UI/$button$dark\_$x.png"]}]} {
       set toolbar_images($button$dark\_$x) $toolbar_images(blank)
           sputs "Can't read image:$button$dark\_$x"
       }
     }
    ttk::style element create Disclosure.Icon.MD.TCheckbutton.button$dark\_$x image [list $toolbar_images(button_disclose_u$dark\_$x) {selected} $toolbar_images(button_disclose_d$dark\_$x)] -border [list 0 0 0 0] -padding {0 0} -sticky nsew
    ttk::style element create Icon.MD.TCheckbutton.hover$dark\_$x image [list $toolbar_images(blank) active $toolbar_images(button_hover$dark\_$x)] -border [list 0 0 0 0] -padding {0 0} -sticky nsew

   ##
   ## Read UI Button icons (not info, orf, find butttons for now)
    foreach button [list button_comment button_table button_link button_locked button_unlocked fingerprint_on fingerprint_off button_info] {
       if {[catch {set toolbar_images($button$dark\_$x) [image create photo -file "$image_dir/Green_UI/$button$dark\_$x.png"]}]} {
         set toolbar_images($button$dark\_$x) $toolbar_images(blank)
         sputs "Can't read image:$button$dark\_$x"
       }
       set toolbar_images($button$dark,$x) $toolbar_images($button$dark\_$x)
    }
    
  ##
  ## Standard Push Buttons
    foreach button [list Button_Normal  Button_Alt Button_Active Button_Pressed Button_Disabled] {
       if {[catch {set toolbar_images($button$dark\_$x) [image create photo -file "$image_dir/Green_UI/$button$dark\_$x.png"]}]} {
         set toolbar_images($button$dark\_$x) $toolbar_images(blank)
         sputs "Can't read image:$button$dark\_$x"
       }
    }
    set border [expr { [image height $toolbar_images(Button_Normal_$x)]/2 -2}]
    ttk::style element create MD.TButton.button$dark\_$x image [list $toolbar_images(Button_Normal$dark\_$x) disabled $toolbar_images(Button_Disabled$dark\_$x)  background $toolbar_images(Button_Disabled$dark\_$x) {pressed} $toolbar_images(Button_Pressed$dark\_$x) {active} $toolbar_images(Button_Active$dark\_$x) {alternate} $toolbar_images(Button_Alt$dark\_$x) ] -border [list $border $border $border $border] -padding {5 5} -sticky nsew
  ##
  ## Menu Buttons
    set border [expr { [image height $toolbar_images(Button_Normal_$x)]/2 -2}]
    ttk::style element create MD.TMenubutton.button$dark\_$x image [list $toolbar_images(Button_Normal$dark\_$x) disabled $toolbar_images(Button_Disabled$dark\_$x)  background $toolbar_images(Button_Disabled$dark\_$x) {pressed} $toolbar_images(Button_Alt$dark\_$x) {active} $toolbar_images(Button_Active$dark\_$x) ] -border [list $border $border $border $border] -padding {5 5} -sticky nsew
    ttk::style element create MD.TButton.disclosure$dark\_$x image [list $toolbar_images(button_disclose_d$dark\_$x) {pressed} $toolbar_images(button_disclose_u$dark\_$x)] -border [list 0 0 0 0] -padding {0 0} -sticky nsew
      
    ## Add chip widget- rounded button with checkbutton function.

    };# foreach x
  }; #foreach dark

  set md_spacer_image [image create photo -height 16 -width 16]
  #$md_spacer_image put red -to 0 0 20 20
  ttk::style element create MD.TCheckbutton.spacing image $md_spacer_image -sticky nswe  -padding {4 0 4 0}
  ttk::style element create MD.TRadiobutton.spacing image $md_spacer_image -sticky nswe  -padding {4 0 4 0}
  ttk::style element create MD.TButton.spacing image $md_spacer_image -border 0 -padding {6 4} -sticky nsew
  ttk::style element create MD.TMenubutton.spacing image $md_spacer_image -border 0 -padding {6 4} -sticky nsew
  ttk::style element create MD.TMenubutton.disclosure_spacing image $md_spacer_image -border 0 -padding {8 0 4 0} -sticky nsew
    # All layouts are done in recolor app, so that the bg_color is applied


  if {[catch {set toolbar_images(groupbox.active.primary) [image create photo -file "$image_dir/Green_UI/groupbox.active.primary.png"]}]} {
    set toolbar_images(groupbox.active.primary) $toolbar_images(blank)
    sputs "Can't read image:groupbox.active.primary"
  }
  ttk::style element create roundframe2 image [list $toolbar_images(groupbox.active.primary)] -border {12 12 12 12} -sticky news
  # layout done in recolor_app
  #ttk::style layout Roundframe {OSXBackground roundframe2}

  if {[tk windowingsystem] == "aqua"} {
    #Mac has a focus ring around the treeview text, which overrides the -anchor setting on column #0
    #### ttk::style layout Item {Treeitem.padding -sticky nswe -children {Treeitem.indicator -side left -sticky {} Treeitem.image -side left -sticky {} Treeitem.text -side right -sticky {}}}
     #ttk::style layout Featuretable.Treeview.Item {Treeitem.padding -sticky nswe -children {Treeitem.indicator -side left -sticky {} Treeitem.image -side left -sticky {} Treeitem.text -side right -sticky {}}}
   #####  ttk::style layout Featuretable.Treeview.Item {Treeitem.padding -sticky nsw -children {Treeitem.indicator -side left -sticky {} Treeitem.image -side left -sticky {} Treeitem.text -side right -sticky {}}}
    ##### ttk::style layout Treeview.Item {Treeitem.padding -sticky nswe -children {Treeitem.indicator -side left -sticky {} Treeitem.image -side left -sticky {} Treeitem.text -side left -sticky {}}}
  }

## some style configurations
# components: Treeview Item Cell Heading Row
# ttk::style configure Treeview -rowheight 18
# ttk::style configure Row -background red
# ttk::style configure Treeview -fieldbackground red ;#- this is the rows without data

## change selection colors
#  ttk::style map Treeview.Row  -background [ list selected COLOR ]
#  ttk::style map Treeview.Cell -foreground [ list selected COLOR ]
#  ttk::style map Treeview.Item -foreground [ list selected COLOR ]

# Heading backgrounds:
#    set id2 [image create photo -width 3 -height 15]
#    $id2 blank
#    $id2 put {{blue blue blue} {blue red blue} {blue red blue} {blue red blue} {blue red blue} {blue red blue} {blue red blue} {blue red blue} {blue red blue} {blue red blue} {blue red blue} {blue red blue} {blue red blue} {blue red blue} {blue blue blue}}
#    ttk::style element create Treehaeding.field image $id2 -border [list 1 1 1 1] -sticky nsew; # need to define images for pressed and normal
#    ttk::style layout Heading {Treehaeding.field -sticky we Treeheading.image -side right -sticky {} Treeheading.text -sticky {}}
# Fonts:
#    ttk::style configure Heading -font {Courier 24}
#    ttk::style configure Heading -font {Helvetica 11 bold} -foreground gray40; # iTunes11
#    ttk::style configure Treeview -font {Courier 12}; works- setting Item and Cell fonts doesn't work?
#    ttk::style configure Treeview.Item -font {Courier 12}; # sets only the 0# column
#    ttk::style configure Treeview.Cell -font {Courier 12}; # sets all but 0# column

#left justified with no focus ring around text
#ttk::style layout Item {Treeitem.padding -sticky nswe -children {Treeitem.indicator -side left -sticky {} Treeitem.image -side left -sticky {} Treeitem.text -side left -sticky {}}}

#right justified with no focus ring around text, applied to sub-style
# ttk::style layout Featuretable.Treeview.Item {Treeitem.padding -sticky nswe -children {Treeitem.indicator -side left -sticky {} Treeitem.image -side left -sticky {} Treeitem.text -side right -sticky {}}}
  ### ttk::style layout Featuretable.Treeview.Item {Treeitem.padding -sticky nsw -children {Treeitem.indicator -side left -sticky {} Treeitem.image -side left -sticky {} Treeitem.text -side right -sticky {}}}

}

##############
## make the images for unmapped buttons blank, image for the last mapped image an arrow and put the unmapped in a dropdown menu
##############
proc toolbar_extend {w} {
  global toolbar_images info

  if {![winfo exists $w.toolbar]} {return}
  set lastcolumn [lindex [grid location $w.toolbar [expr {[winfo width $w.toolbar]-15}] 0] 0]
  if {$lastcolumn < 0} {return}
  set lastbutton [lindex [grid size $w.toolbar] 0]
  if {$lastbutton < 2} {return}


  if {$lastcolumn +1 < $lastbutton} {
    #grid remove $w.toolbar.more_arrow
    $w.toolbar.more_arrow.menu delete 0 end

    for {set i [expr {$lastcolumn}]} {$i < $lastbutton && $i < 40} {incr i} {
      set button [lindex [grid slaves $w.toolbar -row 0 -column $i] end]
      if {[regexp separator $button]} {continue}
      foreach {tooltip c1 c2} [bind $button <<More_Menu>>] {
        if {[regexp "(.*)\n[mc Shift:](.*)" $tooltip none tooltip1 tooltip2]} {
          $w.toolbar.more_arrow.menu add command -label $tooltip1 -command $c1
          $w.toolbar.more_arrow.menu add command -label $tooltip2 -command $c2
        } else {
          $w.toolbar.more_arrow.menu add command -label $tooltip -command $c1
        }
      }
    }
    ## bug in Tk- text in a window that's not mapped locks up the UI
    #if {$info(toolbar_compound) eq "image"} {
     # grid configure $w.toolbar.more_arrow -column [expr {max(0,$lastcolumn)}] -ipadx 5 -columnspan 2 -sticky w
    #} else {
    #  grid configure $w.toolbar.more_arrow -column [expr {max(0,$lastcolumn-1)}] -ipadx 5 -columnspan 2 -sticky w
    #}
    place $w.toolbar.more_arrow -relx 1 -rely 0 -anchor ne

  } else {
    place forget $w.toolbar.more_arrow
  }
}

##############
## Configure the toolbar via modifier-leftButton popup menu
##############
proc toolbar_config_popup {b button_number x y} {
  global info
  catch {destroy $b.popup_menu}
  menu $b.popup_menu
  
  menu $b.popup_menu.layout
  $b.popup_menu add cascade  -label [mc "Button Layout"] -menu $b.popup_menu.layout
  foreach label [list "Icon Only" "Text Only"  "Icon Above Text" "Icon Below Text"] value [list image text bottom top] {
	$b.popup_menu.layout add radiobutton -label [mc $label] -indicatoron 1 -value $value -variable info(toolbar_compound) -command "toolbar_set_icons $info(toolbar_size)"
  }
  if {$info(toolbar_compound) ne "text"} {
	menu $b.popup_menu.icon_size
	$b.popup_menu add cascade  -label [mc "Icon Size"] -menu $b.popup_menu.icon_size
	foreach label [list "1x" "2x" "3x" "4x" "8x" "16x"] value [list 16 32 48 64 128 256] {
	  $b.popup_menu.icon_size add radiobutton -label [mc $label] -indicatoron 1 -value $value -variable info(toolbar_size) -command "toolbar_set_icons \$info(toolbar_size)"
	}
  }
  ## UI Color
  
  if {$info(toolbar_compound) ne "image"} {
	menu $b.popup_menu.fontsize
	$b.popup_menu add cascade  -label [mc "Font Size"] -menu $b.popup_menu.fontsize
	foreach fontsize [lsort -unique -integer [concat [list 8 9 10 11 12 13 14 16 18 24 28 32 36 42 48] $info(toolbar_label_size)]] {
	  $b.popup_menu.fontsize add radiobutton -label $fontsize -indicatoron 1 -value $fontsize -variable info(toolbar_label_size) -command "toolbar_set_icons $info(toolbar_size)"
	}
		 
	menu $b.popup_menu.fontmenu
	$b.popup_menu add cascade -label [mc "Font Family"] -menu $b.popup_menu.fontmenu
	if {[llength $info(allfontlist)] <= 20} {
	  foreach fontfam $info(allfontlist) {
		$b.popup_menu.fontmenu add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable info(toolbar_label_font) -command "toolbar_set_icons $info(toolbar_size)";# -font [list $fontfam 10]
	  }
	} else {
	  for {set fi 0} {$fi < [llength $info(allfontlist)]} {incr fi 20} {
		if {[set fj [expr {$fi + 19}]] >= [llength $info(allfontlist)]} {set fj [expr {[llength $info(allfontlist)]-1}]}
		$b.popup_menu.fontmenu add cascade -label "[lindex $info(allfontlist) $fi]-[lindex $info(allfontlist) $fj]" -menu $b.popup_menu.fontmenu.menu$fi 
		menu $b.popup_menu.fontmenu.menu$fi
		foreach fontfam [lrange $info(allfontlist) $fi $fj] {
		  $b.popup_menu.fontmenu.menu$fi add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable info(toolbar_label_font) -command "toolbar_set_icons $info(toolbar_size)";# -font [list $fontfam 10]
		}
	  }
	}
  }
  
  $b.popup_menu add separator
  ## move button left/right
  if {$button_number > 0} {
    $b.popup_menu add command -label [mc "Move %1\$s Left" [mc [lindex $info(toolbarlist) $button_number]]]  -command "toolbar_move_ins_del left $button_number"
  }
  if {$button_number < [llength $info(toolbarlist)]} {
    $b.popup_menu add command -label [mc "Move %1\$s Right" [mc [lindex $info(toolbarlist) $button_number]]]  -command "toolbar_move_ins_del right $button_number"
  }
  ## remove current button
  $b.popup_menu add command -label [mc "Remove %1\$s" [mc [lindex $info(toolbarlist) $button_number]]]  -command "toolbar_move_ins_del delete $button_number"
  
  $b.popup_menu add command -label [mc "Add Separator"] -command "toolbar_move_ins_del insert $button_number separator"
  ## cascade of off buttons to turn on in place
  menu $b.popup_menu.addb
  $b.popup_menu add cascade -label [mc "Add Button"] -menu $b.popup_menu.addb
  set toolbar_function_list [list New Open Duplicate Save {Save As} Cut Copy Paste {Cut RC} {Copy RC} {Paste RC} Select Jump Find {Find Again} {Clear Find} Uppercase Lowercase {Swap Case} {Reverse Com} Origin Enzymes {Graphic Map} {Graphic Map U} {Highlight Enzymes} {Clear Highlighting} Digest {Text Map} {Find Primers} PCR {Golden Gate} Gibson Align Translate {Recomb Assembler} {GG Assembler} {Copy GB} {Copy Translated} {Copy Translated RC} {New Feature} {Edit Features} {Restack Features} Annotate {Clear Feaures} {Restriction Assembler} Calculator {Mol Calculator} BLAST {ORF Map} {Digest Dialog} {Digest w Selected} {Silent Sites} ]
  foreach new_button $toolbar_function_list {
    if {$new_button ni $info(toolbarlist)} {
      $b.popup_menu.addb add command -label [mc $new_button]  -command "toolbar_move_ins_del insert $button_number \{$new_button\}"
    }
  }
  tk_popup $b.popup_menu $x $y
}

##############
## move/add/remove buttons on the toolbar via modifier-leftButton popup menu
##############
proc toolbar_move_ins_del {mode button_number {new_button {}}} {
  global info
  switch $mode {
    left {
	  set item [lindex $info(toolbarlist) $button_number]
	  set new_col [expr {$button_number -1}]
	  lset info(toolbarlist) $button_number [lindex $info(toolbarlist) $new_col]
	  lset info(toolbarlist) $new_col $item
    }
    right {
      set item [lindex $info(toolbarlist) $button_number]
	  set new_col [expr {$button_number +1}]
	  lset info(toolbarlist) $button_number [lindex $info(toolbarlist) $new_col]
	  lset info(toolbarlist) $new_col $item
    }
    insert {
      set info(toolbarlist) [linsert $info(toolbarlist) $button_number $new_button]
      sputs 0 $info(toolbarlist)
    }
    delete {
      set info(toolbarlist) [lreplace $info(toolbarlist)  $button_number $button_number]
    }
  }
  after idle "toolbar_set_icons $info(toolbar_size)"
}

##############
## add buttons to the toolbar
##############
## toolbar list is a list of lists, each button element is a list of image name, tooltip, command
proc fill_toolbar {w} {

  global tcl_platform
  global toolbar_images
  global info modifier

  foreach b [winfo children $w.toolbar] {
    destroy $b
  }
  if {$info(toolbarlist) == [list]} {
    $w.toolbar configure -height 1
    return
  }

  #set up the binding to make the button images change if the toolbar is shorter than can hold all of the buttons
  bind $w.toolbar <Configure> "toolbar_extend $w"

  if {[tk windowingsystem] == "aqua"} {
    if {$info(bg_color) == "systemWindowBackgroundColor" && $info(dark_mode)} {
      set normal_color gray30;#$info(bg_color)
      set inactive_color gray20
    } elseif {$info(dark_mode)} {
      set normal_color [mix_color $info(bg_color,dark) gray50 50];#$info(bg_color)
      set inactive_color $info(bg_color,dark)
    } else {
      set info(aqua_active_bg_color) [mix_color $info(bg_color) white 27]
      set normal_color $info(aqua_active_bg_color);#$info(bg_color)
      set inactive_color $info(bg_color)
    }
      set separator_width 1
  } else {
    set normal_color $info(bg_color)
    set inactive_color $normal_color
    set separator_width 1
  }
  
  set i 0
  if {[tk windowingsystem] != "aqua"} {
    set secbut 3
  } else {
    set secbut 2
  }

  #foreach button [winfo children $w.toolbar] {
    #grid remove $button
 # }

  set column 0
  foreach button_title [concat $info(toolbarlist) more_arrow] {
    set command2 ""
    set tooltip ""
    set command ""
    set button [string tolower [regsub -all " " $button_title "_"]]
    switch $button {
      separator {set button_type separator}
      translate {set button_type button; set tooltip [mc {Translate}]; set command "translation_window $w"; set command2 ""}
	  recomb_assembler {set button_type button; set tooltip [mc {Recombination Assembler}]; set command "recombination_window $w"; set command2 ""}
	  gg_assembler {set button_type button; set tooltip [mc {Golden Gate Assembler}]; set command "golden_gate_dialog $w"; set command2 ""}
	  copy_gb {set button_type button; set tooltip [mc {Copy as Genbank}]; set command "clipboard clear;clipboard_append -displayof $w \[genbank_text $w\]"; set command2 ""}
	  copy_translated {set button_type button; set tooltip "[mc {Copy Translated}] \n[mc Shift:][mc {Copy Translated RC}] "; set command "clip_copy_special $w translated"; set command2 "clip_copy_special $w translated rev_com"}
	  copy_translated_rc {set button_type button; set tooltip [mc {Copy Translated RC}]; set command "clip_copy_special $w translated rev_com"; set command2 ""}
	  new_feature {set button_type button; set tooltip [mc {New Feature}]; set command "add_sel_feature_file_dialog $w"; set command2 ""}
	  edit_features {set button_type button; set tooltip [mc {Edit Features}]; set command "\{grid configure $w.tvframe; grid configure $w.tvframe.buttons\}"; set command2 ""}
	  restack_features {set button_type button; set tooltip [mc {Restack Features}]; set command "restack_features $w"; set command2 ""}
	  annotate {set button_type button; set tooltip "[mc {Annotate Features}] \n[mc Shift:][mc {Clear Features}] "; set command "feature_scan $w"; set command2 "feature_clear $w"}
	  clear_feaures {set button_type button; set tooltip [mc {Clear Features}]; set command "feature_clear $w"; set command2 ""}
	  restriction_assembler {set button_type button; set tooltip [mc {Restriction Assembler}]; set command "re_cloning_wizard_dialog $w"; set command2 ""}
	  calculator {set button_type button; set tooltip "[mc {Calculator}] \n[mc Shift:][mc {Molecular Claculator}] "; set command "calc"; set command2 "mol_calc"}
	  mol_calculator {set button_type button; set tooltip "[mc {Molecular Calculator}] \n[mc Shift:][mc {Calculator}] "; set command "mol_calc"; set command2 "calc"}
	  blast {set button_type button; set tooltip [mc {NCBI BLAST}]; set command "NCBI_Blast $w"; set command2 ""}
	  orf_map {set button_type button; set tooltip "[mc {ORF Map}] \n[mc Shift:][mc {Translate}] "; set command "orf_map $w \$info(analyze_selection)"; set command2 "translation_window $w"}
	  digest_dialog {set button_type button; set tooltip [mc {Digest Dialog}]; set command "enz_digest_dialog2 $w"; set command2 ""}
	  silent_sites {set button_type button; set tooltip [mc {Silent Sites}]; set command "{silent_sites $w \$info(enz_currently_selected)}"; set command2 ""}
      new {set button_type button; set tooltip "[mc {New File}] \n[mc Shift:][mc {Duplicate Selection}] "; set command "create_window"; set command2 "duplicate_window $w selection"}
      open {set button_type button; set tooltip [mc "Open File"]; set command "open_file_dialog"}
      duplicate {set button_type button; set tooltip "[mc {Duplicate Selection}]\n[mc {Duplicate All}]"; set command "duplicate_window $w selection"; set command2 "duplicate_window $w all"}
      save {set button_type button; set tooltip "[mc {Save File}] \n[mc Shift:][mc {Save As}] "; set command "save_file $w Save"; set command2 "save_file $w Save_as"}
      cut {set button_type button; set tooltip "[mc {Cut to Clipboard}] \n[mc Shift:][mc {Cut Rev-Com}]"; set command "clip_cut_copy $w cut"; set command2 "clip_cut_copy $w cut rev-com"}
      copy {set button_type button; set tooltip "[mc {Copy to Clipboard}] \n[mc Shift:][mc {Copy Rev-Com}]"; set command "clip_cut_copy $w copy"; set command2 "clip_cut_copy $w copy rev-com"}
      paste {set button_type button; set tooltip "[mc {Paste from Clipboard}] \n[mc Shift:][mc {Paste Rev-Com}]"; set command "clip_paste $w"; set command2 "clip_paste $w rev-com"}
      cut_rc {set button_type button; set tooltip [mc {Cut(RC) to Clipboard}]; set command "clip_cut_copy $w cut rev-com"}
      copy_rc {set button_type button; set tooltip [mc {Copy(RC) to Clipboard}]; set command "clip_cut_copy $w copy rev-com"}
      paste_rc {set button_type button; set tooltip [mc {Paste(RC) from Clipboard}]; set command "clip_paste $w rev-com"}
      select {set button_type button; set tooltip "[mc {Select From-To}] \n[mc Shift:][mc {Jump to}]"; set command "select_from_to $w"; set command2 "jump_to $w"}
      jump {set button_type button; set tooltip [mc {Jump To}]; set command "jump_to $w"}
      find {set button_type button; set tooltip "[mc {Find...}] \n[mc Shift:][mc {Clear Find Highlighting}]"; set command "find_dialog $w"; set command2 "clear_find_highlight $w"}
      find_again {set button_type button; set tooltip [mc {Find Again}]; set command "do_find $w again"}
      clear_find {set button_type button; set tooltip [mc {Remove Find Highlighting}]; set command "clear_find_highlight $w"}
      uppercase {set button_type button; set tooltip "[mc {Change to Uppercase}] \n[mc Shift:][mc {UPPER<->lower Exchange}]"; set command "change_case $w upper"; set command2 "change_case $w exchange"}
      lowercase {set button_type button; set tooltip "[mc {Change to Lowercase}] \n[mc Shift:][mc {UPPER<->lower Exchange}]"; set command "change_case $w lower"; set command2 "change_case $w exchange"}
      swap_case {set button_type button; set tooltip [mc "UPPER<->lower Exchange"]; set command "change_case $w exchange"}
      reverse_com {set button_type button; set tooltip [mc "Reverse Complement"]; set command "rev_com_window $w"}
      origin {set button_type button; set tooltip [mc "Set Origin"]; set command "set_origin $w"}
      enzymes {set button_type button; set tooltip "[mc {Enzyme Selection Dialog}]\n[mc Shift:][mc {Toggle Selected Only}]"; set command "enzyme_selection_dialog $w"; set command2 "if {\$info(analyze_selection)== \"all\"} {set info(analyze_selection) selection} else {set info(analyze_selection) all}"}
      graphic_map {set button_type button; set tooltip "[mc {Graphic Map}] \n[mc Shift:][mc {+Unique}]"; set command "enz_graphic_map $w"; set command2 "enz_graphic_map $w {==1}"}
      graphic_map_u {set button_type button; set tooltip [mc "Graphic Map +Unique Enzymes"]; set command "enz_graphic_map $w {==1}"}
      highlight_enzymes {set button_type button; set tooltip "[mc {Highlight Selected Enzymes}] \n[mc Shift:][mc {Clear Highlight}]"; set command "highlight_enzymes $w \$info(enz_currently_selected)"; set command2 "highlight_enzymes_clear $w"}
      clear_highlighting {set button_type button; set tooltip [mc "Clear Enzyme Highlighting"]; set command "highlight_enzymes_clear $w"}
      digest {set button_type button; set tooltip "[mc {Digest Dialog}]\n[mc Shift:][mc {Digest with Selected Enzymes}]"; set command "enz_digest_dialog2 $w"; set command2 "enz_digest $w \$info(enz_currently_selected) \$info(analyze_selection)"}
      digest_w_selected {set button_type button; set tooltip [mc {Digest with Selected Enzymes}]; set command "enz_digest $w \$info(enz_currently_selected) \$info(analyze_selection)"; set command2 ""}
      text_map {set button_type button; set tooltip [mc {Text Map}]; set command "enz_text_map $w"}
      find_primers {set button_type button; set tooltip [mc {Find PCR Primers}]; set command "primer_window $w"}
      pcr {set button_type button; set tooltip "[mc {PCR}]\n[mc {PCR primers}]"; set command "pcr_dialog $w"; set command2 "primer_window $w"}
      golden_gate {set button_type button; set tooltip [mc {Golden Gate Designer}]\n[mc Shift:][mc "Golden Gate Assembler"]; set command "gg_wizard_dialog $w"; set command2 "golden_gate_dialog $w"}
      gibson {set button_type button; set tooltip [mc {Gibson Designer}]\n[mc Shift:][mc "Recombination Assembler"]; set command "gibson_wizard_dialog $w"; set command2 "recombination_window $w"}
      align {set button_type button; set tooltip [mc {Align Sequences}]; set command "align_dialog2 $w";# set command2 "align_dialog $w"}
      more_arrow {set button_type menu; set tooltip [mc {More Tools}]; set command "";}
      temp {set tooltip ""; set command ""}
      default {set button_type button; set tooltip "Unknown button type $button"; set command ""}
    }
    if {![info exists toolbar_images($button)]} {set toolbar_images($button) $toolbar_images(unknown)}
    if {$button_title eq "more_arrow"} {
      set button_title "More Commands"
    }
    set bt [mc $button_title]

    # make text double line centered
    if {[string first " " $bt] > -1} {
      set sp [expr {[string length $bt]/2-[string first " " $bt] }]
      set bt "[string repeat " " $sp][regsub " " $bt "\n[string repeat { } [expr {-$sp}]]"]"
    } 
    switch $button_type {
      button {
        if {[winfo exists $w.toolbar.$button]} {
          #$w.toolbar.$button configure -image $toolbar_images($button) -bg $normal_color -relief $normal_relief -highlightthickness 0 -bd $but_bd -width $but_size -height $but_size
	      $w.toolbar.$button configure -image $toolbar_images($button) -text 
          grid configure $w.toolbar.$button -row 0 -column $column -sticky w -padx 0
          incr column
        } else {
          #label $w.toolbar.$button -image $toolbar_images($button) -bg $normal_color -relief $normal_relief -highlightthickness 0 -bd $but_bd -width $but_size -height $but_size

	      ttk::button $w.toolbar.$button -image $toolbar_images($button) -style ToolbarButton.MD.TButton -text $bt
          grid configure $w.toolbar.$button -row 0 -column $column -sticky w -padx 0
          bind "$w.toolbar.$button" <<More_Menu>> [list $tooltip $command $command2]
          bind "$w.toolbar.$button" <ButtonRelease-1> $command
          bind "$w.toolbar.$button" <$modifier-ButtonRelease-1> "toolbar_config_popup $w.toolbar.$button $column %X %Y"
          incr column
          if {$command2 != ""} {
            bind "$w.toolbar.$button" <Shift-ButtonRelease-1> "$command2; after 1 $w.toolbar.$button state !pressed; break"
            bind "$w.toolbar.$button" <<RightClick>> "$command2; after 1 $w.toolbar.$button state !pressed; break"
            foreach event {<Button-2> <Button-3> <Control-Button-1> <Shift-Key-F10>} {
              bind $w.toolbar.$button $event [bind List $event]
            }
          }
        }
	    if {$tooltip ne {}} {
          tooltip_install $w.toolbar.$button $tooltip
	    }
        #bindtags "$w.toolbar.$button" "$w.toolbar.$button"
      }
      separator {
        if {[winfo exists $w.toolbar.separator$i]} {
          $w.toolbar.separator$i configure -image $toolbar_images(separator) -bg $normal_color -relief flat -border 0 -width $separator_width
          grid configure "$w.toolbar.separator$i" -row 0 -column $column -padx 5
          if {([tk windowingsystem] == "aqua") && ([focus -displayof .] == {})} {
            "$w.toolbar.separator$i" configure -bg $inactive_color
          }
        } else {
          grid [label "$w.toolbar.separator$i" -image $toolbar_images(separator) -bg $normal_color -relief flat -border 0 -width $separator_width] -row 0 -column $column -padx 5
        }
        bind "$w.toolbar.separator$i" <$modifier-ButtonRelease-1> "toolbar_config_popup $w.toolbar.separator$i $column %X %Y"
        incr column
        if {[tk windowingsystem] == "aqua"} {
          if {[focus -displayof .] == {}} {
            "$w.toolbar.separator$i" configure -bg $inactive_color
          }
          bind "$w.toolbar.separator$i" <Activate> "$w.toolbar.separator$i configure -bg $normal_color"
          bind "$w.toolbar.separator$i" <Deactivate> "$w.toolbar.separator$i configure -bg $inactive_color"
        }
        incr i
      }
      menu {
        if {[winfo exists "$w.toolbar.$button"]} {
         "$w.toolbar.$button" configure -image $toolbar_images($button) -text [regsub -all " " [mc $button_title] \n]
          grid configure "$w.toolbar.$button" -row 0 -column $column -sticky w
          incr column
          if {([tk windowingsystem] == "aqua") && ([focus -displayof .] == {})} {
            #"$w.toolbar.$button" configure -bg $inactive_color
          }
        } else {
	      ttk::button $w.toolbar.$button -image $toolbar_images($button) -style ToolbarButton.MD.TButton -text $bt
          grid configure $w.toolbar.$button -row 0 -column $column -sticky w -padx 0
         # grid [label "$w.toolbar.$button" -image $toolbar_images($button) -bg $normal_color -highlightthickness 0] -row 0 -column $column -sticky w
	 # ttk::button $w.toolbar.$button -image $toolbar_images($button) -style ToolbarButton.MD.TButton
	 # grid configure $w.toolbar.$button -row 0 -column $column -sticky w -padx 0
          incr column
          menu $w.toolbar.$button.menu
          bind "$w.toolbar.$button" <Button-1>  "tk_popup $w.toolbar.$button.menu %X %Y"
          bind "$w.toolbar.$button" <ButtonRelease-1> "$command"

          bindtags "$w.toolbar.$button" "$w.toolbar.$button"
        }
        if {[tk windowingsystem] == "aqua"} {
         # bind "$w.toolbar.$button" <Activate> "$w.toolbar.$button configure -bg $normal_color"
         # bind "$w.toolbar.$button" <Deactivate> "$w.toolbar.$button configure -bg $inactive_color"
        }
      }
    }
  }

  #grid [frame $w.toolbar.f -width 100 -height 2 -relief ridge -borderwidth 2 -pady 0]
  if {[winfo exists $w.toolbar.more_arrow]} {grid remove $w.toolbar.more_arrow}

  #prevents flicker on configuration of the toolbar (it resets to requested height briefly before collapsing back to size of buttons
  #I don't know where the extra 2 pixels come from
  #$w.toolbar configure -height [expr {$but_size + 2}]
}

##############
##change all icon sizes
##############
proc toolbar_set_icons {toolbar_size} {
  global info toolbar_images 

  if {[dict exists [list 16 1x 32 2x 48 3x 64 4x 128 8x 256 16x] $toolbar_size]} {
	set x [dict get [list 16 1x 32 2x 48 3x 64 4x 128 8x 256 16x] $toolbar_size]
  } else {
	set x "1x"
  }
  set dark [expr {$info(dark_mode) ? "_dark" : ""}]
  set toolbar_function_list [list more_arrow new open duplicate save cut copy paste cut_rc copy_rc paste_rc select jump find find_again clear_find uppercase lowercase swap_case reverse_com origin enzymes enzymes_all enzymes_sonly graphic_map graphic_map_u highlight_enzymes clear_highlighting digest text_map find_primers pcr golden_gate gibson align translate recomb_assembler gg_assembler copy_gb copy_translated copy_translated_rc new_feature edit_features restack_features annotate clear_feaures restriction_assembler calculator mol_calculator blast orf_map digest_dialog digest_w_selected silent_sites]

  foreach button $toolbar_function_list {
    if {[info exists toolbar_images($button,1x)]} {
      set toolbar_images($button) $toolbar_images($button$dark,$x)
    } else {
      set toolbar_images($button) $toolbar_images(unknown$dark,$x)
    }
  }

  if {![info exists info(analyze_selection)]} {set info(analyze_selection) "all"}
  if {$info(analyze_selection)== "selection"} {
    $toolbar_images(enzymes) blank
    $toolbar_images(enzymes) copy $toolbar_images(enzymes_sonly)
  } else {
    $toolbar_images(enzymes) blank
    $toolbar_images(enzymes) copy $toolbar_images(enzymes_all)
  }
  ## set up toolbar interface colors and ttk styles for hover
  if {[tk windowingsystem] == "aqua"} {
    if {$info(bg_color) == "systemWindowBackgroundColor" && $info(dark_mode)} {
      set normal_color gray30;#$info(bg_color)
      set inactive_color gray20
    } elseif {$info(dark_mode)} {
      set normal_color [mix_color $info(bg_color,dark) gray50 50];#$info(bg_color)
      set inactive_color $info(bg_color,dark)
    } else {
      set info(aqua_active_bg_color) [mix_color $info(bg_color) white 27]
      set normal_color $info(aqua_active_bg_color);#$info(bg_color)
      set inactive_color $info(bg_color)
    }
  } else {
    set normal_color $info(bg_color)
    set inactive_color $normal_color
  }

  set background_color_image [image create photo -height 20 -width 20]
  set rgb_color [format "\#%04X%04X%04X" {*}[winfo rgb . $normal_color]] 
  $background_color_image put $rgb_color -to 0 0 20 20

## for compound toolbar
## ttk::style layout ToolbarButton.MD.TButton {Toolbar_bg_#FAD8FAD8FAD8,#ECECECECECEC -sticky nswe -children {ToolbarButton.MD.TButton.hover_1x -side top -sticky {} -children {Button.image -sticky {}} Button.text}}
## ttk::style map ToolbarButton.MD.TButton -font {hover "Helvetica 8 bold" !pressed "Helvetica 8" pressed "Helvetica 8 bold"} -foreground {!pressed systemButtonText pressed systemButtonText}
## preferences: toolbar icon size, toolbar font (no text is default), text size

  ttk::style map ToolbarButton.MD.TButton -font [list hover [list $info(toolbar_label_font) $info(toolbar_label_size) bold] !pressed [list $info(toolbar_label_font) $info(toolbar_label_size)] pressed [list $info(toolbar_label_font) $info(toolbar_label_size) bold]] -foreground [list !pressed $info(label_fg_color) pressed $info(label_fg_color)]
  switch $info(toolbar_compound) {
    "top" {
      set button_children [list ToolbarButton.MD.TButton.hover$dark\_$x -side bottom -sticky {} -children {Button.image -sticky {}} Button.text -side top]
    }
    "bottom" {
        set button_children [list ToolbarButton.MD.TButton.hover$dark\_$x -side top -sticky {} -children {Button.image -sticky {}} Button.text -side bottom]
    }
    "text" {
        set button_children [list Button.text -side top -sticky {}]
    }
    "image" -
    default {
      set button_children [list ToolbarButton.MD.TButton.hover$dark\_$x -side top -sticky {} -children {Button.label -sticky {}}]
    }
  }

  if {$normal_color != $inactive_color} {
    set toolbar_second_color [image create photo -height 20 -width 20]
    set i_color [format "\#%04X%04X%04X" {*}[winfo rgb . $inactive_color]] 
    $toolbar_second_color put $i_color -to 0 0 20 20
    if {![catch {ttk::style element create "Toolbar_bg_$rgb_color\,$i_color" image [list $background_color_image background $toolbar_second_color] -padding {5} -border {0} -sticky news} err]} {
       ttk::style layout ToolbarButton.MD.TButton "Toolbar_bg_$rgb_color\,$i_color -sticky nswe -children [list $button_children]"
        ttk::style layout Toolbar.TFrame "Toolbar_bg_$rgb_color\,$i_color"
    } else {
       catch {ttk::style layout ToolbarButton.MD.TButton "Toolbar_bg_$rgb_color\,$i_color -sticky nswe -children [list $button_children]"}
        catch {ttk::style layout Toolbar.TFrame "Toolbar_bg_$rgb_color\,$i_color"}
    }
  } else {
    if {![catch {ttk::style element create "Toolbar_bg_$rgb_color" image [list $background_color_image] -padding {5} -border {0} -sticky news} err]} {
      ttk::style layout ToolbarButton.MD.TButton "Toolbar_bg_$rgb_color -sticky nswe -children [list $button_children]"
      ttk::style layout Toolbar.TFrame "Toolbar_bg_$rgb_color"
    } else {
      catch {ttk::style layout ToolbarButton.MD.TButton "Toolbar_bg_$rgb_color -sticky nswe -children [list $button_children]"}
      catch {ttk::style layout Toolbar.TFrame "Toolbar_bg_$rgb_color"}
    }
  }


  foreach w [winfo children .] {
    if {[winfo exists $w.toolbar]} {
      fill_toolbar $w
    }
  }
}

##############
## procedure called to display a tooltip
##############
if {([tk windowingsystem] == "aqua")} {
## on Aqua, a tooltip can't be moved, so has to be deleted and regenerated
proc tooltip_show {window tip {at_mouse 0} {font ""}} {
  global tooltip_after
  global tcl_platform

  if {![winfo exists $window] || ($tip eq "")} {return}
  if {[winfo containing [winfo pointerx $window] [winfo pointery $window]] ne $window} {return}
  set tooltip_after showing

  if {[winfo exists .w_tooltip]} {
    destroy .w_tooltip
  }

  if {[catch {toplevel .w_tooltip}]} {
    #after 400 "tooltip_show $window {$tip} $at_mouse $font"
    return
  }
  if {0 && ([tk windowingsystem] == "aqua")} {
    tk::unsupported::MacWindowStyle style .w_tooltip help {}; after 40 "catch \{raise .w_tooltip\}"
  } else {
    wm overrideredirect .w_tooltip 1;after 40 "catch \{raise .w_tooltip\}"
  }
  wm attributes .w_tooltip -alpha .9
  if {$font ne ""} {
    grid [label .w_tooltip.label1 -text $tip -background #7ea2ff -foreground white -border 1 -font $font] -row 0 -column 0 -sticky nswe
  } else {
    grid [label .w_tooltip.label1 -text $tip -background #7ea2ff -foreground white -border 1 -font labelfont] -row 0 -column 0 -sticky nswe
  }

  if {$at_mouse} {
    wm geometry .w_tooltip "+[expr {[winfo pointerx $window]}]+[expr {[winfo pointery $window]}]"
  } else {
    wm geometry .w_tooltip "+[expr {[winfo rootx $window]+[winfo height $window]/2}]+[expr {[winfo rooty $window]+[winfo height $window]}]"
  }
}
} else {
##############
## non-Aqua versionprocedure called to display a tooltip
##############
proc tooltip_show {window tip {at_mouse 0} {font ""}} {
  global tooltip_after
  global tcl_platform


  if {![winfo exists $window] || ($tip eq "")} {return}
  if {[winfo containing [winfo pointerx $window] [winfo pointery $window]] ne $window} {return}
  set tooltip_after showing
  if {![winfo exists .w_tooltip]} {
    if {![catch {toplevel .w_tooltip -borderwidth 1 -background black}]} {
      if { 0 && ([tk windowingsystem] == "aqua")} {
        tk::unsupported::MacWindowStyle style .w_tooltip help {noActivates noUpdates}
      } else {
        wm overrideredirect .w_tooltip 1
      }
      if {$font ne ""} {
        grid [label .w_tooltip.label1 -text $tip -background #ffffd8 -foreground black -border 0 -font $font] -row 0 -column 0 -sticky nswe
      } else {
        grid [label .w_tooltip.label1 -text $tip -background #ffffd8 -foreground black -border 0] -row 0 -column 0 -sticky nswe
      }
    }
  } else {
    catch {.w_tooltip.label1 configure -text $tip}
  }
  if {$at_mouse} {
    wm geometry .w_tooltip "+[expr {[winfo pointerx $window]}]+[expr {[winfo pointery $window]}]"
  } else {
    wm geometry .w_tooltip "+[expr {[winfo rootx $window]+[winfo height $window]/2}]+[expr {[winfo rooty $window]+[winfo height $window]}]"
  }
  if {([tk windowingsystem] == "aqua")} {
    after 400 "raise .w_tooltip"
  }
}
}

##############
## procedure called on leaving object with a tooltip
##############
proc tooltip_leave {window} {
  global tooltip_after

  if {[winfo exists .w_tooltip]} {destroy .w_tooltip}
  if {[string equal -length 5 $tooltip_after "after"] == 1} {
    after cancel $tooltip_after
  } else {
    set tooltip_after "showing_[after 300 {set tooltip_after "not_showing"}]"
  }  
}

##############
## procedure called on entering object with a tooltip
##############
proc tooltip_enter {window tip {at_mouse 0}  {font ""}} {
  global tooltip_after

  if {[winfo exists .w_tooltip]} {destroy .w_tooltip}
  if {[string equal -length 7 $tooltip_after "showing"] == 1} {
    tooltip_show $window $tip $at_mouse $font
    after cancel {set tooltip_after "not_showing"}
  } else {
    set tooltip_after [after 1200 [list tooltip_show $window $tip $at_mouse $font]]
  }
}

##############
## procedure called on entering object with a tooltip
##############
proc tooltip_install {w tip} {
  global info
  if {$info(android)} {return}
  bind $w <Enter> "+; tooltip_enter %W \{$tip\}"
  bind $w <Leave> "+; tooltip_leave %W"
  bind $w <Deactivate>  "+; tooltip_leave %W"
}


##############
## Double-click to select the current feature
##############
proc sequence_window_double_button {w x y} {
  set tags [$w.textarea tag names @$x,$y] 
  set result [list]
  foreach text_tag $tags {
    if {([regexp {f[0-9]+#} $text_tag])} {
      lappend result $text_tag
    }
  }
  if {$result == {}} {return}
  set tag [lindex $result end]
  set start_end_ix [feature_tag_start_end_ix $w $tag]
  select_region $w [lindex $start_end_ix 1] [lindex $start_end_ix 0]
}

##############
## popup menu on sequence windows- add feature edit cascade if relevant
##############
proc sequence_window_popup {w popupmenu rootx rooty} {
  global info dialogblock
  set tags [$w.textarea tag names @[expr {$rootx-[winfo rootx $w.textarea]}],[expr {$rooty-[winfo rooty $w.textarea]}]]
  set result [list]
  if {!$info($w,locked) && !$dialogblock} {
    foreach text_tag $tags {
      if {([regexp {f[0-9]+#} $text_tag])} {
        lappend result $text_tag
      }
    }
    $popupmenu entryconfigure [mc "New Feature..."] -state normal
  } else {
    $popupmenu entryconfigure [mc "New Feature..."] -state disabled
  }
  if {[winfo exists $popupmenu.edit_feature]} {
    if {$result != {}} {
      catch {[$popupmenu entryconfigure [mc "Edit Feature"] -state normal]} msg
      $popupmenu.edit_feature delete 0 end
      foreach feature $result {
        $popupmenu.edit_feature add command -label [lindex [$w.textarea tag bind $feature <<Metadata>>] 0] -command "edit_feature_dialog $w $w $feature"
      }
    } else {
      catch {[$popupmenu entryconfigure [mc "Edit Feature"] -state disabled]}
    }
  }

  if {[winfo exists $popupmenu.arrange_feature]} {
    if {$result != {}} {
      catch {[$popupmenu entryconfigure [mc "Arrange Feature"] -state normal]} msg
      $popupmenu.arrange_feature entryconfigure 0 -state normal
      $popupmenu.arrange_feature entryconfigure 1 -state normal
      $popupmenu.arrange_feature.raise delete 0 end
      $popupmenu.arrange_feature.lower delete 0 end
      foreach feature $result {
        $popupmenu.arrange_feature.raise add command -label [lindex [$w.textarea tag bind $feature <<Metadata>>] 0] -command "textarea_tag_raise $w.textarea $feature;register_undo_separator $w {Raise Feature}" -state normal
        $popupmenu.arrange_feature.lower add command -label [lindex [$w.textarea tag bind $feature <<Metadata>>] 0] -command "textarea_tag_lower $w.textarea $feature;register_undo_separator $w {Lower Feature}" -state normal
      }
      sputs $popupmenu
    } else {
      catch {[$popupmenu entryconfigure [mc "Arrange Feature"] -state disabled]}
    }
  }
  
  if {[winfo exists $popupmenu.delete_feature]} {
    if {$result != {}} {
      catch {[$popupmenu entryconfigure [mc "Delete Feature"] -state normal]} msg
      $popupmenu.delete_feature delete 0 end
      foreach feature $result {
        $popupmenu.delete_feature add command -label [lindex [$w.textarea tag bind $feature <<Metadata>>] 0] -command "textarea_tag_delete $w.textarea $feature; features_to_tree_view $w; register_undo_separator $w \"Delete Feature\""
      }
    } else {
      catch {[$popupmenu entryconfigure [mc "Delete Feature"] -state disabled]}
    }
  }

  if {[winfo exists $popupmenu.hide_feature]} {
    if {$result != {}} {
      catch {[$popupmenu entryconfigure [mc "Hide Feature"] -state normal]} msg
      $popupmenu.hide_feature delete 0 end
      foreach feature $result {
        $popupmenu.hide_feature add command -label [lindex [$w.textarea tag bind $feature <<Metadata>>] 0] -command "textarea_tag_hide $w.textarea $feature;features_to_tree_view $w; register_undo_separator $w \"Hide Feature\""
      }
    } else {
      catch {[$popupmenu entryconfigure [mc "Hide Feature"] -state disabled]}
    }
  }

  if {[winfo exists $popupmenu.copy_feature]} {
    if {$result != {}} {
      catch {[$popupmenu entryconfigure [mc "Copy Feature"] -state normal]} msg
      $popupmenu.copy_feature delete 0 end
      foreach feature $result {
        $popupmenu.copy_feature add command -label [lindex [$w.textarea tag bind $feature <<Metadata>>] 0] -command "clip_copy_features_text $w $feature"
      }
    } else {
      catch {[$popupmenu entryconfigure [mc "Copy Feature"] -state disabled]}
    }
  }

  tk_popup $popupmenu $rootx $rooty
}

##############
## Adjust Feature colors for black or white text readability
##############
proc features_adjust_color_dialog {w} {
  global info ok black_adjust white_adjust dialogblock
  set s [new_dialog $w "Adjust Feature Colors" "OK"]
  bind $s <<Cancel>> "set ok -1"
  bind $s <<OK>> "set ok 1"
  set ok 0

  set black_adjust 1
  set white_adjust 1
  grid [frame $s.labels] -row 1 -column 0 -sticky nwe
  grid rowconfigure $s.labels 1 -weight 1
  grid [checkbutton $s.labels.black -text [mc "Adjust for Black Text"] -variable black_adjust] -row 0 -column 1 -sticky nw
  grid [checkbutton $s.labels.white -text [mc "Adjust for White Text"] -variable white_adjust] -row 1 -column 1 -sticky nw
    
  if {!$info(android)} {
    grid [frame $s.f3 -relief flat] -row 3 -column 0 -sticky nwe
    grid [button $s.f3.ok -command "set ok 1" -text [mc "OK"] -default active] -row 0 -column 1 -padx 10 -pady 3
    bind $s <Key-Return> "set ok 1" 
  #grid [button .dialog.f3.cancel -command "set ok -1" -text [mc "Cancel"]] -row 0 -column 0 -padx 10
    grid columnconfigure $s.f3 0 -weight 1 -uniform 1
    grid columnconfigure $s.f3 1 -weight 1 -uniform 1
#return 
  }

  #palette_display [set palettereslist [random_palette [expr {$palette_start_color_on?"$palette_start_color":{}}] $colornum $lpercent]] $s.labels
  #bind $s <Configure> "$s.controls.go invoke"
  vwait ok

  destroy $s
  set dialogblock 0
  bind . <<RaiseDialogs>> ""
  if {$ok == 1} {
    foreach tag [$w.textarea tag names] {
      if {[regexp {f[0-9]+#} $tag]} {
        set dir [lindex [$w.textarea tag bind $tag <<Metadata>>] 3]
        set result [list]
        foreach color [$w.textarea tag bind $tag <<Revcolors>>] {
          lassign [color2hsl $color] h s l2
          if {$black_adjust} { 
			while {$l2 < 1.0 && [luminance [set color [hsl2rgb $h $s $l2]]] < .15} {
			  set l2 [expr {min(1.0,$l2+.05)}]
			}
		  }
		  if {$white_adjust} {
			while {$l2 > 0  && [luminance [set color [hsl2rgb $h $s $l2]]] > .55} {
			  set l2 [expr {max(0,$l2-.05)}]
			}
		  }
		  lappend result [hsl2rgb $h $s $l2]
        }
        $w.textarea tag bind $tag <<Revcolors>> $result
        if {[$w.textarea tag cget $tag -background] != {}} {
          textarea_tag_configure $w.textarea $tag -background [lindex $result $dir]
        }
      }
    }
    register_undo_separator $w "Edit Feature"
    features_to_tree_view $w
  } 
  unset -nocomplain white_adjust   black_adjust
}

##############
## generate a random palette of N color values- all with same Saturation and Lightness, equally spaced Hue
##############
proc random_palette {{palette_start_color {}} {n 5} {lperc 0} {shademin 0.3} {lwidth 0.4}} {
  global  readability_on

    set color_list [list]
    set color_store_list [list]
    set change_list [list]
  if {$palette_start_color  == ""} {
    lassign [list [expr {rand()}] [expr {rand()*(1-$shademin)+$shademin}] [expr {rand()*$lwidth+(1-$lwidth)/2.0}]] h s l
  } else {
    #foreach {r g b} [winfo rgb . $palette_start_color] {}
    #foreach {h s l} [color2hsl [expr {$r/65536.0}] [expr {$g/65536.0}] [expr {$b/65536.0}]] {}
    foreach {h s l} [color2hsl $palette_start_color] {}
  }

  set u [expr {(rand()*(1.0/10-1/(9*$n))+(1.0/(9*$n)))*(rand()>0.5?1:-1)}]
  set u [expr {(rand()*(1.0/8-1/(7*$n))+(1.0/(7*$n)))*(rand()>0.5?1:-1)}]
  
  set back [expr {-int(rand()*$n)}]
  for {set i $back} {$i< [expr {$n+$back}]} {incr i} {
    if {[expr {rand()< ($lperc/100.0)}] && (($palette_start_color  == "") || $i>0)} {
      set l2 [expr {(rand()+rand())/2.0}]
    } else {
      set l2 $l
    }

    set change 0
    set color_store [hsl2rgb $h $s $l2]
    if {$readability_on} { 
      while {$l2 < 1.0 && [luminance [set color [hsl2rgb $h $s $l2]]] < .15} {
        set l2 [expr {min(1.0,$l2+.05)}]
        set change 1
      }
      while {$l2 > 0  && [luminance [set color [hsl2rgb $h $s $l2]]] > .55} {
        set l2 [expr {max(0,$l2-.05)}]
        set change -1
      }
    } else {
      set color $color_store
    }

    set pos [expr {int(rand()*($i+1))}]
    set color_list [linsert $color_list $pos $color]
    set color_store_list [linsert $color_store_list $pos $color_store]
    set change_list [linsert $change_list $pos $change]

    set h [expr {($h+$u)}]
    set h [expr {($h> 1)?($h-1):$h}]
    set h [expr {($h< 0)?($h+1):$h}]
  }

  return $color_list
}


#########
## this proc needs Tk 9.0+ to run (needs photo -withalpha option)
proc recolor_icons {} {

set dir [tk_chooseDirectory]
set dir2  [tk_chooseDirectory -title "Chose Destination Directory"]
set colorlist [list]
#set f [tk_getOpenFile]
#yellow:-0.166
#blue:0.3 purple:0.46 red:0.68 orange:0.78
# cyan 0.166
set hue_angle 0.78
foreach subdir [list "" "Green_UI"] {
  if {![file exists [file join $dir2 $subdir]]} {
    file mkdir [file join $dir2 $subdir]
  }
  foreach f [glob "[file join $dir $subdir]/*.png"] {
	set i [image create photo -file $f]
	set d [$i data];llength $d
	set width [llength [lindex $d 0]]
	set height [llength $d]
	set i2 [image create photo -width $width -height $height]
	for {set x 0} {$x < $width} {incr x} {
	  for {set y 0} {$y < $height} {incr y} {
		lassign [$i get $x $y -withalpha]  r g b alpha
		set color [format "\#%02X%02X%02X" $r $g $b]
		lassign [color2hsl $color] h s l
		lappend colorlist [list $color $h $s $l]
		set h2 $h
		if {$h >.3518} {
		  ## yellow: -0.1 orange:-0.1
		  set h2 [expr {$h + $hue_angle-0.1}]
		  if {$s>0.05 && $l>0.05 && $l<0.8} {
			## yellow: +0.25, orange:0.15, blue 0.15, purple 0.5 red .25
			set l [expr {$l+min(0.15,((1-$l)/3))}]
		  }
		} elseif {$h > .1} {
		  set h2 [expr {$h + $hue_angle}]
		  if {$s>0.05 && $l>0.05 && $l<0.8} {
			## yellow: +0.05 orange: +0.05
			set l [expr {min(1,$l+.05)}]
		  }
		}
		set color2 [hsl2rgb $h2 $s $l]
		$i2 put $color2 -to $x $y
		$i2 transparency set $x $y $alpha -alpha
	  }
	}
	$i2 write [file join $dir2 $subdir [file tail $f]] -format png]
  }
}
set result1 [lsort -unique -real -index 1 $colorlist]; llength $result1


toplevel .t
grid [set c [canvas .t.c -bg white -width 1800]]
set x 0
  
  foreach clist $result1 {
	lassign $clist color h s l
	set k [$c create line $x 0 $x 29 -fill $color -width 3]
  $c bind $k <Enter> "puts $color"
	if {$h >= .3518} {
	  set h2 [expr {$h + $hue_angle-0.1}]
	  if {$s>0.05 && $l>0.05 && $l<0.8} {
			set l [expr {$l+min(0.166,((1-$l)/3))}]
	   }
	} elseif {$h > .1} {
	  set h2 [expr {$h + $hue_angle}]
	  if {$s>0.05 && $l>0.05 && $l<0.8} {
		set l [expr {min(1,$l+.05)}]
	  }
	}
	set color2 [hsl2rgb $h2 $s $l]
	$c create line $x 30 $x 59 -fill $color2 -width 3
	incr x 3
  }


}


#########
proc palette_display {palettereslist {widgetbase .t}} {

  set n [llength $palettereslist]
  for {set i 0} {$i<$n} {incr i} {
    catch {destroy $widgetbase.f$i}
    grid [canvas $widgetbase.f$i -height 350 -width 100] -row 0 -column $i -padx 1 -sticky nswe
    $widgetbase.f$i create text 50 30 -fill white -text ACGTacgt -anchor s
    $widgetbase.f$i create text 50 50 -fill black -text ACGTacgt -anchor s
    $widgetbase.f$i configure -background [lindex $palettereslist $i]

    #if {[lindex $palettereslist 2 $i] == 1} {
    #  $widgetbase.f$i create rectangle 40 60 60 80 -fill [lindex $palettereslist 1 $i] -outline black -tags alert
    #} elseif {[lindex $palettereslist 2 $i] == -1} {
    #  $widgetbase.f$i create rectangle 40 60 60 80 -fill [lindex $palettereslist 1 $i] -outline white  -tags alert
    #}
  }
  while {[winfo exists $widgetbase.f$i]} {
    catch {destroy $widgetbase.f$i}
    incr i
  }
}

proc random_num {x y} {return [expr {(rand()>.5?-1:1)}]}


## try to implement brightness scaling:http://colaargh.blogspot.com/2013/03/colour-text-readability-experiment.html
##http://www.1stwebdesigner.com/improve-website-readability-through-colors/
##http://snook.ca/technical/colour_contrast/colour.html
#http://www.w3.org/TR/AERT#color-contrast
proc rgb_brightness {color} {
  foreach {r g b} [winfo rgb . $color] {}
  return [expr {((($r>>8) * 299) + (($g>>8) * 587) + (($b>>8) * 114)) / 1000.0}]
}

proc color_difference {color1 color2} {
  foreach {r1 g1 b1} [winfo rgb . $color1] {}
  foreach {r2 g2 b2} [winfo rgb . $color2] {}
  return [expr {abs(($r1>>8)-($r2>>8))+abs(($g1>>8)-($g2>>8))+abs(($b1>>8)-($b2>>8))}]
}

#http://www.w3.org/TR/2008/REC-WCAG20-20081211/#visual-audio-contrast-contrast
#luminance between 0.1 and 0.3 for contrast ratio >3 relative to both black and white
proc luminance {color} {
  foreach {a} [winfo rgb . $color] {
    lappend rgb [expr {($a>>8)/255.0 <= 0.03928 ? ($a>>8)/255.0/12.92 : ((($a>>8)/255.0+0.055)/1.055) ** 2.4}]
  }
  foreach {r g b} $rgb {}
  return [expr { 0.2126 * $r + 0.7152 * $g + 0.0722 * $b}]
}

proc contrast_ratio {color1 color2} {
  set l1 [luminance $color1]
  set l2 [luminance $color2]
  return [expr {$l1>$l2? ($l1 + 0.05) / ($l2 + 0.05) : ($l2 + 0.05) / ($l1 + 0.05)}]
}


proc palette_test {w} {
global info ok
#proc initialize: set up the frames widgets, clear palettelist, set index to 0, showpalette
#proc showpalette: if index is out of range add new palette to palettelist (in index == -1 add to beginning of list and set index to 0), fill in the frames based on the index into palettelist
# next button: incr index, showpalette
# prev button: icr index -1, showpalette
# initialize when number is changed, lightness variation, or base color is changed
# .t <Configure>: confiure width of frames
# copy: copy index of palettelist
# prefs: spacing, bg_color, randomize order
  global palette_start_color palette_start_color_on lpercent colornum readability_on ok


  set s [new_dialog $w "Random Palette Generator" "OK"]
  bind $s <<Cancel>> "set ok -1"
  bind $s <<OK>> "set ok 1"
  set ok 0

  grid [frame $s.labels] -row 1 -column 1 -sticky nwe
  grid rowconfigure $s.labels 1 -weight 1
  for {set i 0} {$i<10} {incr i} {
   grid columnconfigure $s.labels $i -weight 1
  }
  grid columnconfigure $s 1 -weight 1
  grid [frame $s.controls] -row 2 -column 1 -sticky nwe
  grid rowconfigure $s 1 -weight 1

  grid [frame $s.controls.colornumf] -row 0 -column 1 -sticky nwe
  grid [label $s.controls.colornumf.l0  -text [mc "Number Of Colors"] ] -row 0 -column 0 -sticky nw
  grid [ttk::scale $s.controls.colornumf.num  -orient horizontal -from 3 -to 10 -variable colornum -command "set colornum \[expr {int(\$colornum)}\];#"] -row 0 -column 2 -sticky nwe
  set colornum 4
  grid [label $s.controls.colornumf.numl  -textvariable colornum ] -row 0 -column 1 -sticky nw
  grid columnconfigure $s.controls.colornumf 2 -weight 1

  grid [frame $s.controls.lpercf] -row 1 -column 1 -sticky nwe
  grid [label $s.controls.lpercf.l1  -text [mc "Lightness Variation"]] -row 0 -column 0 -sticky nw
  grid [ttk::scale $s.controls.lpercf.num  -orient horizontal -from 0 -to 100 -variable lpercent -command "set lpercent \[expr {int(\$lpercent)}\];#" -value 0] -row 0 -column 2 -sticky nwe
  set lpercent 30
  grid [label $s.controls.lpercf.numl  -textvariable lpercent ] -row 0 -column 1 -sticky nw
  grid columnconfigure $s.controls.lpercf 2 -weight 1

  grid [frame $s.controls.start_color] -row 3 -column 1 -sticky nwe
  grid [label $s.controls.start_color.l1  -text [mc "Base Color:"]] -row 0 -column 0 -sticky nw
  set palette_start_color #FF0000
  grid [color_button $s.controls.start_color.startc palette_start_color 24] -row 0 -column 1 -sticky nw
  grid [checkbutton $s.controls.start_color.startcon -variable palette_start_color_on] -row 0 -column 2 -sticky nw
  set palette_start_color_on 0
  grid [label $s.controls.start_color.l2  -text [mc "Readable:"]] -row 1 -column 0 -sticky nw
  grid [checkbutton $s.controls.start_color.readabilityon -variable readability_on] -row 1 -column 1 -columnspan 2 -sticky nw
  set readability_on 0
  grid [button $s.controls.go -command "palette_display \[set palettereslist \[random_palette \[expr \{\$palette_start_color_on?\"\$palette_start_color\":\{\}\}\] \$colornum \$lpercent\]\] $s.labels" -text [mc "Make Random Palette"]] -row 4 -column 1 -sticky nw
  grid [button $s.controls.copy -command "clipboard clear; clipboard_append \[ regsub -all {\[\\\{\\\}\]}  \$palettereslist \"\"\]" -text [mc "Copy Palette"]] -row 5 -column 1 -sticky nw
  set palettereslist ""



  set info(stored_palettes) [list [list "Palette 1"  [list #00A6E7 #00BD7C #00886F #00CDEA #00CB66 #00C5BF]]]

  grid [menubutton $s.controls.palettemenu -textvariable currentpalettename -menu $s.controls.palettemenu.menu] -row 6 -column 1 -sticky nw
  menu $s.controls.palettemenu.menu
  $s.controls.palettemenu.menu add command -label [mc "Rename Palette"]
  $s.controls.palettemenu.menu add command -label [mc "New Palette"]
  $s.controls.palettemenu.menu add command -label [mc "Delete Palette"]
  $s.controls.palettemenu.menu add separator
  set i 0
  foreach palette $info(stored_palettes) {
    $s.controls.palettemenu.menu add radiobutton -label [lindex $palette 0] -value $i -variable currentpalettenumber -command "set currentpalettename \[lindex \$info(stored_palettes) $i 0\]; palette_display \[lindex \$info(stored_palettes) $i 1\] $s.labels"
  }
  $s.controls.palettemenu.menu invoke 4

# return
  grid columnconfigure $s.controls 1 -weight 1

  set palettereslist ""

  if {!$info(android)} {
    grid [frame .dialog.f3 -relief flat] -row 3 -column 0 -sticky nwe
    grid [button .dialog.f3.ok -command "set ok 1" -text [mc "OK"] -default active] -row 0 -column 1 -padx 10 -pady 3
    bind .dialog <Key-Return> "set ok 1" 
  #grid [button .dialog.f3.cancel -command "set ok -1" -text [mc "Cancel"]] -row 0 -column 0 -padx 10
    grid columnconfigure .dialog.f3 0 -weight 1 -uniform 1
    grid columnconfigure .dialog.f3 1 -weight 1 -uniform 1
#return 
  }

  #palette_display [set palettereslist [random_palette [expr {$palette_start_color_on?"$palette_start_color":{}}] $colornum $lpercent]] $s.labels
  #bind $s <Configure> "$s.controls.go invoke"
  vwait ok

  destroy $s
  set dialogblock 0
  bind . <<RaiseDialogs>> ""

}
#http://serennu.com/colour/rgbtohsl.php
##############
## Color to HSL list
##############
proc color2hsl {color} {
  foreach a [winfo rgb . $color] {lappend rgb [expr {$a/65536.0}]}
  foreach {var_r var_g var_b} $rgb {}
  set var_min [expr {min($var_r,$var_g,$var_b)}]
  set var_max [expr {max($var_r,$var_g,$var_b)}]
  set del_max [expr {$var_max - $var_min}]

  set l [expr { 1.0* ($var_max + $var_min) / 2.0}]
  if {($del_max == 0)} {
    set h  0
    set s  0
  } else {
    if {($l < 0.5)} {
      set s [expr {1.0 * $del_max / ($var_max + $var_min)}]
    } else {
      set s [expr {1.0 * $del_max / (2 - $var_max - $var_min)}]
    }

    set del_r [expr {1.0* ((($var_max - $var_r) / 6.0) + ($del_max / 2)) / $del_max}]
    set del_g [expr {1.0* ((($var_max - $var_g) / 6.0) + ($del_max / 2)) / $del_max}]
    set del_b [expr {1.0* ((($var_max - $var_b) / 6.0) + ($del_max / 2)) / $del_max}]
    if {$var_r == $var_max} {
      set h [expr {$del_b - $del_g}]
    } elseif {$var_g == $var_max} {
      set h [expr {(1.0 / 3) + $del_r - $del_b}]
    } elseif {$var_b == $var_max}  {
      set h [expr { (2.0 / 3) + $del_g - $del_r}]
    }

    if {$h < 0}  {
       set h [expr {$h +1}]
    }
    if {$h > 1}  {
       set h [expr {$h -1}]
    }
  }
  return [list $h $s $l]
}

##############
## HSL color list to RGB # formatted
##############
proc hsl2rgb {h2 s l} {
  if {$s == 0} {
    set r  [expr {int($l * 255)}]
    set g  [expr {int($l * 255)}]
    set b  [expr {int($l * 255)}]

  } else {
    if {$l < 0.5}  {
      set var_2 [expr {$l * (1 + $s)}]
    }  else {
      set var_2 [expr {($l + $s) - ($s * $l)}]
    }
    set var_1  [expr {2 * $l - $var_2}]
    set r [expr {int(255 * [hue_2_rgb $var_1 $var_2 [expr {$h2 + (1.0 / 3)}]])}]
    set g [expr {int(255 * [hue_2_rgb $var_1 $var_2 $h2])}]
    set b [expr {int(255 * [hue_2_rgb $var_1 $var_2 [expr {$h2 - (1.0 / 3)}] ])}]
  }
  return [format "\#%02X%02X%02X" $r $g $b]
}

##############
## hue in 0-1 number to RGB
##############
proc hue_2_rgb {v1 v2 vh} {
  if {$vh < 0} {
     set vh [expr {$vh +1}]
  }
  if {$vh > 1} {
    set vh [expr {$vh -1}]
  }
  if {(6 * $vh) < 1} {
    return [expr {$v1 + ($v2 - $v1) * 6.0 * $vh}]
  }
  if {(2 * $vh) < 1} {
    return $v2
  }
  if {(3 * $vh) < 2} {
    return [expr {$v1 + ($v2 - $v1) * ((2.0 / 3 - $vh) * 6)}]
  }
  return $v1
}


##############
## wavelength to RGB https://stackoverflow.com/questions/1472514/convert-light-frequency-to-rgb
##############
proc wavelength2rgb {wavelength} {
    set max_uv 380.0
    set max_violet 420.0
    set max_blue 460.0
    set max_cyan 490.0
    set max_green 510.0
    set max_yellow 540.0
    set max_red 615.0
    set max_ir 711.1
    set red 0.0
    set green 0.0
    set blue 0.0
    if {($wavelength < $max_violet)} {
        set red [expr {max(0.0,0.3*($wavelength - $max_uv) / ( $max_violet- $max_uv))}]
        set blue [expr {max(0.0,0.6*($wavelength - $max_uv) / ( $max_violet- $max_uv))}]
    } elseif {($wavelength < $max_blue)} {
        set red [expr {0.3*-($wavelength - $max_blue) / ($max_blue - $max_violet)}]
        set blue [expr {0.6+ 0.4*($wavelength - $max_violet) / ($max_blue - $max_violet)}]
    } elseif { ($wavelength < $max_cyan)} {
        set green [expr {($wavelength - $max_blue) / ($max_cyan - $max_blue)}]
        set blue 1.0
    } elseif { ($wavelength < $max_green)} {
        set green 1.0
        set blue [expr {-($wavelength - $max_green) / ($max_green - $max_cyan)}]
    } elseif { ($wavelength < $max_yellow)} {
        set red [expr {($wavelength - $max_green) / ($max_yellow - $max_green)}]
        set green 1.0
    } elseif { ($wavelength < $max_red)} {
        set red 1.0
        set green [expr {-($wavelength - $max_red) / ($max_red - $max_yellow)}]
    } else {
        set red [expr {max(0.0,($max_ir-$wavelength) / ($max_ir - $max_red))}]
    } 
sputs $red $blue
  set r [expr {int(255*$red)}]
  set g [expr {int(255*$green)}]
  set b [expr {int(255*$blue)}]
  return [format "\#%02X%02X%02X" $r $g $b]
}

##############
## save an RTF format of a text window
##############
##need to set underline and bold
proc text_to_rtf {textarea {keep_breaks 0} {start {}} {end {}}} {
  global info
  set tagdepth 0
  if {$start == {}} {set start 1.0}
  if {$end == {}} {set end "end"}
  set colortable "colortbl;"
  set text ""
  set i 1
  set last_ix $start
  set tagdump [list tagon sel $start {*}[$textarea dump -tag $start $end] tagoff sel $end]
  foreach {a b c} [lrange $tagdump 0 end-3] {d e f} [lrange $tagdump 3 end] {
    if {($c != $f) && ([llength [set taglist [lsearch -inline -regexp -all -not [$textarea tag names $c] {trans[0-9]+#|fn[0-9]+#|tempsel|sel|ls[0-9]+_[0-9]+|dnatag}]]] > $tagdepth)} {
      set color [get_tag_color $textarea [lindex $taglist end]]
      if {$color eq ""} {continue}
      foreach {r g b} [winfo rgb . $color] {}
      ##sputs $taglist $c $f "\\red[expr {$r>>8}]\\green[expr {$g>>8}]\\blue[expr {$b>>8}]" $r $g $b $color
      append colortable "\\red[expr {$r>>8}]\\green[expr {$g>>8}]\\blue[expr {$b>>8}];"
      if {$c != $last_ix} {
        append text "{[$textarea get $last_ix $c]}"
      }
      append text "{\\chshdng0\\chcbpat$i\\cb$i [$textarea get $c $f]}"
      incr i
      set last_ix $f
    }
  }
  if {[$textarea compare $end > $last_ix]} {
    append text "{[$textarea get $last_ix $end]}"
  }
  if {$keep_breaks} {
    regsub -all \n $text "\\par" text
  } else {
    regsub -all \n $text "" text
  }
  return "{\\rtf1\\ansi{\\fonttbl\\f0\\fmodern Courier;}{\\$colortable}\\f0\\pard
$text\\par}"
}

##############
## get the color of a sequence textarea tag
##############
proc get_tag_color {textarea tag} {
  global enzymes info
        if {$tag == "foundf"} {
          ##found tags don't bind <<Metadata>>
          set color [lindex [$textarea tag bind $tag <<Revcolors>>] 0]
        } elseif {$tag == "foundr"} {
          set color [lindex [$textarea tag bind $tag <<Revcolors>>] 1]
        } elseif {[regexp {f[0-9]+#} $tag]} {
          #set color [lindex [$textarea tag bind $tag <<Revcolors>>] [lindex [$textarea tag bind $tag <<Metadata>>] 3]]
          set color [$textarea tag cget $tag -background]
        } elseif {[lsearch -exact $enzymes $tag] > -1} {
          set color $info(enzyme_highlight_color)
        } elseif {$tag == "sel"} {
          set color ""
        } else {
          set color [$textarea tag cget $tag -background]
          #sputs configure transparent unknown tag $tag
        }
}

##############
## save an HTML format of a text window
##############
##need to set underline and bold
proc text_to_html {textarea {range {1.0 end}}} {
  global info
  set keep_breaks 1
  set start_index [lindex $range 0]
  set end_index [lindex $range 1]
  sputs $start_index $end_index
  set tagdepth 0
  set text ""
  set last_ix 1.0
  foreach {a b c} [lrange [$textarea dump -tag $start_index $end_index] 0 end-3] {d e f} [lrange [$textarea dump -tag $start_index $end_index] 3 end] {
    if {($c != $f) && ([llength [set taglist [lsearch -inline -regexp -all -not [$textarea tag names $c] {trans[0-9]+#|fn[0-9]+#|tempsel|sel|ls[0-9]+_[0-9]+|dnatag}]]] > $tagdepth)} {
      set color [get_tag_color $textarea [lindex $taglist end]]
      set color [string toupper [color_to_svgrgb $color]]
      if {$color eq ""} {continue}
      if {$c != $last_ix} {
        set temp_text "[$textarea get $last_ix $c]"
        #regsub -all " " $temp_text "\\&nbsp;" temp_text
        append text $temp_text
      }
      set temp_text [$textarea get $c $f]
      #regsub -all " " $temp_text "\\&nbsp;" temp_text
      append text "<span style=\"background-color:$color;\">$temp_text</span>"
      set last_ix $f
    }
  }
  if {[$textarea compare $end_index > $last_ix]} {
    set temp_text "[$textarea get $last_ix $end_index]"
    #regsub -all " " $temp_text "\\&nbsp;" temp_text
    append text $temp_text
  }
  #set text "<span style='font-family:\"$info(textfontfamily)\", \"Courier New\", Courier, monospace'>$text</span>"
  set text "<pre>$text</pre>"
  if {$keep_breaks} {
    #regsub -all \n $text "<br>\n" text
    #set text "<html>\n<body>\n$text\n</body>\n</html>"
  } else {
    regsub -all \n $text "" text
    set text "<div style=\"word-wrap:break-word;\">\n$text\n</div>"
    #set text "<html>\n<body>\n<div style=\"word-wrap:break-word;\">\n$text\n</div>\n</body>\n</html>"
  }

  return $text
  set filename [tk_getSaveFile]
  set fid [open $filename w]
  puts $fid $text
  close $fid
}

##############
## save an HTML format of a text window
##############
proc text_to_clipboard_html {textarea {range {1.0 end}}} {
  global info

  if {$range eq {}} {set range [list 1.0 end]}
  set start_index [lindex $range 0]
  set end_index [lindex $range 1]
  set font [$textarea cget -font]
  set fontsize [font actual $font -size]
  set fontfamily [font actual $font -family]
  set text "<span style=\"font-size:$fontsize.0 pt; font-family:'$fontfamily', Courier, monospace;\">"
  set last_ix $start_index
  set last_color ""
  set taglist [lsearch -inline -regexp -all -not [$textarea tag names $start_index] {trans[0-9]+#|fn[0-9]+#|tempsel|sel|ls[0-9]+_[0-9]+|dnatag}]
  set tag [lindex $taglist end]
  set span 0
  if {$tag !={}} {
    set color [$textarea tag cget $tag -background]
    set last_color $color
    if {$color !={}} {
      set color [string toupper [color_to_svgrgb $color]]
      append text "<span style=\"background-color:$color;\">"
      set span 1
    }
  }
  foreach {on_off tag index}  [$textarea dump -tag $start_index $end_index] {
    if {[$textarea compare $index > $last_ix]} {
      set temp_text "[$textarea get $last_ix $index]"
      regsub -all " " $temp_text "\\&nbsp;" temp_text
      regsub -all "\n" $temp_text "<br>" temp_text
      append text $temp_text
      set taglist [lsearch -inline -regexp -all -not [$textarea tag names $index] {trans[0-9]+#|fn[0-9]+#|tempsel|sel|ls[0-9]+_[0-9]+|dnatag}]
      set tag [lindex $taglist end]
      if {$tag !={}} {
        set color [$textarea tag cget $tag -background]
        if {$color != $last_color} {
          if {$span} {
            append text "</span>"
	    set span 0
          }
	  set last_color $color
          if {$color !={}} {
            set color [string toupper [color_to_svgrgb $color]]
            append text "<span style=\"background-color:$color;\">"
            set span 1
	  }
        }
      } else {
        if {$span} {
          append text "</span>"
	  set span 0
	  set last_color ""
        }
      }
    }
    set last_ix $index
  }
  if {$span} {
    append text "</span>"
  }
  
  append text "</span>"
  #set filename [tk_getSaveFile]
  #set fid [open $filename w]
  #puts $fid $text
  #close $fid
  
  return $text
}

##############
## save a webpage of a sequence window- Javascript to keep the svg version of the seq area the correct aspect ratio
##############
## http://stackoverflow.com/questions/10298658/mouse-position-inside-autoscaled-svg
## http://www.petercollingridge.co.uk/interactive-svg-components/draggable-svg-element
## http://www.petercollingridge.co.uk/interactive-svg-components/tooltip
## watch mouse (shift-click, press, drag) and set selection variables- also can use this for x-ray window

## need to set an onclose action to close the server window
## need to port the Tm proc
## CAN THERE BE MOUSEOVER ACTIONS ON EACH OF THE ENZYME AND FEATURE tags?

proc seq_to_webpage {decoded_url w user} {
  global server_info
  if {[info exists server_info($user,browser_width)]} {
    set browser_width $server_info($user,browser_width)
  } else {
    set browser_width 600
  }
  #set w [dict get $server_info($user,open_files) $file_path win]
  #set url [file_path_to_url $file_path $user]
  set url [format_url $decoded_url]
  set t $w.textarea
  set text_font [$t cget -font]
  set char_x [font measure $text_font A]
  set char_y [font metrics $text_font -linespace]
  set linewidth [lindex [split [$t index 1.end] .] 1]
  ### HTML STARTS HERE
set result "<!DOCTYPE html>
<html><head><meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\"><meta name=\"apple-mobile-web-app-capable\" content=\"yes\">
<meta name=\"viewport\" content=\"width=device-width\">

<script>
function on_resize(){
var height = window.innerHeight;
document.getElementById(\"divsize\").style.height=(height- document.getElementById(\"toolbar\").offsetHeight - document.getElementById(\"infobox\").offsetHeight)+\"px\";
document.getElementById(\"browser_width\").value = window.innerWidth;
document.getElementById(\"toolbar\").style.width = (window.innerWidth-2)+\"px\";
document.getElementById(\"infobox\").style.width = (window.innerWidth-2)+\"px\";
document.getElementById(\"divsize\").style.width = (window.innerWidth-2)+\"px\";
<!--document.getElementById(\"toolbar_info\").innerHTML= (window.innerWidth-2)+\"px\";-->
}
function submit_action(action) {
  slide_hamburger_in(300, -10, 10);
  <!--document.getElementById(\"hamburger\").style.display = \"none\"-->
  document.getElementById(\"action\").value = action;
  document.getElementById(\"SelectorForm\").submit();
}

function on_load() {"

  if {[$t tag ranges sel] != {}} {
    set start_base [ix2bp $t [lindex [$t tag ranges sel] 0]]
    set end_base [ix2bp $t [lindex [$t tag ranges sel] 1]]
    append result "
  hit = -1;
  set_selection($start_base,$end_base);
"
  } else {
    set start_base 1
    set end_base 1
  }

append result "
}
function translate (dna) {
  dna =  dna.toString().toLowerCase();
  var result = \"\";
  var codon_array = \[\"ttt\" , \"ttc\" , \"tta\" , \"ttg\" , \"tct\" , \"tcc\" , \"tca\" , \"tcg\" , \"tat\" , \"tac\" , \"taa\" , \"tag\" , \"tgt\" , \"tgc\" , \"tga\" , \"tgg\" , \"ctt\" , \"ctc\" , \"cta\" , \"ctg\" , \"cct\" , \"ccc\" , \"cca\" , \"ccg\" , \"cat\" , \"cac\" , \"caa\" , \"cag\" , \"cgt\" , \"cgc\" , \"cga\" , \"cgg\" , \"att\" , \"atc\" , \"ata\" , \"atg\" , \"act\" , \"acc\" , \"aca\" , \"acg\" , \"aat\" , \"aac\" , \"aaa\" , \"aag\" , \"agt\" , \"agc\" , \"aga\" , \"agg\" , \"gtt\" , \"gtc\" , \"gta\" , \"gtg\" , \"gct\" , \"gcc\" , \"gca\" , \"gcg\" , \"gat\" , \"gac\" , \"gaa\" , \"gag\" , \"ggt\" , \"ggc\" , \"gga\" , \"ggg\"\];
  var aa_string = \"XFFLLSSSSYY**CC*WLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG\";
  var codon = \"\";
  var pos = 0;
  for (i = 0; i < Math.floor(dna.length/3)*3; i+=3) { 
    codon = dna.substr(i, 3);
    pos = codon_array.indexOf(codon)+1
    result = result + aa_string.charAt(pos);
  }
  return result;
}

function percent_gc (dna) {
  dna =  dna.toString();
  if ( dna.length == 0) {return 0};
  var gc = dna.length - dna.replace(/(g|G|c|C)/g,'').length;
  return (Math.round(100* gc/ dna.length));
}
function onchange_selection(){
  var start = document.getElementById(\"selection_start\").value;
  var end = document.getElementById(\"selection_end\").value;
  if (Number(start) > Number(end)) {
    var temp = start;
    start = end;
    end = temp;
    hit = -3;
    document.getElementById(\"selection_start\").value = start;
    document.getElementById(\"selection_end\").value = end;
  } else {
   hit = -1;
  }
  document.cookie=\"selection_start=\"+ start + \"; path=$url\";
  document.cookie=\"selection_end=\"+ end + \"; path=$url\";
  set_selection(start, end);
}

var hit=1;
function set_selection(start, end){
  var start_y = Math.ceil(start/$linewidth);
  if (document.getElementById(\"svg_text_line\"+start_y) == null) {
  }
  var end_y =  Math.ceil(end/$linewidth);
  var start_x = start - $linewidth * (start_y - 1) - 1;
  var end_x = end - $linewidth * (end_y - 1);

  var sel = window.getSelection();
  var range = document.createRange();
  range.setStart(document.getElementById(\"svg_text_line\"+start_y).childNodes\[0\], start_x);
  range.setEnd(document.getElementById(\"svg_text_line\"+end_y).childNodes\[0\], end_x);
  sel.removeAllRanges();
  sel.addRange(range);
  <!-- for parsing through svg for right y position:document.getElementById(\"toolbar_info\").innerHTML = document.getElementById(\"divsize\").childNodes\[1\].childNodes\[1\];-->
  update_selection_info(start,end);
}

function update_selection_info(start, end){
  document.getElementById(\"selection_length\").innerHTML= end-start+1;
  var selected = window.getSelection();
  var trans = translate(selected);
  if (trans.length > 48) {
    document.getElementById(\"selection_translate\").innerHTML = trans.substr(0, 15)+\".....\"+trans.substr(trans.length-15, 15);
  } else {
    document.getElementById(\"selection_translate\").innerHTML = trans;
  }
  if (trans.charAt(0) == \"M\") {
    var orf = \"M\";
  } else {
    var orf = \"\";
  }
  if (trans.indexOf(\"*\")> -1) {
    orf = orf + \"---\";
  }
  document.getElementById(\"selection_orf\").innerHTML = orf;
  document.getElementById(\"percent_gc\").innerHTML = percent_gc(selected);
}


document.onselectionchange = on_selection_change;
  function on_selection_change(){
    if (hit <= 0) {
      hit++;
      return;
    }
  <!--document.getElementById(\"toolbar_info\").innerHTML =\"through\";-->
  var selection = window.getSelection();
  if (selection.rangeCount == 0) {
    return;
  }
  var selRange = selection.getRangeAt(0);
  try {
    var start_y =((selRange.startContainer.parentElement.y.baseVal\[0\].value-[expr {$char_y-3}])/$char_y);
    var end_y =((selRange.endContainer.parentElement.y.baseVal\[0\].value-[expr {$char_y-3}])/$char_y);
  }
  catch (error) {
    return;
  }
  var start_base = start_y*$linewidth+selRange.startOffset+1;
  var end_base = end_y*$linewidth+selRange.endOffset;
  if (Number(start_base) > Number(end_base)) {
    if (start_base - end_base == 1) { 
      start_base = start_base - 1;
    }
    var temp = start_base;
    start_base = end_base;
    end_base = temp;
  }
  if (document.getElementById(\"selection_start\").value != start_base) {
    document.getElementById(\"selection_start\").value = start_base;
    document.cookie=\"selection_start=\"+ start_base + \"; path=$url\";
  }
  if (document.getElementById(\"selection_end\").value != end_base) {
    document.getElementById(\"selection_end\").value = end_base;
    document.cookie=\"selection_end=\"+ end_base + \"; path=$url\";
  }
  update_selection_info(start_base,end_base);
  <!--set_selection(start_base,end_base);-->
}
function test(){
}
function slide_hamburger_in(size, direction, timeout){
  var h = document.getElementById(\"hamburger\");
  h.style.display = \"block\";
  if (direction > 0) {
    h.style.overflow = \"hidden\";
  } else {
    h.style.overflow = \"hidden\";
  }
  h.style.height = (window.innerHeight-2)+\"px\";

  size = size + direction;
  h.style.width = size+\"px\";
  if(size < 300 && size  > 0) {
    setTimeout(slide_hamburger_in, timeout, size, direction, timeout);
  } else if (size == 0) {
    h.style.display = \"none\";
  }
}


</script>
<title>[file tail $decoded_url]</title>
</head>
<body onresize=\"on_resize()\" onload=\"on_resize(); on_load();\" style=\"padding:0px; margin:0px; border:0px; background-color:#d0d0d0;\">
<form id=\"SelectorForm\" action=\"$url\" target=\"_blank\" method=\"post\">
<div id=\"toolbar\" style=\"width:$browser_width\px; height:0px; background-color:#d0d0d0; padding:0px; margin:0px; border:0px;\">
<!--
<image src=\"https:/toolbar_open,2x.gif\" height=\"32\" width=\"32\" onclick='submit_action(\"open_file_dialog\")'>
<image src=\"https:/toolbar_enzymes,2x.gif\" height=\"32\" width=\"32\" onclick='submit_action(\"enzyme_selector\")'>
<image src=\"https:/toolbar_graphic_map,2x.gif\" height=\"32\" width=\"32\" onclick='submit_action(\"graphic_map\")'>
<image src=\"https:/toolbar_highlight_enzymes,2x.gif\" height=\"32\" width=\"32\" onclick='submit_action(\"highlight\")'>
<image src=\"https:/toolbar_digest,2x.gif\" height=\"32\" width=\"32\" onclick='submit_action(\"digest\")'>
<image src=\"https:/toolbar_text_map,2x.gif\" height=\"32\" width=\"32\" onclick='submit_action(\"text_map\")'>
<image src=\"https:/toolbar_align,2x.gif\" height=\"32\" width=\"32\" onclick='submit_action(\"align\")'>
<span id=\"toolbar_info\"> </span>
-->
</div>

<div id=\"infobox\"  style=\"width:$browser_width\px; height:75px; background-color:#d0d0d0; padding:0px; margin:0px; border:0px;\">
<table style=\"width:100%; text-align:center;\">
<tr style=\"\"><td rowspan=\"3\" style=\"width:65px; background-color: #AAAAA0;\"><img src=\"https://localhost:9005/toolbar_open,2x.gif\" height=\"64\" width=\"64\" onclick='slide_hamburger_in(0, 10, 10);'></td><td>Start</td><td>Length</td><td>End</td><td>ORF</td><td>Tm</td><td>%GC</td></tr>
<tr><td><input type=\"number\" name=\"selection_start\" form=\"\" id=\"selection_start\" onchange=\"onchange_selection()\" value=\"$start_base\" style=\"width:7em;\"></td><td><span id=\"selection_length\">[expr {$end_base-$start_base}]</span></td><td><input type=\"number\" name=\"selection_end\" form=\"\" id=\"selection_end\" onchange=\"onchange_selection()\" value=\"$end_base\" style=\"width:7em;\"></td><td><span id=\"selection_orf\"></span></td><td>Tm</td><td><span id=\"percent_gc\"></span></td></tr>
<tr><td colspan=\"8\" style = \"background-color:#d0d0d0;\"><span id=\"selection_translate\" ></span></td></tr>
</table>
<!--<img src=\"https://localhost:9005/toolbar_open,2x.gif\" height=\"32\" width=\"32\" onclick='document.getElementById(\"hamburger\").style.display = \"block\"'>-->
</div>

<div id=\"hamburger\" style=\"width:0px;height:0px;display:none;overflow:hidden;position:absolute; top:0px; left:0px; padding: 0px; margin: 0px; border: 0px; background-color: #FFFFFF;\" onclick='slide_hamburger_in(300, -10, 10);'>
<table style=\"width:300px; text-align:left;font-size:200%;overflow:hidden\">
<!--<tr style=\" \"><td onclick='slide_hamburger_in(300, -10, 10);'>Sequence1</td></tr>
<tr style=\"\"><td onclick='document.getElementById(\"hamburger\").style.display = \"none\"'>Sequence2</td></tr>-->
<!--<tr style=\" \"><td onclick='submit_action(\"upload_file_dialog\")'>Upload File</td></tr>-->
<tr style=\" \"><td onclick='submit_action(\"open_file_dialog\")'>Open</td></tr>
<tr style=\" \"><td onclick='submit_action(\"enzyme_selector\")'>Enzyme Selector</td></tr>
<tr style=\" \"><td onclick='submit_action(\"graphic_map\")'>Graphic Map</td></tr>
<tr style=\" \"><td onclick='submit_action(\"graphic_map_u\")'>Graphic Map +U</td></tr>
<tr style=\" \"><td onclick='submit_action(\"highlight\")'>Highlight</td></tr>
<tr style=\" \"><td onclick='submit_action(\"digest\")'>Digest</td></tr>
<tr style=\" \"><td onclick='submit_action(\"text_map\")'>Text Map</td></tr>
<tr style=\" \"><td onclick='submit_action(\"align_dialog\")'>Align</td></tr>
</table>
</div>


<div id=\"divsize\" style=\"width: $browser_width\px; height: 611px; overflow: auto; padding: 0px; margin: 0px; border: 0px; background-color:#FFFFFF;\">
 [text_to_svg $w.textarea 1 end 1]
</div>
<!--Hidden variables -->
 <input type=\"hidden\" name=\"browser_width\" id=\"browser_width\" value=\"\">
 <input type=\"hidden\" name=\"action\" id=\"action\" value=\"open\">
<!--Hidden variables -->
</form>
</body>
</html>"
  return $result
}


##############
## save a webpage of an abi window- Javascript to keep the svg version of the seq area the correct aspect ratio
##############
proc abi_to_webpage {w} {
  set result ""
  set c $w.c
  foreach {abi_minx abi_miny abi_maxx abi_maxy} [$c bbox all] {}
  set abi_width [expr {$abi_maxx-$abi_minx}]
  set abi_height [expr {$abi_maxy-$abi_miny}]
  append result {<!DOCTYPE html>
<html>
<meta name="apple-mobile-web-app-capable" content="yes">
<meta name="viewport" content="width=device-width">
<head>
<script>
function on_resize()}\
"{"\
{var body = document.body;
var html = document.documentElement;

var height = window.innerHeight;
var width = window.innerWidth;
document.getElementById("divsize").style.height=(height-65)+"px";
document.getElementById("svgbox").setAttribute("height",(height-85)+"px");}
append result "document.getElementById(\"svgbox\").setAttribute(\"width\", $abi_width / $abi_height * (height-85)+\"px\");"

  append result "}"\
{</script>
<title>}
  append result [wm title $w]
  append result {</title>
</head>
<body onresize="on_resize()" onload="on_resize()" style="padding:0px; margin:0px; border:0px">
<div id="toolbar" style="width:100%; height:50px; background-color:#d0d0d0; padding:0px; margin:0px; border:0px;">
</div>
<div id="divsize" style="width:100%; height:100%; overflow: auto; padding:0px; margin:0px; border:0px;">
  }
  append result [canvas_to_svg $w.c]
  append result "\n</body>\n</html>\n"


  return $result
}

##############
## save a webpage of an abi window- Javascript to keep the svg version of the seq area the correct aspect ratio
##############
proc canvas_to_webpage {c} {

  foreach {a_minx a_miny a_maxx a_maxy} [$c bbox all] {}
  set abi_width [expr {$a_maxx-$a_minx}]
  set abi_height [expr {$a_maxy-$a_miny}]
## need to take out height and width of svg element so that it scales with the div
  set result "<!DOCTYPE html>
<html>
<meta name=\"apple-mobile-web-app-capable\" content=\"yes\">
<meta name=\"viewport\" content=\"width=device-width\">
<head>
<script>
  function on_resize() {
    var width = window.innerWidth;
    var height = window.innerHeight;
    <!--document.getElementById(\"divsize\").style.width=(Math.min(height/width*$abi_width/$abi_height, 1)*.97 * width)+\"px\";-->
    document.getElementById(\"divsize\").style.width= width;
    document.getElementById(\"divsize\").style.height= height;
    document.getElementById(\"svgbox\").style.width=(Math.min(height/width*$abi_width/$abi_height, 1)*0.99 * width)+\"px\";
    document.getElementById(\"svgbox\").style.height=(Math.min(width/height*$abi_height/$abi_width, 1)*.97 * height)+\"px\";
  }
</script>
<title>[wm title [winfo toplevel $c]]</title>
</head>
<body onresize=\"on_resize()\" onload=\"on_resize()\" style=\"padding:0px; margin:0px; border:0px;background-color:#FFFFFF;\">
<div id=\"divsize\" style=\"width:100%; overflow: auto; padding:0px; margin:0px; border:0px;background-color:#FFFFFF;\">

 [canvas_to_svg $c]
</div>
</body>
</html>"

  return $result
}

##############
## save a webpage of an abi window- Javascript to keep the svg version of the seq area the correct aspect ratio
##############
proc analysis_text_to_webpage {text} {
  set html_text [text_to_html $text]

  set max_line 0
  for {set i 1.0} {[$text compare $i < end]} {set i [$text index "$i+1line"]} {
    if {[regexp {[0-9]+\.([0-9]+)} [$text index "$i lineend"] -- line_length]} {
      set max_line [expr {max($max_line, $line_length)}]
    }
  }

  ## needs to properly calculate the onresize function to set pixel size for longest line in the text
  set result "<!DOCTYPE html>
<html>
<head>
<meta http-equiv=\"Content-Type\" content=\"text/html; charset=UTF-8\">
<meta name=\"apple-mobile-web-app-capable\" content=\"yes\">
<meta name=\"viewport\" content=\"width=device-width\">
<script>
function on_resize(){
document.getElementById(\"text_box\").style.fontSize = Math.min(36, (window.innerWidth/[expr {$max_line*.9}]))+\"pt\";
}
</script>
<title>[wm title [winfo toplevel $text]]</title>
</head>
<body onresize=\"on_resize()\"  onload=\"on_resize()\">
<div id=\"text_box\">
$html_text 
</div>
</body>
</html>"
}

##############
## sequence window to svg (should work for any non-wrapping text area)
##############
proc text_to_svg0 {t startline endline} {
##need to reuse code from text_to_canvas, but skip the intermediate canvas, use a single text with textspan items, use dx and dy lists to format the text
  set c [text_to_canvas $t $startline $endline]
  set result [canvas_to_svg $c]
  destroy $c
  return $result
}

##############
## sequence window to svg (should work for any non-wrapping text area with equal line spacing)
##############
proc text_to_svg {t startline endline {line_numbers 0}} {
 set bg_formatted_tags [list]
  foreach tag [$t tag names] {
    if {([$t tag cget $tag -background] != "") && ($tag ne "sel")} {
      lappend bg_formatted_tags $tag
    }
  }
  if {$endline eq "end"} {set endline [expr {int([$t index end])-1}]}
  set result ""
  set text_font [$t cget -font]
  set char_x [font measure $text_font A]
  set char_y [font metrics $text_font -linespace]
  set linewidth [lindex [split [$t index 1.end] .] 1]

  set max_linewidth 0
  for {set i "1.0+$startline lines"} {[$t compare $i < "1.0+$endline lines"]} {set i [$t index "$i+1line"]} {
    if {[regexp {[0-9]+\.([0-9]+)} [$t index "$i lineend"] -- line_length]} {
      set max_linewidth [expr {max($max_linewidth, $line_length)}]
    }
  }

  if {$max_linewidth > 0} {

  set right_space 0
  append result "<svg xmlns=\"http://www.w3.org/2000/svg\" version=\"1.1\" preserveAspectRatio=\"xMidYMid meet\" viewBox=\"[expr {$line_numbers?-$char_x * 5:0}] [expr {0*$char_y}] [expr {(($max_linewidth+$right_space)*$char_x+($line_numbers?$char_x * 5:0))}] [expr {($endline-$startline+1)*$char_y}]\">\n"
  foreach tag $bg_formatted_tags {
    set color [$t tag cget $tag -background]
    foreach {row1 col1 row2 col2} [split [$t tag ranges $tag] ". "] {
      for {set i $row1} {$i < $row2} {incr i} {
        if {($i < $startline)} {set col1 0; continue}
        if {($i > $endline)} break
        append result "<rect x=\"[expr {$col1*$char_x}]\" y=\"[expr {($i-$startline)*$char_y}]\" width=\"[expr {($max_linewidth-$col1)*$char_x}]\" height=\"$char_y\" stroke-width=\"1\" stroke=\"[color_to_svgrgb $color]\" fill=\"[color_to_svgrgb $color]\"/>\n"
        set col1 0
      }
      if {($i >= $startline) && ($i<= $endline)} {
        append result "<rect x=\"[expr {$col1*$char_x}]\" y=\"[expr {($i-$startline)*$char_y}]\" width=\"[expr {($col2-$col1)*$char_x}]\" height=\"[expr {$char_y}]\" stroke-width=\"1\" stroke=\"[color_to_svgrgb $color]\" fill=\"[color_to_svgrgb $color]\"/>\n"
      }
    } 
  }
  append result "<text font-weight=\"[font actual $text_font -weight]\" font-style=\"[font actual $text_font -slant]\" font-family=\"[font actual $text_font -family], monospace\" font-size=\"[expr {round([tk scaling]*[font actual $text_font -size]*10)/10.0}]\" fill=\"#000000\" xml:space='preserve'>\n"

  set x_pos_list [list]
  set old_linewidth 0
  for {set i $startline} {$i <= [expr {$endline}]} {incr i} {
    set linewidth [lindex [split [$t index $i.end] .] 1]
    if {$linewidth != $old_linewidth} {
      set x_pos_list [list]
      for {set j 0} {$j< [expr {$linewidth+$right_space}]} {incr j} {
        lappend x_pos_list [expr {$j*$char_x}]
      }
      set x_pos_string [join $x_pos_list ,]
    }
    set old_linewidth $linewidth

    set txt [string map {> &#62; < &#60; \" &#34; & &#38;} [$t get $i.0 $i.0lineend]]
    append txt [string repeat " " $right_space]
    append result "<tspan id=\"svg_text_line[expr {($i-$startline+1)}]\"  x=\"$x_pos_string\" y=\"[expr {($i-$startline+1)*$char_y-3}]\" >$txt</tspan>\n"
  }
  append result "</text>\n"

  if {$line_numbers} {
    append result "<rect x=\"[expr {-1* $char_x * 5-10}]\" y=\"0\" width=\"[expr {$char_x * 5+10}]\" height=\"[expr {($endline-$startline+1)*$char_y}]\" stroke-width=\"1\" stroke=\"#f0f0f0\" fill=\"#f0f0f0\"/>\n"
    append result "<line x1=\"-1\" y1=\"0\"  x2=\"-1\" y2=\"[expr {($endline-$startline+1)*$char_y}]\" stroke-width=\"2\" stroke=\"#000000\"/>\n"
    append result "<text text-anchor= \"end\" onmousemove=\"test()\" font-weight=\"[font actual labelfont -weight]\" font-style=\"[font actual labelfont -slant]\" font-family=\"[font actual labelfont -family], sans-serif\" font-size=\"[expr {round([tk scaling]*[font actual labelfont -size]*10)/10.0}]\" fill=\"#000000\" style=\"-webkit-user-select:none; -webkit-user-select:none;\" unselectable=\"on\">\n"
    for {set i $startline} {$i<=$endline} {incr i} {
      append result "<tspan x=\"-2\" y=\"[expr {($i-$startline+1)*$char_y-3}]\" style=\"-webkit-user-select:none; -webkit-user-select:none;\" unselectable=\"on\">[expr {1+($i-1)*$max_linewidth}]</tspan>\n"
    }
    append result "</text>\n"
  }
  append result "</svg>\n"
  }; #if linewidth >0
  return $result
}

##############
## open a file
##############
#recognizes fasta, plain and strider files

proc open_file_dialog {{w ""}} {
  global info dialogblock
  if {$dialogblock == 1} {return}
  set dialogblock 1
  while {![file isdirectory $info(default_dnadir)]} {
    set info(default_dnadir) [file dirname $info(default_dnadir)]
    if {[file dirname $info(default_dnadir)] == $info(default_dnadir)} {
      set info(default_dnadir) [valid_default_dir]
    }
  }
  set focus_win ""
  if {$w == "" || ![winfo exists $w]} {
    if { [winfo toplevel [focus]] ne ""} {
      set focus_win [winfo toplevel [focus]]
    }
  } else {
    set focus_win $w
  }
  if {$focus_win == "" || $focus_win == "."} {
    set focus_win .
    set filename [tk_getOpenFile -initialdir $info(default_dnadir) -title [mc "Open DNA file"] -multiple 1]
  } else {
    set filename [tk_getOpenFile -initialdir $info(default_dnadir) -title [mc "Open DNA file"] -parent $focus_win -multiple 1]
  }

  if {([winfo exists $focus_win]) && ($focus_win != ".")} {
    wm deiconify [winfo toplevel $focus_win]
    focus $focus_win
  }



  foreach file $filename {
    catch {open_file $file}
  }
  set dialogblock 0
}


if {$info(android)} {
  proc open_file_dialog {{w ""}} {
    global env
    set filename [post_file_hamburger $env(EXTERNAL_STORAGE)]
    if {$filename != ""} {
      foreach file $filename {
        catch {open_file $file}
      }
    }
  }
}

##############
## Read Pascal string from a file
##############
proc read_pascal_string {fileid {bits 8}} {
  if {$bits ==8} {
    binary scan [read $fileid 1] c length
  } elseif {$bits == 32} {
    binary scan [read $fileid 4] Iu length
  } else {
    return
  }
#sputs length $length
  set result  [read $fileid $length]
  #binary scan $result c* temp
  #sputs pascal_string $temp
  return $result
}


##############
## open a file
##############
#recognizes fasta, plain and strider files
# interactive_opening- 0 = no dialogs, open files, 1 = with warning dialog, open files, 2 = with dialogs Genbank type only returns just the data
proc open_file {filename  {interactive_opening 1}} {
  global info header
  if {$filename != ""} {
    if {[tk windowingsystem] == "win32"} {
      regsub -all {\\} $filename {/} filename
    }

    if {$interactive_opening != 2} {
      ## check for already open file
	  foreach win [dnawindows_list] {
		if {$info($win,filename) == $filename} {
		  if {$interactive_opening} {
			tk_messageBox -message [mc "The file %s is already open." [file tail $filename]] -type ok -icon info
		  }
		  wm deiconify $win
		  raise $win
		  after 100 "focus $win"
		  return $win
		}
	  }
    }

    if {![catch {open $filename r} fileid err]} {
      #read in the 1st header line and determine filetype (storing info from the line)
      fconfigure $fileid -translation binary
      set striderheader [read $fileid 112]
      fconfigure $fileid -translation auto -encoding [encoding system]
      seek $fileid 0
      set a [gets $fileid]
      if {[eof $fileid] != 1} {
        set b [gets $fileid]
      } else {
        set b ""
      }
      seek $fileid 0
      set a [gets $fileid]
#sputs a:$a
      #if the string is long enough to be a strider file, extract the strider header info
        set strversion -1; set strtype -1
        if {[binary scan $striderheader cccx14cx10IIx60I strversion strtype strtopology strmet strlength strminus strcomlength] < 7} {
          set strversion -1; set strtype -1
        }
        if {[binary scan $striderheader I2x16IIx* gck_magnum gck_packet gck_seq_len] < 3} {
          set gck_magnum 0
          set  gck_packet 0
          set gck_seq_len 0
        } else {
          #sputs gck $gck_magnum $gck_packet $gck_seq_len
        }
        if {[binary scan $striderheader H64Ix* macvec_magnum macvec_seq_len] < 2} {
          set macvec_magnum 0
          set macvec_header_ints [list 0 0 0 0 0 0 0]
        } elseif {[binary scan $striderheader I9x* macvec_header_ints] < 1} {
          set macvec_header_ints [list 0 0 0 0 0 0 0]
        }

        if {[binary scan $striderheader cIc8SSSx* snapgene_packet_tag snapgene_header_len snapgene_cookie snapgene_filetype snapgene_export snapgene_import] < 6} {
          set snapgene_packet_tag 0
          set snapgene_header_len 0
          set snapgene_cookie 0
          set snapgene_filetype 0
          set snapgene_export 0
          set snapgene_import 0
        }
#sputs snapgene $snapgene_header_len $snapgene_cookie
        if {[string range $striderheader 40 69] eq "Written by SeqBuilder version " || [string range $striderheader 40 69] eq "Created by SeqBuilder version "} {
          set seqbuilder_magnum 1
        } else {
          set seqbuilder_magnum 0
        }
#sputs  strversion $strversion  strtype $strtype  strtopology $strtopology  strmet $strmet  strlength $strlength strminus $strminus strcomlength $strcomlength
      #check for header types
      if {$striderheader == ""} {
        set filetype "empty"
      } elseif {[string range $a 0 4] == "LOCUS"} {
         set filetype "GenBank"
      } elseif {[string range $a 0 1] == "ID"} {
         set filetype "embl"
      } elseif {([string first "Created:" $a] > -1) && ($b == "^^")} {  
         set filetype "editseq"
      } elseif {($strversion == 0) && (($strtype == 1) || ($strtype == 2) || ($strtype == 3) || ($strtype == 4))  && ($strtopology==1 || $strtopology==0)} {
         set filetype "strider"
      } elseif {($strversion == 1) && (($strtype == 1) || ($strtype == 2) || ($strtype == 3) || ($strtype == 4)) && ($strtopology==1 || $strtopology==0)} {
         set filetype "strider1"
      } elseif {([string first "VERSION  pDRAW" $a] > -1)} {
         set filetype "pdraw"
      } elseif {([llength $gck_magnum] == 2 && [lindex $gck_magnum 0] == [lindex $gck_magnum 1]) && ( [expr {$gck_packet-4}] == $gck_seq_len)} {
         set filetype "gck"
      } elseif {($snapgene_cookie == {83 110 97 112 71 101 110 101}) && ( $snapgene_packet_tag == 9) && ( $snapgene_filetype == 1)} {
         set filetype "snapgene"
      } elseif {[regexp  {0000000.01014} $macvec_magnum] || ([info exists macvec_header_ints] && [lindex $macvec_header_ints 4] ==1 && [lindex $macvec_header_ints 6] ==1  && [lindex $macvec_header_ints 5] == [lindex $macvec_header_ints 7] && [lindex $macvec_header_ints 7] == [lindex $macvec_header_ints 8] )} {
         set filetype "macvector"
      } elseif {[string index $a 0] == ">"} {
        set filetype "fasta"
        set filecomment [string range $a 1 end]
      } elseif {[string index $a 0] == "@"} {
        set filetype "fastq"
        set filecomment [string range $a 1 end]
      } elseif {([string length $a] > 10) && ([regexp -nocase {[^ACGTN*BDHKMRSUVWY 0-9]} $a] == 0)} {
         set filetype "plain"
      } elseif {[string range $a 0 3] == "ABIF"} {
         set filetype "abi"
      } elseif {[string range $a 0 3] == ".scf"} {
         set filetype "scf"
      } elseif {$seqbuilder_magnum} {
         set filetype "seqbuilder"
      } elseif {$a eq "!!NA_SEQUENCE 1.0"} {
         set filetype "gcg"
      }  elseif {[string first "<?xml version" $a] > -1 || [string first "<rdf:RDF" $a] > -1} {
         ## some kind of XML- check for SBOL
         sputs xml detected
         seek $fileid 0
         set text ""
         # without any kind of magic number, have to read in the whole file to seach for the identifier somewhere in it
         while {[eof $fileid] != 1} {
           append text [gets $fileid]
         }
         if {[regexp {="http://sbols.org/v([0-9]+)#} $text -- sbol_version] && $sbol_version in {1 2 3}} {
           set filetype "SBOL"   
         } else {
           set filetype "unknown"
         }
         unset text
      }  elseif {[regexp {##gff-version\s+3} $a]} {
         set filetype "gff3"
      } else {
          set filetype "unknown"
sputs unknown file [string range $a 0 1000]\n[string range $b 0 1000]
      }

      if {$interactive_opening == 2 && $filetype ne "GenBank"} {
        close $fileid
	    set dialogblock 0
        return -code error "Not Genbank type"
      }
      
      if {$filetype eq "unknown"} {
		tk_messageBox -message [mc "The file %s \n is not a recognised FASTA, FASTQ, Plain, GenBank, EMBL, editseq, GCG, GCK, pDraw, MacVector, Snapgene, Seqbuilder, GFF3, or Strider file." [file tail $filename]] -type ok -icon warning -default ok
		if {(([lsearch [winfo children .] ".dna_window*"] != -1) || ([lsearch [winfo children .] ".abi_window*"] != -1))} {
		  close $fileid
		  set dialogblock 0
		  return -code error "Unknown type"
		} else {
  sputs open_error 0
		  set filetype "empty" 
		}
      }
      #read in DNA and comment for each file type
      set genbank_features [list]
      set genbank_header_info [list]
      set linked_abi_list [list]
      set methylated $info(methylated_default)
      set seguid_dict [dict create]
      set phred_string ""
      set graphic_format_dict [list]
      set newdna ""
      set filecomment ""
      set startindex 1
      set circular "linear"
      set new_tags [list]
      set new_title [mc "New_DNA"]
	  
      switch $filetype {
        empty {
          set filetype "None"
        }
        fasta {
          if {1} {
            ## just open the first fasta record
            set newdna ""
            set filecomment $a
            while {![eof $fileid]} {append newdna [gets $fileid]}
            if {[set gt [string first ">" $newdna]] > -1} {
              set newdna [string range $newdna 0 $gt]
            }
            set circular "linear"
            set new_tags [list]
            set new_title [file tail $filename]
            set filetype "FASTA"
          } else {
            ## use a dialog list to select all desired fasta records
            set first_fasta_window [open_fasta_files $fileid $interactive_opening]
            if {$interactive_opening && ($first_fasta_window ne {}) && $info(dnadir_follows_open)} {
              set info(default_dnadir) [file dirname $filename]
            }
            close $fileid
            set dialogblock 0
            return $first_fasta_window
          }
        }
        fastq {
          set newdna ""
          set filecomment $a
          set newdna [gets $fileid]
          set qual_comment  [gets $fileid]
          if {[string index $qual_comment 0] ne "+"} {
            sputs fastq error- no + line
          } else {
             set phred_string  [gets $fileid]
          }
          if {[string length $newdna] != [string length $phred_string]} {
            sputs fastq error- q string length not equal to DNA length
            set phred_string ""
          }
          set circular "linear"
          set new_tags [list]
          set new_title [file tail $filename]
          set filetype "FASTQ"
        }
        plain {
          #sputs "plain: $filename"
          set newdna $a
          while {[eof $fileid] != 1} {append newdna [gets $fileid]}
          set filecomment ""
          set circular "linear"
          set new_tags [list]
          set new_title [file tail $filename]
          set filetype "Plain Text"
        }
        strider {
          #sputs "strider: $filename"
          seek $fileid 112
          fconfigure $fileid -translation binary -encoding binary
          set newdna [read $fileid $strlength]
          #regsub -all {\*} $newdna "N" newdna
          set filecomment [read $fileid $strcomlength]
          set strider_features [read $fileid]
          sputs strider_features: [string length $strider_features]
          set startindex [expr {1+$strminus}]
          set circular [expr ($strtopology?"circular":"linear")]
          if {($strmet != 0) && ($strmet != 1)} {set strmet 0}
          set methylated $strmet
          set new_tags [serial_cloner_features_to_taglist $strider_features $circular [string length $newdna]]
          set new_title [file tail $filename]
#sputs new_title $new_title
          if {$strtype == 3} {
            set circular "RNA"
            #set newdna [string map {u t U T} $newdna]
          }
          if {$strtype == 4} {
            set filecomment ">$filecomment"
            append filecomment \n $newdna 
            set newdna [reverse_translate $newdna]
          }
          set filetype "DNA Strider"
        } 
        strider1 {
          #sputs "strider: $filename"
          global 
          seek $fileid 112
          set newdna [read $fileid $strlength]
          #regsub -all {\*} $newdna "N" newdna
          set filecomment [read $fileid $strcomlength]

          if {![eof $fileid]} {
fconfigure $fileid -translation binary
           # while {![eof $fileid] && [binary scan  [read $fileid 1] c unknown_byte]} {
            #sputs  $unknown_byte
            # }
#global remnant
 #set remnant [read $fileid]
#  set roh_length [read_pascal_string $fileid]
#   if {$roh_length != ""} {
#     set roh [read $fileid $roh_length]
#  }
#   set loh_length [read_pascal_string $fileid]
#   if {$loh_length != ""} {
#     set loh [read $fileid $loh_length]
#  }
#  binary scan [read $fileid 1] c annotations_count
#  set annotations_count [expr { $annotations_count & 0xff }]
# sputs strider1 [eof $fileid]
#}
          set startindex [expr {1+$strminus}]
          set circular [expr ($strtopology?"circular":"linear")]
          if {($strmet != 0) && ($strmet != 1)} {set strmet 0}
          set methylated $strmet
          set new_tags [list]
          set new_title [file tail $filename]
#sputs new_title $new_title
          if {$strtype == 3} {
            set circular "RNA"
            #set newdna [string map {u t U T} $newdna]
          }
          if {$strtype == 4} {
            set filecomment ">$filecomment"
            append filecomment \n $newdna 
            set newdna [reverse_translate $newdna]
          }
          set filetype "DNA Strider v1"
        } 
        macvector {
          set filecomment ""
          set new_title [file tail $filename]
          set filetype "MacVector"
          lassign [open_macvector_file $fileid $striderheader] circular newdna new_tags genbank_header_info
        }
        snapgene {
          set filecomment ""
          set new_tags [list]
          set new_title [file tail $filename]
          set filetype "Snapgene"
          fconfigure $fileid -translation binary
          seek $fileid 19
          set packet_list [list]
          while {![eof $fileid]} {
            set packet_header [read $fileid 5]
            if {[binary scan $packet_header cI packet_tag packet_len] == 2} {
              set packet_data [read $fileid $packet_len]
#sputs snapgene packet $packet_tag $packet_len
              lappend packet_list $packet_tag $packet_data
            } else {
              if {[string length $packet_header] > 0} {
                sputs err snapgene read 
              }
              break
            }
          }
	  set feature_count 0
	  foreach {packet_tag packet_data} $packet_list {
            switch $packet_tag {
              0 {
		#Sequence
                set newdna [string range $packet_data 1 end]
	        set flags [string index $packet_data 0]
		binary scan $flags b8 bflags
		if {[string index $bflags 1]} {set circular "circular"}
              }
              5 {
		#Primers
		#regexp {(<Primer [^>]+>)(<BindingSite [^>]+>)} $packet_data - primer_record location_data
		set result [list]
		foreach {- primer_record location_data} [regexp -inline -all {<Primer ([^>]+?)>(.*?)</Primer>} $packet_data] {
		  set qual_list [list]
                  if {![regexp {name=\"([^\"]+)} $primer_record - name]} {continue}
		  if {[regexp {sequence=\"([^\"]+)} $primer_record - sequence]} {
		    lappend qual_list "PCR_conditions" "primer sequence:$sequence"
		  }
                  if {[regexp {description=\"([^\"]+)} $primer_record - note]} {
		    lappend qual_list "note" $note
		  }

		  if {[set color_index [lsearch -exact $info(feature_default_type_colors) primer_bind]] != -1} {
                    set clist [lindex $info(feature_default_type_colors) [expr {$color_index+1}]]
                  } else {
                    set clist [list #38acff #4ec02b]
                  }
                  set fwd_color [lindex $clist 0]
		  set rev_color [lindex $clist 1]

		  set bindlist [list <<Revcolors>> <<Metadata>>]
		  if {[catch {set Apeinfo_gformat [dict get $info(feature_default_type_gformat) "primer_bind"]}]} {
                    set Apeinfo_gformat $info(feature_default_gformat)
                  }
		  foreach {- binding_record binding_data} [regexp -inline -all {<BindingSite ([^>]+?)>(.*?)</BindingSite>} $location_data] {
		    if {[regexp {simplified="1"} $binding_record]|| ![regexp {location=\"([^\-]+)\-([^\"]+)} $binding_record - from to]  || ![regexp {boundStrand=\"([^\"]+)} $binding_record - reverse]} {continue}
		    if {!$reverse} {
                      set formatlist [list $fwd_color {} {}]
                    } else {
                      set formatlist [list $rev_color {} {}]
                    }
		    if {[list $fwd_color $rev_color] == [list #ffffff #ffffff]} {
		      set fwd_color #bbbbbb
		      set rev_color #bbbbbb
		    }
                    set actionlist [list [list $fwd_color $rev_color] [list $name $Apeinfo_gformat primer_bind $reverse $qual_list {}]]
		    lappend new_tags "f$feature_count#" [list [list $from [expr {1+$to}]] $formatlist $bindlist $actionlist]
		    incr feature_count
		  }
	        }
              }
              6 {
		#Notes
		set filecomment_list [list]
		set notes_data $packet_data
		regexp {<Notes>(.*)</Notes>} $packet_data - notes_data
	        foreach {- field field_data} [regexp -inline -all {<([^>]+?)>(.*)</\1>} $notes_data] {
		  if {[set sub_data_list [regexp -inline -all {<([^\s]+) (.*)/>} $field_data]] != {}} {
		    foreach {- sub_field sub_data} $sub_data_list {
                      lappend filecomment_list "$field: $sub_field: $sub_data"
		    }
		  } else {
                    lappend filecomment_list "$field: $field_data"
		  }
		}
		set filecomment [join $filecomment_list \n]
              }
              10 {
		#Features
		set result [list]
		foreach {- feature_record feature_data} [regexp -inline -all -nocase {<Feature ([^>]+?)>(.*?)</Feature>} $packet_data] {
		  #sputs start $feature_record
		  #sputs $feature_data\n
                  if {![regexp {name=\"([^\"]+)} $feature_record - name] || ![regexp {type=\"([^\"]+)} $feature_record - feature_type]} {continue}
                  set name [encoding convertfrom utf-8 $name]
		  set directionality ""
		  if {[regexp {directionality=\"([^\"]+)} $feature_record - directionality] && $directionality == 2} {set reverse 1} else {set reverse 0}
		  if {[dict exists $info(feature_default_type_colors) $feature_type]} {
                    set clist [dict get $info(feature_default_type_colors) $feature_type]
                  } else {
                    set clist [list #ff926c #ff926c]
                  }
                  set fwd_color [lindex $clist 0]
		  set rev_color [lindex $clist 1]

		  set bindlist [list <<Revcolors>> <<Metadata>>]
		  if {[catch {set Apeinfo_gformat [dict get $info(feature_default_type_gformat) $feature_type]}]} {
                    set Apeinfo_gformat $info(feature_default_gformat)
                  }
		  if {$directionality == ""} {
                     ## bezier arrow data change here-  arrow points list can be dict of pts min_x_scale and smooth
                    dict set Apeinfo_gformat arrow_data [list {0 .5 .1 .5 .1 -.5 0 -.5} {0 .5 .1 .5 .1 -.5 0 -.5} 0]
                    #dict set Apeinfo_gformat arrow_data [list {0.0 0.5 0.0 0.5 0.0 -0.5 0.0 -0.5 0.0 -0.5 0.0 0.5} {0.0 0.5 0.0 0.5 0.0 -0.5 0.0 -0.5 0.0 -0.5 0.0 0.5} 0]
		  }
		  set qual_list [list]
		  foreach {- q_record q_data} [regexp -inline -all -nocase {<Q ([^>]+?)>(.*?)</Q>} $feature_data] {
		    if {[regexp {name=\"([^\"]+)} $q_record - q_name] && [regexp {text=\"([^\"]+)} $q_data - qual_data]} {
		      regsub -all {&amp;} $qual_data {\&} qual_data
		      regsub -all {&lt;} $qual_data < qual_data
		      regsub -all {&gt;} $qual_data > qual_data
		      regsub -all {&nbsp;} $qual_data " " qual_data
		      regsub -all {&quot;} $qual_data "\"" qual_data
		      regsub -all {&apos;} $qual_data "'" qual_data
		      regsub -nocase -all {<html>|</html>|<body>|</body>|<br>} $qual_data "" qual_data
		      lappend qual_list [encoding convertfrom utf-8 $q_name] [encoding convertfrom utf-8 $qual_data]
		    }
		  }

		  set coord_list [list]
		  foreach {- segment_data} [regexp -inline -all -nocase {<Segment (.*?)/>} $feature_data] {
		    if {[regexp {range=\"([0-9]+)\-([0-9]+)} $segment_data - from to]} {
		      incr from -1
		      if {$from < $to} {
		        lappend coord_list $from $to
		      } else {
		        lappend coord_list $from [expr {[string length $newdna]}]
		        lappend coord_list 0 $to
		      }
		    }
		    if {[regexp {color=\"([0-9a-f#]+)} $segment_data - color] ||[regexp {color=\"(noColor)} $segment_data - color]} {
		      if {$color == "#ffffff"} {
			set color #bbbbbb
			dict set Apeinfo_gformat graphic_fg_color_0 "#ffffff"
			dict set Apeinfo_gformat graphic_fg_color_1 "#ffffff"
			dict set Apeinfo_gformat outline_color_0 "#000000"
			dict set Apeinfo_gformat outline_color_1 "#000000"
		      }
		      if {$color == "noColor"} {
			set color #444444
			dict set Apeinfo_gformat graphic_fg_color_0 "#000000"
			dict set Apeinfo_gformat graphic_fg_color_1 "#000000"
			dict set Apeinfo_gformat outline_color_0 "#ffffff"
			dict set Apeinfo_gformat outline_color_1 "#ffffff"
		      }
		      set clist [list $color $color]
		      set fwd_color $color
		      set rev_color $color
		    }
		  }
                  if {$coord_list == [list]} {continue}

		  if {!$reverse} {
                    set formatlist [list $fwd_color {} {}]
                  } else {
                    set formatlist [list $rev_color {} {}]
                  }
		  set actionlist [list [list $fwd_color $rev_color] [list $name $Apeinfo_gformat $feature_type $reverse $qual_list {}]]
		  lappend new_tags "f$feature_count#" [list $coord_list $formatlist $bindlist $actionlist]
		  incr feature_count
	        }

	      }
              2 {
                 #binary scan [string range $packet_data 0 1700] c1I256c* data2a data2b data2c
                 #sputs snapgene data2 $data2a $data2b $data2c
              }
              3 {
                 ## restriction data?
                 #binary scan [string range $packet_data 0 700] c1I1 number string_length
                 #set seqs_string [string range $packet_data 5 [expr {4+$string_length}]]
                # set seqs_list [split $seqs_string ,]
                 #set num_seqs [llength $seqs_list]
                # sputs snapgene data3 [string length $packet_data] $number $string_length $seqs_list 

                # set rest_of_data  [string range $packet_data [expr {5+$string_length}] end]
                # binary scan $rest_of_data I$num_seqs\S$num_seqs\c*    fwd_count_list    fwd_count_list_short_ints     list3
                 #sputs fwd_count_list $fwd_count_list 
                 #sputs fwd_count_list_short_ints $fwd_count_list_short_ints 
                 #sputs list3 $list3 
              }
              13 {
              #   binary scan $packet_data c* data13
                 #sputs snapgene data13 $data13
               }
              default {
                #sputs snapgene data $packet_tag $packet_data
              }
            }
          }
        }
        gck {
          set methylated 0
          set filecomment ""
          set genbank_header_info [list]
          set new_title [file tail $filename]
          set filetype "GCK"
          lassign [open_gck_file $fileid $striderheader] circular newdna new_tags
        }
        seqbuilder {
          set third 0
          seek $fileid 78
          set filecomment ""
          set newline [gets $fileid]; #sputs seqbuilder [string length $newline]
          if {![regexp {([abcdghkmnrstuvwyABCDGHKMNRSTUVWY*]*)LOCUS       (.*) ([0-9]*) bp (   |ss-|ds-|ms-)(NA    |DNA   |RNA   |tRNA  |rRNA  |mRNA  |uRNA  |snRNA |snoRNA|      )[ ]*(linear|circular|        )[ ]*([ A-Z]{0,3})[ ]*(..-...-....)} $newline x newdna name size stranded type c div date]} {

            set name "Untitled"
            if {![regexp {([abcdghkmnrstuvwyABCDGHKMNRSTUVWY*]*)\^\^} $newline x newdna]} {
              sputs seqbuilder bad DNA
              set newdna ""
            }
            if  {([gets $fileid nextline] == -1) || ([binary scan $nextline I145c14c3c8c4cc3 first comblkfmt second seqshape third circ fourth] < 7)} {
              sputs seqbuilder bad header read
            }
            if {[string first RNA $type] > -1} {
              set circular "RNA"
            }
          } else {
            ##GenBank header data
            regexp  {(LOCUS.*)} $newline - a
            set genbank_type_array(0) "LOCUS       "
            set genbank_data_array(0) [string range $a 12 end]
            set genbank_header_info [list]
            set genbank_type_array(0) "LOCUS       "
            set genbank_data_array(0) [string range $a 12 end]
            set i 0
            set text ""
            while {([gets $fileid nextline] != -1) && ([binary scan $nextline I145c14c3c8c4cc3 first comblkfmt second seqshape third circ fourth] < 7)} {
              set lastlen [string length $text]
              set text [string range $nextline 12 end]
              set type [string range $nextline 0 11]

              if {$type == "            "} {
                if {($lastlen + [string first " " "$text "]) > 66 } {
                  append genbank_data_array($i) " " $text
                } else {
                  append genbank_data_array($i) \n $text
                }
              } else {
                incr i
                set genbank_type_array($i) $type
                set genbank_data_array($i) $text
              }
            }
            set genbank_header_info [list]
            for {set j 0} {$j <= $i} {incr j} {
              if {$genbank_type_array($j) == "COMMENT     "} {
                append filecomment $genbank_data_array($j)
              }
              lappend genbank_header_info $genbank_type_array($j) $genbank_data_array($j)
            }
            unset i j
            array unset genbank_type_array
            array unset genbank_data_array
            
          }

          if {$third == {4 0 0 0}} {
            ## read seqbuilder features
            seek $fileid -[string length $nextline] current
            seek $fileid 612 current
            set result [list]
            set temp_list [list]
            set range_list [list]
            set feature_count 0
            while { [set featuredata [read $fileid 1]] != ""} {

              if {$featuredata eq "/"} {
                seek $fileid -1 current
                set subdata ""
                gets $fileid temp
                if {[regexp {/(.*)=(.*)} $temp - subtype subdata] || [regexp {/(.*)} $temp - subtype]} {
                  lappend temp_list $subtype $subdata
                }
              } else {
                if {$range_list != [list]} {
                  if {[dict exists $info(feature_default_type_colors) $feature_type]} {
                    set clist [dict get $info(feature_default_type_colors) $feature_type]
                  } else {
                    set clist {pink pink}
                  }
                 set fwd_color [lindex $clist 0]
                 set rev_color [lindex $clist 1]

                 if {1 || [catch {set ad [dict get $Apeinfo_gformat arrow_data]; dict get $Apeinfo_gformat width; dict get $Apeinfo_gformat offset}] || [llength $ad] !=3 || ([llength [lindex $ad 0]] % 2)|| ([llength [lindex $ad 1]] % 2) } {
                    if {[catch {set Apeinfo_gformat [dict get $info(feature_default_type_gformat) $feature_type]}]} {
                      set Apeinfo_gformat $info(feature_default_gformat)
                    }
                  }
                  if {$feature_type eq "source"} {
                    set formatlist [list {} {} {}]
                  } elseif {!$reverse} {
                    set formatlist [list $fwd_color {} {}]
                  } else {
                    set formatlist [list $rev_color {} {}]
                  }
                  set bindlist [list <<Revcolors>> <<Metadata>>]
                  set actionlist [list [list $fwd_color $rev_color] [list $label $Apeinfo_gformat $feature_type $reverse $temp_list {}]]
                  set range_list [lsort -integer $range_list]
                  if {[llength $range_list] == 2} {
                    lappend result "f$feature_count#" [list $range_list $formatlist $bindlist $actionlist]
                  } else {
                    lappend result "f$feature_count#" [list $range_list $formatlist $bindlist $actionlist]
                    lappend result "fn$feature_count#" [list [list [lindex $range_list 0] [lindex $range_list end]] [list {} {} {}] [list] [list]]
                  }
                  incr feature_count
                  set temp_list [list]
                  set range_list [list]
                }
                seek $fileid -1 current
                set featuredata [read $fileid 354];
                if {[regexp {CommonBlock} $featuredata]} {break}
                binary scan $featuredata c6c1 t ps
                if {$t != {0 101 0 0 0 0}} {
                  sputs "0-6:$t"
                }
                set label [string range $featuredata 7 [expr {6+$ps}]]
                binary scan $featuredata c264c1c1c1 pad q1 q2 ps2
                if {[lsort -integer -unique [lrange $pad [expr {7+$ps}] end]] != {0}} {
                  sputs "pad:[lrange $pad [expr {7+$ps}] end]"
                }
                #sputs q:$q1,$q2
                set  feature_type [string range $featuredata 267  [expr {266+$ps2}]]
                binary scan  $featuredata  x353c count
                #sputs "count:$count"
                for {set j 0} {$j<$count} {incr j} {
                    binary scan  [read $fileid 62]  S21SSSc1c1c* zeros start zero end zero1 reverse data
                    #sputs "data:$zeros; $zero; $zero1; $data"
                    #sputs "start:$start;end: $end;reverse: $reverse"
                    if {$reverse} {
                      lappend range_list $start [expr {$end-1}]
                    } else {
                      lappend range_list [expr {$start-1}] $end
                    }
                 }
                 set subdata ""
                 gets $fileid temp
                 if {[regexp {/(.*)=(.*)} $temp - subtype subdata] || [regexp {/(.*)} $temp - subtype]} {
                  lappend temp_list $subtype $subdata
                }
              }
            }
          }
          set circular [expr {$circ < 2 ? "linear" : "circular"}]
          set new_tags $result
          set new_title [file tail $filename]
          set filetype "Seqbuilder"
        }

        abi {
          #sputs "abi: $filename"
          close $fileid
          set abi_window [open_abi $filename $interactive_opening]
          if {$interactive_opening && ([string first ".abi_window" $abi_window] > -1) && $info(dnadir_follows_open)} {
            set info(default_dnadir) [file dirname $filename]
          }
          set dialogblock 0
          return $abi_window
        }
        scf {
          #sputs "scf: $filename"
          close $fileid
          set abi_window [open_abi $filename $interactive_opening]
          if {$interactive_opening && ([string first ".abi_window" $abi_window] > -1) && $info(dnadir_follows_open)} {
            set info(default_dnadir) [file dirname $filename]
          }
          set dialogblock 0
          return $abi_window
        }
        gcg {
          set filecomment ""
          while {([gets $fileid nextline] != -1) && ([string first ".." $nextline] == -1)} {
            append filecomment $nextline
          }

          set newdna ""
          while {([gets $fileid nextline] != -1)} {
            append newdna $nextline
       
          }
          regsub -all {[\n ]} $newdna "" newdna
          regsub -all {<.*?<} $newdna "" newdna
          regsub -all {>.*?>} $newdna "" newdna
          regsub -all {$.*?$} $newdna "" newdna
          set circular "linear"
          set new_tags [list]
          set new_title [file tail $filename]
          set filetype "GCG"
        }
        pdraw {
          while {([gets $fileid nextline] != -1) && ([string first ".." $nextline] == -1)} {
            append fileheader $nextline\n
          }

          set newdna ""
          while {([gets $fileid nextline] != -1)} {
            append newdna $nextline
       
          }
          regsub -all {[[:space:]0-9\n]} $newdna "" newdna
          set filecomment ""
          if {[regexp -nocase {IScircular +YES} $fileheader]} {
            set circular "circular"
          } else {
            set circular "linear"
          }
          set new_tags [list]
          set pdraw_features_list [list]
          foreach fline [regexp -all -inline {Element[[:space:]]+.{30}[-0-9]+[[:space:]]+[-0-9]+[[:space:]]+[0-9]+[[:space:]]+[-0-9]+[[:space:]]+\n} $fileheader] {
            if {[regexp {Element[[:space:]]+(.{30})([-0-9]+)[[:space:]]+([-0-9]+)[[:space:]]+([0-9]+)[[:space:]]+([-0-9]+)[[:space:]]+\n} $fline fline fname fstart fend ftype frev]} {
              lappend pdraw_features_list [list [string trimright $fname " "] $fstart $fend $ftype $frev]
            }
          }
          foreach fline [regexp -all -inline {Annotation_Name [^\n]*\nAnnotation_Start [-0-9]+\nAnnotation_End [-0-9]+\nAnnotation_Type [0-9]\nAnnotation_Orientation [-0-1]+} $fileheader] {
            if {[regexp {Annotation_Name ([^\n]*)\nAnnotation_Start ([-0-9]+)\nAnnotation_End ([-0-9]+)\nAnnotation_Type ([0-9])\nAnnotation_Orientation ([-0-1]+)} $fline fline fname fstart fend ftype frev]} {
              lappend pdraw_features_list [list [string trimright $fname " "] $fstart $fend $ftype $frev]
sputs pdwfh $fstart $fend $ftype $frev
            }
          }
          set new_tags [pdraw_features_to_taglist $pdraw_features_list]
          set new_title [file tail $filename]
          set filetype "pDraw"
#VERSION  pDRAW 1.0 v2/beta
#DNAname
#IScircular YES/NO
#v2 features
#Annotation_Number 	1
#Annotation_Name BSD
#Annotation_Start 4236
#Annotation_End 4631
#Annotation_Type 0 #0-3?
#Annotation_Orientation -1/0 (fwd/reverse)
#Annotation_ArrowLength 0
#Annotation_ArrowWidth 0
#Annotation_Custom False
#v beta features
#Element   CMV                           212       816       2    -1 (start end type orientation:0=rev:-1=fwd)
#HEADER comment lines
#Sequence ..

        }
        GenBank {
          #sputs "GenBank: $filename"
          set filecomment ""

          if {![regexp {LOCUS       (.*) ([0-9]*) bp (   |ss-|ds-|ms-)(NA    |DNA   |RNA   |tRNA  |rRNA  |mRNA  |uRNA  |snRNA |snoRNA)[ ]*(linear  |circular|        )[ ]*([ A-Z]{3})[ ]*(..-...-....)} $a x name size stranded type circular div date] || $circular== "        "} {
            set circular "linear"
            set name "Untitled"
            set type DNA
          }  
          regsub -all {[^a-zA-Z0-9]} $name _ name
          regsub -all {[[:space:]]} $circular "" circular
          set topology $circular
          if {[string first RNA $type] > 1} {
            set circular "RNA"
          }
          set header $a\n
          set newdna ""
          set dna_started 0
          #fconfigure $fileid -encoding utf-8 
          while {([gets $fileid nextline] != -1) && ($nextline ne "//")} {
            if {!(([string range $nextline 0 5] eq "ORIGIN") || ([string range $nextline 0 9] eq "BASE COUNT"))} {
              if {$dna_started} {
                append newdna $nextline\n
              } else {
                append header $nextline\n
              }
            } elseif {[string range $nextline 0 5] eq "ORIGIN"} {
              set dna_started 1
            }
          }
          if {($newdna == "") && ($nextline ne "//")} {
            tk_messageBox -message [mc "Can't parse GenBank format"] -icon error -type ok
          }
          #read in subsequent records
          set postscript ""
          while {([gets $fileid nextline] != -1)} {
            append postscript $nextline
          }
          if {[llength [set t [regexp -all -inline {LOCUS       linked_abi.*?//} $postscript]]] > 0} {
            set linked_abi_list [list]
            foreach e $t {
              lappend linked_abi_list [decode_abi $e]
            }
          }
          #interpret GenBank header

          if {![regexp -indices {(.*)(FEATURES             Location/Qualifiers\n)} $header temp genbank_header_indices feature_indices]} {
            set genbank_header $header
            set feature_table ""
          } else {
            set genbank_header [string range $header 0 [lindex $genbank_header_indices 1]]
            set feature_table [string range $header [lindex $feature_indices 1] end] 
          }
          set genbank_header_info [list]
          set vnti 0
          #this parses header into fields
          foreach record [regexp -inline -all {(?:(?:[\ A-Z]{3}[A-Z][\ A-Z]{8}[^\n]*?\n)(?:\s{12}[^\n]*\n)+)|(?:[\ A-Z]{3}[A-Z][\ A-Z]{8}[^\n]*?\n)} $genbank_header] {
            regexp {(.{12})(.*)\n} $record junk type data
            if {$type == "COMMENT     "} {
              if {$vnti} continue
              if {[string first "This file is created by Vector NTI" $data] == 0} {
                set vnti 1
                continue
              }
              if {[regexp {ApEinfo:methylated:(1|0)} $data temp methylated]} {
                continue
              }
              if {[regexp {ApEinfo:.?SEGUID:([A-Z,a-z,0-9,_,-]{27})} $data -- seguid]} {
                dict set seguid_dict stored_seguid $seguid
                continue
              }
              if {[regexp {ApEinfo:([cl][ds]seguid=)([A-Z,a-z,0-9,_,-]{27})} $data -- segtype seguid]} {
                dict set seguid_dict stored_seguid "$segtype$seguid"
                continue
              }
              if {[regexp {ApEinfo:graphicformat:(.*)} $data temp graphic_format_dict]} {
                regsub -all {\n\s{12}} $graphic_format_dict " " graphic_format_dict
                continue
              }
              regsub -all {([^\s]{67})\n\s{12}} $data {\1} data
              regsub -all {\n\s{12}} $data " " data
              if {[set ntistart [string first "This file is created by Vector NTI" $data]] >= 0} {
                set data [string range $data 0 [expr {$ntistart-1}]]
              }
              append filecomment "$data\n"
            } else {
              regsub -all {\n\s{12}} $data " " data
              lappend genbank_header_info $type $data
            }

          }
          #sputs genbank_header_info $genbank_header_info
          regsub \n\n$ $filecomment ""  filecomment
          regsub -all {[[:space:]0-9\n]} $newdna "" newdna
          if {[regexp {[^abcdghkmnrstuvwyABCDGHKMNRSTUVWY*]} $newdna]} {
            tk_messageBox -message [mc "Error: bad dna sequence in GenBank"] -icon error -type ok
          }
          set new_tags [feature_table_to_taglist [split $feature_table \n] $topology [string length $newdna]]
          #sputs gb_new_tags $new_tags
          set new_title [file tail $filename]
          set filetype "GenBank"
        }
        GenBank2 {
          #sputs "GenBank: $filename"
          set filecomment ""
          if {![regexp {LOCUS       (.*) ([0-9]*) bp (   |ss-|ds-|ms-)(NA    |DNA   |RNA   |tRNA  |rRNA  |mRNA  |uRNA  |snRNA |snoRNA)[ ]*(linear  |circular|        )[ ]*([ A-Z]{3})[ ]*(..-...-....)} $a x name size stranded type circular div date] || $circular== "        "} {
            set circular "linear"
          }  
          regsub -all {[^a-zA-Z0-9]} $name _ name
          regsub -all {[[:space:]]} $circular "" circular
          set topology $circular
          if {[string first RNA $type] > 1} {
            set circular "RNA"
          }
          set genbank_type_array(0) "LOCUS       "
          set genbank_data_array(0) [string range $a 12 end]
          set i 0
          set text ""
          while {([gets $fileid nextline] != -1) && ([string range $nextline 0 7] != "FEATURES") && ([string range $nextline 0 5] != "ORIGIN") && ([string range $nextline 0 9] != "BASE COUNT")} {
            set lastlen [string length $text]
            set text [string range $nextline 12 end]
            set type [string range $nextline 0 11]

            if {$type == "            "} {
              if {($lastlen + [string first " " "$text "]) > 66 } {
                append genbank_data_array($i) " " $text
              } else {
                append genbank_data_array($i) \n $text
              }
            } else {
              incr i
              set genbank_type_array($i) $type
              set genbank_data_array($i) $text
            }
          }
          set genbank_header_info [list]
          set vnti 0
          for {set j 0} {$j <= $i} {incr j} {
            if {$genbank_type_array($j) == "COMMENT     "} {
              if {[string first "This file is created by Vector NTI" $genbank_data_array($j)] == 0} {
                set vnti 1
              }
              if {$vnti} continue
              if {[regexp {ApEinfo:methylated:(1|0)} $genbank_data_array($j) temp methylated]} {
                unset temp
                continue
              }
              append filecomment $genbank_data_array($j)
            }
            lappend genbank_header_info $genbank_type_array($j) $genbank_data_array($j)
          }
          unset i j
          array unset genbank_type_array
          array unset genbank_data_array

          if {[string range $nextline 0 7] == "FEATURES"} {
            while {([gets $fileid nextline] != -1) && ([string range $nextline 0 5] != "ORIGIN")} {
              lappend genbank_features $nextline
            }
          } else {
            while {([gets $fileid nextline] != -1) && ([string range $nextline 0 5] != "ORIGIN")} {
              lappend genbank_features $nextline
            }
          }
          set newdna ""
          while {([gets $fileid nextline] != -1) && ($nextline != "//")} {
            set newdna "$newdna$nextline"
          }
#sputs $genbank_features
          regsub -all {[^abcdghkmnrstuvwyABCDGHKMNRSTUVWY*]} $newdna "" newdna

          set new_tags [feature_table_to_taglist $genbank_features $topology [string length $newdna]]  

          set new_title [file tail $filename]
          set filetype "GenBank"
        }
        embl {
          #sputs "embl: $filename"
          if {([string match "*;*circular*;*" $a])} { 
            set circular "circular"
          } else {
            set circular "linear"
          }
          set filecomment $a
          while {([gets $fileid nextline] != -1) && ([regexp {([A-Z]{2})\ *(.*)} $nextline nextline type text])} {
            if {$type == "FT"} {
              lappend genbank_features "  [string range $nextline 2 end]"
            } elseif {$type == "SQ"} {
              break
            }  else {
              set filecomment "$filecomment\n$nextline" 
            }
          }
          set newdna ""
          while {([gets $fileid nextline] != -1) && ($nextline != "//")} {
            set newdna "$newdna$nextline"
          }
          regsub -all {[^abcdghkmnrstuvwyABCDGHKMNRSTUVWY*]} $newdna "" newdna
          set new_tags [feature_table_to_taglist $genbank_features $circular [string length $newdna]]
          set new_title [file tail $filename]
          set filetype "EMBL"
        }
        editseq {
          #sputs "editseq: $filename"
          set newdna ""
          set filecomment $a
          gets $fileid
          while {[eof $fileid] != 1} {append newdna [gets $fileid]}
          if {[regexp -nocase {[^ACGTN*BDHKMRSVWY 0-9]} $newdna] == 0} {
            set circular "linear"
            set new_tags [list]
            set new_title [file tail $filename]
            set filetype "Editseq"
          } else {
            close $fileid
            tk_messageBox -message [mc "This editseq file contains protein sequence. I can't open it. Sorry."] -title [mc "Can't open protein sequences"] -icon info -type ok
            set dialogblock 0
            return -code error "Unreadable File"
          }
        }
        SBOL {
          set methylated 0
          set filecomment ""
          set genbank_header_info [list]
          set new_title [file tail $filename]
          set filetype "SBOL"
          switch $sbol_version {
            1 {
              lassign [open_sbol1_file $fileid] circular newdna new_tags
            }
            2 {
              lassign [open_sbol2_file $fileid] circular newdna new_tags
            }
            3 {
              lassign [open_sbol3_file $fileid] circular newdna new_tags
            }
          }

        }
        gff3 {
          global gff3file

          set methylated 0
          set new_title [file tail $filename]
          set genbank_header_info [list]
          set gff3file [list]
          while {[eof $fileid] != 1} {lappend gff3file [gets $fileid]}
          foreach {newdna filecomment circular startindex seqlength new_tags error} [parse_gff_file $gff3file] {}
          if {$error != ""} {
            close $fileid
            tk_messageBox -message [mc "Error opening GFF file: $error"] -title [mc "Error opening GFF file"] -icon info -type ok
            set dialogblock 0
            return -code error "GFF error"
          }
          #if newdna is empty, dialog for fasta file, or n's
          if {$newdna == ""} {
            set newdna [string repeat N $seqlength]
          }
        }
        default {
          sputs "unknown filetype: $filename"
          set dialogblock 0
          close $fileid
          return -code error "Unkown filetype"
        }  
      }
      close $fileid
      regsub -all {[^abcdghkmnrstuvwyABCDGHKMNRSTUVWY*]} $newdna "" newdna
      if {$interactive_opening == 2} {
        return [list $newdna $filename $filecomment $circular $methylated $startindex $new_title $new_tags $genbank_header_info $filetype $graphic_format_dict $seguid_dict]
      } elseif {$interactive_opening == 1} {
        if {$info(dnadir_follows_open)} {
          set info(default_dnadir) [file dirname $filename]
        }
        set info(open_previous) [linsert $info(open_previous) 0 $filename]
        return [create_window $newdna $filename $filecomment $circular $methylated $startindex $new_title $new_tags $genbank_header_info $filetype $linked_abi_list $graphic_format_dict $seguid_dict $phred_string]
      } else {
        #return [create_minimal_window $newdna $filename $filecomment $circular $methylated $startindex $new_title $new_tags $genbank_header_info $filetype $linked_abi_list]
        return [create_window $newdna $filename $filecomment $circular $methylated $startindex $new_title $new_tags $genbank_header_info $filetype $linked_abi_list $graphic_format_dict $seguid_dict $phred_string]
      }
    } elseif {$interactive_opening} {
      if {![file exists $filename]} {
        tk_messageBox -message [mc "Sorry, that file doesn't exist. It may have been deleted or moved."] -type ok -icon warning
sputs doesn't exist:$filename
      } elseif {![file readable $filename]} {
        tk_messageBox -message [mc "Sorry, that file is not readable. You may not have the correct permissions for the file."] -type ok -icon warning
      }
      sputs  open error:$filename [file exists $filename] [file readable $filename]
      update_open_previous_menu
      return -code error "Read permission"
    } else {
      return -code error "Read permission"
    }
  } else {
    sputs filename == ""
    return  -code error "Error"
  }
}


###############
## read macvector file returns: list: circular newdna new_tags genbank_header_info
###############
proc open_macvector_file {fileid striderheader} {
  global info
  set mac_vec_type_dict {0 continuation 2 CDS 3 sig_peptide 4 mat_peptide 5 tRNA 8 misc_RNA 9 precursor_RNA 10 mRNA 11 misc_feature 16 misc_binding 18 conflict 22 D_loop 24 iDNA 26 intron 27 LTR 31 variation 32 rep_origin 34 misc_recombination 36 old_sequence 37 repeat_region 38 misc_signal 39 misc_feature 41 unsure 42 misc_difference 44 variation 53 -35_signal 52 -10_signal 55 3'_UTR 57 5'_UTR 60 C_region 62 enhancer 63 exon 67 misc_structure 68 N_region 69 polyA_signal 70 polyA_site 72 primer_bind 73 prim_transcript 74 promoter 75 protein_bind 76 RBS 80 stem_loop 81 STS 84 terminator 86 V_region 87 gene 88 source 89 J_segment 90 V_segment 91 D-segment 94 operon 95 oriT 97 gap 98 ncRNA 99 tmRNA 108 assembly_gap 109 centromere 110 mobile_element 111 telomere 112 regulatory}


  fconfigure $fileid -translation binary -encoding utf-8

  binary scan $striderheader I9x* header_bytes
  binary scan $striderheader H64Ix* macvec_magnum macvec_seq_len
  if {[lindex $header_bytes 0] == 1} {
    set circular "circular"
  } else {
    set circular "linear"
  }
  #sputs header_bytes  $header_bytes
  # linear sequence is {0 128 xx 0 1 len 1 len len}
  # circular is {1 0 xx 16 1 len 1 len len}
  sputs macv fid $fileid
  seek $fileid 36
  binary scan [read $fileid $macvec_seq_len] H* newdna
  set newdna [string map {01 A 02 C 03 M 04 G 05 R 06 S 07 V 08 T 09 W 0a Y 0b H 0c K 0d D 0e B 0f N} $newdna]


  set data [read $fileid 2]
  binary scan $data S  feature_number
  #sputs feature_number $feature_number

  set bindlist [list <<Revcolors>> <<Metadata>>]
  ## read feature data- S_type c_direction 9_bytes I_string_length "string of genbank qualifiers", I_start, I_end
  set result [list]
  for {set i1 0} {$i1 < $feature_number} {incr i1} {
    #sputs i1 $i1
    set data [read $fileid 12]
    binary scan $data Scc*  type1 direction1 unknown_data1
    #sputs feature data line   $type1 $direction1 $unknown_data1
    set str_len_data [read $fileid 4]
    binary scan $str_len_data I* string_length
    #sputs string length $string_length
    set qualifier_data [read $fileid $string_length]
    #sputs feature qualifier $qualifier_data
    if {$type1 > 0 && [regexp {/label="([^\"]*)"} $qualifier_data - name]} {
    } elseif {[regexp {/gene="([^\"]*)"} $qualifier_data - name]} {
    } elseif {[regexp {/note="([^\"]*)"} $qualifier_data - name]} {
    } elseif {[regexp {/organism="([^\"]*)"} $qualifier_data - name]} {
    } else {
       set name "New Feature"
    }
    #sputs string $qualifier_data
    set loc_data [read $fileid 8]
    binary scan $loc_data II start1 end1
    #sputs feature data $type1 $direction1 $start1 $end1

    if {$type1 == 0} {
      ## Feature Extension item
      set coords_list [lindex $result end 0]
      lappend coords_list [expr {$start1-1}] [expr {$end1}]
      set coords_list [lsort -integer -increasing $coords_list]
      lset result end 0 $coords_list
    } else {
      ## New Feature item
      if {[dict exists $mac_vec_type_dict $type1]} {
        set f_type [dict get $mac_vec_type_dict $type1]
      } else {
        set f_type "misc_feature"
        sputs feature code not in MacVector dict: $filename : $type1
       #sputs $qualifier_data $start1 $end1
      }
      if {[catch {set Apeinfo_gformat [dict get $info(feature_default_type_gformat) $f_type]}]} {
        set Apeinfo_gformat $info(feature_default_gformat)
      }
      if {[dict exists $info(feature_default_type_colors) $f_type]} {
        set clist [dict get $info(feature_default_type_colors) $f_type]
      } else {
        set clist [list #ff926c #ff926c]
        #sputs feature type not in default colors: $f_type
      }
      lassign $clist fwd_color rev_color

      if {$f_type eq "source"} {
        set formatlist [list {} {} {}]
      } elseif {$direction1 == 0} {
        set formatlist [list $fwd_color {} {}]
      } else {
        set formatlist [list $rev_color {} {}]
      }

      ## need to add genbank qualifier data to features
      set genbank_list [list]
      #sputs qualifier_data $qualifier_data
      regsub {^/}  $qualifier_data ""  qualifier_data
      regsub -all {; /}  $qualifier_data "\u0001"  qualifier_data
      foreach qual_line [split $qualifier_data "\u0001"] {
        #sputs qual_line $qual_line
        set subdata {}
        if {![regexp {([^=]*)=(.*)} $qual_line -- subtype subdata] && ![regexp {([^=]*)} $qual_line -- subtype]} {
          sputs can't parse $qual_line
        } else {
          regexp {\"(.*)\"} $subdata -- subdata
          regexp {"(.*)"} $subdata -- subdata
          if {$subtype == "ncRNA_class"} {
            set f_type  "ncRNA:$subdata"
          } elseif {$subtype == "regulatory_class"} {
            set f_type  "regulatory:$subdata"
          } elseif {$subtype == "recombination_class"} {
            set f_type  "misc_recomb:$subdata"
          } else {
            lappend  genbank_list $subtype $subdata
          }
        }
      }
      set actionlist [list [list $fwd_color $rev_color] [list $name $Apeinfo_gformat $f_type $direction1 $genbank_list]]
      lappend result "f$i1#" [list [list [expr {$start1-1}] [expr {$end1}]] $formatlist $bindlist $actionlist]
    }
  }
  ## add Fn tags
  foreach {tag tag_data} $result {
    if {[llength [lindex $tag_data 0]] > 2} {
      set fntag [regsub f $tag fn]
      lappend result $fntag [list [list [lindex $tag_data 0 0] [lindex $tag_data 0 end]] [list] [list]]
    }
  }
  set new_tags $result
  #sputs mv_new_tags $new_tags

  set data [read $fileid 2]
  binary scan $data S  header_lines_number
  #sputs header_lines_number $header_lines_number


  ## read genbank header data
  set genbank_header_info [list]
  set mv_gb_header_dict {2 {LOCUS       } 3 {DEFINITION  } 4 {ACCESSION   } 5 {KEYWORDS    } 7 {SOURCE      } 8  {  ORGANISM  } 10 {REFERENCE   } 11 {  AUTHORS   } 12 {  TITLE     } 13 {  JOURNAL   } 14 {COMMENT     } 16 {BASE COUNT  } 20 {  REMARK    } 23 {NID    } 24 {VERSION     } 30 {CONTIG      } 31 {DBLINK      }}
  for {set i1 0} {$i1 < $header_lines_number} {incr i1} {
   set data [read $fileid 12]
   binary scan $data c* first_data
   #sputs first data $first_data
   set header_line_type [lindex $first_data 1]
   set str_len_data [read $fileid 4]
   binary scan $str_len_data I* string_length
   set header_line [read $fileid $string_length]
   regsub -all {[\n\r\f]*} $header_line "" header_line
   #sputs header_line $header_line
   if {[dict exists $mv_gb_header_dict $header_line_type]} {
     lappend genbank_header_info [dict get $mv_gb_header_dict $header_line_type] $header_line
   } else {
     sputs genbank header line type not known: $header_line_type
     sputs $header_line
     sputs $filename
   }
   set data [read $fileid 8]
   # this data seems to always be 8 bytes of zero
   #binary scan $data c* line_data
   #sputs line data $line_data
   #sputs
  }
#sputs genbank_header_info $genbank_header_info
###
## need to add genbank header data to genbank_header_info
  set data [read $fileid]
  #sputs [string length $data] 
  binary scan $data c* format_data
  #sputs $format_data 
  #sputs [string range $data 0 800]
  return [list $circular $newdna $new_tags $genbank_header_info]
}

###############
## read gck file returns: list: circular newdna new_tags(not assigned at this time)
###############
proc open_gck_file {fileid striderheader} {
  #sputs "strider: $filename"
  binary scan $striderheader I2x16IIx* gck_magnum gck_packet gck_seq_len
  fconfigure $fileid -translation binary -encoding binary
  seek $fileid 32
  set newdna [read $fileid $gck_seq_len]
  #regsub -all {\*} $newdna "N" newdna

  binary scan [read $fileid 4] I unknown_packet_length
  set unknown_packet [read $fileid $unknown_packet_length]
  binary scan [string range $unknown_packet 0 5] c* unk_list
  sputs unknown packet $unknown_packet_length $unk_list
  for {set i 6} {$i < [string length $unknown_packet]} {incr i 44} {
    binary scan [string range $unknown_packet $i [expr {$i+43}]] c* unk_list
    sputs unknown packet $unknown_packet_length $unk_list
  }

  ## features packet
  binary scan [read $fileid 4] I features_packet_length
  binary scan [read $fileid 6] IS seq_length number_features
  set feature_list [list]
    #sputs gck number of features:$number_features, seq_length $seq_length
  for {set i 0} {$i < $number_features} {incr i} {
  binary scan [read $fileid 92] IuIux6Sux14cux17IIx35c f_start f_end f_type f_strand f_pointer f_comment f_version
   lappend feature_list [list $f_start $f_end [expr {$f_type==0 ? "misc_feature" : "CDS"}] [expr {$f_strand==1 ? 1 : 0}] [expr {$f_pointer != 0}] [expr {$f_comment != 0}] [expr {$f_version != 0}]]
  }
  if {$features_packet_length >=0} {
    set extra_bytes [read $fileid [expr {$features_packet_length -$number_features * 92 -6}]]
    binary scan $extra_bytes c* bytes_list
    sputs gck extra bytes  [expr {$features_packet_length -$number_features * 92 -6}] $bytes_list
  } else {
    sputs gck features packet length is negative ($features_packet_length)?
  }
  foreach feature $feature_list {
    foreach {start end type strand has_name has_comment ignore} $feature {}
    sputs gck f $start $end $type $strand $has_name $has_comment $ignore
    if {$has_name} {
      sputs name:[read_pascal_string $fileid 8]
    }
    if {$has_comment} {
      sputs comment:[read_pascal_string $fileid 8]
    } 
  }
  # don't read tags for now
  set new_tags [list]

  ## sites packet
  binary scan [read $fileid 4] I sites_packet_length
  binary scan [read $fileid 6] IS seq_length number_sites
  set sites_list [list]

  if {0} {
    for {set i 0} {$i < $number_sites} {incr i} {
      binary scan [read $fileid 88] IuIuc24IuIuc48 s_start s_end c24 f_pointer f_comment c48
      lappend sites_list [list $f_start $f_end [expr {$f_pointer != 0}] [expr {$f_comment != 0}]]
    }
    set extra_bytes [read $fileid [expr {$sites_packet_length -$number_sites * 88 -6}]]
    binary scan $extra_bytes c* bytes_list
    sputs gck sites extra bytes  [expr {$sites_packet_length -$number_sites * 92 -6}] $bytes_list

    foreach site $sites_list {
      foreach {start end  has_name has_comment} $site {}
      sputs gck f $start $end $has_name $has_comment
      if {$has_name} {
        #sputs name:[read_pascal_string $fileid 8]
      }
      if {$has_comment} {
        #sputs comment:[read_pascal_string $fileid 8]
      } 
    }
  }
         

  seek $fileid -1 end
  binary scan [read $fileid 1] c* circ_flag
  sputs circ_flag:$circ_flag
  set circular [expr {$circ_flag !=0 ? "circular": "linear"}] 
  sputs gck $circular
  return [list $circular $newdna $new_tags]
}

##########
proc open_sbol_get_xml_subtree {in_list target {max_depth -1} {depth 0}} {
  set result [list]
  if {$max_depth > -1 && $depth > $max_depth} {
    return [list]
  }
  incr depth
  foreach l $in_list {
    if {([regexp {[^:#]*[\:\#]([^:]*)} [lindex $l 1] -- s] && $s eq $target) ||([lindex $l 1] eq $target)} {
      lappend result [list $l]
    } elseif {[lindex $l 3] ne {}} {
      lappend result {*}[open_sbol_get_xml_subtree [lindex $l 3] $target $max_depth $depth]
    }
  }
  return $result
}

#############
proc open_sbol_text_to_xml_list {text} {
  set text [string map {\u007b &#123 \u007d &#125 \u005c  &#92} $text];sputs
  regsub -all {\n} $text "" text
  regsub -all {<\?.*?\?>} $text "" text
  regsub -all {</[^>]+>} $text "\u0003\}\} \u0002" text
  regsub -all {<([^\s>]+)\s?([^>]*)/>} $text "\u0003 \{xxx \\1 \{\\2\} \{\}\} \u0002" text
  regsub -all {<([^\s>]+)\s?([^>]*)>} $text "\u0003 \{xxx \\1 \{\\2\} \{\u0002" text
  regsub -all {\u0002\s*\u0003} $text "" text
  regsub -all {\u0002[^\{\}\u0003\u0002]*\u0003} $text "\{\{\\0\}\}" text
  regsub -all {\u0002|\u0003} $text "" text
  return $text
}



#############
proc open_sbol1_file_parse_anotation {in_list first} {
  set so_dict {SO:0000002 misc_structure SO:0000110 misc_feature SO:0000147 exon SO:0000178 operon SO:0000185 prim_transcript SO:0000188 intron SO:0000204 5'UTR SO:0000205 3'UTR SO:0000234 mRNA SO:0000252 rRNA SO:0000253 tRNA SO:0000296 rep_origin SO:0000297 D-loop SO:0000305 modified_base SO:0000019 stem_loop SO:0000316 CDS SO:0000331 STS SO:0000409 misc_binding SO:0000410 protein_bind SO:0000413 misc_difference SO:0000418 sig_peptide SO:0000419 mat_peptide SO:0000458 D_segment SO:0000466 V_segment SO:0000470 J_segment SO:0000478 C_region SO:0001430 polyA_site SO:0000577 centromere SO:0000584 tmRNA SO:0000624 telomere SO:0000704 gene SO:0000723 iDNA SO:0000724 oriT SO:0000725 transit_peptide SO:0000730 gap SO:0001037 mobile_element SO:1000007 variation SO:0001062 propeptide SO:0001086 unsure SO:0001833 V_region SO:0001835 N_region SO:0001836 S_region SO:0002200 {tRNA pseudogene allelic} SO:0002206 source SO:0002249 mat_peptide SO:0002250 propeptide SO:0002251 sig_peptide SO:0002252 transit_peptide SO:0005850 primer_bind SO:0000005 {repeat_region rpt_type satellite} SO:0000013 {ncRNA ncRNA_class scRNA} SO:0000035 {regulatory regulatory_class riboswitch} SO:0000036 {regulatory regulatory_class matrix_attachment_region} SO:0000037 {regulatory regulatory_class locus_control_region} SO:0000043 {gene pseudogene processed} SO:0000139 {regulatory regulatory_class ribosome_binding_site} SO:0000140 {regulatory regulatory_class attenuator} SO:0000141 {regulatory regulatory_class terminator} SO:0000165 {regulatory regulatory_class enhancer} SO:0000167 {regulatory regulatory_class promoter} SO:0000172 {regulatory regulatory_class CAAT_signal} SO:0000173 {regulatory regulatory_class GC_signal} SO:0000174 {regulatory regulatory_class TATA_box} SO:0000175 {regulatory regulatory_class minus_10_signal} SO:0000176 {regulatory regulatory_class minus_35_signal} SO:0000274 {ncRNA ncRNA_class snRNA} SO:0000275 {ncRNA ncRNA_class snoRNA} SO:0000649 {ncRNA ncRNA_class miRNA} SO:0000286 {repeat_region rpt_type long_terminal_repeat} SO:0000289 {repeat_region rpt_type microsatellite} SO:0000294 {repeat_region rpt_type inverted} SO:0000298 {misc_recomb recombination_class other} SO:0000314 {repeat_region rpt_type direct} SO:0000336 {gene pseudogene unknown} SO:0000374 {ncRNA ncRNA_class ribozyme} SO:0000380 {ncRNA ncRNA_class hammerhead_ribozyme} SO:0000385 {ncRNA ncRNA_class RNase_MRP_RNA} SO:0000386 {ncRNA ncRNA_class RNase_P_RNA} SO:0000390 {ncRNA ncRNA_class telomerase_RNA} SO:0000404 {ncRNA ncRNA_class vault_RNA} SO:0000405 {ncRNA ncRNA_class Y_RNA} SO:0000433 {repeat_region rpt_type non_ltr_retrotransposon_polymeric_tract} SO:0000454 {ncRNA ncRNA_class rasiRNA} SO:0000479 {tRNA trans_splicing {}} SO:0000516 {misc_RNA pseudo {}} SO:0000551 {regulatory regulatory_class polyA_signal_sequence} SO:0000588 {ncRNA ncRNA_class autocatalytically_spliced_intron} SO:0000590 {ncRNA ncRNA_class SRP_RNA} SO:0000602 {ncRNA ncRNA_class guide_RNA} SO:0000625 {regulatory regulatory_class silencer} SO:0000627 {regulatory regulatory_class insulator} SO:0000643 {repeat_region rpt_type minisatellite} SO:0000644 {ncRNA ncRNA_class antisense_RNA} SO:0000646 {ncRNA ncRNA_class siRNA} SO:0000657 {repeat_region rpt_type other} SO:0000658 {repeat_region rpt_type dispersed} SO:0000685 {regulatory regulatory_class DNase_I_hypersensitive_site} SO:0000705 {repeat_region rpt_type tandem} SO:0000777 {rRNA  pseudo {}} SO:0000778 {tRNA pseudo {}} SO:0001242 {misc_recomb recombination_class chromosome_breakpoint} SO:0001035 {ncRNA ncRNA_class piRNA} SO:0001055 {regulatory regulatory_class transcriptional_cis_regulatory_region} SO:0001484 {repeat_region rpt_type x_element_combinatorial_repeat} SO:0001485 {repeat_region rpt_type Y_prime_element} SO:0001496 {repeat_region rpt_type telomeric_repeat} SO:0001649 {repeat_region rpt_type nested} SO:0001682 {regulatory regulatory_class replication_regulatory_region} SO:0001759 {gene pseudogene unitary} SO:0001760 {gene pseudogene unprocessed} SO:0001797 {repeat_region rpt_type centromeric_repeat} SO:0001877 {ncRNA ncRNA_class lncRNA} SO:0002087 {CDS pseudo {}} SO:0002094 {misc_recomb recombination_class non_allelic_homologous_recombination} SO:0002154 {misc_recomb recombination_class mitotic_recombination} SO:0002155 {misc_recomb recombination_class meiotic_recombination} SO:0002189 {gene pseudogene allelic} SO:0002190 {regulatory regulatory_class enhancer_blocking_element} SO:0002191 {regulatory regulatory_class imprinting_control_region} SO:0002192 {repeat_region rpt_type flanking} SO:0002193 {rRNA pseudogene processed} SO:0002194 {rRNA pseudogene unprocessed} SO:0002195 {rRNA pseudogene unitary} SO:0002196 {rRNA pseudogene allelic} SO:0002197 {tRNA pseudogene processed} SO:0002198 {tRNA pseudogene unprocessed} SO:0002199 {tRNA pseudogene unitary} SO:0002201 {repeat_region rpt_type terminal} SO:0002205 {regulatory regulatory_class response_element} SO:0005836 {regulatory regulatory_class other} SO:1001268 {regulatory regulatory_class recoding_stimulatory_region} SO:0001210 {CDS ribosomal_slippage {}} SO:0000805 {misc_feature note engineered_foreign_region} SO:0000804 {misc_feature note engineered_region} SO:0001411 {misc_feature note biological_region}}

  set start [lindex [open_sbol_get_xml_subtree $in_list bioStart 2] 0 0 3 0 0]
  set end [lindex [open_sbol_get_xml_subtree $in_list bioEnd 2] 0 0 3 0 0]
  set dir [lindex [open_sbol_get_xml_subtree $in_list strand 2] 0 0 3 0 0]
  set dnacomponent [lindex [open_sbol_get_xml_subtree $in_list DnaComponent 3] 0]
  set type [lindex [open_sbol_get_xml_subtree $dnacomponent ns2:type 2] 0 0 2]
  if {[regexp {ns2:resource=\"http://purl.obolibrary.org/obo/SO_([0-9]+)\"} $type -- so_code] && [dict exists $so_dict "SO:$so_code"]} {
    set f_type_data [dict ge $so_dict "SO:$so_code"]
  } else {
    set f_type_data {misc_feature}
  }
  set displayid [lindex [open_sbol_get_xml_subtree $dnacomponent displayId 2] 0 0 3 0 0]
  set name [lindex [open_sbol_get_xml_subtree $dnacomponent name 2] 0 0 3 0 0]
  set description [lindex [open_sbol_get_xml_subtree $dnacomponent description 2] 0 0 3 0 0]
  set sub_a_list [list [list [expr {$start+$first-1}] [expr {$end+$first-1}] $dir $f_type_data $displayid $name $description]]
  foreach sub_annotation [open_sbol_get_xml_subtree $dnacomponent annotation 2] {
    lappend sub_a_list {*}[open_sbol1_file_parse_anotation $sub_annotation $start]
  }
  return $sub_a_list
}

#############
proc open_sbol1_file {fileid} {
  global info 

  fconfigure $fileid -translation auto -encoding utf-8
  seek $fileid 0

  set text ""
  while {[eof $fileid] != 1} {
    append text [gets $fileid]
  }

  # convert text to xml list
  set xml_list [open_sbol_text_to_xml_list $text]
  set dna_component_list [list]
  foreach c [open_sbol_get_xml_subtree $xml_list DnaComponent] {
    lappend dna_component_list $c
  }
  # needs a way to pick a component out of the file, but take the first element for now
  set c [lindex $dna_component_list 0]
  set displayID [lindex [open_sbol_get_xml_subtree $c displayId 3] 0 0 3 0 0]
  set newdna [lindex [open_sbol_get_xml_subtree $c nucleotides 3] 0 0 3 0 0]
  set feature_list [list]
  foreach f [open_sbol_get_xml_subtree $c annotation 1] {
    lappend feature_list {*}[open_sbol1_file_parse_anotation $f 1]
  }


  ## convert feature list to tag list here
  ## feature data are: start end $dir (+/-) $f_type_data $displayid $name $description
  ## f_type_data are: base type, qualifier, qualifier value
  set result [list]
  set i 0
  foreach fea $feature_list {
    lassign $fea start end dir f_type_data displayid name description
    
    #sputs feature qualifier $qualifier_data
    if {$name eq {}} {
      set name "New Feature"
    }
    set f_type [lindex $f_type_data 0]
    if {$f_type eq {}} {
      set f_type "misc_feature"
    }
    set dir [expr {($dir eq "+") ? 0 : 1}]

    if {[catch {set Apeinfo_gformat [dict get $info(feature_default_type_gformat) $f_type]}]} {
      set Apeinfo_gformat $info(feature_default_gformat)
    }
    if {[dict exists $info(feature_default_type_colors) $f_type]} {
      set clist [dict get $info(feature_default_type_colors) $f_type]
    } else {
      set clist [list #ff926c #ff926c]
      #sputs feature type not in default colors: $f_type
    }
    lassign $clist fwd_color rev_color
    if {$f_type eq "source"} {
     set formatlist [list {} {} {}]
    } elseif {$dir == 0} {
     set formatlist [list $fwd_color {} {}]
    } else {
     set formatlist [list $rev_color {} {}]
    }

    ## need to add genbank qualifier data to features
    set genbank_list [list]
    if {[lindex $f_type_data 1] ne {}} { 
      set subtype [lindex $f_type_data 1]
      if {$subtype == "ncRNA_class"} {
        set f_type  "ncRNA:$subdata"
      } elseif {$subtype == "regulatory_class"} {
        set f_type  "regulatory:$subdata"
      } elseif {$subtype == "recombination_class"} {
        set f_type  "misc_recomb:$subdata"
      } else {
        lappend genbank_list [lindex $f_type_data 1] [lindex $f_type_data 2]
     }
    }
    if {$description ne {}} {
      lappend genbank_list "note" $description
    }
    set bindlist [list <<Revcolors>> <<Metadata>>]
    set actionlist [list [list $fwd_color $rev_color] [list $name $Apeinfo_gformat $f_type $dir $genbank_list]]
    lappend result "f$i#" [list [list [expr {$start-1}] [expr {$end}]] $formatlist $bindlist $actionlist]
    incr i
  }
  ## add Fn tags
  foreach {tag tag_data} $result {
    if {[llength [lindex $tag_data 0]] > 2} {
      set fntag [regsub f $tag fn]
      lappend result $fntag [list [list [lindex $tag_data 0 0] [lindex $tag_data 0 end]] [list] [list]]
    }
  }
  set new_tags $result


  set circular "linear"
  # set new_tags [list]
  return [list $circular $newdna $new_tags]
}

proc open_sbol2_file {} {
sputs sbol2 file
  return [list "circular" "" ""]
}

proc open_sbol3_file {} {
sputs sbol3 file
  return [list "circular" "" ""]
}

###############
## parse gff file- returns list: newdna filecomment circular startindex new_tags 
###############
proc parse_gff_file {gff3file} {
  global info headerlist
  set error ""

  if {[set fastasplit [lsearch -regexp $gff3file {^>.*}]] > 0} {
    set headerlist [lrange $gff3file 0 [expr {$fastasplit-1}]]
    set dna_list [lrange $gff3file $fastasplit end]
  } else {
    set headerlist $gff3file
    #get dnalist from file, from clipboard, or fill with n's
    set dna_list [list]
  }
  set dna [join [lrange $dna_list 1 end] ""]

  set filecomment [join [lsearch -regexp -inline -all $headerlist {^#[^#].*}] \n]
  set startindex 0
  set seqstart 1
  set seqend [string length $dna]
  foreach sequence_region_line [lsearch -all -regexp -inline $headerlist {##sequence-region}] {
    if {[regexp {##sequence-region[\s:]+([^\s:]+)[\s:]+([0-9]+)[\s\.]+([0-9]+)} $sequence_region_line x seqid seqstart seqend]} {
      set seqregion_array($seqid) [list $seqstart $seqend]
    }
  }

  set features_list [lsearch -regexp -inline -all $headerlist {^[a-zA-Z0-9.:^*$@!+_?\-|]+\t(.+\t){7}.+}]
  if {[lsearch -regexp $features_list {^[a-zA-Z0-9.:^*$@!+_?\-|]+\t(.+\t){7}.*Is_circular=true.*}] > -1} {
    set circular "circular"
  } else {
    set circular "linear"
  }

  ##parse features into tag list
  set nextid 1
  set seqid_list [list]
  set parent_list [list]
  ##generate data arrays for each line

  foreach feature_line $features_list {
    if {[regexp {([^\t]+)\t([^\t]+)\t([^\t]+)\t([^\t]+)\t([^\t]+)\t([^\t]+)\t([^\t]+)\t([^\t]+)\t([^\t]+)} $feature_line line seqid source type start end score strand phase attributes]} {
      if {[lsearch -exact $seqid_list $seqid] == -1} {
        lappend seqid_list $seqid
      }
      if {[expr {[llength [set attrdict [split $attributes ";="]]] % 2}]} {set attrdict [list]}
      if {[catch {set id [dict get $attrdict ID]}]} {
        set id $nextid
        incr nextid
      }
      if {[catch {set name [dict get $attrdict Name]}]} {
        set name ""
      }
      if {[catch {set note [dict get $attrdict Note]}]} {
        set note ""
      }
      if {$score == "."} {
        set score ""
      }
      if {[dict exists $attrdict Parent]} {
        set parentlist [split [dict get $attrdict Parent] ","]
      } else {
        set parentlist [list {}]
      }
      foreach p $parentlist {
        lappend loc_array($seqid,$type,$id,$p) [list $start $end]
        set info_array($seqid,$type,$id,$p) [dict create type $type strand $strand parent $p name $name id $id note $note score $score]
        if {$p != {}} {
          lappend typep_array($type,$p) "$seqid,$type,$id,$p"
          lappend parent_list $p
        }
      }
    }
  }


  # if multiple seqids in file, pick one and delete all the others
  if {[llength [lsort -unique $seqid_list]] > 1} {
    #choose seqid here- use #0 for now
    set seqid [lindex $seqid_list 0]
  } else {
    set seqid [lindex $seqid_list 0]
  }
  if {[catch {set seqregion $seqregion_array($seqid)}]} {
    set seqregion {1 1}
  }
  set seqstart [lindex $seqregion 0]
  set seqend [lindex $seqregion 1]
  if {$seqstart > $seqend} {
    sputs "end of gff seq region is less than start?"
    set seqtemp $seqstart
    set seqstart $seqend
    set seqend $seqtemp 
  }
  set seqlength [expr {$seqend - $seqstart}]
  set length_from_seqregion [expr {$seqend > 1}]

  #combine all features with the same type and parent, unless there are already multiple ranges due to the same ID used to combine them
  foreach tp [array names typep_array] {
    set keylist [lsort -unique $typep_array($tp)]
    if {[llength $loc_array([lindex $keylist 0])] == 1} {
      foreach key [lrange $keylist 1 end] {
        lappend loc_array([lindex $keylist 0]) [lindex $loc_array($key) 0]
        array unset loc_array $key 
      }
    }
  }

  #take out parent features, if requested
  if {($parent_list != [list])  && ([tk_messageBox -message [mc "Do you want to remove all parent features from the GFF file?"] -type yesno -icon question] == "yes" )} {
    foreach p $parent_list {
      array unset loc_array *,*,$p,*
    }
  }


  #look up the parent tree to find a name if possible- assign the topmost ID if no name in the tree. Needs to add derives_from keys for branching parent trees
  foreach n [array names loc_array] {
    if {[dict get $info_array($n) name] ==""} {
      set parent_key $n
      set i 0
      while {($i < 10) &&([dict get $info_array($parent_key) name] == "") && ([set p [dict get $info_array($parent_key) parent]] != "")} {
        incr i
        if {[set new_parent_key [array names info_array "*,*,$p,*"]] == ""} {break}
        set parent_key $new_parent_key
      }
      if {([set new_name [dict get $info_array($parent_key) name]] == "") && ([set new_name [dict get $info_array($parent_key) id]] == "")} {
        set new_name [dict get $info_array($n) id]
      }
      dict set info_array($n) name "$new_name\_[dict get $info_array($n) type]"
    }
  }

  set tags [list]
  set i 0

  foreach n [array names loc_array] {
    set type [dict get $info_array($n) type]
    set name [dict get $info_array($n) name]
    set dir [expr {[dict get $info_array($n) strand] eq "-"}]
    set score [dict get $info_array($n) score]
    set note [dict get $info_array($n) note]
    set subdata [list]
    if {$score ne ""} {
      lappend subdata score $score
    }
    if {$note ne ""} {
      regsub -all {%20} $note { } note
      regsub -all {%3B} $note {;} note
      lappend subdata note $note
    }
    if {[dict exists $info(feature_default_type_colors) $type]} {
      set clist [dict get $info(feature_default_type_colors) $type]
    } else {
       set clist {#5fd5a3 #5fd5a3}
    }
    set fwd_color [lindex $clist 0]
    set rev_color [lindex $clist 1]
    if {$dir == 0} {
      set formatlist [list $fwd_color {} {}]
    } else {
       set formatlist [list $rev_color {} {}]
    }
    set bindlist [list <<Revcolors>> <<Metadata>>]
    if {[catch {set Apeinfo_gformat [dict get $info(feature_default_type_gformat) $type]}]} {
      set Apeinfo_gformat $info(feature_default_gformat)
    }
    set actionlist [list [list $fwd_color $rev_color] [list $name $Apeinfo_gformat $type $dir $subdata {}]]


    set new_range [list]
    foreach loclist $loc_array($n) {
      foreach {a b} $loclist {
        set b [expr {$b +1}]

        if {($length_from_seqregion)} {
          if {$a > [expr {$seqend}]} {
            #sputs bad gff3 format- feature past end:$name $a $seqend
             set a [expr {$seqend}]
          }
          if {$b > [expr {$seqend + 1}]} {
            if {($circular== "circular")} {
              lappend new_range [expr {$a - $seqstart}] [expr {$seqend + 1}] 0  [expr {$b - $seqend}]
              continue
            } else {
              #sputs bad gff3 format- feature past end:$name $b $seqend
              set b [expr {$seqend + 1}]
            }
          }
        } else {
          set seqend [expr {max ($seqend, $b)}]
        }
        lappend new_range [expr {$a - $seqstart}]  [expr {$b - $seqstart}]
      } 
    }

##don't know what do do about unsorted range- needs to be sorted in the file to deal with split features that span the origin
    if {([lindex $new_range 0] > [lindex $new_range end])} {
      set new_range [lsort -integer $new_range ]
    }
        if {[llength $new_range] > 0} { 
          if {[llength $new_range] > 2} {
            if {($circular== "circular") && ([lindex $new_range 0] > [lindex $new_range end])} {
              #crosses the origin
              if {([llength $new_range] == 4) && ([lindex $new_range 1]== [expr {$seqend + 1}]) && ([lindex $new_range 2]== 0)} {
                #single range, just crosses the origin
                lappend tags "f$i#" [list $new_range $formatlist $bindlist $actionlist]
              } else {
   #add f mark instead of fn tag
                #multi-range feature, that crosses the origin
                lappend tags "f$i#" [list $new_range $formatlist $bindlist $actionlist]
                lappend tags "fn$i#" [list [list [lindex $new_range 0] $dna_length 0 [lindex $new_range end]] [list {} {} {}] [list] [list]]
              }
            } else {
              #multi-range feature, doesn't cross the origin
              lappend tags "f$i#" [list $new_range $formatlist $bindlist $actionlist]
              lappend tags "fn$i#" [list [list [lindex $new_range 0] [lindex $new_range end]] [list {} {} {}] [list] [list]]
            }
          } else {
            #simple 1 range feature
            lappend tags "f$i#" [list $new_range $formatlist $bindlist $actionlist]
          }
          incr i
       }

  }
  if {!$length_from_seqregion} {
    set seqlength [expr {$seqend - $seqstart}]
  }
  if {$seqlength > 200000} {set seqlength 200000}
  return [list $dna $filecomment $circular $startindex $seqlength $tags $error]
}

###########
## Make a new window from selection (duplicate all if no selection)
###########
proc duplicate_window {w {region selection}} {
  global info
 
  if {([llength [$w.textarea tag ranges sel]] > 0) && ($region == "selection")} {
    if {[llength [$w.textarea tag ranges sel]] == 2} {
      set start [$w.textarea index sel.first]
      set end [$w.textarea index sel.last]
    } else {
      set start [lindex [$w.textarea tag ranges sel] 2]
      set end [lindex [$w.textarea tag ranges sel] 3]
      set start2 [lindex [$w.textarea tag ranges sel] 0]
      set end2 [lindex [$w.textarea tag ranges sel] 1]
    }
    set circ linear
    set tags [get_tags $w.textarea [list $start $end] forward]
    set seguid_data [dict create]
    set phred_string ""
#selection used here - ok
  } else {
    set start 1.0
    set end [end_ix $w.textarea]
    set circ $info($w,circular)
    if {[info exists info($w,SEGUID)] && $info($w,SEGUID) ne {}} {
      set seguid_data [dict create stored_seguid $info($w,SEGUID)]
    } else {
      set seguid_data [dict create]
    }
    if {[info exists info($w,phred_string)] && $info($w,phred_string) ne {}} {
      set phred_string $info($w,phred_string)
    } else {
      set phred_string ""
    }
    if {$circ eq "linear"} {
      set tags [get_tags_exact $w.textarea [list $start $end] forward]
    } else {
      set text $w.textarea
      set tags [list]
      foreach tagname [$text tag names] {
        set formatlist [list [$text tag cget $tagname -background] [$text tag cget $tagname -foreground] [$text tag cget $tagname -font] [$text tag cget $tagname -underline]]
        set bindlist [$text tag bind $tagname]
        set actionlist [list]
        foreach binding $bindlist {
          lappend actionlist [$text tag bind $tagname $binding]
        }
        set indexlist [list]
        foreach index [$text tag ranges $tagname] {
          lappend indexlist [expr {[ix2bp $text $index] }]
        }
        if {($tagname ne "sel") && ($tagname ne "tempsel")} {
          lappend tags $tagname [list $indexlist $formatlist $bindlist $actionlist]
        }
      }
    }
  }

  set dna [textarea_get $w.textarea $start $end]


  if {[info exists start2]} {
    set len [string length $dna]
    append dna [textarea_get $w.textarea $start2 $end2]
    set new_tags [get_tags $w.textarea [list $start2 $end2] "forward"]
    set tags [join_tags $tags $new_tags $len]
    set start $start2
  }
  #  {newdna ""} {filename ""} {filecomment ""} {circular linear} {methylated -1} {startindex 1} {title "New_DNA"} {tags ""} {genbank_header_list {}} {filetype "None"} {abi_data {}} {gformat_data {}} {seguid_data {}} {phred_string {}}
  create_window $dna "" "[expr {($info($w,filename) eq "")?[wm title $w]:[file tail [file rootname $info($w,filename)]]}] from [expr {[ix2bp $w.textarea $start]+1}] to [ix2bp $w.textarea $end]\n[$w.comframe.comtextframe.text get 1.0 end-1char]" $circ $info($w,Dam_Dcm_methylated) 0 [mc "New_DNA"] $tags $info($w,genbank_header_list) $info($w,filetype) $info($w,linked_abi_list) $info($w,gformat_data) $seguid_data $phred_string
}

###########
## Get a list of fixed fonts on the system (in the background)
###########
proc get_fixed_fonts {{i 0}} {
  global info
  set info(fixedfontlist) [list]
  set target [llength [font families]]
  for {set i 0} {$i < $target} {incr i} {
    set font [list [lindex [font families] $i]]
    if {![regexp {[^a-z,0-9,A-Z,\ ,\}\{\_\(\)\-]} $font]} {
      if {[font metrics $font -fixed]} {
        lappend info(fixedfontlist) [lindex $font 0]
      }
    }
  }
}

proc get_fixed_fonts0 {{i 0}} {
  global info temp_info fixed_fonts_block

  #time {font metrics [list [lindex [font families] [expr {int(rand()*[llength [font families]])}]]] -fixed} 100
  if {$i == 0} {
    set info(fixedfontlist) [list]
  }
  set target_i [expr {min([llength [font families]], $i+30)}]
set atime [clock milliseconds]
  while {$i < $target_i} {
    set font [lindex [font families] $i]
    if {![regexp {[^a-z,0-9,A-Z,\ ,\}\{\_\(\)\-]} \{$font\}]} {
      if [font metrics [list $font] -fixed] {
        lappend info(fixedfontlist) $font
      }
    } else {
    }
    incr i
  }
sputs time [expr {([clock milliseconds] - $atime)}]
  if {$i < [llength [font families]]} {
    #after 1 "get_fixed_fonts [expr {$i}]"
update idletasks
get_fixed_fonts [expr {$i}]

  } else {
    if {[llength $info(fixedfontlist)] == 0} {lappend info(fixedfontlist) courier}
    if {[winfo exists .dialog.tabsframe.generaloptions.f1.menubutton1.menu]} {
      .dialog.tabsframe.generaloptions.f1.menubutton1.menu delete 0
      foreach fontfam $info(fixedfontlist) {
        .dialog.tabsframe.generaloptions.f1.menubutton1.menu add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable temp_info(textfontfamily) -font [list $fontfam 10]
      }
    }
  }
}


###########
## Get a list of fixed fonts on the system
###########
proc get_fixed_fonts2 {{i 0}} {
  global info temp_info 
  set info(fixedfontlist) [list]
  foreach font [font families] {
    if {(![regexp {[^a-z,0-9,A-Z,\ ,\}\{\_\(\)]} \{$font\}]) && ([font metrics \{$font\} -fixed])} {
        lappend info(fixedfontlist) $font
    }
  }
  if {[llength $info(fixedfontlist)] == 0} {
    lappend info(fixedfontlist) courier
  }
  if {[winfo exists .dialog.tabsframe.generaloptions.f1.menubutton1.menu]} {
    .dialog.tabsframe.generaloptions.f1.menubutton1.menu delete 0
    foreach fontfam $info(fixedfontlist) {
      .dialog.tabsframe.generaloptions.f1.menubutton1.menu add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable temp_info(textfontfamily) -font [list $fontfam 10]
    }
  }
}

###########
## Get a list of fixed fonts on the system
###########
proc get_fixed_fonts1 {{i 0}} {
  global info
  set fflist [font families]
  set  info(fixedfontlist) {}
  set i 0
  while {$i < [llength $fflist]} {
    set font [lindex $fflist $i]
    if {![regexp {[^a-z,0-9,A-Z,\ ,\}\{\_\(\)\-]} \{$font\}]} {
      if {[font metrics \{$font\} -fixed]} {
        lappend info(fixedfontlist) $font
      }
    }
    incr i
    if {!($i%5)} {update}
  }
  if {[llength $info(fixedfontlist)] == 0} {lappend info(fixedfontlist) courier}
  if {[winfo exists .dialog.tabsframe.generaloptions.f1.menubutton1.menu]} {
    .dialog.tabsframe.generaloptions.f1.menubutton1.menu delete 0
    foreach fontfam $info(fixedfontlist) {
      .dialog.tabsframe.generaloptions.f1.menubutton1.menu add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable temp_info(textfontfamily) ;#-font [list $fontfam 10]
    }
  }
}


###########
## tk_messageBox needs to reset the focus
###########
if {0} {
rename tk_messageBox old_tk_messageBox

proc tk_messageBox {args} {
  global tk_patchLevel

  set focus_store [focus]

  if {([tk windowingsystem] == "aqua") && (($tk_patchLevel == "8.4.13") ||($tk_patchLevel == "8.4.14"))} {
    set temp_args [list]
    foreach {x y} $args {
      if {($x == "-default") && (($y== "no") || ($y == "cancel"))} {
        sputs aqua dialog bug detected
      } else {
        lappend temp_args $x $y
      }
    }
    set args $temp_args
  } 
  set ret [old_tk_messageBox {*}$args]
  catch {focus $focus_store}
  return $ret
}
}

###########
## replace tk::PostOverPoint, so that it makes the menu upwards, rather than just at bottom of screen
###########
proc tk::PostOverPoint {menu x y {entry {}}} {
    global tcl_platform
    if {[string compare $entry {}]} {
	if {$entry == [$menu index last]} {
	    incr y [expr {-([$menu yposition $entry]  + [winfo reqheight $menu])/2}]
	} else {
	    incr y [expr {-([$menu yposition $entry]  + [$menu yposition [expr {$entry+1}]])/2}]
	}
	incr x [expr {-[winfo reqwidth $menu]/2}]
    }

    if {$tcl_platform(platform) == "windows"} {
	# We need to fix some problems with menu posting on Windows.
	set yoffset [expr {[winfo screenheight $menu]  - $y - [winfo reqheight $menu]}]
	if {$yoffset < 0} {
	    # The bottom of the menu is offscreen, so adjust upwards
            #incr yoffset -5
	    #incr y $yoffset
	    incr y [expr {-[winfo reqheight $menu]}]
	    if {$y < 0} { set y 0 }
	}
	# If we're off the top of the screen (either because we were
	# originally or because we just adjusted too far upwards),
	# then make the menu popup on the top edge.
	if {$y < 0} {
	    set y 0
	}
    }
    if {![catch {$menu post $x $y} error]} {
      if {$entry ne "" && [$menu entrycget $entry -state] ne "disabled"} {
	  $menu activate $entry
	  GenerateMenuSelect $menu
      }
    } else {
      sputs menu eror $error
    }
}

###########
## creates a color picker button
###########
proc color_button {name variable {size 12}} {
  global [regsub {\(.*\)} $variable ""] info

  if {$info(android)} {
    set size [expr {int($size * 2.5)}]
  }
  if {[info exists $variable]} {set color [set $variable]}
  if {[catch {winfo rgb . $color}]} {set color $info(bg_color)}
  #set $variable $color
  set rgb_color [format "\#%04X%04X%04X" {*}[winfo rgb . $color]] 
  set new_image [image create photo -width $size -height $size]
  $new_image put [string repeat "{[string repeat "$rgb_color " $size] } " $size]
  if {[info commands tk_button] == {}} {
    button $name -image $new_image -width $size -height $size
  } else {
    #non-tile button
    tk_button $name -image $new_image -width $size -height $size
  }
  $name configure -command "
    set button_priv \[tk_chooseColor -parent $name -initialcolor \[expr {\[catch {winfo rgb . \$$variable}\]?\$info(bg_color):\$$variable}\] \];
    if \{\$button_priv != \"\"\} \{
      set $variable \$button_priv
      event generate $name <<color_picked>>
    \}"

  #bind $name <<updatevar>> "$new_image put  \[string repeat \"{\[string repeat \"\[ format #%%04X%%04X%%04X {*}\[winfo rgb . \[expr {\[catch {winfo rgb . \$$variable}\]?\$info(bg_color):\$$variable}\] \]\]  \" $size] } \" $size\]"

  bind $name <<updatevar>> "color_button_fill $new_image \$$variable"

  bindtags $name [list $name ColorButton [winfo toplevel $name] all]
  trace add variable $variable write "event generate $name <<updatevar>>; #"
  bind $name <Destroy> "image delete $new_image;trace remove variable $variable write \"event generate $name <<updatevar>>; #\""
  return $name
}

bind ColorButton <ButtonRelease-1> "%W invoke"

proc color_button_fill {image_name color} {
  set size [$image_name cget -width]
  if {[catch {winfo rgb . $color}]} {
    if {$color eq {}} {
      $image_name put gray80 -to 0 0 $size $size
      for {set i 0} {$i < $size} {incr i} {
        $image_name put red -to [expr {max (0,$i-1)}] [expr {max(0,$i-1)}] [expr {$i+1}] [expr {$i+1}]
      }
    } else {
      for {set i 0} {$i < [expr {$size/2}]} {incr i 4} {
        $image_name put gray80 -to [expr {$i}] [expr {$i}] [expr {$size-$i}] [expr {$size-$i}]
        $image_name put gray20 -to [expr {$i+2}] [expr {$i+2}] [expr {$size-$i-2}] [expr {$size-$i-2}]
      }
    }
  } else {
    $image_name put  [format #%04X%04X%04X {*}[winfo rgb . $color]] -to 0 0 $size $size
  }
}

###############
## Preferences dialog
###############
###new version with tile
proc configure_preferences {{w .}} {
  global info temp_info abi_info temp_abi tcl_platform
  global keysubst
  global allowedkeys possible_extensions transdir ui_icon_color_text

  global ok current_NCBI_translation_code 
  global dialogblock 


  if {$dialogblock == 1} {return}
  set dialogblock 1

  if {[llength $info(fixedfontlist)] == 0} {
    get_fixed_fonts
  }
  
  #this is called with $w=="." on the mac when ::tk::mac::ShowPreferences is called
  if {$w=="."} {
    for {set i 0} {$i < [llength [wm stackorder .]]} {incr i} {
      set w [lindex [wm stackorder .] end-$i]
      if {[winfo exists $w.menubar]} {break}
    }
    if {$w == ""} {
      set w .
    }
  }

  if {[tk windowingsystem] != "aqua"} {
    set window_title "Preferences"
  } else {
    if {$tcl_platform(osVersion) < 22} {
      set window_title "Preferences"
    } else {
      set window_title "Settings"
    }
  }
  set s [new_dialog $w $window_title "DONE"]

  bind $s <<Cancel>> "after 300 execute_pref_changes -1"
  bind $s <<OK>> "after 300 execute_pref_changes 1"
  set ok 0


  grid [set t [ttk::notebook $s.tabsframe]] -row 0 -column 0 -sticky nswe


  ###general options frame
  $t add [ttk::frame $t.generaloptions] -text [mc General] -sticky nswe
  array set temp $info(keysubstmap)
  set keysubst(A) ""
  set keysubst(C) ""
  set keysubst(G) ""
  set keysubst(T) ""
  foreach sub [array names temp] {
    if {([string is upper $sub]) || (![string is alpha $sub])} {
      append keysubst($temp($sub)) $sub
    }
  }
  set allowedkeys [string map {"ACGTacgt" "ACGT" "ACGTNacgtn*" "ACGTN" "ABCDGHKMNRSTVWYabcdghkmnrstvwy*" "degenerate code" "ACGTUacgtu" "ACGTU" "ACGUacgu" "ACGU" "ACGUNacgun*" "ACGUN" "ACGTUNacgtun*" "ACGTUN"} $info(allowedkeys)]

  foreach element [list print_formatted antialias_width antialias_percent antialias_show print_abi_lines_per_page dnafontsize textfontfamily default_textarea_width graphicfontsize graphicfontfamily menu_font_size toolbar_size locale find_orf_starts draw_graphic_connectors circ_map_feature_names_centered show_comment comment_height circ_map_radius gel_min_gray selection_shows_Trans selection_shows_Trans_upper selection_shows_Trans_dir enzyme_highlight_font enzyme_highlight_underline enzyme_highlight_transparent methylated_default genbank_strict_genbank genbank_skip_blank mac_antialias_limit leopard_dialog_bug translation_code autosave_dir autosave_max_bkp_files autosave_max_dir_files autosave_max_age_days autosave_on autosave_minutes lock_bug linear_map_bump_label color_feature_table_tags ui_icon_color inline_mode inline_canvas_space_height inline_show_second_strand feature_transparency selection_on_top primer_salt primer_dna] {
    set temp_info($element) $info($element)
  }

  foreach element [list bg_color label_fg_color menu_bg_color menu_fg_color menu_select_bg_color menu_select_fg_color text_bg_color text_fg_color text_select_bg_color text_select_fg_color text_select2_bg_color text_select2_fg_color graphic_bg_color graphic_fg_color find_forward_highlight find_reverse_highlight feature_default_fcolor feature_default_rcolor enzyme_highlight_color] {
    set temp_info($element) $info($element)
  }

  grid [ttk::frame $t.generaloptions.f1 -relief flat -borderwidth 3] -row 1 -column 0 -columnspan 2 -sticky nwe
  grid [ttk::label $t.generaloptions.f1.label1 -text [mc "Text font:"]] -row 0 -column 0 -sticky e

  grid [menubutton $t.generaloptions.f1.menubutton -textvariable temp_info(dnafontsize) -menu $t.generaloptions.f1.menubutton.menu -indicatoron 1 -relief raised] -row 0 -column 1 -sticky w
  menu $t.generaloptions.f1.menubutton.menu 
    foreach fontsize [lsort -unique -integer [concat [list 8 9 10 11 12 13 14 16 18 24 28 32 36 42 48] $temp_info(dnafontsize)]] {
      $t.generaloptions.f1.menubutton.menu add radiobutton -label $fontsize -indicatoron 1 -value $fontsize -variable temp_info(dnafontsize)
    }
  bind $t.generaloptions.f1.menubutton.menu <<MenuSelect>> "focus $s"
  grid [ttk::label $t.generaloptions.f1.label2 -text "pt"] -row 0 -column 2 -sticky w
  grid [menubutton $t.generaloptions.f1.menubutton1 -textvariable temp_info(textfontfamily) -menu $t.generaloptions.f1.menubutton1.menu -indicatoron 1 -relief raised] -row 0 -column 3 -sticky w
  menu $t.generaloptions.f1.menubutton1.menu 
  bind $t.generaloptions.f1.menubutton1.menu <<MenuSelect>> "focus $s"
  foreach fontfam $info(fixedfontlist) {
      $t.generaloptions.f1.menubutton1.menu add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable temp_info(textfontfamily);# -font [list $fontfam 10]
  }
  grid [ttk::label $t.generaloptions.f1.label3 -text [mc "Graphic font:"]] -row 1 -column 0 -sticky e
  grid [menubutton $t.generaloptions.f1.menubutton2 -textvariable temp_info(graphicfontsize) -menu $t.generaloptions.f1.menubutton2.menu -indicatoron 1 -relief raised] -row 1 -column 1 -sticky w
  menu $t.generaloptions.f1.menubutton2.menu 
    foreach fontsize [lsort -unique -integer [concat [list 8 9 10 11 12 13 14 16 18 24 28 32 36 42 48] $temp_info(graphicfontsize)]] {
      $t.generaloptions.f1.menubutton2.menu add radiobutton -label $fontsize -indicatoron 1 -value $fontsize -variable temp_info(graphicfontsize)
    }
  bind $t.generaloptions.f1.menubutton2.menu <<MenuSelect>> "focus $s"
  grid [ttk::label $t.generaloptions.f1.label4 -text "pt"] -row 1 -column 2 -sticky w
  grid [menubutton $t.generaloptions.f1.menubutton3 -textvariable temp_info(graphicfontfamily) -menu $t.generaloptions.f1.menubutton3.menu -indicatoron 1 -relief raised] -row 1 -column 3 -sticky w
  menu $t.generaloptions.f1.menubutton3.menu 
    if {[llength $info(allfontlist)] <= 20} {
      foreach fontfam $info(allfontlist) {
        $t.generaloptions.f1.menubutton3.menu add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable temp_info(graphicfontfamily);# -font [list $fontfam 10]
        bind $t.generaloptions.f1.menubutton3.menu <<MenuSelect>> "focus $s"
      }
    } else {
      for {set fi 0} {$fi < [llength $info(allfontlist)]} {incr fi 20} {
        if {[set fj [expr {$fi + 19}]] >= [llength $info(allfontlist)]} {set fj [expr {[llength $info(allfontlist)]-1}]}
        $t.generaloptions.f1.menubutton3.menu add cascade -label "[lindex $info(allfontlist) $fi]-[lindex $info(allfontlist) $fj]" -menu $t.generaloptions.f1.menubutton3.menu.menu$fi 
        menu $t.generaloptions.f1.menubutton3.menu.menu$fi
        foreach fontfam [lrange $info(allfontlist) $fi $fj] {
          $t.generaloptions.f1.menubutton3.menu.menu$fi add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable temp_info(graphicfontfamily);# -font [list $fontfam 10]
        }
        bind $t.generaloptions.f1.menubutton3.menu.menu$fi <<MenuSelect>> "focus $s"
      }
    }


if {[tk windowingsystem] != "aqua"} {
  grid [ttk::label $t.generaloptions.f1.label5 -text [mc "Menu font:"]] -row 2 -column 0 -sticky e
    grid [menubutton $t.generaloptions.f1.menubutton4 -textvariable temp_info(menu_font_size) -menu $t.generaloptions.f1.menubutton4.menu -indicatoron 1 -relief raised] -row 2 -column 1 -sticky w
    menu $t.generaloptions.f1.menubutton4.menu 
      foreach fontsize [lsort -unique -integer [concat [list 8 9 10 11 12 13 14 16 18 24 28 32 36 42 48] $temp_info(menu_font_size)]] {
        $t.generaloptions.f1.menubutton4.menu add radiobutton -label $fontsize -indicatoron 1 -value $fontsize -variable temp_info(menu_font_size)
      }
    bind $t.generaloptions.f1.menubutton4.menu <<MenuSelect>> "focus $s"
    grid [ttk::label $t.generaloptions.f1.label6 -text "pt"] -row 2 -column 2 -sticky w
}

grid [ttk::label $t.generaloptions.f1.label7 -text [mc "Toolbar size:"]] -row 3 -column 0 -sticky e
grid [menubutton $t.generaloptions.f1.menubutton6 -textvariable temp_info(toolbar_size) -menu $t.generaloptions.f1.menubutton6.menu -indicatoron 1 -relief raised] -row 3 -column 1 -sticky w
  menu $t.generaloptions.f1.menubutton6.menu 
    foreach iconsize [lsort -unique -integer [concat [list 16 32 48 64 128 256] $temp_info(toolbar_size)]] {
      $t.generaloptions.f1.menubutton6.menu add radiobutton -label $iconsize -indicatoron 1 -value $iconsize -variable temp_info(toolbar_size)
    }
  bind $t.generaloptions.f1.menubutton6.menu <<MenuSelect>> "focus $s"
  grid [ttk::label $t.generaloptions.f1.label10 -text "px"] -row 3 -column 2 -sticky w

  grid [ttk::label $t.generaloptions.f1.label9 -text [mc "Default Sequence Width"]] -row 4 -column 0 -sticky w
  grid [entry $t.generaloptions.f1.textwidthentry  -textvariable temp_info(default_textarea_width) -validate key -vcmd "check_char %S" -width 3 -justify left] -row 4 -column 1 -sticky w
  grid [ttk::label $t.generaloptions.f1.label8 -text [mc "Locale:"]] -row 5 -column 0 -sticky e
  grid [menubutton $t.generaloptions.f1.menubutton5 -textvariable temp_info(locale) -menu $t.generaloptions.f1.menubutton5.menu -indicatoron 1 -relief raised] -row 5 -column 1 -columnspan 2 -sticky w

  menu $t.generaloptions.f1.menubutton5.menu 
    foreach localefile [glob -directory [file join $info(Accdir) Msgs] *.msg] {
      set localefile [string tolower [file rootname [file tail $localefile]]]
      $t.generaloptions.f1.menubutton5.menu add radiobutton -label $localefile -indicatoron 1 -value $localefile -variable temp_info(locale)
    }
  bind $t.generaloptions.f1.menubutton5.menu <<MenuSelect>> "focus $s"

  grid [ttk::separator $t.generaloptions.f1.s1 -orient horizontal] -row 6 -column 0 -columnspan 4 -sticky we

  grid [checkbutton $t.generaloptions.f1.b1 -text [mc "Inline Feature Mode"] -selectcolor white -variable temp_info(inline_mode) -onvalue 1 -offvalue 0] -row 8 -column 0 -columnspan 3 -sticky nw
  grid [checkbutton $t.generaloptions.f1.b2 -text [mc "Selection Highlight on top"] -selectcolor white -variable temp_info(selection_on_top) -onvalue 1 -offvalue 0] -row 9 -column 0 -columnspan 3 -sticky nw
  grid [ttk::label $t.generaloptions.f1.label12 -text [mc "Feature Transparency:"]] -row 10 -column 0 -sticky w
  grid [ttk::scale $t.generaloptions.f1.fea_trans_scale -from 0 -to 100 -command "set temp_info(feature_transparency) \[expr {round(\$temp_info(feature_transparency))}\];#" -orient horizontal -variable temp_info(feature_transparency)] -row 10 -column 1 -columnspan 2 -sticky we
  grid [checkbutton $t.generaloptions.f1.b2b -text [mc "Show Second Strand in Inline Mode"] -selectcolor white -variable temp_info(inline_show_second_strand) -onvalue 1 -offvalue 0] -row 11 -column 0 -columnspan 3 -sticky nw
  grid [ttk::label $t.generaloptions.f1.label13 -text [mc "Spacing Between Rows in Inline Mode:"]] -row 12 -column 0 -columnspan 2 -sticky w
  grid [menubutton $t.generaloptions.f1.menubutton7 -textvariable temp_info(inline_canvas_space_height) -menu $t.generaloptions.f1.menubutton7.menu -indicatoron 1] -row 12 -column 2 -columnspan 2 -sticky w
  menu $t.generaloptions.f1.menubutton7.menu 
      foreach spacersize [list 0 1 2 3 4 5 6 7 8 9 10] {
        $t.generaloptions.f1.menubutton7.menu add radiobutton -label $spacersize -indicatoron 1 -value $spacersize -variable temp_info(inline_canvas_space_height)
      }
  bind $t.generaloptions.f1.menubutton7.menu <<MenuSelect>> "focus $s"
  
  grid [checkbutton $t.generaloptions.f1.b3 -text [mc "Color Feature Table Rows"] -selectcolor white -variable temp_info(color_feature_table_tags) -onvalue 1 -offvalue 0] -row 13 -column 0 -columnspan 3 -sticky w
  grid [ttk::separator $t.generaloptions.f1.s2 -orient horizontal] -row 14 -column 0 -columnspan 3 -sticky we

  grid columnconfigure $t.generaloptions.f1 3 -weight 1 -pad 0

  grid [ttk::frame $t.generaloptions.f2 -relief flat -borderwidth 3] -row 2 -column 0 -columnspan 2 -sticky nwe
  grid [ttk::label $t.generaloptions.f2.label1 -text [mc "Allowed keys:"]] -row 0 -column 0  -sticky w
  grid [menubutton $t.generaloptions.f2.menubutton -textvariable allowedkeys -menu $t.generaloptions.f2.menubutton.menu -indicatoron 1 -relief raised] -row 0 -column 1  -sticky w
  menu $t.generaloptions.f2.menubutton.menu 
    $t.generaloptions.f2.menubutton.menu add radiobutton -label "ACGT" -value "ACGT" -variable allowedkeys -state active
    $t.generaloptions.f2.menubutton.menu add radiobutton -label "ACGTN" -value "ACGTN" -variable allowedkeys
    $t.generaloptions.f2.menubutton.menu add radiobutton -label [mc "degenerate code"] -value "degenerate code" -variable allowedkeys
    $t.generaloptions.f2.menubutton.menu add radiobutton -label "ACGTU" -value "ACGTU" -variable allowedkeys
    $t.generaloptions.f2.menubutton.menu add radiobutton -label "ACGUN" -value "ACGUN" -variable allowedkeys
    $t.generaloptions.f2.menubutton.menu add radiobutton -label "ACGU" -value "ACGU" -variable allowedkeys
    $t.generaloptions.f2.menubutton.menu add radiobutton -label "ACGTUN" -value "ACGTUN" -variable allowedkeys
  bind $t.generaloptions.f2.menubutton.menu <<MenuSelect>> "focus $s"
  grid [ttk::frame $t.generaloptions.f2.f1 -relief flat -borderwidth 3] -row 2 -column 0  -columnspan 2 -sticky nwe
  grid [ttk::label $t.generaloptions.f2.f1.label2 -text [mc "Key substitutions:"]] -row 1 -column 0  -sticky w
  grid [entry $t.generaloptions.f2.f1.entryA -textvariable keysubst(A) -width 3 -justify right] -row 1 -column 1 -sticky w
  grid [ttk::label $t.generaloptions.f2.f1.label3 -text "=A,  "] -row 1 -column 2  -sticky w
  grid [entry $t.generaloptions.f2.f1.entryC -textvariable keysubst(C) -width 3 -justify right] -row 1 -column 3 -sticky w
  grid [ttk::label $t.generaloptions.f2.f1.label4 -text "=C,  "] -row 1 -column 4  -sticky w
  grid [entry $t.generaloptions.f2.f1.entryG -textvariable keysubst(G) -width 3 -justify right] -row 1 -column 5 -sticky w
  grid [ttk::label $t.generaloptions.f2.f1.label5 -text "=G,  "] -row 1 -column 6  -sticky w
  grid [entry $t.generaloptions.f2.f1.entryT -textvariable keysubst(T) -width 3 -justify right] -row 1 -column 7 -sticky w
  grid [ttk::label $t.generaloptions.f2.f1.label6 -text "=T.  "] -row 1 -column 8  -sticky w
  grid [ttk::separator $t.generaloptions.f2.s1 -orient horizontal] -row 2 -column 0 -columnspan 8 -sticky swe
  grid columnconfigure $t.generaloptions.f2 1 -weight 1


  if {0 && [tk windowingsystem] == "aqua"} {
    grid [ttk::frame $t.generaloptions.f3 -relief flat -borderwidth 3] -row 3 -column 0 -columnspan 2 -sticky nwe
    #grid [checkbutton $t.generaloptions.f3.print_formatted -text [mc "Print Text with color Formatting (slower)"] -selectcolor white -onvalue 1 -offvalue 0 -variable temp_info(print_formatted)] -row 0 -column 0 -columnspan 3 -sticky nw
    tk_optionMenu $t.generaloptions.f3.antialiased temp_info(mac_antialias_limit) 0 1 2 3 4 5 6
    grid [ttk::label $t.generaloptions.f3.antialiased_label -text [mc "Core Graphics Anti-alias limit"]] -row 1 -column 0 -sticky nw
    grid $t.generaloptions.f3.antialiased -row 1 -column 1 -sticky w
    #grid [checkbutton $t.generaloptions.f3.leopard_bug -text [mc "Activate Leopard bug workaround"] -selectcolor white -onvalue 1 -offvalue 0 -variable temp_info(leopard_dialog_bug)] -row 2 -column 0 -columnspan 3 -sticky nw
    grid columnconfigure $t.generaloptions.f3 1 -weight 1
    grid [ttk::separator $t.generaloptions.f3.s1 -orient horizontal] -row 3 -column 0 -columnspan 5 -sticky swe
  }

  if {[tk windowingsystem] != "aqua"} {
    grid [ttk::frame $t.generaloptions.f3 -relief flat -borderwidth 3] -row 3 -column 0 -columnspan 2 -sticky nwe
    grid [checkbutton $t.generaloptions.f3.antialias_on -text [mc "Use antialias on graphic maps"] -selectcolor white -onvalue 1 -offvalue 0 -variable temp_info(antialias_show)] -row 1 -column 1 -columnspan 4 -sticky w
    grid [ttk::label $t.generaloptions.f3.antialias_w_label -text [mc "Anti-alias width"]] -row 2 -column 1 -sticky w
    tk_optionMenu $t.generaloptions.f3.antialias_w temp_info(antialias_width) 0 1 2 3 4
    grid $t.generaloptions.f3.antialias_w -row 2 -column 2 -sticky w

    grid [ttk::label $t.generaloptions.f3.antialias_p_label -text [mc "Anti-alias percent"]] -row 2 -column 3 -sticky w
    tk_optionMenu $t.generaloptions.f3.antialias_p temp_info(antialias_percent) 10 20 30 40 50 60
    grid $t.generaloptions.f3.antialias_p -row 2 -column 4 -sticky w
    grid columnconfigure $t.generaloptions.f3 6 -weight 1

    grid [ttk::separator $t.generaloptions.f3.s1 -orient horizontal] -row 3 -column 0 -columnspan 6 -sticky swe
  }



  ## Speech options
  if  {[tk windowingsystem] == "aqua"} {
    ###OSX speech options-- not used with OS native speech
    grid [ttk::frame $t.generaloptions.f4 -relief flat -borderwidth 3] -row 4 -column 0 -columnspan 2 -sticky nwe
    foreach var [list speak_use_words speak_voice speak_delay] {
      set temp_info($var) $info($var)
    }
    grid [ttk::frame $t.generaloptions.f4.f0 -relief flat -borderwidth 2] -row 0 -column 0 -sticky nswe
    grid [ttk::label $t.generaloptions.f4.f0.dellabel -text [mc "Speak Text Delay (ms):"]] -row 0 -column 0 -sticky nswe
    grid [entry $t.generaloptions.f4.f0.del -textvariable temp_info(speak_delay) -validate key -vcmd "check_char %S" -width 5 -justify right] -row 0 -column 1 -sticky nw
    if  {1} {
      grid [ttk::frame $t.generaloptions.f4.f2 -relief flat -borderwidth 2] -row 1 -column 0 -sticky nswe
      #grid [checkbutton $t.generaloptions.f4.f2.native -text [mc "Use Mac Native Speech"] -selectcolor white -onvalue 1 -offvalue 0 -variable temp_info(speak_use_aqua)] -row 1 -column 1
      #grid [menubutton $t.generaloptions.f4.f2.menubutton -textvariable temp_info(speak_voice) -menu $t.generaloptions.f4.f2.menubutton.menu -indicatoron 1 -relief raised] -row 2 -column 1 -sticky w
      #menu $t.generaloptions.f4.f2.menubutton.menu 
      #foreach menuitem [speech::speakers] {
     #   $t.generaloptions.f4.f2.menubutton.menu add radiobutton -label $menuitem -value $menuitem -variable temp_info(speak_voice) -state active -command "speech::speak {$menuitem} -voice {$menuitem}"
     # }
      #if {[lsearch -exact [speech::speakers] $temp_info(speak_voice)] ==-1} {
      #  set temp_info(speak_voice) [lindex [speech::speakers] 0]
      #}
      grid [checkbutton $t.generaloptions.f4.f2.words -text [mc "Use NATO phonetics"] -selectcolor white -onvalue 1 -offvalue 0 -variable temp_info(speak_use_words)] -row 3 -column 1
    }
    grid rowconfigure $t.generaloptions.f4 14 -weight 1
    grid [ttk::separator $t.generaloptions.f4.s1 -orient horizontal] -row 2 -column 0 -columnspan 3 -sticky swe
    grid columnconfigure $t.generaloptions.f4 2 -weight 1 -pad 0
  } elseif  {[info commands snack::sound] != {}} {
    ###snack options 
    grid [ttk::frame $t.generaloptions.f4 -relief flat -borderwidth 3] -row 4 -column 0 -columnspan 2 -sticky nwe
    foreach var [list speak_delay] {
      set temp_info($var) $info($var)
    }
    grid [ttk::frame $t.generaloptions.f4.f0 -relief flat -borderwidth 2] -row 0 -column 0 -sticky nswe
    grid [ttk::label $t.generaloptions.f4.f0.dellabel -text [mc "Delay (ms):"]] -row 0 -column 0 -sticky nswe
    grid [entry $t.generaloptions.f4.f0.del -textvariable temp_info(speak_delay) -validate key -vcmd "check_char %S" -width 5 -justify right] -row 0 -column 1 -sticky nw
    grid rowconfigure $t.generaloptions.f4 14 -weight 1
    grid [ttk::separator $t.generaloptions.f4.s1 -orient horizontal] -row 2 -column 0 -columnspan 3 -sticky swe
    grid columnconfigure $t.generaloptions.f4 2 -weight 1 -pad 0
  } 
####


  grid [ttk::frame $t.generaloptions.f5 -relief flat -borderwidth 3] -row 5 -column 0 -columnspan 2 -sticky nwe
  grid [checkbutton $t.generaloptions.f5.connectors -text [mc "Draw Connectors in Graphic Map"] -selectcolor white -onvalue 1 -offvalue 0 -variable temp_info(draw_graphic_connectors)] -row 0 -column 0 -columnspan 3 -sticky nw
  grid [checkbutton $t.generaloptions.f5.center_labels -text [mc "Center Feature Labels on Graphic Map"] -selectcolor white -onvalue 1 -offvalue 0 -variable temp_info(circ_map_feature_names_centered)] -row 1 -column 0 -columnspan 3 -sticky nw
  ##grid [checkbutton $t.generaloptions.f5.bump_labels -text [mc "Bump Feature Labels on Linear Map"] -selectcolor white -onvalue 1 -offvalue 0 -variable temp_info(linear_map_bump_label)] -row 2 -column 0 -columnspan 3 -sticky nw
  grid [checkbutton $t.generaloptions.f5.meth -text [mc "Dam/Dcm default"] -selectcolor white -onvalue 1 -offvalue 0 -variable temp_info(methylated_default)] -row 3 -column 0 -columnspan 3 -sticky nw
  grid [frame $t.generaloptions.f5.comment_frame] -row 4 -column 0 -sticky nw
  grid [checkbutton $t.generaloptions.f5.comment_frame.comment -text [mc "Show File Comment"] -selectcolor white -onvalue 1 -offvalue 0 -variable temp_info(show_comment)] -row 0 -column 0 -sticky w
  grid [ttk::label $t.generaloptions.f5.comment_frame.label1 -text [mc "Comment Height"]] -row 0 -column 1 -sticky e -padx {30 0}
  grid [ttk::spinbox $t.generaloptions.f5.comment_frame.commheight -width 1 -textvariable temp_info(comment_height) -from 1 -to 15 -validate all -validatecommand "entry_integer %P %W %V 1 15"] -row 0 -column 2  -sticky w
  grid [frame $t.generaloptions.f5.transel_frame] -row 5 -column 0 -sticky nw
  grid [checkbutton $t.generaloptions.f5.transel_frame.transel -text [mc "Translate Selection"] -selectcolor white -onvalue 1 -offvalue 0 -variable temp_info(selection_shows_Trans)] -row 0 -column 0  -sticky w
  grid [menubutton $t.generaloptions.f5.transel_frame.transel_dir -textvariable transdir -menu $t.generaloptions.f5.transel_frame.transel_dir.menu -indicatoron 1 -relief raised] -row 0 -column 1  -sticky w
  menu $t.generaloptions.f5.transel_frame.transel_dir.menu 
  $t.generaloptions.f5.transel_frame.transel_dir.menu add radiobutton -label [mc "Forward"] -value 0 -variable  temp_info(selection_shows_Trans_dir) -command "set transdir [mc Forward]"
  $t.generaloptions.f5.transel_frame.transel_dir.menu add radiobutton -label [mc "Reverse"] -value 1 -variable  temp_info(selection_shows_Trans_dir) -command "set transdir [mc Reverse]"
  set transdir [expr {$temp_info(selection_shows_Trans_dir)?[mc "Reverse"]: [mc "Forward"]}]
  grid [checkbutton $t.generaloptions.f5.transel_frame.transel_upper -text [mc "Translate Uppercase Only"] -selectcolor white -onvalue 1 -offvalue 0 -variable temp_info(selection_shows_Trans_upper)] -row 0 -column 2  -sticky w -padx {30 0}
  grid [frame $t.generaloptions.f5.circradlabel_frame] -row 6 -column 0 -sticky nw
  grid [ttk::label $t.generaloptions.f5.circradlabel_frame.circradlabel -text [mc "Circular Map Radius"]] -row 0 -column 0 -sticky w
  grid [ttk::spinbox $t.generaloptions.f5.circradlabel_frame.circrad -width 3 -textvariable temp_info(circ_map_radius) -from 100 -to 500 -validate key -validatecommand "check_char %S"] -row 0 -column 1 -sticky w
  grid [ttk::frame $t.generaloptions.f5.f1] -row 7 -column 0 -sticky nw
  grid [ttk::label $t.generaloptions.f5.f1.l1 -text [mc "Minimal Gel Band Gray Level"]] -row 0 -column 0  -sticky w
  grid [ttk::spinbox $t.generaloptions.f5.f1.l2 -width 3 -textvariable temp_info(gel_min_gray) -from 0 -to 100 -validate all -validatecommand "entry_integer %P %W %V 0 100"]  -row 0 -column 1  -sticky w

  grid columnconfigure $t.generaloptions.f5.f1 1 -weight 1
  grid columnconfigure $t.generaloptions.f5 3 -weight 1 -pad 0

  #grid rowconfigure $t.generaloptions 0 -weight 1
  #grid rowconfigure $t.generaloptions 1 -weight 1
 # grid rowconfigure $t.generaloptions 2 -weight 1
  grid rowconfigure $t.generaloptions 6 -weight 1


  ###color options frame
  $t add [ttk::frame $t.coloroptions] -text [mc Color] -sticky nswe
  grid [ttk::label $t.coloroptions.l1  -text [mc "Background"]] -row 0 -column 1 -sticky n
  grid [ttk::label $t.coloroptions.l2  -text [mc "Foreground"]] -row 0 -column 2 -sticky n
  if {([tk windowingsystem] ne "none") || !$info(use_tile)} {
    #can't set bg color in aqua tile theme
    grid [ttk::label $t.coloroptions.l3  -text [mc "Program"]] -row 1 -column 0 -sticky nw
    grid [color_button $t.coloroptions.b1  temp_info(bg_color)] -row 1 -column 1 -sticky n
    grid [color_button $t.coloroptions.b1b  temp_info(label_fg_color)] -row 1 -column 2 -sticky n
  } else {
    set temp_info(bg_color) gray9
    set temp_info(label_fg_color) black
  }
  if {[tk windowingsystem] != "aqua"} { 
    #Aqua menus don't set colors
    grid [ttk::label $t.coloroptions.l4  -text [mc "Menu"]] -row 2 -column 0 -sticky nw
    grid [color_button $t.coloroptions.b2  temp_info(menu_bg_color)] -row 2 -column 1 -sticky n
    grid [color_button $t.coloroptions.b3  temp_info(menu_fg_color)] -row 2 -column 2 -sticky n
    grid [ttk::label $t.coloroptions.l5  -text [mc "Menu (selected)"]] -row 3 -column 0 -sticky nw
    grid [color_button $t.coloroptions.b4  temp_info(menu_select_bg_color)] -row 3 -column 1 -sticky n
    grid [color_button $t.coloroptions.b5  temp_info(menu_select_fg_color)] -row 3 -column 2 -sticky n
  }
  grid [ttk::label $t.coloroptions.l6  -text [mc "Text"]] -row 4 -column 0 -sticky nw
  grid [color_button $t.coloroptions.b6  temp_info(text_bg_color)] -row 4 -column 1 -sticky n
  grid [color_button $t.coloroptions.b7  temp_info(text_fg_color)] -row 4 -column 2 -sticky n
  grid [ttk::label $t.coloroptions.l7  -text [mc "Text (selected)"]] -row 5 -column 0 -sticky nw
  grid [color_button $t.coloroptions.b8  temp_info(text_select_bg_color)] -row 5 -column 1 -sticky n
  grid [color_button $t.coloroptions.b9  temp_info(text_select_fg_color)] -row 5 -column 2 -sticky n
  grid [ttk::label $t.coloroptions.l8  -text [mc "Text (inactive window)"]] -row 6 -column 0 -sticky nw
  grid [color_button $t.coloroptions.b10  temp_info(text_select2_bg_color)] -row 6 -column 1 -sticky n
  grid [color_button $t.coloroptions.b11  temp_info(text_select2_fg_color)] -row 6 -column 2 -sticky n

  grid [ttk::label $t.coloroptions.l6g  -text [mc "Graphics"]] -row 7 -column 0 -sticky nw
  grid [color_button $t.coloroptions.b6g  temp_info(graphic_bg_color)] -row 7 -column 1 -sticky n
  grid [color_button $t.coloroptions.b7g  temp_info(graphic_fg_color)] -row 7 -column 2 -sticky n

  grid [ttk::label $t.coloroptions.l9  -text [mc "Find (forward)"]] -row 8 -column 0 -sticky nw
  grid [color_button $t.coloroptions.b12  temp_info(find_forward_highlight)] -row 8 -column 1 -sticky n
  grid [ttk::label $t.coloroptions.l10  -text [mc "Find (reverse)"]] -row 9 -column 0 -sticky nw
  grid [color_button $t.coloroptions.b13  temp_info(find_reverse_highlight)] -row 9 -column 1 -sticky n

  grid [ttk::label $t.coloroptions.l11  -text [mc "Feature default (fwd)"]] -row 10 -column 0 -sticky nw
  grid [color_button $t.coloroptions.b14  temp_info(feature_default_fcolor)] -row 10 -column 1 -sticky n
  grid [ttk::label $t.coloroptions.l12  -text [mc "Feature default (rev)"]] -row 11 -column 0 -sticky nw
  grid [color_button $t.coloroptions.b15  temp_info(feature_default_rcolor)] -row 11 -column 1 -sticky n

  grid [ttk::label $t.coloroptions.l13  -text [mc "Enzyme highlight"]] -row 12  -column 0 -sticky nw
  grid [color_button $t.coloroptions.b16  temp_info(enzyme_highlight_color)] -row 12 -column 1 -sticky n
  grid [checkbutton $t.coloroptions.b17 -text [mc "No Enzyme Color"] -selectcolor white -variable temp_info(enzyme_highlight_transparent) -onvalue 1 -offvalue 0] -row 13 -column 0 -columnspan 3 -sticky nw
  grid [checkbutton $t.coloroptions.enzhighfont -text [mc "Enzyme Highlight Bold"] -selectcolor white -onvalue bolddnafont -offvalue dnafont -variable temp_info(enzyme_highlight_font)] -row 14 -column 0 -columnspan 3 -sticky nw
  grid [checkbutton $t.coloroptions.enzhighunderl -text [mc "Enzyme Highlight Underline"] -selectcolor white -onvalue 1 -offvalue 0 -variable temp_info(enzyme_highlight_underline)] -row 15 -column 0 -columnspan 3 -sticky nw

  grid [ttk::separator $t.coloroptions.s0 -orient horizontal] -row 16 -column 0 -columnspan 3 -sticky swe
  grid [checkbutton $t.coloroptions.b18 -text [mc "Color Feature Table Rows"] -selectcolor white -variable temp_info(color_feature_table_tags) -onvalue 1 -offvalue 0] -row 17 -column 0 -columnspan 3 -sticky nw
  #grid [checkbutton $t.coloroptions.b19 -text [mc "Selection Highlight on top"] -selectcolor white -variable temp_info(selection_on_top) -onvalue 1 -offvalue 0] -row 18 -column 0 -columnspan 3 -sticky nw
  #grid [checkbutton $t.coloroptions.b18 -text [mc "Use png formatted Button Images"] -selectcolor white -variable temp_info(use_png_images) -onvalue 1 -offvalue 0] -row 15 -column 0 -columnspan 3 -sticky nw

  grid [ttk::label $t.coloroptions.label15 -text [mc "Main User Interface Color (Restart Required):"]] -row 18 -column 0 -columnspan 2 -sticky w
  grid [menubutton $t.coloroptions.menubutton2 -textvariable ui_icon_color_text -menu $t.coloroptions.menubutton2.menu -indicatoron 1] -row 18 -column 2 -columnspan 2 -sticky w
  set ui_icon_color_text [mc $temp_info(ui_icon_color)]
  menu $t.coloroptions.menubutton2.menu 
      foreach icon_color [list Green Red Blue Yellow Orange Purple] {
        $t.coloroptions.menubutton2.menu add radiobutton -label [mc $icon_color] -indicatoron 1 -value $icon_color -variable temp_info(ui_icon_color) -command "set ui_icon_color_text [mc $icon_color]"
      }
  bind $t.coloroptions.menubutton2.menu <<MenuSelect>> "focus $s"
  
  #ABI options 
  grid [ttk::separator $t.coloroptions.s1 -orient horizontal] -row 19 -column 0 -columnspan 3 -sticky swe
  
  grid [ttk::frame $t.coloroptions.f1 -relief flat -borderwidth 0] -row 20 -column 0  -columnspan 4 -sticky nwe
  grid [ttk::label $t.coloroptions.f1.abilabel -justify left -text [mc "ABI"] ] -row 0 -column 0 -sticky nw
  foreach base [list A C G T N] row [list 1 2 3 4 5] {
    set temp_abi($base) $abi_info(colors,$base)
    grid [ttk::label $t.coloroptions.f1.label$base -justify right -text "$base\:" ] -row $row -column 0 -sticky nw
    grid [color_button $t.coloroptions.f1.button$base temp_abi($base)] -row $row -column 1 -sticky nw
  }
  set temp_abi(non) $abi_info(colors,B)
  grid [ttk::label $t.coloroptions.f1.labelnon -justify right -text "BDHKMRSVWY\:" ] -row 6 -column 0 -sticky nw
  grid [color_button $t.coloroptions.f1.buttonnon temp_abi(non)] -row 6 -column 1 -sticky nw
  grid [ttk::frame $t.coloroptions.f1.abi_print_options -relief flat -borderwidth 2] -row 7 -column 0 -columnspan 2 -sticky nswe
  grid [ttk::label $t.coloroptions.f1.abi_print_options.l1 -text [mc "Print lines per page:"]] -row 0 -column 0 -sticky w
  grid [menubutton $t.coloroptions.f1.abi_print_options.menubutton -textvariable temp_info(print_abi_lines_per_page) -menu $t.coloroptions.f1.abi_print_options.menubutton.menu -indicatoron 1 -relief raised] -row 0 -column 1  -sticky w
  menu $t.coloroptions.f1.abi_print_options.menubutton.menu 
  foreach menuitem [list 2 3 4 5 6 7 8] {
    $t.coloroptions.f1.abi_print_options.menubutton.menu add radiobutton -label $menuitem -value $menuitem -variable temp_info(print_abi_lines_per_page) -state active
  }
  grid [ttk::separator $t.coloroptions.s2 -orient horizontal] -row 21 -column 0 -columnspan 3 -sticky swe

  grid [button $t.coloroptions.bdefaults -text [mc "Restore Program Defaults"] -command "
    if {\$info(dark_mode)} {
      foreach {var color} \$info(system_default_colors,dark) {
        set temp_info(\$var) \$color
      }
    } else {
      foreach {var color} \$info(system_default_colors) {
        set temp_info(\$var) \$color
      }
    }
    set temp_info(ui_icon_color) Green
    set ui_icon_color_text [mc Green]
  "] -row 22 -sticky n -column 0 -columnspan 3
  grid rowconfigure $t.coloroptions 21 -weight 1

  ### Analysis Options Frame
  $t add [ttk::frame $t.analysis] -text [mc Analysis] -sticky nswe
  grid [ttk::frame $t.analysis.f4 -relief flat -borderwidth 3] -row 4 -column 0 -columnspan 2 -sticky nwe
  grid columnconfigure $t.analysis.f4 1 -weight 1
  grid [ttk::label $t.analysis.f4.label1 -text [mc "Find ORFs Starting With:"]] -row 0 -column 0  -sticky nw
  grid [menubutton $t.analysis.f4.menubutton -textvariable temp_info(find_orf_starts) -menu $t.analysis.f4.menubutton.menu -indicatoron 1 -relief raised] -row 0 -column 1 -sticky nw
    menu $t.analysis.f4.menubutton.menu
    $t.analysis.f4.menubutton.menu add radiobutton -label "Met" -value "Met" -variable temp_info(find_orf_starts)
    $t.analysis.f4.menubutton.menu add radiobutton -label [mc "Stop+1"] -value "Stop+1" -variable temp_info(find_orf_starts)
  bind $t.analysis.f4.menubutton.menu <<MenuSelect>> "focus $s"
  grid [ttk::frame $t.analysis.f4.traslation_code -relief flat -borderwidth 3] -row 1 -column 0 -columnspan 3 -sticky nswe
    grid [menubutton $t.analysis.f4.traslation_code.menubutton -textvariable current_NCBI_translation_code -menu $t.analysis.f4.traslation_code.menubutton.menu -indicatoron 1 -relief raised] -row 1 -column 1 -sticky nwe
    set current_NCBI_translation_code [get_ncbi_translation_code $temp_info(translation_code)]
    menu $t.analysis.f4.traslation_code.menubutton.menu
    ##** NCBI translation code goes here
    foreach {name code} $info(NCBI_translation_code_list) {
      $t.analysis.f4.traslation_code.menubutton.menu add command -label $name -command "set temp_info(translation_code) $code; set current_NCBI_translation_code \[get_ncbi_translation_code $code\]"
    }
    ##* need to add vcode to change current_NCBI_translation_code when code is changed and to make sure that the code is 64 char long
    grid [ttk::label $t.analysis.f4.traslation_code.code_entry -textvariable temp_info(translation_code) -width 65 -justify left -font dnafont] -row 2 -column 1 -sticky nwe
    grid [ttk::label $t.analysis.f4.traslation_code.line1 -text {TTTTTTTTTTTTTTTTCCCCCCCCCCCCCCCCAAAAAAAAAAAAAAAAGGGGGGGGGGGGGGGG} -width 65 -justify left -font dnafont] -row 3 -column 1 -sticky nwe
    grid [ttk::label $t.analysis.f4.traslation_code.line2 -text {TTTTCCCCAAAAGGGGTTTTCCCCAAAAGGGGTTTTCCCCAAAAGGGGTTTTCCCCAAAAGGGG} -width 65 -justify left -font dnafont] -row 4 -column 1 -sticky nwe
    grid [ttk::label $t.analysis.f4.traslation_code.line3 -text {TCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAGTCAG} -width 65 -justify left -font dnafont] -row 5 -column 1 -sticky nwe
  
    grid [ttk::labelframe $t.analysis.f4.f1 -text [mc "Start Codon"]] -row 2 -column 0 -columnspan 3 -sticky nswe
    set col 0
    foreach codon [list ATG GTG TTG ATA ATT CAG CTG] {
      grid [ttk::checkbutton $t.analysis.f4.f1.start_$codon -variable temp_info(start_codon,$codon) -text $codon] -row 1 -column  [expr {$col}]  -sticky w
      set temp_info(start_codon,$codon) [expr {$codon in $info(start_codons)}]
      incr col
    }
    set temp_info(start_codon,ATG) 1
    $t.analysis.f4.f1.start_ATG state disabled

    grid [ttk::separator $t.analysis.s1 -orient horizontal] -row 5 -column 0 -columnspan 3 -sticky swe
    grid [ttk::frame $t.analysis.f5 -relief flat -borderwidth 3] -row 6 -column 0 -columnspan 2 -sticky nwe
    grid [ttk::label $t.analysis.f5.tm -text [mc "Melting Temperature Prediction"] -justify left ] -row 0 -column 1 -columnspan 3 -sticky nw
    grid [ttk::label $t.analysis.f5.lsalt -text [mc "Salt (mM):"]] -row 1 -column 1 -sticky nw
    grid [entry $t.analysis.f5.esalt -width 10 -textvariable temp_info(primer_salt) -validate all -vcmd "entry_integer %P %W %V 1 1000"] -row 1 -column 2  -sticky nw
    grid [ttk::label $t.analysis.f5.ldna -text [mc "Primer (nM):"]] -row 2 -column 1 -sticky nw
    grid [entry $t.analysis.f5.edna -width 10 -textvariable temp_info(primer_dna) -validate all -vcmd "entry_integer %P %W %V 1 1000"] -row 2 -column 2  -sticky nw

  ###Files options frame
  foreach var [list default_dnadir dnadir_follows_open featuredir_follows_open default_file_format save_file_format_warning default_file_extension max_open_previous restore_on_startup] {
    set temp_info($var) $info($var)
  }
  $t add [ttk::frame $t.files] -text [mc Files] -sticky nswe
  grid [ttk::frame $t.files.f1 -relief flat -borderwidth 2] -row 0 -column 0 -sticky nswe
  grid [ttk::label $t.files.f1.dnalabel -text [mc "Default DNA Directory:"]] -row 0 -column 0 -sticky w
  grid [ttk::label $t.files.f1.dnadir -textvariable temp_info(default_dnadir)] -row 1 -column 0 -columnspan 2 -sticky nsw
  grid [button $t.files.f1.changednadir -text [mc "Change Directory"] -command "set temp_info(default_dnadir) \[tk_chooseDirectory -initialdir \$temp_info(default_dnadir) -mustexist 1 -title \"Choose New DNA Directory...\" -parent $s\]"] -row 2 -column 0 -sticky w
  grid [checkbutton $t.files.f1.follows -text [mc "Follows Last Opened File"] -selectcolor white -onvalue 1 -offvalue 0 -variable temp_info(dnadir_follows_open)] -row 2 -column 1 -sticky w
  grid [ttk::separator $t.files.f1.s1 -orient horizontal] -row 3 -column 0 -columnspan 3 -sticky swe
  grid columnconfigure $t.files.f1 1 -weight 1 -uniform 1

  grid [ttk::frame $t.files.f2 -relief flat -borderwidth 2] -row 1 -column 0 -sticky nswe
  grid [ttk::label $t.files.f2.dnalabel -text [mc "Default Feature Directory:"]] -row 0 -column 0 -sticky w
  grid [ttk::label $t.files.f2.dnadir -textvariable info(default_featuredir)] -row 1 -column 0 -columnspan 2 -sticky nsw
  #grid [button $t.files.f2.changefeadir -text [mc "Change Directory"] -command "set temp_info(default_featuredir) \[tk_chooseDirectory -initialdir \$temp_info(default_featuredir) -mustexist 1 -title \"Choose New Feature Directory...\" -parent $s\]" ] -row 2 -column 0 -sticky w
  grid [button $t.files.f2.changefeadir -text [mc "Move Directory"] -command "move_default_folder default_featuredir $s"] -row 2 -column 0 -sticky w
  if {0} {
    grid [button $t.files.f2.exportfeatures -text [mc "Create Default Feature File"] -command {
      if {(![file exists [file join $temp_info(default_featuredir) "Default_Features.txt"]]) || ([tk_messageBox -message [mc {Replace Default_Features.txt in directory %1$s?} $temp_info(default_featuredir)] -title [mc "Default Features file exists"] -icon question -type yesno -default no] == "yes")} {
          file copy -force [file join $info(Accdir) "Features" "Default_Features.txt"] [file join $temp_info(default_featuredir) "Default_Features.txt"]
      }
    }] -row 3 -column 0 -sticky w
  }
  #grid [checkbutton $t.files.f2.follows -text [mc "Follows Last Opened File"] -selectcolor white -onvalue 1 -offvalue 0 -variable temp_info(featuredir_follows_open)] -row 2 -column 1 -sticky w
  grid [ttk::separator $t.files.f2.s1 -orient horizontal] -row 3 -column 0 -columnspan 3 -sticky swe
  grid columnconfigure $t.files.f2 1 -weight 1 -uniform 1

  grid [ttk::frame $t.files.f3 -relief flat -borderwidth 2] -row 2 -column 0 -sticky nswe
  grid [ttk::label $t.files.f3.dnalabel -text [mc "Default Enzyme Directory:"]] -row 0 -column 0 -sticky w
  grid [ttk::label $t.files.f3.dnadir -textvariable info(default_enzymedir)] -row 1 -column 0 -columnspan 2 -sticky nsw
  #grid [button $t.files.f3.changeenzdir -text [mc "Change Directory"] -command "set temp_info(default_enzymedir) \[tk_chooseDirectory -initialdir \$temp_info(default_enzymedir) -mustexist 1 -title \"Choose New Enzyme Directory...\" -parent $s\] "] -row 2 -column 0 -sticky w
  grid [button $t.files.f3.changeenzdir -text [mc "Move Directory"] -command "move_default_folder default_enzymedir $s"] -row 2 -column 0 -sticky w
  if {0} {
    grid [button $t.files.f3.exportenzymes -text [mc "Create Default Enzyme File"] -command {
      if {(![file exists [file join $temp_info(default_enzymedir) "Default_Enzymes.txt"]]) || ([tk_messageBox -message [mc {Replace Default_Enzymes.txt in directory %1$s?} $temp_info(default_enzymedir)] -title [mc "Default Enzymes file exists"] -icon question -type yesno -default no] == "yes")} {
          file copy -force [file join $info(Accdir) "Enzymes" "Default_Enzymes.txt"] [file join $temp_info(default_enzymedir) "Default_Enzymes.txt"]
      }
    }] -row 2 -column 1 -sticky w
  }
  grid [ttk::separator $t.files.f3.s1 -orient horizontal] -row 3 -column 0 -columnspan 3 -sticky swe
  grid columnconfigure $t.files.f3 1 -weight 1 -uniform 1

  grid [ttk::frame $t.files.f4 -relief flat -borderwidth 2] -row 3 -column 0 -sticky nswe
  grid [ttk::label $t.files.f4.formatlabel -text [mc "Save Files in Format:"]] -row 0 -column 0 -sticky wn
  tk_optionMenu $t.files.f4.format temp_info(default_file_format) GenBank {DNA Strider} FASTA
  grid $t.files.f4.format -row 0 -column 1 -sticky wn
  grid [checkbutton $t.files.f4.formatwarning -text [mc "Warn if Changing File Formats"] -selectcolor white -onvalue 1 -offvalue 0 -variable temp_info(save_file_format_warning)] -row 1 -column 0 -sticky nw -columnspan 2
  grid [checkbutton $t.files.f4.strictformat -text [mc "Strict GenBank Format"] -selectcolor white -onvalue 1 -offvalue 0 -variable temp_info(genbank_strict_genbank)] -row 2 -column 0 -sticky nw -columnspan 2
  grid [checkbutton $t.files.f4.skipblankgenbank -text [mc "Skip Blank Fields in GenBank"] -selectcolor white -onvalue 1 -offvalue 0 -variable temp_info(genbank_skip_blank)] -row 3 -column 0 -sticky nw -columnspan 2
  grid [ttk::label $t.files.f4.extensionlabel -text [mc "Default File Extension"]] -row 4 -column 0 -sticky wn
  tk_optionMenu $t.files.f4.extension temp_info(default_file_extension) {*}$possible_extensions
  grid $t.files.f4.extension -row 4 -column 1 -sticky wn
  grid [ttk::label $t.files.f4.rfileslabel -text [mc "Recently used files list"]] -row 5 -column 0 -sticky wn
  tk_optionMenu $t.files.f4.rfiles temp_info(max_open_previous) 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30
  grid $t.files.f4.rfiles -row 5 -column 1 -sticky wn
  #grid [checkbutton $t.files.f4.restoreonclose -text [mc "Restore Open Files on Startup"] -selectcolor white -onvalue 1 -offvalue 0 -variable temp_info(restore_on_startup)] -row 6 -column 0 -sticky nw -columnspan 2
  grid columnconfigure $t.files.f4 1 -weight 1 -uniform 1

  #autosave
  grid [ttk::separator $t.files.s4 -orient horizontal] -row 4 -column 0 -sticky swe
  grid [ttk::frame $t.files.f5 -relief flat -borderwidth 2] -row 5 -column 0 -sticky nswe
  grid [ttk::label $t.files.f5.asdirlabel -text [mc "Autosave Directory:"]] -row 0 -column 0 -sticky w
  grid [ttk::label $t.files.f5.asdir -textvariable temp_info(autosave_dir)] -row 1 -column 0 -columnspan 2 -sticky nsw
  grid [button $t.files.f5.aschangednadir -text [mc "Change Directory"] -command "set temp_info(autosave_dir) \[tk_chooseDirectory -initialdir \$temp_info(autosave_dir) -mustexist 1 -title \"Choose New Autosave Directory...\" -parent $s\]"] -row 2 -column 0 -sticky w

  grid [ttk::label $t.files.f5.autosavemaxperfilelabel -text [mc "Maximum autosaves per file:"]] -row 3 -column 0 -sticky en
  grid [entry $t.files.f5.autosavemaxperfile -textvariable temp_info(autosave_max_bkp_files) -validate key -vcmd "check_char %S" -width 3 -justify left] -row 3 -column 1 -sticky wn
  grid [ttk::label $t.files.f5.autosavemmaxfileslabel -text [mc "Maximum total files in the directory:"]] -row 4 -column 0 -sticky e
  grid [entry $t.files.f5.autosavemmaxfiles -textvariable temp_info(autosave_max_dir_files) -validate key -vcmd "check_char %S" -width 3 -justify left] -row 4 -column 1 -sticky w
  grid [ttk::label $t.files.f5.autosavemmaxagelabel -text [mc "Maximum autosave file age (days):"]] -row 5 -column 0 -sticky e
  grid [entry $t.files.f5.autosavemmaxage -textvariable temp_info(autosave_max_age_days) -validate key -vcmd "check_char %S" -width 4 -justify left] -row 5 -column 1 -sticky w

  grid [ttk::label $t.files.f5.autosaveminuteslabel -text [mc "Autosave frequency (minutes):"]] -row 6 -column 0 -sticky e
  grid [entry $t.files.f5.autosaveminutes -textvariable temp_info(autosave_minutes) -validate key -vcmd "check_char %S" -width 3 -justify left] -row 6 -column 1 -sticky w

  grid [checkbutton $t.files.f5.autosaveon -text [mc "Autosave ON"] -selectcolor white -onvalue 1 -offvalue 0 -variable temp_info(autosave_on)] -row 8 -column 0 -sticky nw -columnspan 2
  grid columnconfigure $t.files.f5 1 -weight 1 -uniform 1

  grid rowconfigure $t.files 14 -weight 1

  ###Filetypes options frame
  if {[tk windowingsystem] == "win32"} {
    $t add [ttk::frame $t.filetypes] -text [mc Filetypes] -sticky nswe
    global possible_extensions
    #grid [ttk::frame $t.filetypes -relief flat -borderwidth 2] -row 0 -column 1 -sticky nswe
    set registered [get_registered_types]
    set ape_registered [lindex $registered 0]
    set other_registered [lindex $registered 1]
    set other_appl [lindex $registered 2]
    set r 0
    foreach extension $possible_extensions {
      if {[lsearch -exact $ape_registered $extension] > -1} {
        set temp_info($extension,selected) 2
        grid [checkbutton $t.filetypes.button$r -text "$extension"  -selectcolor white -variable temp_info($extension,selected) -onvalue 2 -offvalue 0] -row $r -column 0 -sticky w
      } elseif {[set pos [lsearch $other_registered $extension]] > -1} {
        set temp_info($extension,selected) -3
        grid [ttk::label $t.filetypes.button$r -text [format [mc {%1$s is already: %2$s}] $extension [lindex $other_appl $pos]]] -row $r -column 0 -sticky w
      } else {
        set temp_info($extension,selected) -1
        grid [checkbutton $t.filetypes.button$r -text "$extension" -selectcolor white -variable temp_info($extension,selected) -onvalue 1 -offvalue -1] -row $r -column 0 -sticky w
      }
      incr r
    }
    grid rowconfigure $t.filetypes 14 -weight 1
    $t add [ttk::frame $t.filelockbug] -text [mc "Lock Bug"] -sticky nswe
    grid [checkbutton $t.filelockbug.lockbug -text [mc "Ignore File Writable Status"] -selectcolor white -onvalue 1 -offvalue 0 -variable temp_info(lock_bug)] -row 0 -column 0 -sticky nw -columnspan 2
    grid rowconfigure $t.filelockbug 15 -weight 1
  }


  ###ok buttons frame
  if {!$info(android)} {
    grid [ttk::frame $s.f3 -relief flat] -row 1 -column 0 -columnspan 2 -sticky nswe
    grid [button $s.f3.ok -command "after 300 execute_pref_changes 1" -text [mc "OK"] -default active] -row 0 -column 1 -padx 10 -pady 3
    bind $s <Key-Return> "after 300 execute_pref_changes 1" 
    grid [button $s.f3.cancel -command "after 300 execute_pref_changes -1" -text [mc "Cancel"]] -row 0 -column 0 -padx 10
    grid columnconfigure $s.f3 0 -weight 1 -uniform 1
    grid columnconfigure $s.f3 1 -weight 1 -uniform 1
  }

  grid columnconfigure $s 1 -weight 1
  grid rowconfigure $s 0 -weight 1
  #wm resizable [winfo toplevel $s] 0 0
  #update idletasks

  if {[tk windowingsystem] == "aqua"} {
    set width [winfo reqwidth $s]
    set height [winfo reqheight $s]
    set x [expr { ( [winfo vrootwidth  $s] - $width  ) / 2 }]
    set y [expr { ( [winfo vrootheight $s] - $height ) / 2 }]
    #wm geometry [winfo toplevel $s] ${width}x${height}+${x}+${y}
    #update
  } else {
    regexp {([0-9]*)x([0-9]*)\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry [winfo toplevel $s]] wgeom winw winh winx winy
    if {[expr {$winx+$winw}] > [winfo screenwidth .]} {set winx [expr {[winfo screenwidth .]-$winw}]}
    if {$winx < 0} {set winx 0}
    if {[expr {$winy+$winh}] > [winfo screenheight .]} {set winy [expr {[winfo screenheight .]-$winh}]}
    if {$winy < 0} {set winy 0}
    wm geometry [winfo toplevel $s] "+$winx+$winy"
    #update
  }
  catch {focus $s}

  #if {[llength $info(fixedfontlist)] == 0} {
  #  $t.generaloptions.f1.menubutton1.menu add command -label [mc "Searching for fixed fonts on the system, please wait..."]
  #  get_fixed_fonts
  #} else {
  #  foreach fontfam $info(fixedfontlist) {
  #    $t.generaloptions.f1.menubutton1.menu add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable temp_info(textfontfamily);# -font [list $fontfam 10]
  #  }
  #}


  #grab set $s
}

#############
##
#############
proc move_default_folder {folder  parent} {
  global info

  set old_dir [file dirname [file nativename $info($folder)]]
  set folder_name [file tail $info($folder)]
  set new_location [tk_chooseDirectory -initialdir $old_dir  -title [mc "Choose New Location for %s Directory..."  $folder_name] -parent $parent]
  set new_file_path [file join $new_location $folder_name]
  if {![catch {file copy [file nativename $info($folder)] $new_file_path}]} {
    file delete -force [file nativename $info($folder)]
    set info($folder) $new_file_path
  } 
}

#############
##
#############
proc execute_pref_changes {ok} {
  global info temp_info abi_info temp_abi
  global keysubst
  global allowedkeys possible_extensions

  global current_NCBI_translation_code
  global dialogblock

  destroy .dialog
  set dialogblock 0
  bind . <<RaiseDialogs>> ""

  if {![info exists temp_info(dnafontsize)]} {
    return
  }
  ###execute changes
  if {$ok == 1} {
    set eddict [dict create]
    #text changes
    if {$temp_info(dnafontsize) != $info(dnafontsize)} {
      if {0 && $info(use_cocoa)} {
        foreach we [winfo children .] {
            if {![catch {dict set eddict $we [$we.menubar entrycget {Edit } -menu]}]} {
              $we.menubar entryconfigure {Edit } -menu ""
            }
        }
      }
      font configure dnafont  -family $temp_info(textfontfamily) -size $temp_info(dnafontsize)
      font configure bolddnafont  -family $temp_info(textfontfamily) -size $temp_info(dnafontsize)
      font configure labelfont_half -size [expr {$temp_info(dnafontsize)/2}]
      font configure labelfont -size $temp_info(dnafontsize)
      font configure boldlabelfont -size $temp_info(dnafontsize)
      font configure entryfont -size $temp_info(dnafontsize)
      ttk::style configure Treeview -rowheight  [expr {[font metrics [ttk::style lookup Treeview -font] -linespace] + 1}]
      ttk::style configure Featuretable.Treeview -rowheight [expr {[font metrics [ttk::style lookup Featuretable.Treeview -font] -linespace] + 1}]
      if {0 && $info(use_cocoa)} {
        foreach we [dict keys $eddict] {
            $we.menubar entryconfigure {Edit } -menu [dict get $eddict $we]
        }
      }
    } elseif {$temp_info(textfontfamily) != $info(textfontfamily)} {
      if {0 && $info(use_cocoa)} {
        foreach we [winfo children .] {
            if {![catch {dict set eddict $we [$we.menubar entrycget {Edit } -menu]}]} {
              $we.menubar entryconfigure {Edit } -menu ""
            }
        }
      }
      font configure dnafont  -family $temp_info(textfontfamily) -size $temp_info(dnafontsize)
      font configure bolddnafont  -family $temp_info(textfontfamily) -size $temp_info(dnafontsize)
      if {0 && $info(use_cocoa)} {
        foreach we [dict keys $eddict] {
            $we.menubar entryconfigure {Edit } -menu [dict get $eddict $we]
        }
      }
    }
    if {($temp_info(graphicfontfamily) != $info(graphicfontfamily)) || ($temp_info(graphicfontsize) != $info(graphicfontsize))} {
      font configure graphicfont -family $temp_info(graphicfontfamily) -size $temp_info(graphicfontsize)
    }
    if {($temp_info(locale) != $info(locale))} {
      mclocale $temp_info(locale)
      if {[catch {mcload [file join $info(Accdir) Msgs]} err]} {sputs $err}
    }

    if {(![string is integer $temp_info(comment_height)]) || ($temp_info(comment_height) > 10) ||($temp_info(comment_height) <0)} {
      set temp_info(comment_height) $info(comment_height)
    }

    if {(![string is integer $temp_info(default_textarea_width)]) || ($temp_info(default_textarea_width) > 300) ||($temp_info(default_textarea_width) <0)} {
      set temp_info(default_textarea_width) $info(default_textarea_width)
    }

    if {($temp_info(menu_font_size) != $info(menu_font_size))} {
      #&#option add *Menu.font [list [font configure TkMenuFont -family] $temp_info(menu_font_size)] 40
      font configure menufont -size $temp_info(menu_font_size)
    }

    if {($temp_info(toolbar_size) != $info(toolbar_size))} {
      toolbar_set_icons $temp_info(toolbar_size)
    }

    set temp_info(start_codons) [list]
    foreach codon [list ATG GTG TTG ATA ATT CAG CTG] {
      if {$temp_info(start_codon,$codon)} {
        lappend temp_info(start_codons) $codon
      }
      array unset temp_info start_codon,$codon
    }

   if {$temp_info(inline_mode) ne $info(inline_mode)} {
     set change_inline_mode 1
   } else {
     set change_inline_mode 0
   }

    #######
    ####### apply temp_info to info array
    foreach element [array names temp_info] {
      set info($element) $temp_info($element)
    }


    foreach key [dict keys $info(system_default_colors)] {
      if {$info(dark_mode)} {
        set info($key,dark) $info($key)
      } else {
        set info($key,light) $info($key)
      }
    }

    set info(allowedkeys) [string map {"ACGTN" "ACGTNacgtn*" "ACGT" "ACGTacgt" "degenerate code" "ABCDGHKMNRSTVWYabcdghkmnrstvwy*"  "ACGTU" "ACGTUacgtu" "ACGU" "ACGUacgu" "ACGTUN" "ACGTUNacgtun*" "ACGUN" "ACGUNacgun*"} $allowedkeys] 
    set info(keysubstmap) [list]
    foreach sub [array names keysubst] {
      foreach char [split $keysubst($sub)] {
        if {[string is alpha $char]} {
          lappend info(keysubstmap) [string toupper $char] $sub [string tolower $char] [string tolower $sub]
        } else {
          lappend info(keysubstmap) $char $sub
        }
      }
    }

    recolor_app
    if {$change_inline_mode} {
      change_inline_mode
    }
    
    if {[info exists ::tk::mac::CGAntialiasLimit]} {
      #set ::tk::mac::CGAntialiasLimit $info(mac_antialias_limit)
    }


    #ABI changes
    foreach base [list A C G T N] {
      set abi_info(colors,$base) $temp_abi($base)
    }
    foreach base [list B D H K M R S V W Y -] {
      set abi_info(colors,$base) $temp_abi(non)
    }
    foreach window [winfo children .] { 
      if {([string match ".abi_window*" $window]) && (![string match "*analysis*" $window])} {
        if {$abi_info($window,rev_com)} {
          foreach base [list A C G T N B D H K M R S V W Y] rc_base [list T G C A N V H D K H Y W B S R] {
            $window.c itemconfigure $base -fill $abi_info(colors,$rc_base)
          }
        } else {
          foreach base [list A C G T N B D H K M R S V W Y] {
            $window.c itemconfigure $base -fill $abi_info(colors,$base)
          }
        }
      }
    }
    #filetype changes
    if {[tk windowingsystem] == "win32"} {
      set on_list [list]
      set off_list [list]
      set tot_on 0
      foreach extension $possible_extensions {
        if {$temp_info($extension,selected) > 0} {incr tot_on}
        if {$temp_info($extension,selected) == 0} {lappend off_list $extension}
        if {$temp_info($extension,selected) == 1} {lappend on_list $extension}
      }
      file_typer $on_list $off_list [expr {$tot_on==0}]
    }

    #autosave changes
    if { 0 && $info(autosave_on)} {
      if {![file isdirectory $info(autosave_dir)]} {
        if {[tk_messageBox -type okcancel -message [mc "The autosave directory is invalid, please choose another"] ] == "ok"} {
          set info(autosave_dir) [tk_chooseDirectory -title [mc "New Autosave Directory"]]
        }
      }
      while {![file writable $info(autosave_dir)] && ( $info(autosave_dir) != {})} {
        if {[tk_messageBox -type okcancel -message [mc "The autosave directory is not writable, please choose another"] ] == "ok"} {
          set info(autosave_dir) [tk_chooseDirectory -title [mc "New Autosave Directory"]]
        } else {
          break
        }
      }
      if {![file isdirectory $info(autosave_dir)] || ![file writable $info(autosave_dir)]} {
        tk_messageBox -type ok -message [mc "Autosave has been turned off"]
        set info(autosave_on) 0
      }
    }
    if {0 && $info(autosave_on)} {
      run_autosave
    }
    save_defaults
  }

  array unset keysubst
  array unset temp_info
  array unset temp_abi
  unset -nocomplain allowedkeys transdir ui_icon_color_text

  unset -nocomplain ok current_NCBI_translation_code
}

###########
## recolor the app, including recoloring widgets, recoloring tile widget backgrounds, and applying defaults
###########
proc recolor_app {} {
  global info tcl_platform
    #color changes
    recolor_widget_tree .

  foreach {option color} [list background $info(bg_color) troughColor gray50 activeBackground $info(bg_color) activeForeground black] {
    option add *$option $color
  }    

  catch {style default -background  $info(bg_color)}

  option add *Label.foreground $info(label_fg_color)
  option add *Checkbutton.foreground $info(label_fg_color)
  option add *Radiobutton.foreground $info(label_fg_color)
  option add *Labelframe.foreground $info(label_fg_color)
  if {[tk windowingsystem] ne "aqua"} {
    option add *Menubutton.foreground $info(label_fg_color)
    option add *Menubutton.disabledForeground $info(label_disabled_fg_color)
  }
  option add *Checkbutton.disabledForeground $info(label_disabled_fg_color)
  option add *Radiobutton.disabledForeground $info(label_disabled_fg_color)

  option add *Text.background $info(text_bg_color)
  option add *Text.foreground $info(text_fg_color)
  option add *Text.selectForeground $info(text_select_fg_color) 
  option add *Text.selectBackground $info(text_select_bg_color) 
  option add *Text.inactiveSelectBackground $info(text_select2_bg_color)

  option add *Canvas.background $info(graphic_bg_color)
  option add *Canvas.foreground $info(graphic_fg_color)

  option add *Entry.background $info(text_bg_color)
  option add *Entry.foreground $info(text_fg_color)
  option add *Entry.selectForeground $info(text_select_fg_color) 
  option add *Entry.selectBackground $info(text_select_bg_color) 
  option add *Entry.highlightBackground $info(bg_color)

  ttk::style configure Treeview -fieldbackground $info(text_bg_color)
  ttk::style configure Treeview -background $info(text_bg_color)
  ttk::style configure Treeview -foreground $info(text_fg_color)

  option add *Menu*foreground $info(menu_fg_color)
  option add *Menu*background $info(menu_bg_color)
  option add *Menu*activeBackground $info(menu_select_bg_color)
  option add *Menu*activeForeground $info(menu_select_fg_color)


  option add *Checkbutton.activeBackground $info(bg_color)
  option add *Checkbutton.selectColor white
  option add *Radiobutton.activeBackground $info(bg_color)
  option add *Button.highlightBackground $info(bg_color)

  ttk::style configure TRadiobutton -foreground $info(label_fg_color)
  ttk::style configure TCheckbutton -foreground $info(label_fg_color)
  #ttk::style map TEntry -foreground [list {} $info(text_fg_color)] -fieldbackground [list {} $info(text_bg_color)]  -selectforeground [list {} $info(text_select_fg_color) background $info(text_select2_fg_color)]  -selectbackground  [list {} $info(text_select_bg_color) background $info(text_select2_bg_color)]
 # ttk::style map TSpinbox -foreground [list {} $info(text_fg_color)] -fieldbackground [list {} $info(text_bg_color)] -selectforeground [list {} $info(text_select_fg_color) background $info(text_select2_fg_color)]  -selectbackground  [list {} $info(text_select_bg_color) background $info(text_select2_bg_color)]
  ttk::style map TLabel -foreground [list {} $info(label_fg_color) background $info(label_disabled_fg_color)]
  ttk::style map TRadiobutton -foreground [list {} $info(label_fg_color) pressed $info(label_fg_color) background $info(label_disabled_fg_color) disabled $info(label_disabled_fg_color)]
  ttk::style map TCheckbutton -foreground [list {} $info(label_fg_color) pressed $info(label_fg_color) background $info(label_disabled_fg_color) disabled $info(label_disabled_fg_color)]
  ttk::style map Chip.TButton -foreground [list {} $info(label_fg_color) pressed white background $info(label_disabled_fg_color)]
  ttk::style map TButton -foreground "!pressed $info(label_fg_color) pressed white"
  #ttk::style map TMenubutton -foreground "!pressed $info(label_fg_color) pressed white"
  ttk::style configure TMenubutton -foreground  $info(label_fg_color)
  
  if {$info(color_feature_table_tags)} {
    ttk::style map Featuretable.Treeview -background [list {background selected} $info(text_select2_bg_color) selected $info(text_select_bg_color)] -foreground [list !selected $info(text_fg_color) selected $info(text_select_fg_color)]
  } else {
    ttk::style map Featuretable.Treeview -background [list {!selected} $info(text_bg_color) {background selected} $info(text_select2_bg_color) selected $info(text_select_bg_color)] -foreground [list !selected $info(text_fg_color) selected $info(text_select_fg_color)]
  }

    ## apply background colors to tile widgets (not perfect for radiobutton and checkbutton)
  #sputs recolor $info(bg_color)
  set background_color_image [image create photo -height 20 -width 20]
  set rgb_color [format "\#%04X%04X%04X" {*}[winfo rgb . $info(bg_color)]] 
  $background_color_image put $rgb_color -to 0 0 20 20
  if {[catch {ttk::style element create "Tile_bg_$rgb_color" image [list $background_color_image] -padding {0} -border {0} -sticky news}]} {
    image delete $background_color_image
  }


  if {([tk windowingsystem] == "aqua" || $tcl_platform(platform) == "windows") && $info(bg_color) eq [dict get $info(system_default_colors) bg_color]} {
    ttk::style layout InfoboxStyle.TLabel {Label.padding -sticky nswe -border 0 -children {Label.label -sticky nswe}}
    ttk::style layout TLabel {Label.padding -sticky nswe -border 0 -children {Label.label -sticky nswe}}
    ttk::style layout Horizontal.TScale {Horizontal.Scale.trough -sticky nswe -children {Horizontal.Scale.slider -side left -sticky {}}}
    ttk::style layout TFrame {Frame.border -sticky nswe}
    ttk::style layout Roundframe "roundframe2"
    ttk::style layout TNotebook {Notebook.client -sticky nswe}
    ttk::style layout TSpinbox {Spinbox.buttons -side right -sticky {} -children {Spinbox.uparrow -side top -sticky e Spinbox.downarrow -side bottom -sticky e} Spinbox.field -sticky we -children {Spinbox.textarea -sticky we}}
    #ttk::style layout TCheckbutton {Checkbutton.button -sticky nswe -children {Checkbutton.padding-sticky nswe -children {Checkbutton.label -side left -sticky {}}}}
    #ttk::style layout TRadiobutton {Radiobutton.button -sticky nswe -children {Radiobutton.padding -sticky nswe -children {Radiobutton.label -side left -sticky {}}}}
    #ttk::style layout TButton {Button.button -sticky nswe -children {Button.padding -sticky nswe -children {Button.label -sticky nswe}}}
  } else {
    ttk::style layout InfoboxStyle.TLabel "Tile_bg_$rgb_color -sticky nswe -border 0 -children {Label.label -sticky nswe}"
    ttk::style layout TLabel "Tile_bg_$rgb_color -sticky nswe -border 0 -children {Label.label -sticky nswe}"
    ttk::style layout Horizontal.TScale "Tile_bg_$rgb_color -sticky nswe -children {Horizontal.Scale.trough -sticky nswe -children {Horizontal.Scale.slider -side left -sticky {}}}"
    ttk::style layout TFrame "Tile_bg_$rgb_color -sticky nswe -children {Frame.border -sticky nswe}"
    ttk::style layout Roundframe "Tile_bg_$rgb_color roundframe2"
    ttk::style layout TNotebook "Tile_bg_$rgb_color -sticky nswe -children {Notebook.client -sticky nswe}"
    ttk::style layout TSpinbox "Tile_bg_$rgb_color -sticky nswe -children {Spinbox.buttons -side right -sticky {} -children {Spinbox.uparrow -side top -sticky e Spinbox.downarrow -side bottom -sticky e} Spinbox.field -sticky we -children {Spinbox.textarea -sticky we}}"
    #ttk::style layout TCheckbutton "Checkbutton.button -sticky nswe -children {Tile_bg_$rgb_color -sticky nswe -children {Checkbutton.label -side left -sticky {}}}"
    #ttk::style layout TRadiobutton "Radiobutton.button -sticky nswe -children {Tile_bg_$rgb_color -sticky nswe -children {Radiobutton.label -side left -sticky {}}}"
    #ttk::style layout TButton "Tile_bg_$rgb_color -sticky nswe -children {Button.button -sticky nswe -children {Button.padding -sticky nswe -children {Button.label -sticky nswe}}}"
  }

  ## Material Design-like Tile widgets- set the layout based on the background color and text size
  ui_buttons_set_icons


  ## recolor specific window sub-elements
  foreach w [winfo children .] {
    ## Textarea tag elements
    if {[winfo exists $w.textarea]} {
      #$w.textarea tag configure tempsel -foreground $info(text_select2_fg_color)
      $w.textarea tag configure foundf -background $info(find_forward_highlight)
      $w.textarea tag configure foundr -background $info(find_reverse_highlight)
      $w.horzindex configure -background $info(bg_color) -fg $info(label_fg_color)
      $w.horzindex2 configure -background $info(bg_color) -fg $info(label_fg_color)
      $w.vertindex configure -background $info(bg_color) -fg $info(label_fg_color)

      $w.map configure -background $info(text_bg_color)
      $w.map_zoom configure -background $info(text_bg_color)

      # apply feature colors, if $info(color_feature_table_tags)
      features_to_tree_view $w 

      # recolor the background color values
      toolbar_set_icons $info(toolbar_size)
      fill_toolbar $w
    }
    ## recolor gel bands to match gel foreground and background
    if {[regexp {.dna_window[0-9]+_analysis[0-0]+} $w] && [winfo exists $w.canvas] && [bind $w.canvas <<Info>>] ne {}} {
      catch {digest_color_bands $w}
    }
    ## recolorabi window phred 
    if {[regexp {.abi_window[0-9]+} $w] && [winfo exists $w.c]} {
      set p [$w.c find withtag phred_graph]
      if {[$w.c itemcget $p  -fill] != {}} {
        $w.c itemconfig $p  -fill [mix_color #8080FF $info(graphic_bg_color) 20] -outline [mix_color  #8080FF $info(graphic_bg_color) 35] 
      }
    }
  }

}   

###########
## recolor the app widgets color schemes change
###########
proc recolor_widget_tree {w} {
global info
  foreach child [winfo children $w] {
    recolor_widget_tree $child
  }
  switch [winfo class $w] {
    "Text" {
      set param [list -background $info(text_bg_color) -foreground $info(text_fg_color) -selectforeground $info(text_select_fg_color) -selectbackground $info(text_select_bg_color) -inactiveselectbackground $info(text_select2_bg_color)] 
    }
    "Entry" {
      set param [list -background $info(text_bg_color) -foreground $info(text_fg_color) -selectforeground $info(text_select_fg_color) -selectbackground $info(text_select_bg_color) -highlightbackground $info(bg_color)] 
    }
    "Listbox" {
      set param [list -background $info(text_bg_color) -foreground $info(text_fg_color) -selectforeground $info(text_select_fg_color) -selectbackground $info(text_select_bg_color)] 
    }
    "Menu" {
      set param [list -background $info(menu_bg_color) -foreground $info(menu_fg_color) -activebackground $info(menu_select_bg_color) -activeforeground $info(menu_select_fg_color)]
    }
    "Checkbutton" -
    "Radiobutton" {
      set param [list -background $info(bg_color) -foreground $info(label_fg_color)]
    }
    "Button" {
      set param [list -highlightbackground $info(bg_color) -foreground $info(label_fg_color)]
    }
    "Menubutton" -
    "Labelframe" -
    "Label" {
      set param [list -background $info(bg_color) -foreground $info(label_fg_color)] 
    }
    "Toplevel" -
    "Frame" {
      set param [list -background $info(bg_color)] 
    }
    "Canvas" {
      if {[winfo class [winfo parent $w]] eq "Text"} {
        set param [list -background $info(text_bg_color)] 
      } else {
        set param [list -background $info(graphic_bg_color)] 
       }
     }
    default {
      set param [list]
    }
  }
  foreach {option value} $param {
    $w configure $option $value
  }
}

###########
## recolor menus when color schemes change
###########
proc recolor_menu {m} {
  global info
  $m configure -background $info(menu_bg_color) -foreground $info(menu_fg_color) -activebackground $info(menu_select_bg_color) -activeforeground $info(menu_select_fg_color)
  foreach m2 [winfo children $m] {
    recolor_menu $m2
  }
}


###########
## recolor frames inside Tnotebook or Tlabelframes if using stupid systemWindowBackgroundColor levels
###########
proc recolor_tabframe_bg {t level} {
  foreach e [winfo children $t] {
    set class [winfo class $e]
    if  {$class eq "Frame" || $class eq "TFrame"} {
      $e configure -bg "systemWindowBackgroundColor$level"
      recolor_tabframe_bg $e $level
    } elseif {$class eq "TLabelframe" || $class eq "TFrame"} {
      recolor_tabframe_bg $e [expr {min(7, $level+1)}]
    }
  }
}

###########
## change app to dark mode
###########
proc darkmode_set {mode} {
  global info

  if {$mode == -1} {
    if {$info(user_set_dark_mode) == -1} {
        if {([tk windowingsystem] == "aqua" && [bind . <<DarkAqua>> ] ne {})} {
          set is_dark [tk::unsupported::MacWindowStyle isdark .]
        } elseif {([tk windowingsystem] == "win32" && ![catch {set is_light [registry get {HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Themes\Personalize} "AppsUseLightTheme"]}])} {
          set is_dark [expr {!$is_light}]
        } else {
          set is_dark 0
        }
        if {$info(dark_mode) == $is_dark} {
          return
        }
        set info(dark_mode) $is_dark
    } elseif {$info(dark_mode) == $info(user_set_dark_mode)} {
      return
    } else {
      set info(dark_mode) $info(user_set_dark_mode)
    }
  } else {
    set info(dark_mode) $mode
  }

  foreach key [dict keys $info(system_default_colors)] {
    if {$info(dark_mode)} {
      set info($key) $info($key,dark)
    } else {
      set info($key) $info($key,light)
    }
  }

    if {![catch {winfo rgb . systemWindowBackgroundColor}]} {
	foreach tl [winfo children .] {
	    if {[winfo class $tl] eq "Toplevel"} {
	      catch {tk::unsupported::MacWindowStyle appearance $tl [expr {$info(dark_mode)?"darkaqua":"auto"}]}
            }
	}
    } 
  recolor_app
}
#######
## Change the size and color of icons for checkbuttons, radiobuttons and Icon buttons to match the text size and dark mode
######
proc ui_buttons_set_icons {} {
  global info toolbar_images
  set background_color_image [image create photo -height 20 -width 20]
  set rgb_color [format "\#%04X%04X%04X" {*}[winfo rgb . $info(bg_color)]] 
  $background_color_image put $rgb_color -to 0 0 20 20
  catch {ttk::style element create "Tile_bg_$rgb_color" image [list $background_color_image] -padding {0} -border {0} -sticky news}

  set x "1x"
  set text_size [expr {round([tk scaling]  * [font actual labelfont -size])}]
  if {$text_size < 14} {
    set x "1x"
  } elseif {$text_size < 30} {
    set x "2x"
  } elseif {$text_size < 50} {
    set x "3x"
  } elseif {$text_size < 70} {
    set x "4x"
  } elseif {$text_size < 110} {
    set x "8x"
  } else {
    set x "16x"
  }

  if {$info(dark_mode)} {
    set dark "_dark"
  } else {
    set dark ""
  }
 # sputs setting UI icons: $x Tile_bg_$rgb_color $info(bg_color)
## Can set the size and mode by appending _$darkmode_$x to the button element

  if {$info(bg_color) eq [dict get $info(system_default_colors) bg_color]} {
    ttk::style layout TCheckbutton "MD.TCheckbutton.spacing -side left -sticky w -children {MD.TCheckbutton.button$dark\_$x} Checkbutton.label -sticky w -side left"
    ttk::style layout Switch.MD.TCheckbutton "Checkbutton.label -sticky w -side left MD.TCheckbutton.spacing -side left -sticky nswe -children {Switch.MD.TCheckbutton.button$dark\_$x -side left -sticky w}"
    ttk::style layout TRadiobutton "MD.TRadiobutton.spacing -side left -sticky nswe -children {MD.TRadiobutton.button$dark\_$x -side left -sticky w} TRadiobutton.label -sticky w -side left"
    ttk::style layout Icon.MD.TCheckbutton "Icon.MD.TCheckbutton.hover$dark\_$x -side left -sticky nsew -children {TCheckbutton.image}"
    ttk::style layout Disclosure.Icon.MD.TCheckbutton "Disclosure.Icon.MD.TCheckbutton.button$dark\_$x -side left -sticky w Icon.MD.TCheckbutton.hover$dark\_$x -side left -sticky nsew -children {TCheckbutton.image}"
    ttk::style layout TButton "MD.TButton.spacing -sticky nswe -children {MD.TButton.button$dark\_$x -sticky nswe -children {Button.label  -sticky nswe}}"
    ttk::style layout TMenubutton "MD.TMenubutton.spacing -sticky nswe -children {MD.TMenubutton.button$dark\_$x -sticky nswe -children {TMenubutton.label -sticky ns -side left MD.TMenubutton.disclosure_spacing -sticky e -side right -children { MD.TButton.disclosure$dark\_$x -sticky {}}}}"
  } else {
    ttk::style layout TCheckbutton "Tile_bg_$rgb_color -sticky nswe -children {MD.TCheckbutton.spacing -side left -sticky w -children {MD.TCheckbutton.button$dark\_$x} Checkbutton.label -sticky w -side left}"
    ttk::style layout Switch.MD.TCheckbutton "Tile_bg_$rgb_color -sticky nswe -children {Checkbutton.label -sticky w -side left MD.TCheckbutton.spacing -side left -sticky nswe -children {Switch.MD.TCheckbutton.button$dark\_$x -side left -sticky w}}"
    ttk::style layout TRadiobutton "Tile_bg_$rgb_color -sticky nswe -children {MD.TRadiobutton.spacing -side left -sticky nswe -children {MD.TRadiobutton.button$dark\_$x -side left -sticky w} TRadiobutton.label -sticky w -side left}"
    ttk::style layout Icon.MD.TCheckbutton "Tile_bg_$rgb_color -sticky nswe  -children {Icon.MD.TCheckbutton.hover$dark\_$x -side left -sticky nsew -children {TCheckbutton.image}}"
    ttk::style layout Disclosure.Icon.MD.TCheckbutton "Tile_bg_$rgb_color -sticky nswe  -children {Disclosure.Icon.MD.TCheckbutton.button$dark\_$x -side left -sticky w Icon.MD.TCheckbutton.hover$dark\_$x -side left -sticky nsew -children {TCheckbutton.image}}"
    ttk::style layout TButton "Tile_bg_$rgb_color -sticky nswe -children {MD.TButton.spacing -sticky nswe -children {MD.TButton.button$dark\_$x -sticky nswe -children {Button.label  -sticky nswe}}}"
    
    ttk::style layout TMenubutton "Tile_bg_$rgb_color -sticky nswe -children {MD.TMenubutton.spacing -sticky nswe -children {MD.TMenubutton.button$dark\_$x -sticky nswe -children {TMenubutton.label -sticky ns -side left MD.TMenubutton.disclosure_spacing -sticky e -side right -children { MD.TButton.disclosure$dark\_$x -sticky {}}}}}"
  }


  foreach button [list button_locked button_unlocked fingerprint_on fingerprint_off button_link button_comment button_table] {
    set toolbar_images($button) $toolbar_images($button$dark,$x)
  }
  set toolbar_images(button_info) $toolbar_images(button_info$dark,1x)
  foreach w [winfo children .] {
    #if {[winfo exists [set s $w.findframe]]} {
    #  $s.buttons_frame.edit_features configure -image $toolbar_images(button_edit) 
    #  $s.buttons_frame.seq_info configure -image $toolbar_images(button_info)
    #  $s.buttons_frame.find_orf configure -image $toolbar_images(button_orf)
    #}
    #if {[winfo exists [set s $w.edit_features_frame]]} {
    #  $s.buttons_frame.find  configure -image $toolbar_images(button_find)
    #  $s.buttons_frame.seq_info  configure -image $toolbar_images(button_info)
    #  $s.buttons_frame.find_orf  configure -image $toolbar_images(button_orf)
    #}  
    #if {[winfo exists [set s $w.orf_search_frame]]} {
    #  $s.buttons_frame.edit_features configure -image $toolbar_images(button_edit)
    #  $s.buttons_frame.find configure -image $toolbar_images(button_find)
    #  $s.buttons_frame.seq_info configure -image $toolbar_images(button_info)
    #}
    #if {[winfo exists $w.infoframe]} {
    #  $w.infoframe.find configure -image $toolbar_images(button_find)
    #  $w.infoframe.edit_features configure -image $toolbar_images(button_edit)
    #  $w.infoframe.find_orf configure -image $toolbar_images(button_orf)
    #}
    if {[winfo exists $w.show_feature_table]} {
      $w.show_feature_table configure -image $toolbar_images(button_table)
    }
    if {[winfo exists $w.infobutton]} {
      $w.infobutton configure -image $toolbar_images(button_info)
    }
    
    if {[winfo exists $w.showcomment]} {
      $w.showcomment configure -image $toolbar_images(button_comment)
    }
    if {[winfo exists $w.infoframe.locked]} {
      $w.infoframe.locked configure -image [list $toolbar_images(button_unlocked) selected $toolbar_images(button_locked)]
    }
    if {[winfo exists $w.infoframe.checksum]} {
      if {[info exists info($w,SEGUID)] && $info($w,SEGUID) ne {}} {
        $w.infoframe.checksum configure -image $toolbar_images(fingerprint_on) 
      } else {
        $w.infoframe.checksum configure -image $toolbar_images(fingerprint_off) 
      }
    }
    if {[winfo exists $w.infoframe.linked_abi]} {
      $w.infoframe.linked_abi configure -image $toolbar_images(button_link)
    }
    if {[winfo exists $w.fileframe.linked_abi]} {
      $w.fileframe.linked_abi configure -image $toolbar_images(button_link)
    }
  }

  if {!$info(android)} {
    set x "1x"
    set text_size [expr {round([tk scaling]  * [font actual menufont -size])}]
    if {$text_size < 32} {
      set x "1x"
    } elseif {$text_size < 48} {
      set x "2x"
    } elseif {$text_size < 64} {
      set x "3x"
    } elseif {$text_size < 128} {
      set x "4x"
    } elseif {$text_size < 256} {
      set x "8x"
    } else {
      set x "16x"
    }
    foreach w [winfo children .] {
      if {[winfo exists $w.menubar.filemenu]} {
        set iconlist [list $w.menubar.filemenu [mc New] new $w.menubar.filemenu [mc Open...] open $w.menubar.filemenu [mc Save] save $w.menubar.edit  [mc "Cut"] cut $w.menubar.edit  [mc "Copy"] copy $w.menubar.edit  [mc "Paste"] paste $w.menubar.edit  [mc "Cut Rev-Com"] cut $w.menubar.edit  [mc "Copy Rev-Com"] copy $w.menubar.edit  [mc "Paste Rev-Com"] paste $w.menubar.edit  [mc "Select From-To..."] select $w.menubar.edit  [mc "Jump To..."] jump $w.menubar.edit  [mc "Find..."] find $w.menubar.edit  [mc "Convert to UPPERCASE"] uppercase $w.menubar.edit  [mc "Convert to lowercase"] lowercase $w.menubar.edit  [mc "Reverse-Complement"] reverse_com $w.menubar.enzymes [mc "Enzyme Selector..."] enzymes $w.menubar.enzymes [mc "Graphic Map"] graphic_map $w.menubar.enzymes [mc "Graphic Map +U"] graphic_map $w.menubar.enzymes [mc "Highlight"] highlight_enzymes $w.menubar.enzymes [mc "Clear Highlighting"] highlight_enzymes $w.menubar.enzymes [mc "Digestion"] digest $w.menubar.enzymes [mc "Digestion Dialog..."] digest $w.menubar.enzymes [mc "Text Map..."] text_map $w.menubar.tools [mc "Find PCR Primers..."] find_primers $w.menubar.tools [mc "Align Sequences..."] align  $w.menubar.tools [mc "PCR"] pcr $w.menubar.tools [mc "Recombination Assembler..."] gibson $w.menubar.tools [mc "Gibson Designer"] gibson $w.menubar.tools [mc "Gibson Assembly Wizard"] gibson $w.menubar.tools [mc "Golden Gate Assembler"] golden_gate $w.menubar.tools [mc "Golden Gate Designer"] golden_gate]

        foreach {menu item icon} $iconlist {
          catch {$menu entryconfigure $item  -compound left -image $toolbar_images($icon$dark,$x)} err
        }
      }
    }
  }
      
}


###########
## change app font sizes- requires taking out the Edit menu on aqua due to bug
###########
proc change_app_font_size {size} {
  global info
  if {0 && $info(use_cocoa)} {
    foreach we [winfo children .] {
        if {![catch {dict set eddict $we [$we.menubar entrycget Edit -menu]}]} {
          $we.menubar entryconfigure Edit -menu ""
        }
    }
  }
  set info(dnafontsize) $size
  font configure dnafont  -size $size
  font configure bolddnafont   -size $size
  font configure labelfont -size $size
  font configure labelfont_half -size [expr {$size / 2}]
  font configure boldlabelfont -size $size
  font configure entryfont -size $size
  ttk::style configure Treeview -rowheight  [expr {[font metrics [ttk::style lookup Treeview -font] -linespace] + 1}]
  ttk::style configure Featuretable.Treeview -rowheight [expr {[font metrics [ttk::style lookup Featuretable.Treeview -font] -linespace] + 1}]
  if {0 && $info(use_cocoa)} {
    foreach we [dict keys $eddict] {
        $we.menubar entryconfigure Edit -menu [dict get $eddict $we]
    }
  }
  ui_buttons_set_icons
}

###########
## Save program defaults
###########
proc save_defaults {} {
  global info
  set required_items [list clock_format last_update_check allowedkeys ApE_version use_aqua_system_windows_menu graphicfontsize locale    menu_font_size toolbar_size toolbar_compound  toolbar_label_font toolbar_label_size textfontfamily default_textarea_width default_featuredir default_enzymedir pieces_dir_list graphicfontfamily find_orf_starts default_file_extension methylated_default selection_shows_Trans selection_shows_Trans_upper selection_shows_Trans_dir default_dnadir default_dnadir default_file_format save_file_format_warning max_open_previous open_previous open_at_close restore_on_startup dnadir_follows_open draw_graphic_connectors circ_map_feature_names_centered circ_map_radius linear_map_bump_label featuredir_follows_open  find_reverse_highlight  feature_default_type_colors feature_color_favorites feature_default_fcolor feature_default_rcolor  show_comment comment_height find_forward_highlight find_wrap  enzyme_highlight_color enzyme_highlight_font enzyme_highlight_underline enzyme_highlight_transparent feature_transparency color_feature_table_tags inline_mode inline_canvas_space_height inline_show_second_strand selection_on_top dnafontsize print_formatted print_abi_lines_per_page abi_default_canvas_height abi_default_canvas_width gap_penalty gap_extension_penalty mm_penalty NWmax ignore_NWmax align_blocksize translation_window_copy_highlight align_copy_highlight align_linewidth align_phredtrim align_show_seq_names align_trim_to_alignment genbank_strict_genbank genbank_skip_blank leopard_dialog_bug lock_bug]
  lappend required_items enz_text_dialog_order enz_text_dna_numbers enz_text_show_index enz_text_index_char1 enz_text_index_spacing1 enz_text_index_nums enz_text_index_char2 enz_text_index_spacing2 enz_text_index_char3 enz_text_show_features enz_text_show_hidden_features enz_text_crop_features enz_text_2nd enz_text_graphic_map enz_text_genes enz_text_show_trans enz_text_trans enz_text_show_enz enz_text_enz enz_text_space enz_text_width enz_text_copy_highlight enz_selector_width

  lappend required_items primer_len_min primer_len_max primer_Tm_min primer_Tm_max primer_gc_min primer_gc_max primer_clamp_min primer_clamp_max primer_consec_max primer_scomp_tot_max primer_scomp_adj_max primer_scomp_3_max primer_hcomp_tot_max primer_hcomp_adj_max primer_hcomp_3_max primer_hcomp_oligo primer_check_sc primer_salt primer_dna primer_scan translation_code feature_default_type_gformat gel_min_gray
  lappend required_items primer_len_wt_gt primer_Tm_prefer primer_tmdiff_max primer_use_comp_filter primer_clamp_prefer primer_len_prefer primer_Tm_wt_lt primer_gc_wt_lt primer_gc_prefer primer_Tm_wt_gt primer_clamp_wt_lt primer_gc_wt_gt primer_len_wt_lt primer_use_wt_gt primer_clamp_wt_gt primer_name_string primer_next_number primer_spacing_max primer_template_selection primer_user_default_parameters
  
  lappend required_items rev_gg_max_mismatch rev_gg_max_ry_mismatch gib_min_overlap gib_max_overlap gib_max_nonhom gib_double_nonhom gib_require_circ gib_max_fragments
  lappend required_items gibson_wizard_default_tm gibson_wizard_default_g_tm gibson_wizard_default_tail gibson_wizard_default_tail_side gibson_wizard_default_add_linkers gibson_wizard_default_gibson_deletion gibson_wizard_exo_side
  lappend required_items calc_molar_raction_dict calc_mm_raction_dict
  lappend required_items autosave_on autosave_dir autosave_minutes autosave_max_age_days autosave_max_dir_files autosave_max_bkp_files ui_icon_color


  if {[info exists info(la_api)]} {
    lappend required_items la_api la_uid la_show_password la_store_password la_extension_list la_download_folder
    if {!$info(la_store_password)} {
      set info(la_uid) {}
    }
  }

  lappend required_items "recomb,circularize"
  if {$info(recomb,prototypes,default) ne $info(recomb,prototypes)} {
    lappend required_items "recomb,prototypes"
  }
  if {$info(recomb,sites,default) ne $info(recomb,sites)} {
    lappend required_items "recomb,sites"
  }

  if {$info(android)} {
    lappend required_items tk_scaling
  }

  ##needed to get around the bug in menus- \b is used as a non-printing leader to "-"
  set info(enz_text_index_char2) [string index $info(enz_text_index_char2) end]
  set info(enz_text_index_char1) [string index $info(enz_text_index_char1) end]
  
  lappend required_items start_codons

  set oldfilename [file join $info(user_defaults_dir) "ApE_Defaults.txt"]

  if {[file exists $oldfilename] && [file writable $oldfilename]} {
    #make a unique temporary filename
    set base [file join $info(user_defaults_dir) "O"]
    set i 0
    while {([file exists [set newfilename "$base$i"]])} {incr i}

    #open temp file for writing, old prefs file for reading
    set newfile [open $newfilename w]
    set oldfile [open $oldfilename r]

    set infodict [array get info]
    set saved_items [list]

    ## Save the Light version of colors as the default value of the color
    foreach color [dict keys $info(system_default_colors)] {
      dict set infodict $color [dict get $infodict "$color\,light"]
      lappend required_items $color $color\,dark
    }
    lappend required_items user_set_dark_mode

    #read the prefs file and update values for all items that exist in the info array
    while {[gets $oldfile nextline] != -1} {
      if {([string index $nextline 0] == "#") || ($nextline =="")} {
        puts $newfile $nextline
      } else {
        foreach {param data} [split $nextline \t] {}

        if {[dict exists $infodict $param]} {
          puts $newfile "$param\t[dict get $infodict $param]"
          lappend saved_items $param
        } else {
          puts $newfile $nextline
        }
      }
    }
    close $oldfile

    #add items that should exist but don't
    foreach item $required_items {
      if {[lsearch $saved_items $item] == -1 && [dict exists $infodict $item]} {
        puts $newfile "$item\t[dict get $infodict $item]"
      }
    } 
    close $newfile
    catch {file delete $oldfilename}
    file rename -force $newfilename $oldfilename

  } else {
    warning_dialog "Can't find the \"ApE_Defaults.txt\" file, or file is locked."
  }
}

###########
## clones one info variable into another- used to clone the saved state into the autosaved state, for example
###########
proc info_element_cloner {new_index array old_index op} {
  global info
  if {$op == "write"} {
    set info($new_index) $info($old_index)
  }
}

###########
## saves files that have been edited since last autosave, reschedules autosave
###########
proc run_autosave {} {
  global info
  foreach after $info(autosave_after) {
    after cancel $after
  }
  set info(autosave_after) [list]

#sputs autosave [clock format [clock seconds]]
  if {$info(autosave_on)} {
    if {![file isdirectory $info(autosave_dir)] || ![file writable $info(autosave_dir)]  || ![file readable $info(autosave_dir)]} {
      if {[tk_messageBox -type okcancel -message [mc "The autosave directory is invalid, please choose another"] ] == "ok"} {
        set info(autosave_dir) [tk_chooseDirectory -title [mc "New Autosave Directory"]]
      }
    }
    while {![file writable $info(autosave_dir)] && ( $info(autosave_dir) != {})} {
      if {[tk_messageBox -type okcancel -message [mc "The autosave directory is not writable, please choose another"] ] == "ok"} {
        set info(autosave_dir) [tk_chooseDirectory -title [mc "New Autosave Directory"]]
      } else {
        break
      }
    }
    if {![file isdirectory $info(autosave_dir)] || ![file writable $info(autosave_dir)]} {
      tk_messageBox -type ok -message [mc "Autosave has been turned off"]
      set info(autosave_on) 0
      return
    }

  ## check the autosave directory for old and big files
    set flist [list]
    foreach fname [glob -nocomplain -directory $info(autosave_dir) {*_autosave[0-9][0-9][0-9].ape}] {
      lappend flist [list $fname [file mtime $fname] [file size $fname]]
    }
    set flist [lsort -integer -index 1 $flist] 
    for {set i 0} {$i < [expr {[llength $flist]- $info(autosave_max_dir_files)}] || ([lindex $flist $i 1] != "" && ([lindex $flist $i 1] < [expr {[clock seconds] - 86400*$info(autosave_max_age_days)}]))} {incr i} {
      catch {file delete [lindex $flist $i 0]}
    }


    foreach w [dnawindows_list] {
      if {([info exists info($w,autosaved)] && $info($w,autosaved)) } continue
      set root_filename [file rootname [file tail $info($w,filename)]]
      if {$root_filename==""} {
        set root_filename [wm title $w]
        regsub -all {[\s]} $root_filename "_" root_filename
      }
      set fnamelist [glob -nocomplain -directory $info(autosave_dir) "$root_filename\_autosave\[0-9\]\[0-9\]\[0-9\].ape"]
      if {[llength $fnamelist] < $info(autosave_max_bkp_files)} {
        set i 0
        while {[file exists [set newfilename [file join $info(autosave_dir) "$root_filename\_autosave[format %03d $i].ape"]]] && ($i < 999)} {
          incr i
        }
      } else {
        set oldest_mtime [file mtime [lindex $fnamelist 0]]
        set newfilename [lindex $fnamelist 0]
        foreach fname [lrange $fnamelist 1 end] {
          if {[file mtime $fname] < $oldest_mtime} {
            set oldest_mtime [file mtime "$fname"]
            set newfilename $fname
          }
        }
      }
      if {![catch {set fileid [open $newfilename w]} err_msg]} {
        puts $fileid [genbank_text $w 1]
        close $fileid
        set info($w,autosaved) 1
      } else {
        sputs $err_msg
      }
    }
  }
  lappend info(autosave_after) [after [expr {int(1000*60*$info(autosave_minutes))}] run_autosave]
}

###########
## downloads new ApE from web and updates the application 
###########
proc web_update {} {
  global argv0 info

  set info(web_update_dl_dir) {http://jorgensen.biology.utah.edu/wayned/ape/Download/}
  set appdir [file dir $argv0]
  package require vfs::zip
  if {[lsearch -exact [package names] "vfs::zip"] == -1} {
    tk_messageBox -message [mc "Sorry, zip file package isn't available"] -type ok -icon error
    return
  }
  switch [tk windowingsystem] {
    X11 {
      set dl_filename "ApE_linux_current.zip"
      set zip_dir "zip_volume/ApE"
    }
    win32 {
      set dl_filename "ApE_win_current.exe"
      set zip_dir "zip_volume/ApE"
    }
    aqua {
      set dl_filename "Ape_OSX_current.zip"
      set zip_dir "zip_volume/ApE.app"
      set appdir [eval [concat file join [lrange [file split [file dir $argv0]] 0 end-3]]]
    }
    default {
      set dl_filename ""
      set zip_dir "zip_volume/ApE"
    }
  }

  set error [catch {set http_token [http::geturl "$info(web_update_dl_dir)$dl_filename" -validate 1]} err_msg]
  if {!$error} {
    upvar #0 $http_token state
    array set meta $state(meta)
    ::http::cleanup $http_token
    set web_zip_clock_scan [clock scan $meta(Last-Modified)]
sputs "Zip file was last uploaded [clock format $web_zip_clock_scan]. Clock scan: $web_zip_clock_scan."
    array unset meta
  } else {
    sputs "Error getting zip file date: $err_msg"
    catch {::http::cleanup $http_token}
    set web_zip_clock 0
  }


  set error [catch {set http_token [http::geturl "$info(web_update_dl_dir)$dl_filename" -binary 1]} err_msg]
  if {!$error} {
######need to set the temp file to a place that the user can write to (temp??)
    set tempfilename [file join [tempdir] $dl_filename]
    set tempfile [open $tempfilename w]
    fconfigure $tempfile -translation binary -buffering none
    puts $tempfile [http::data $http_token]
    close $tempfile
    ::http::cleanup $http_token
 
    set zip_file_id [vfs::zip::Mount $tempfilename zip_volume]
    set i 2
    while {!(([set file_list [glob -directory $zip_dir -types f -nocomplain [string repeat /* $i]]] == {}))} {
sputs i:$i, [set dir_list [glob -directory $zip_dir -types d -nocomplain [string repeat /* $i]]]
      foreach incomming $dir_list {
        set existing [eval [concat file join {$appdir} [lrange [file split $incomming] 2 end]]]
sputs $incomming :: $existing
        if {(![file exists $existing])} {
         # sputs needs dir:$existing
        } else {
         # sputs has dir:$existing
        }
      }
      foreach incomming $file_list {
        set existing [eval [concat file join {$appdir} [lrange [file split $incomming] 2 end]]]
        if {(![file exists $existing])} {
          sputs needs:$incomming
        } elseif {[expr {[clock scan [clock format [file mtime $incomming] -format "%m/%d/%y %H:%M:%S" -gmt 1]] - [clock scan [clock format [file mtime $existing] -format "%m/%d/%y %H:%M:%S"]]}] > 0} {
           sputs newer:$incomming [clock format [file mtime $incomming] -gmt 1]
        } else {
           sputs unchanged:$existing [clock format [file mtime $existing] -gmt 1]
        }
      }

      incr i
    }
    vfs::zip::Unmount $zip_file_id zip_volume
    #file delete $tempfilename 
  } else {
    sputs "error copying zip: $err_msg"
  }
}

###########
## Checks for latest version info from web
###########
proc web_version_check {{dialog 0}} {
  global info version
#sputs doing web version check
update
  set info(web_dir)  {http://jorgensen.biology.utah.edu/wayned/ape/}
  set dl_filename "current_version.html"
  set error [catch {set http_token [http::geturl "$info(web_dir)$dl_filename" -timeout 1000]} err_msg]
  if {(!$error) && ([::http::status $http_token] == "ok")} {
    set data [::http::data $http_token]
    catch {::http::cleanup $http_token}
    set windowingsystem ""
    set new_version $version
    foreach line [split $data \n] {
      if {[regexp {([^\\\t]*)\t([^\\\t]*)\t(.*)} $line n windowingsystem variable data]} {
        if {($windowingsystem == [tk windowingsystem]) || ($windowingsystem == "all")} {
          set temp_info($variable) $data
        }
      }
    }
    if {[info exists temp_info(new_version)]} {
      set info(last_update_check) [clock seconds]
      #sputs web new version:$temp_info(new_version)
      if {[package vcompare $temp_info(new_version) $version] > 0} {
        set reply [tk_messageBox -message "There is a new version available ($temp_info(new_version)).\nDo you want to update?" -type yesno -icon info -title [mc "Checking for Updates"]]
        if {$reply == "yes"} {
          if {[info exists  temp_info(url)]} {
            open_url $temp_info(url)
          } else {
            open_url $info(web_dir)
          }
        }
      } elseif {$dialog} {
        tk_messageBox -message "Your current version of ApE is up to date." -type ok -icon info -title [mc "Checking for Updates"]
      }
    } else {
      tk_messageBox -message "Can't get version info from web." -type ok -icon info -title [mc "Checking for Updates"]
#sputs "Can't get version info from web."
    }
  } else {
    if {$error} {
      tk_messageBox -message "Error connecting to web: $err_msg" -type ok -icon info -title [mc "Checking for Updates"]
      #sputs "Error connecting to web: $err_msg"
      catch {::http::cleanup $http_token}
    } elseif {([::http::status $http_token] != "ok")} {
      if {[::http::status $http_token]=="timeout"} {
        tk_messageBox -message "Could not check for web updates, connection timed out. Either the website is down, or you are not connected to the internet" -type ok -icon info -title [mc "Checking for Updates"]
      } else {
        tk_messageBox -message "Error connecting to web: [expr {([::http::status $http_token]!="")?[::http::status $http_token]:""}] [expr {([::http::error $http_token]!="")?[::http:: error $http_token]:""}]." -type ok -icon info -title [mc "Checking for Updates"]
      }
      catch {::http::cleanup $http_token}
    }
  }
}


###########
## coppied from Tcl fileutil
###########
proc tempdir {} {
global tcl_platform env
    set attempdirs [list]

    foreach tmp {TMPDIR TEMP TMP} {
	if { [info exists env($tmp)] } {
	    lappend attempdirs $env($tmp)
	}
    }

    switch $tcl_platform(platform) {
	windows {
	    lappend attempdirs "C:\\TEMP" "C:\\TMP" "\\TEMP" "\\TMP"
	}
	default {
	    lappend attempdirs [file join / tmp]  [file join / var tmp] [file join / usr tmp]
	}
    }

    foreach tmp $attempdirs {
	if { [file isdirectory $tmp] && [file writable $tmp] } {
	    return $tmp
	}
    }

    # If nothing else worked...
    return [tk_chooseDirectory -message [mc "Please select a directory to write temporary files"]]
}

###########
## returns a valid DNA directory
###########
proc valid_default_dir {} {
  global env tcl_platform

    foreach tmp {HOME HOMEPATH} {
	if { [info exists env($tmp)] } {
	    lappend attempdirs $env($tmp)
	}
    }

    switch $tcl_platform(platform) {
	windows {
	    lappend attempdirs [file dirname [file nativename [info nameofexecutable]]] [file dirname [info script]] "C:" "D:"
	}
	default {
          if {[catch {sdltk android}]} {
            ## NOT in Android
	    lappend attempdirs [file join / Applications ApE] [file join / Applications] "/"
          } else {
	    lappend attempdirs INTERNAL_STORAGE
          }
	}
    }

    foreach tmp $attempdirs {
	if { [file isdirectory $tmp]} {
	    return $tmp
	}
    }

    # If nothing else worked...
    return [tk_chooseDirectory -title [mc "Please select a valid working directory"] -mustexist 1]
}

###########
## returns text with all non-ATCG characters removed
###########
proc atgcfilter {s {allowed_keys "acgtACGT"} {message 0}} {

  regsub -all "\[^$allowed_keys\]" $s {} result
  regsub -all "\[$allowed_keys\]" $s {} disallowed
  regsub -all "\n" $disallowed "" disallowed
  regsub -all "\t" $disallowed "" disallowed
  regsub -all "\f" $disallowed "" disallowed
  regsub -all "\ " $disallowed "" disallowed
  regsub -all "\r" $disallowed "" disallowed
  set disallowed [join [lsort -unique [split $disallowed ""]] ""]
  if {$message && ($disallowed != [list])} {
    if {[string length $disallowed] > 100} {
      set disallowed "[string range $disallowed 0 100]..."
    }
    if {[string first N $allowed_keys] > -1} {
      set answer [tk_messageBox -icon warning -title [mc "Disallowed characters being inserted..."] -message [mc "Remove disallowed characters: %s ? \n\n You may remove them (Yes), convert them to N (No), or cancel the insertion (Cancel)." $disallowed] -type yesnocancel -default cancel]
    } else {
      set answer [tk_messageBox -icon warning -title [mc "Disallowed characters being inserted..."] -message [mc "Remove disallowed characters: %s ? \n\n You may remove them (OK) or cancel the insertion (Cancel)." $disallowed] -type okcancel -default cancel]
    }
    if {($answer == "yes") || ($answer == "ok")} {
      return $result
    } elseif {($answer == "no") && ([string first N $allowed_keys] > -1)} {
      regsub -all -nocase "\[^$allowed_keys\]" $s "N" s
      return $s
    } else {
      return ""
    }
  }
  return $result
}


#########
## close window- keep track of open windows, so you can exit if all are closed
#########
proc closewindow {w {exiting 0}} {
  #in aqua, there is a menubar child of .
  set saved_filename ""
  if {$w == ".menubar" || ![winfo exists $w]} {return ""}
  global abi_info
  global info tk_patchLevel

  set proceede 1
  if {[string match "*_analysis*" $w]} {
    #####close an analysis window
     #look at all of the events linked to windows linked to this analysis window
    foreach window $info($w,linked_windows) {
      set templist [list]
      if {![info exists info($window,linked_events)]} {continue}
      foreach event $info($window,linked_events) {
        #if the event doesn't refer to this analysis window, keep it in the list
        if {[winfo exists [lindex $event 0]] && [winfo toplevel [lindex $event 0]] != $w} { 
          lappend templist $event
        }
      }
      set info($window,linked_events) $templist
    }
    array unset info "$w,*"
    if {[winfo exists $w]} {destroy $w}
  } elseif {[string match ".dna_window*" $w]} {
    ####close a dna window
    if {[winfo exists $w] && ([wm state $w] ne "withdrawn")} {
      if {($info($w,saved) == 0)} {
        wm deiconify $w
        raise $w
        set answer [tk_messageBox -icon warning -title [mc "File not saved"] -message [mc "Do you want to save the changes you made to\n%s?" [expr {($info($w,filename)=="")?[wm title $w]:$info($w,filename)}]] -type yesnocancel -default yes -parent $w]
        if {$answer == "yes"} {
          set saved_filename [save_file $w Save]
          if {$saved_filename == ""} {
            set proceede 0
          }
        } elseif {$answer == "cancel"} {
          set proceede 0
        }
      } else {
         set saved_filename $info($w,filename)
      }
    }

    if {$proceede == 1} {
      unlink_analysis_window $w
      if {[winfo exists $w]} {
        # aqua menu bug- have to delete the edit menu first
        set ewm [$w cget -menu]
        set editmenu [$ewm entrycget 1 -menu]  
        if {[set editlabel [$ewm entrycget 1 -label]] eq [mc "Edit "]} {
          $ewm delete 1
        }
        destroy $w
      }
      array unset info "$w,*"
      array unset undo "*,$w"
      if {[llength [array names info $w*]] > 0} {sputs "info array still has elements: [array names info $w*]"}
    }
  } elseif {[string match ".abi_window*" $w]} {
    #####close an abi window
    set saved_filename $abi_info($w,filename)
    unlink_analysis_window $w
    if {[winfo exists $w]} {
      $w.c delete trace
      $w.c delete basecall
      destroy $w.c
      destroy $w
    }
    array unset abi_info "$w,*"
  } else {
    if {[winfo exists $w]} {destroy $w}
  }

  update_windows_menu


  if {([llength [dnawindows_list]] == 0) && ([llength [lsearch -all -inline -regexp [winfo children .] {.abi_window[0-9]+$}]] == 0)} {
    if {!$exiting && (([tk windowingsystem] == "aqua") && ([llength [winfo children .]] <= 2))} {
      wm deiconify .
      wm geometry . 1x1-10-10
    } else {
      exit_with_checks
    }
  }


  if {$proceede} {
    return $saved_filename
  } else {
    return "cancel"
  }
}

########
## Rename exit to final_exit, so exit commands from the outside can be re-directed
########
rename exit exit_proc

proc final_exit {} {
sputs final_exit proc called
  if {[tk windowingsystem] == "win32"} {
    catch {dde servername " "}

  } elseif {[tk windowingsystem] == "aqua"}  {
    catch {. configure -menu ""}
    catch {destroy .menubar}
  }
  exit_proc
}

########
## Exiting, no more dialogs
########
proc exit_with_checks {} {
  global info fea_info option_q

  if {[close_all_windows] eq "cancel"} {return}
  if {[tk windowingsystem] == "aqua"} {
    if {[catch {set restore_on_startup [exec defaults read "Apple Global Domain" NSQuitAlwaysKeepsWindows]}] || ($restore_on_startup && [info exists option_q]) || (!$restore_on_startup && ![info exists option_q]) } {
      set info(open_at_close) [list]
    }
  } else {
    set info(open_at_close) [list]
  }
  unset -nocomplain option_q

  if {$info(enzymes_saved) != 1} {
    if {[tk_messageBox -message [mc "Do you want to save changes to the enzyme set?"] -type yesno -icon question] == "yes"} {
      save_enzymes "" 0
    }
  }
  if {($fea_info(library_file) == "") && ([llength $fea_info(library)] > 0)} {
    if {[tk_messageBox -message [mc "Do you want to save changes to the feature file?"] -type yesno -icon question] == "yes"} {
      save_feature_library
    }
  }

  save_defaults
  final_exit
}

########
## Now, direct exit commands to close all windows
########
proc exit {} {
  exit_with_checks
}



########
## break the event links when a dna window is modified
########
proc unlink_analysis_window {w} {
  global info undo
#unbind all the bound events pointing to $w
  if {![info exists info($w,linked_events)] || $info($w,linked_events) == {} } {return}
  set undo_list [list]
  set clist [list]
  foreach event $info($w,linked_events) {

    if {![winfo exists [lindex $event 0]]} {continue}
    if {[llength $event] == 3} {
      ## Item or tag bindings
      if {[lsearch -exact $clist [lindex $event 0]] == -1} {
        lappend undo_list [list [lindex $event 0] configure -background [[lindex $event 0] cget -background]]
        lappend clist [lindex $event 0]
        if {[tk windowingsystem] ne "aqua"} {
          [lindex $event 0] configure -background gray85
        } else {
          [lindex $event 0] configure -background systemDialogBackgroundActive
        }
      }
      if {[winfo class [lindex $event 0]] == "Text"} {  
        lappend undo_list [list [lindex $event 0] bind [lindex $event 1] [lindex $event 2] [[lindex $event 0] tag bind [lindex $event 1] [lindex $event 2]]]
        [lindex $event 0] tag bind [lindex $event 1] [lindex $event 2] "
          tk_messageBox -message {The window this analysis refers to has been modified.} -parent [winfo toplevel [lindex $event 0]] -icon info -type ok -default ok
          #[lindex $event 0] tag bind [lindex $event 1] [lindex $event 2] {}
        "
      } else {
        lappend undo_list [list [lindex $event 0] bind [lindex $event 1] [lindex $event 2] [[lindex $event 0] bind [lindex $event 1] [lindex $event 2]]]
        [lindex $event 0] bind [lindex $event 1] [lindex $event 2] "
          tk_messageBox -message {The window this analysis refers to has been modified.} -parent [winfo toplevel [lindex $event 0]] -icon info -type ok -default ok
          #[lindex $event 0] bind [lindex $event 1] [lindex $event 2] {}
        "
      }
    } else {
      lappend undo_list [list bind [lindex $event 0] [lindex $event 1] [bind [lindex $event 0] [lindex $event 1]]]
      bind [lindex $event 0] [lindex $event 1] "
        tk_messageBox -message {The window this analysis refers to has been modified.} -parent [winfo toplevel [lindex $event 0]] -icon info -type ok -default ok
       #bind [lindex $event 0] [lindex $event 1] {}
      " 
    }
  }
#take $w out of all the analysis,linked_windows lists
  foreach a [array names info "*,linked_windows"] {
    if {[set i [lsearch -exact $info($a) $w]] != -1 } {
      lappend undo_list [list lappend info($a) [lindex $info($a) $i]]
      set info($a) [lreplace $info($a) $i $i]
    }
  }
  #lappend undo_list [list set info($w,linked_events) $info($w,linked_events)]
  set info($w,linked_events) [list]

  return $undo_list
}

########
## Re-link analysis window using the undo_list from unlink_analysis_window
########
proc relink_analysis_window {w undo_list} {
  global info

  #if {[lsearch [array names info] "$w,linked_events"] == -1} {
  #}
  foreach action $undo_list {
    if {[lindex $action 1] eq "bind"} {
        if {![winfo exists [lindex $action 0]]} {continue} else {
	  lappend info($w,linked_events) [list [lindex $action 0] [lindex $action 2] [lindex $action 3]]
	}
    } elseif { [lindex $action 1] eq "configure"} {
       if {![winfo exists [lindex $action 0]]} {continue} else {
         lappend info($w,linked_events) [list [lindex $action 0] [lindex $action 2] [lindex $action 3]]
       }
    } elseif {([lindex $action 0] eq "bind")} {
      if {![winfo exists [lindex $action 1]]} {continue} else {
        lappend info($w,linked_events) [list [lindex $action 1] [lindex $action 2]]
      }
    } elseif {([lindex $action 0] eq "lappend")} {
      #add $w back to the analysis,linked_windows lists
      if {![regexp {info\((.+),linked_windows} [lindex $action 1] - a] || ![winfo exists $a]} {continue}
    } else {
       sputs "relink error:$action"
    }
    eval $action
  }
}

########
## Close all windows for exit
########
proc close_all_windows {} {
  global info

  set return "close"
  ##close analysis windows first
  foreach window [winfo children .] {
    if {[string first "analysis" $window] > -1} {
      closewindow $window 1
    }
  }
  set info(open_at_close) [list]
  foreach window [winfo children .] {
    #closewindow returns the filename of the window closed, then can make a list of closed files on exit
    if {[set filename [closewindow $window 1]] eq "cancel"} {
      set info(open_at_close) [list]
      set return "cancel"
      break
    } elseif {$filename ne "" } {
      lappend info(open_at_close) $filename
    }
  }
  return $return
}

########
## Make sure the window is on the screen
########
proc window_on_screen {w} {
return
  update idletasks
  if {![winfo exists $w]} {return}
  scan [wm geometry $w] "%dx%d+%d+%d" winw winh winx winy
  if {[expr $winx + $winw] > [lindex [wm maxsize .] 0]} {set winx [expr {[winfo screenwidth $w]-$winw}]}
  if {[expr $winy + $winh] > [lindex [wm maxsize .] 1]} {set winy [expr {[winfo screenheight $w]-$winh}]}
  if {$winx < 20} {set winx 20}
  if {($winy < 20)} {set winy 20}
  wm geometry $w +$winx+$winy
}

########
## set the selection in the textbox (Shift-arrow)
########
proc textkeyselect {w direction} {
global info
  if {1} {
    switch $direction {
      Left {
        set pos [$w.textarea index insert-1c]
        if {[$w.textarea compare $pos == "$pos lineend"]} {
          if {$info(inline_mode)} {
            set pos [$w.textarea index $pos-3c]
          } else {
            set pos [$w.textarea index $pos-1c]
          }
        }
      }
      Right {
        if {$info(inline_mode)} {
          set pos [$w.textarea index insert+1c]
          if {[$w.textarea compare $pos == "$pos lineend"] || [$w.textarea compare $pos+3c >= end]} {
            if {[$w.textarea compare $pos+3c < end]} {
              set pos [$w.textarea index $pos+3c]
            } else {
              set pos [$w.textarea index end-3c]
            }
          }
        } else {
          set pos [$w.textarea index insert+1c]
          if {[$w.textarea compare $pos == "$pos lineend"]} {
            if {[$w.textarea compare $pos+1c < end]} {
              set pos [$w.textarea index $pos+1c]
            } else {
              set pos [$w.textarea index insert]
            }
          }
        }
      }
      Up {
        if {[$w.textarea compare 1.0 < "insert linestart"]} {
          if {$info(inline_mode)} {
            set pos [$w.textarea index insert-2line]
          } else {
            set pos [$w.textarea index insert-1line]
          }
        } else {
          set pos [$w.textarea index insert]
        }
      }
      Down {
        if {$info(inline_mode)} {
          if {[$w.textarea compare end > insert+2line]} {
            set pos [$w.textarea index insert+2line]
          } else {
            set pos [$w.textarea index insert]
          }
        } else {
          if {[$w.textarea compare end > insert+1line]} {
            set pos [$w.textarea index insert+1line]
          } else {
            set pos [$w.textarea index insert]
          }
        }
      }
    } 
  }

  set new $pos
  if {[string equal [$w.textarea tag nextrange sel 1.0 end] ""]} {
    if {[$w.textarea compare $new < insert]} {
      $w.textarea tag add sel $new insert
#selection used here - set 
    } else {
      $w.textarea tag add sel insert $new
#selection used here - set
    }
    $w.textarea mark set anchor insert
    $w.textarea mark set tk::anchor$w.textarea insert
  } else {
    if {[$w.textarea compare $new < tk::anchor$w.textarea]} {
      set first $new
      set last tk::anchor$w.textarea
    } else {
      set first tk::anchor$w.textarea
      set last $new
    }
    $w.textarea tag remove sel 1.0 $first
    $w.textarea tag add sel $first $last
    $w.textarea tag remove sel $last end
#selection used here - set
  }
  $w.textarea mark set insert $new
  $w.textarea see insert

  vertindexbalancer $w
  selection_manager $w
  update idletasks
}

########
## set the cursor in the textbox
########
proc textsetcursor {w pos} {
  global info
    if {[$w.textarea compare $pos == end]} {
      if {$info(inline_mode)} {
        set pos {end - 3 chars}
      } else {
        set pos {end - 1 chars}
      }
    }
    $w.textarea mark set insert $pos
    $w.textarea mark set anchor insert
    $w.textarea mark set tk::anchor$w.textarea insert
    $w.textarea tag remove sel 1.0 end
    $w.textarea tag remove tempsel 1.0 end
    $w.textarea see insert

    vertindexbalancer $w
    selection_manager $w
}

########
## move the cursor in the textbox (arrow movements)
########
proc textarea_move_cursor {w direction} {
global info
  if {1} {
    switch $direction {
      Left {
        set pos [$w.textarea index insert-1c]
        if {[$w.textarea compare $pos == "$pos lineend"]} {
          if {$info(inline_mode)} {
            set pos [$w.textarea index $pos-3c]
          } else {
            set pos [$w.textarea index $pos-1c]
          }
        }
      }
      Right {
        if {$info(inline_mode)} {
          set pos [$w.textarea index insert+1c]
          if {[$w.textarea compare $pos == "$pos lineend"] || [$w.textarea compare $pos+3c >= end]} {
            if {[$w.textarea compare $pos+3c < end]} {
              set pos [$w.textarea index $pos+3c]
            } else {
              set pos [$w.textarea index end-3c]
            }
          }
        } else {
          set pos [$w.textarea index insert+1c]
          if {[$w.textarea compare $pos == "$pos lineend"]} {
            if {[$w.textarea compare $pos+1c < end]} {
              set pos [$w.textarea index $pos+1c]
            } else {
              set pos [$w.textarea index insert]
            }
          }
        }
      }
      Up {
        if {[$w.textarea compare 1.0 < "insert linestart"]} {
          if {$info(inline_mode)} {
            set pos [$w.textarea index insert-2line]
          } else {
            set pos [$w.textarea index insert-1line]
          }
        } else {
          set pos [$w.textarea index insert]
        }
      }
      Down {
        if {$info(inline_mode)} {
          if {[$w.textarea compare end > insert+2line]} {
            set pos [$w.textarea index insert+2line]
          } else {
            set pos [$w.textarea index insert]
          }
        } else {
          if {[$w.textarea compare end > insert+1line]} {
            set pos [$w.textarea index insert+1line]
          } else {
            set pos [$w.textarea index insert]
          }
        }
      }
    } 
  }
  textsetcursor $w $pos
}

########
## return the index of the closest gap to a mouse press
########
proc text_closest_gap {w x y} {
global info
    if {$y < 1} {
      set y 3
    }
    if {$y >= [winfo height $w]} {
      set y [expr {[winfo height $w]-5}]
    }
    set pos [$w index @$x,$y]
    set bbox [$w bbox $pos]

    #check for pointing at an inline canvas, and select the line above
    if {$info(inline_mode) && ($bbox ne "") && [expr {int($pos) %2}] == 0} {
      if {[$w index @1,1] == $pos} {
        $w yview [$w index $pos-1line]
      }
      set pos [$w index @$x,[expr {[lindex $bbox 1] -2}]]
      set bbox [$w bbox $pos]
    }


    if {($bbox ne "") && ($x - [lindex $bbox 0]) >= ([lindex $bbox 2]/2)} {
      set pos [$w index $pos+1char]
    }
    if {[$w compare $pos == "$pos lineend"]} {
      set pos [$w index $pos+1c]
    }
    return $pos
}

########
## handle shift-click in sequence windows
########
proc text_reset_anchor {w index} {
    if {[$w tag ranges sel] eq ""} {
	# Don't move the anchor if there is no selection now; this
	# makes the widget behave "correctly" when the user clicks
	# once, then shift-clicks somewhere -- ie, the area between
	# the two clicks will be selected. [Bug: 5929].
	return
    }
    set anchorname tk::anchor$w
    set a [$w index $index]
    set b [$w index sel.first]
    set c [$w index sel.last]
#selection used here - set
    if {[$w compare $a < $b]} {
	$w mark set $anchorname sel.last
	$w mark set anchor sel.last
	return
    }
    if {[$w compare $a > $c]} {
	$w mark set $anchorname sel.first
	$w mark set anchor sel.first
	return
    }
    scan $a "%d.%d" lineA chA
    scan $b "%d.%d" lineB chB
    scan $c "%d.%d" lineC chC
    if {$lineB < $lineC+2} {
	set total [string length [$w get $b $c]]
	if {$total <= 2} {
	    return
	}
	if {[string length [$w get $b $a]] < ($total/2)} {
	    $w mark set $anchorname sel.last
	    $w mark set anchor sel.last
	} else {
	    $w mark set $anchorname sel.first
	    $w mark set anchor sel.first
	}
	return
    }
    if {($lineA-$lineB) < ($lineC-$lineA)} {
	$w mark set $anchorname sel.last
	$w mark set anchor sel.last
    } else {
	$w mark set $anchorname sel.first
	$w mark set anchor sel.first
    }
}

########
## configure the mouseindex and info box for textarea motion events
########
proc mouseover_info {w index} {
   global info
  if {$index > 0} {
    #$w.mouseindex configure -text [expr {1+[ix2bp $w.textarea $index]}]
    if {!$info(android)} {
      $w.infoframe.mouseindex configure -text [expr {1+[ix2bp $w.textarea $index]}]
    }
    set info1 [list]
    foreach tag [$w.textarea tag names $index] {
      if {[regexp {f[0-9]+#} $tag]} {
        if {([$w.textarea tag cget $tag -background] != {}) && [set name [lindex [$w.textarea tag bind $tag <<Metadata>>] 0]] != ""} {
          lappend info1 $name
        }
      } elseif {[lindex [$w.textarea tag bind $tag <<Metadata>>] 2] == "enzyme"} {
        #set name [lindex [$w.textarea tag bind $tag <<Metadata>>] 0]
        #lappend info "$name\([enz_count $w $name all]):[lindex [$w.textarea tag bind $tag <<Metadata>>] 4]"
        lappend info1 "[lindex [$w.textarea tag bind $tag <<Metadata>>] 0]:[lindex [$w.textarea tag bind $tag <<Metadata>>] 4]"
      }
    }
    $w.infobox configure -text [join $info1 ","]
    if {![info exists info($w,seq_tooltip)]} {
      set info($w,seq_tooltip) 0
    }
    if {$info($w,seq_tooltip) && (([focus -displayof $w] eq "$w.textarea") || ([focus -displayof $w] eq "$w.tvframe.tv") || ([focus -displayof $w] eq "$w.comframe.comtextframe.text")) && [winfo ismapped $w]} {
      catch {after cancel $info($w,seq_tooltip_after)}
      set info($w,seq_tooltip_after) [after 70 "if {[list [$w.textarea bbox $index]] ne {}} {seq_tooltip_post $w [lindex [$w.textarea bbox $index] 0]  [lindex [$w.textarea bbox $index] 1]}"]
    } elseif {$info($w,seq_tooltip) && ([focus -displayof $w] eq "$w.seqtooltip")} {
    } else {
      catch {destroy $w.seqtooltip}
    }


  } else {
    if {!$info(android)} {
      $w.infoframe.mouseindex configure -text ""
    }
    $w.infobox configure -text ""
    catch {after cancel $info($w,seq_tooltip_after)}
    catch {destroy $w.seqtooltip}
  }
}

#######
## post tooltip over sequence window
#######
#### NOT USED
proc seq_tooltip_post0 {w x y} {
  global ::tcl_platform
  if {![winfo exists $w] || [catch {$w.textarea index @$x,$y}]} return
  set textbox $w.textarea
  set index [$textbox index @$x,$y]  
  seq_tooltip_create $w
  foreach {tt_height tt_width} [seq_tooltip_update $w [$w.textarea index "$index linestart"] [$w.textarea index "$index lineend"] $w.seqtooltip.c] {}
  if {$tt_height == 0} {
    catch {destroy $w.seqtooltip}
  } else {
##set the geometry here- currently centers on the selected region, could draw the width of the textarea
    #wm geometry $w.seqtooltip "+[expr {[winfo rootx $textbox]+$x- ($tt_width/2)+7 }]+[expr {[winfo rooty $textbox]+$y- $tt_height-19}]"
    if {([tk windowingsystem] == "aqua") && ($::tcl_platform(osVersion)<11)} {
      wm geometry $w.seqtooltip "+[expr {[winfo rootx $textbox]}]+[expr {[winfo rooty $textbox]+$y- $tt_height-9}]"
    }
  }
}

#######
## post tooltip over sequence window
#######
##new version- re-creates the .seqtooltip window with every new posting- avoids the lion bug of no re-geometry of a toplevel.
proc seq_tooltip_post {w x y} {
  global info 
  if {![winfo exists $w] || [catch {$w.textarea index @$x,$y}]} return
  set start [$w.textarea index "@$x,$y linestart"]
  if {([winfo exists $w.seqtooltip]) && ([bind $w.seqtooltip <<Start>>]== $start)} {return}
  catch {destroy $w.seqtooltip}
  toplevel $w.seqtooltip  -borderwidth 1 -background black
  if {([tk windowingsystem] == "aqua")} {
    wm overrideredirect $w.seqtooltip 1
#after 40 "catch \{focus $w.seqtooltip; raise $w.seqtooltip\}"
    #tk::unsupported::MacWindowStyle style $w.seqtooltip help {}; after 40 "catch \{focus $w.seqtooltip; raise $w.seqtooltip\}"
  } else { 
    wm overrideredirect $w.seqtooltip 1
  }
  catch {wm attributes $w.seqtooltip -alpha $info(seq_tooltip_alpha)}
  wm geometry $w.seqtooltip "+[expr {[winfo rootx $w.textarea]}]+[expr {[winfo rooty $w.textarea]+$y+15}]"
  grid [canvas $w.seqtooltip.c -background $info(text_bg_color) -width [expr {[winfo width $w.textarea]-9}] -height 60] -row 0 -column 0 -sticky nswe
  foreach {tt_height tt_width} [seq_tooltip_update $w [$w.textarea index "[$w.textarea index @$x,$y] linestart"] [$w.textarea index "[$w.textarea index @$x,$y] lineend"] $w.seqtooltip.c] {}
  if {$tt_height == 0} {
    catch {destroy $w.seqtooltip}
  } else {
    bind $w.seqtooltip <<Start>> $start
  }

}


#######
## create tooltip window over sequence (called by seq_tooltip_post)
#######
#### NOT USED
proc seq_tooltip_create {w} {
  global info ::tcl_platform
sputs create
  if {[winfo exists $w.seqtooltip]} {
    return
  }
  toplevel $w.seqtooltip  -borderwidth 1 -background black
  if {([tk windowingsystem] == "aqua")} {
    tk::unsupported::MacWindowStyle style $w.seqtooltip help {}
  } else { 
    wm overrideredirect $w.seqtooltip 1
  }
  catch {wm attributes $w.seqtooltip -alpha $info(seq_tooltip_alpha)}
  if {([tk windowingsystem] == "aqua") && ($::tcl_platform(osVersion)>11)} {
    wm geometry $w.seqtooltip "+[expr {[winfo rootx $w.textarea]}]+[expr {[winfo rooty $w.textarea]}]"
  }
  set seq_width [expr {[winfo width $w.textarea]-9}]
  grid [canvas $w.seqtooltip.c -background $info(graphic_bg_color) -width $seq_width -height 60] -row 0 -column 0 -sticky nswe
  #$w.seqtooltip.c create text 10 10 -tags infotext

}

#######
## update info in sequence tooltip window (called by seq_tooltip_post)
#######
proc seq_tooltip_update {w start_index end_index to_canvas {font dnafont}} {
  global info enzinfo
  #set to_canvas $w.seqtooltip.c
  #set start_index [$w.textarea index "$index linestart"]
  #set end_index [$w.textarea index "$index lineend"]
  set start [ix2bp $w.textarea $start_index]
  set end [ix2bp $w.textarea $end_index]

  if {$start >= $end} {return [list 0 0]}
  #set line_width [lindex [$w.textarea dlineinfo $index] 2]
  set line_width [font measure $font [string repeat "A" [expr {$end-$start}]]]
  #set seq_width [expr {[winfo width $w.textarea]-9}]
  set seq_width [expr {$line_width-3}]



##draw tooltip canvas here
  #$to_canvas delete all
  canvas_delete_all $to_canvas

  set total_length [expr {$end-$start}]
  set templist [feature_find $w $start $end]


  #draw enzymes
  foreach enzyme  [lsearch -inline -regexp -all -not [$w.textarea tag names] {trans[0-9]+#|f[0-9]+#|fn[0-9]+#|tempsel|sel|foundf|foundr}] {
    if {[$w.textarea tag ranges $enzyme] == {}} {continue}
    if {![info exists info($w,$enzyme)] || !$info($w,scanned)} {
      findenzymes $w
    }
    if {1} {
      set sitecount 0
      foreach site $info($w,$enzyme) {
        if {[expr {$site-$start+30}] > 0} {

  #sputs here $enzyme $site $enzinfo(enz_cut_sites,$enzyme) $sitecount [lindex $info($w,enzdir,$enzyme) $sitecount]
          set seqstart [expr {1.0*($site-$start-1)/$total_length*$line_width}]
          set seqend [expr {1.0*($site-1-$start+[string length $enzinfo(flatpat,$enzyme)])/$total_length*$line_width}]
          if {[lindex $info($w,enzdir,$enzyme) $sitecount]} {
            set cut5 [expr {1.0*($site-1-$start+[string length $enzinfo(flatpat,$enzyme)]-[lindex $enzinfo(enz_cut_sites,$enzyme) 1])/$total_length*$line_width}]
            set cut3 [expr {1.0*($site-1-$start+[string length $enzinfo(flatpat,$enzyme)]-[lindex $enzinfo(enz_cut_sites,$enzyme) 0])/$total_length*$line_width}]
          } else {
            set cut5 [expr {1.0*($site-1-$start+[lindex $enzinfo(enz_cut_sites,$enzyme) 0])/$total_length*$line_width}]
            set cut3 [expr {1.0*($site-1-$start+[lindex $enzinfo(enz_cut_sites,$enzyme) 1])/$total_length*$line_width}]
          }

          if {[expr {1.0*max($seqend, $cut5, $cut3)}] <= 0} {
            incr sitecount
            continue
          }
          if {[expr {1.0*min($seqstart, $cut5, $cut3)/$line_width}] >= 1} break

#sputs here $enzyme [expr {1.0*max($seqend, $cut5, $cut3)/$line_width*$total_length}] $seqend, $cut5, $cut3 $line_width $total_length

          set enzy 0
          while {([$to_canvas find overlapping [expr {min($seqstart, $cut5, $cut3)}] [expr {-3-$enzy}] [expr {max($seqend, $cut5, $cut3)}] [expr {-9-$enzy}]] != {}) && ($enzy < [expr {5*(7+[font metrics graphicfont -linespace])}])  } {
            incr enzy [expr {7+[font metrics graphicfont -linespace]}]
          }
          $to_canvas create line $seqstart [expr {-5-$enzy}] $seqend [expr {-5-$enzy}] -width 2
          $to_canvas create line $cut5 [expr {-5-$enzy}] $cut5 [expr {-9-$enzy}] -width 2
          $to_canvas create line $cut3 [expr {-5-$enzy}] $cut3 [expr {-1-$enzy}] -width 2
          if {[expr {min($cut5,$cut3)}] < $seqstart} {
            $to_canvas create line $seqstart [expr {-5-$enzy}] [expr {min($cut5,$cut3)}] [expr {-5-$enzy}] -width 1 -dash {3 3}
          }
          if {[expr {max($cut5,$cut3)}] > $seqend} {
            $to_canvas create line $seqend [expr {-5-$enzy}] [expr {max($cut5,$cut3)}] [expr {-5-$enzy}] -width 1 -dash {3 3}
          }
          $to_canvas create text [expr {max(0,1.0*($site-$start-1)/$total_length*$line_width)}] [expr {-7-$enzy}] -anchor sw -text "$enzyme" -font graphicfont -fill $info(text_fg_color)
        }
        incr sitecount
      }
    }
  }

  if {![info exists info($w,trans_dict)]} {
    set info($w,trans_dict) {}
  }
  set feature_spacing [expr {[font metrics [list $info(graphicfontfamily) $info(graphicfontsize)] -linespace] + 15* $info(tk_scaling)}]
  #draw features
  foreach {name tag} $templist {
    regsub "fn" $tag "f" tag
    set yplus 0

    #need to copy this feature and take out all feature links
    seq_tooltip_linear_feature_draw $to_canvas [expr {$yplus*$feature_spacing}] $w $start $end $total_length $tag $line_width

    ##add translation lines
    if {[dict exists $info($w,trans_dict) $tag]  && [regexp {[^\s]} [string range [dict get $info($w,trans_dict) $tag] $start $end]]} {
      set transy [lindex [$to_canvas bbox $tag] 3]
      $to_canvas create text [expr {0}] [expr {$transy}] -anchor nw -text [string range [dict get $info($w,trans_dict) $tag] $start $end]] -font dnafont -fill $info(text_fg_color) -tags $tag
      incr transy [expr {1+[font metrics dnafont -linespace]}]
      $to_canvas create text [expr {0}] [expr {$transy}] -anchor nw -text [string range [dict get $info($w,cds_dict) $tag] $start $end]] -font dnafont -fill $info(text_fg_color) -tags $tag
    }
  }

  ## use feature bump to arrage features vertically- this takes the length of the labels into account, not just the feature
  linear_map_bump_all_features $to_canvas

  if {[$to_canvas bbox feature]!= {}} {
    $to_canvas move feature 0 [expr {-[lindex [$to_canvas bbox feature] 1]}]
  }

  set bbox [$to_canvas bbox all]
  if {$bbox == [list]} {
    set bbox [list 0 0 $seq_width 0]
  } else {
    set bbox [list 0 [lindex $bbox 1] $seq_width [lindex $bbox 3]]
  }


  set bbox [$to_canvas bbox all]
  if {$bbox == [list]} {
    set bbox [list 0 0 $seq_width 0]
  } else {
    set bbox [list 0 [lindex $bbox 1] $seq_width [lindex $bbox 3]]
  }

  ##add Phred trace 
  if {[info exists info($w,phred_string)] && $info($w,phred_string) ne {}} {
    set sub_phred [string range $info($w,phred_string) $start $end]
    $to_canvas create polygon  {*}[create_phred_string_coords $sub_phred $line_width]  -fill blue -outline black -width 1 -tags [list phred]
    $to_canvas move phred 0 [expr {[lindex $bbox 3] + 60}]
    $to_canvas create line 0  [expr {[lindex $bbox 3] + 60 - 20}] $seq_width [expr {[lindex $bbox 3] + 60 - 20}] 
    $to_canvas create line 0  [expr {[lindex $bbox 3] + 60 - 40}] $seq_width [expr {[lindex $bbox 3] + 60 - 40}] 
    $to_canvas create line 0  [expr {[lindex $bbox 3] + 60 - 60}] $seq_width [expr {[lindex $bbox 3] + 60 - 60}] 
  }
  

  set bbox [$to_canvas bbox all]
  if {$bbox == [list]} {
    set bbox [list 0 0 $seq_width 0]
  } else {
    set bbox [list 0 [lindex $bbox 1] $seq_width [lindex $bbox 3]]
  }

  $to_canvas xview moveto 0
  $to_canvas configure -scrollregion $bbox -width $seq_width -height [expr {[lindex $bbox 3]-[lindex $bbox 1]}]
  return [list [expr {[lindex $bbox 3]-[lindex $bbox 1]}] [expr {[lindex $bbox 2]-[lindex $bbox 0]}]]
}

#######
## draw feature arrows in the seq tooltip window
#######
proc seq_tooltip_linear_feature_draw {c y w start end total_length tag x_right} {
  global info modifier

  set ranges [feature_coords $w $tag $start $end]
  if {$ranges eq {}} {
    set ranges [list [list $end $end]]
  }
  if {[$w.textarea tag cget $tag -background] == ""} {
    return
  } else {
    set state "normal"
  }
  set tag_color [format "\#%04X%04X%04X" {*}[winfo rgb . [lindex [$w.textarea tag bind $tag <<Revcolors>>] [lindex [$w.textarea tag bind $tag <<Metadata>>] 3]]]]
  set tags [list $tag feature]
  set direction [lindex [$w.textarea tag bind $tag <<Metadata>>] 3]
  set label [lindex [$w.textarea tag bind $tag <<Metadata>>] 0]
  set gformat [lindex [$w.textarea tag bind $tag <<Metadata>>] 1]

  set width [dict get $gformat width]
  if {$width == ""} {set width 1}
  set width [expr {$width * $info(tk_scaling)}]

  if {[dict exists $gformat outline_width]} {
    set tag_outline_width [dict get $gformat outline_width]
  } else {
    set tag_outline_width 1
  }
  set tag_outline_width [expr {$tag_outline_width * $info(tk_scaling)}]

  #set arrow_list [dict get $gformat arrow_data]
  set fntag [regsub f $tag fn]
  if {[dict exists $gformat outline_color_$direction]} {
    set tag_bg_color [dict get $gformat outline_color_$direction]
  } else {
    set tag_bg_color [gray_color $tag_color]
  }


  set x_left 0

  # draw first intron, if needed
## linear intron configure here
  set tags_at_start [$w.textarea tag names [bp2ix $w.textarea $start]]
  if {([lsearch $tags_at_start $tag] == -1) && ([lsearch $tags_at_start [regsub f $tag fn]] > -1)} {
    set x1 0
    set x2 [expr {$x_left + $x_right * ([lindex $ranges 0 0] - $start+1) / $total_length}]
    $c create line 0 [expr {$y+$width/2.0}] [expr {($x1+$x2)/2.0}]  [expr {$y+$width/2.0+5}] $x2 [expr {$y+$width/2.0}] -tag [concat $tags intron foreground] -state normal -fill $tag_color -width 2
  }

  #draw first through 2nd to last exon and all introns (no exons drawn if only one exon)
  foreach range1 [lrange $ranges 0 end-1]  range2 [lrange $ranges 1 end] {
    set x1 [expr {$x_left + $x_right * ([lindex $range1 0] - $start) / $total_length}]
    set x2 [expr {$x_left + $x_right * ([lindex $range1 1] - $start+1) / $total_length}]

    $c create rectangle [expr {$x1+$tag_outline_width}] [expr {$y-$width/2.0}] [expr {$x2-$tag_outline_width}] [expr {$y+$width/2.0}] -tag [concat $tags exon outline] -fill $tag_bg_color -outline $tag_bg_color -state normal -width $tag_outline_width
    $c create rectangle $x1 [expr {$y-$width/2.0}] $x2 [expr {$y+$width/2.0}] -tag [concat $tags exon foreground] -fill $tag_color -state normal -outline {}
    if {$range2 != [list]} {
      #draw intron
      set x1 [expr {$x_left + $x_right * ([lindex $range2 0] - $start) / $total_length}]
      if {($x1 >= $x2)} {
        $c create line [expr {$x2+0}] [expr {$y+$width/2.0}] [expr {($x1+$x2)/2.0}]  [expr {$y+$width/2.0+5}] $x1 [expr {$y+$width/2.0}] -tag [concat $tags intron foreground] -state normal -fill $tag_color -width 1
      } else {
        #split around the circle
        $c create line $x2 $y [expr {$x2+1}] $y -tag [concat $tags intron foreground] -fill $tag_color -width 4 -state normal
        $c create line [expr {$x2+3}] $y [expr {$x2+4}] $y -tag [concat $tags intron foreground] -fill $tag_color -width 4 -state normal
        $c create line [expr {$x2+6}] $y [expr {$x2+7}] $y -tag [concat $tags intron foreground] -fill $tag_color -width 4 -state normal
        $c create line $x1 $y [expr {$x1-1}] $y -tag [concat $tags intron foreground] -fill $tag_color -width 4 -state normal
        $c create line [expr {$x1-3}] $y [expr {$x1-4}] $y -tag [concat $tags intron foreground] -fill $tag_color -width 4 -state normal
        $c create line [expr {$x1-6}] $y [expr {$x1-7}] $y -tag [concat $tags intron foreground] -fill $tag_color -width 4 -state normal
      }
    }
  }
  #draw final (or only) exon
  set x1 [expr {$x_left + $x_right * ([lindex [lindex $ranges end] 0] - $start) / $total_length}]
  set x2 [expr {$x_left + $x_right * ([lindex [lindex $ranges end] 1] - $start+1) / $total_length}]
  $c create rectangle [expr {$x1+$tag_outline_width}] [expr {$y-$width/2.0}] [expr {$x2-$tag_outline_width}] [expr {$y+$width/2.0}] -tag [concat $tags exon outline] -fill $tag_bg_color -outline $tag_bg_color -width $tag_outline_width -state normal
  $c create rectangle $x1 [expr {$y-$width/2.0}] $x2 [expr {$y+$width/2.0}] -tag [concat $tags exon foreground] -fill $tag_color -outline {} -state normal
  set tags_at_end [$w.textarea tag names [bp2ix $w.textarea $end]]
  if {([lsearch $tags_at_end $tag] == -1) && ([lsearch $tags_at_end [regsub f $tag fn]] > -1)} {
    set x1 $x_right
    $c create line [expr {$x2+0}] [expr {$y+$width/2.0}] [expr {($x1+$x2)/2.0}]  [expr {$y+$width/2.0+5}] $x1 [expr {$y+$width/2.0}] -tag [concat $tags intron foreground] -state normal -fill $tag_color -width 2
  }
    

  if {[$w.textarea compare [bp2ix $w.textarea $end] == [end_ix $w.textarea]]} {
    if {$info($w,circular) eq "circular"} {
      set tags_at_end [$w.textarea tag names [bp2ix $w.textarea 0]]
    } else {
      set tags_at_end [list]
    }
  } else {
    set tags_at_end [$w.textarea tag names [bp2ix $w.textarea [expr {$end+1}]]] 
  }
  if {([lsearch $tags_at_end $tag] == -1) && ([lsearch $tags_at_end [regsub f $tag fn]] == -1)} {
    ## bezier arrow data change here- arrow points list can be dict of pts min_x_scale and smooth
    $c create polygon 0 0 0 0 -tag  [concat $tags fwd_arrow outline]  -fill $tag_bg_color -outline $tag_bg_color -width [expr {max (0,$tag_outline_width-1)}] -state normal
    ## bezier arrow data change here- arrow points list can be dict of pts min_x_scale and smooth
    $c create polygon 0 0 -tag  [concat $tags fwd_arrow foreground]  -fill $tag_color -state normal -outline {}
  }
  if {$start == 0} {
    if {$info($w,circular) eq "circular"} {
      set tags_at_start [$w.textarea tag names [end_ix $w.textarea]]
    } else {
      set tags_at_start [list]
    }
  } else {
    set tags_at_start [$w.textarea tag names [bp2ix $w.textarea [expr {$start-1}]]] 
  }
  if {([lsearch $tags_at_start $tag] == -1) && ([lsearch $tags_at_start [regsub f $tag fn]] == -1)} {
    ## bezier arrow data change here-  arrow points list can be dict of pts min_x_scale and smooth
    $c create polygon 0 0 -tag  [concat $tags rev_arrow outline]  -fill $tag_bg_color -outline $tag_bg_color -width [expr {max (0,$tag_outline_width-1)}] -state normal
    ## bezier arrow data change here-  arrow points list can be dict of pts min_x_scale and smooth
    $c create polygon 0 0 -tag  [concat $tags rev_arrow foreground]  -fill $tag_color  -state normal -outline {}
  }

  set first_exon [lindex [$c find withtag $tag&&exon&&foreground]  0]
  set first_exon_bg [lindex [$c find withtag $tag&&exon&&outline]  0]
  set last_exon [lindex [$c find withtag $tag&&exon&&foreground]  end]
  set last_exon_bg [lindex [$c find withtag $tag&&exon&&outline]  end]

  $c bind $tag <<Gformat>> $gformat
  $c bind $tag <<Coord_list>> [list [list $first_exon $first_exon_bg [$c coords $first_exon]] [list $last_exon $last_exon_bg [$c coords $last_exon]]]
  $c bind $tag <<Direction>> $direction


  linear_feature_draw_arrow $c $tag


  #draw label
  set x1 [expr {$x_left + $x_right * ((([lindex [lindex $ranges 0] 0] + [lindex [lindex $ranges end] 1])/2)-$start) / $total_length }]
  set dirchar [expr {$direction?"\u21d0":"\u21d2"}]
  set featurelabelid [$c create text $x1 [expr {$y+$width/2.0+2}] -text "$label $dirchar" -anchor n -font [list $info(graphicfontfamily) $info(graphicfontsize)] -fill $info(text_fg_color) -tag [concat $tags feature label moveabletext] -state normal -fill $info(graphic_fg_color)]

  $c lower intron exon

  $c itemconfigure $tag -state $state
}

#######
##
#######
proc seq_tooltip_add_primer_seq {to_canvas w start end tag line_width} {
  global info
  if {[$w.textarea tag cget $tag -background] == ""} {
    return
  }
  ## regexp -all -indices -inline -expanded {[^\n]+} [$w.textarea get 1.63 9.26]

  set metadata [$w.textarea tag bind $tag <<Metadata>>]
  if {[set type [lindex $metadata 2]] ne "primer_bind" || ![dict exists [set quals [lindex $metadata 4]] PCR_conditions]} return
  if {![regexp {primer sequence:\s?([A-Za-z]+)} [dict get $quals "PCR_conditions"] -- seq]} {return}
  set ranges [feature_coords $w $tag $start $end]
  if {$ranges eq {}} {
    set ranges [list [list $end $end]]
  }
 # sputs md [lindex $metadata 0] $seq $start $end [feature_bp_before_after $w $tag $start $end] [feature_coords $w $tag $start $end]
  
  set tag_color [format "\#%04X%04X%04X" {*}[winfo rgb . [lindex [$w.textarea tag bind $tag <<Revcolors>>] [lindex [$w.textarea tag bind $tag <<Metadata>>] 3]]]]

  set direction [lindex [$w.textarea tag bind $tag <<Metadata>>] 3]
  set label [lindex [$w.textarea tag bind $tag <<Metadata>>] 0]
  set gformat [lindex [$w.textarea tag bind $tag <<Metadata>>] 1]
}

#######
##
#######
proc create_phred_string_coords {s line_width} {
  if {$s eq {}} {return}
  set result [list 0 0]
  set x 0
  set incr [expr {$line_width * 1.0 / [string length $s]}]
  foreach c [split $s ""] {
    set q [scan $c %c]
    lappend result $x [expr {33-$q}] 
   set x [expr {$x + $incr}]
    lappend result $x [expr {33-$q}] 
  }
  lappend result $x 0
}

#######
## insert canvas windows between each text line to draw features as graphic
#######
proc draw_text_canvas_features {t} {
  ### needs to figure out how to fix bp2ix function
  set j 0
  for {set i 1.0} {[$t compare $i < end]} {set i [$t index $i+2lines]} {
    $t insert $i \n
    #$t window create $i -window [canvas $t.c$j]
    incr j
  }
}

#######
## 
#######
proc feature_bp_before_after {w fea {c1 -1} {c2 -1}} {
  set fntag_ranges [$w.textarea tag ranges [regsub f $fea fn]]
  if {$fntag_ranges == ""} {set fntag_ranges [$w.textarea tag ranges $fea]}
  set end [ix2bp $w.textarea [lindex $fntag_ranges 1]]
  if {$c1 == -1} {
    set c1 0
  } 
  if {$c2 == -1} {
    set c2 [ix2bp $w.textarea end]
  }
  incr c2 -1
  set result [list]
  set before 0
  set after 0
  foreach {x1 x2} [$w.textarea tag ranges $fea] {
    set x1 [ix2bp $w.textarea  $x1]
    set x2 [ix2bp $w.textarea  $x2]
    incr x2 -1
    if {$x1 >= $c1} {
      if {$x1 <= $c2} {
        if {$x2 <= $c2} {
          lappend result [list $x1 $x2]
        } else {
          lappend result [list $x1 $c2]
          incr after [expr {$x2-$c2}]
        }
      } elseif {$x2 <= $end} {
        incr after [expr {$x2-$x1+1}]
      } else {
        incr before [expr {$x2-$x1+1}]
      }
    } else {
      if {$x2 >= $c1} {
        incr before [expr {$c1-$x1}]
        if {$x2 <= $c2} {
          lappend result [list $c1 $x2]
        } else {
          lappend result [list $c1 $c2]
          incr after [expr {$x2 - $c2}]
        }
      } elseif {$x2 <= $end && $end < $c1} {
        incr after [expr {$x2-$x1+1}]
      } else {
        incr before [expr {$x2-$x1+1}]
      }
    }
  }

  return [list $before $after $result]
}

#############
##
#############
proc feature_bp_before_after {w fea} {
  global info
  set fntag_ranges [$w.textarea tag ranges [regsub f $fea fn]]
  if {$fntag_ranges == ""} {set fntag_ranges [$w.textarea tag ranges $fea]}
  set end [lindex $fntag_ranges 1]
  regexp {([0-9]+).([0-9]+)} $end -- fend_line fend_char
  set line_dict [dict create]
  set before 0
  set after 0
  set line_len [$w.textarea count -chars 1.0 1.end]
  foreach {x1 x2} [$w.textarea tag ranges $fea] {
    regexp {([0-9]+).([0-9]+)} $x1 -- start_line start_char
    regexp {([0-9]+).([0-9]+)} $x2 -- end_line end_char
    if {$start_line != $end_line} {
	  dict incr line_dict $start_line [expr {$line_len - $start_char}]
	  set i [expr {$info(inline_mode)?2:1}]
	  for {set h [expr {$start_line+$i}]} {$h < $end_line} {incr h $i} {
		dict incr line_dict $h $line_len
	  }
	  dict incr line_dict $end_line [expr { $end_char}]
    } else {
      dict incr line_dict $start_line [expr {$end_char - $start_char}]
    }
  }
  set s1 0
  set s2 0
  set before_dict [dict create]
  foreach {l c} $line_dict {
    dict set before_dict $l $s1
    incr s1 $c
    if {$l> $fend_line} {
      incr s2 $c
    }
  }
  if {$s2 > 0} {
    foreach l [dict keys $before_dict] {
	  if {$l> $fend_line} {
		dict set before_dict $l [expr {[dict get $before_dict $l] -$s1 +$s2}]
	  } else {
	  	dict set before_dict $l [expr {[dict get $before_dict $l] +$s2}]
	  }
    }
  }
  set after_dict [dict create]
  foreach l [dict keys $before_dict] {
    dict set after_dict $l [expr {$s1 - [dict get $before_dict $l] - [dict get $line_dict $l] }]
  }
  return [list $before_dict $after_dict]
}

###############
##
###############
# call in reline to set the before and after lists for primer_bind features (features_to_tree_view needs to call this instead of reline in non-inline mode)
proc add_primer_bind_before_after_data {w} {
  global info
  set result [dict create]
  foreach tag [$w.textarea tag names] {
    if {[regexp {f[0-9]+#} $tag]} {
      set metadata  [$w.textarea tag bind $tag <<Metadata>>]
      set type [lindex $metadata 2]
	  if {[set type [lindex $metadata 2]] ne "primer_bind" || ![dict exists [set quals [lindex $metadata 4]] PCR_conditions]} return
	  if {![regexp {primer sequence:\s?([A-Za-z]+)} [dict get $quals] -- seq]} {return}
	  set fntag_ranges [$w.textarea tag ranges [regsub f $tag fn]]
	  if {$fntag_ranges == ""} {set fntag_ranges [$w.textarea tag ranges $tag]}
	  set end [lindex $fntag_ranges 1]
	  regexp {([0-9]+).([0-9]+)} $end -- fend_line fend_char
	  set line_dict [dict create]
	  set before 0
	  set after 0
	  set line_len [$w.textarea count -chars 1.0 1.end]
	  foreach {x1 x2} [$w.textarea tag ranges $tag] {
		regexp {([0-9]+).([0-9]+)} $x1 -- start_line start_char
		regexp {([0-9]+).([0-9]+)} $x2 -- end_line end_char
		if {$start_line != $end_line} {
		  dict incr line_dict $start_line [expr {$line_len - $start_char}]
		  sputs 1 $start_line [expr {$line_len - $start_char}]
		  set i [expr {$info(inline_mode)?2:1}]
		  for {set h [expr {$start_line+$i}]} {$h < $end_line} {incr h $i} {
			dict incr line_dict $h $line_len
				sputs 2 $start_line [expr {$line_len - $start_char}]
		  }
		  dict incr line_dict $end_line [expr { $end_char}]
		  sputs 3 $end_line [expr {$line_len - $start_char}]
		} else {
		  dict incr line_dict $start_line [expr {$end_char - $start_char}]
		  sputs 4 $start_line [expr {$end_char - $start_char}]
		}
	  }
	  set s1 0
	  set s2 0
	  set before_dict [dict create]
	  foreach {l c} $line_dict {
		dict set before_dict $l $s1
		incr s1 $c
		if {$l> $fend_line} {
		  incr s2 $c
		}
	  }
	  if {$s2 > 0} {
		foreach l [dict keys $before_dict] {
		  if {$l> $fend_line} {
			dict set before_dict $l [expr {[dict get $before_dict $l] -$s1 +$s2}]
		  } else {
			dict set before_dict $l [expr {[dict get $before_dict $l] +$s2}]
		  }
		}
	  }
	  set after_dict [dict create]
	  foreach l [dict keys $before_dict] {
		dict set after_dict $l [expr {$s1 - [dict get $before_dict $l] - [dict get $line_dict $l] }]
	  }
	}
	dict set result $tag [list $before_dict $after_dict]
  }
  return $result
}

#######
## calculates a scroll percentage for touchscreen drags
#######
proc vertindex_touch_delta {v pixels} {
  set height_in_lines [$v cget -height]
  set height_in_pixels [winfo height $v]
  set total_lines [$v index end-1line] 
  set scrollable_lines [expr {$total_lines- $height_in_lines}]
  set scrollable_percent [expr {1- ($height_in_lines/$total_lines)}]
  set lines_per_pixel [expr {$height_in_pixels / $height_in_lines}]
  set lines_to_move [expr {$pixels/ $lines_per_pixel}]
  set move_percent [expr {$lines_to_move/ $scrollable_lines *$scrollable_percent}]
  return $move_percent
}





## need to update map when features change (fill_treeview)
## need to do map mouseover info to add feature name to infobox 
##########
## fill the right side map
##########
proc textarea_fill_map {w} {
  global info
  
  if {![winfo exists $w]} {
    return
  } 
  if { [winfo height $w.map] <= 1} {
    set height 100
  } else {
    set height [winfo height $w.map]
    set info($w,textheight) $height
  }

  #$w.map delete all
  canvas_delete_all $w.map
  set dna_length [ix2bp $w.textarea end]
  set c_scale [expr {1.0 * $height /$dna_length}]

  #$w.map_zoom delete all
  canvas_delete_all $w.map_zoom
  if {[winfo width $w.textarea] <= 1} {
    set width $info(default_textarea_width)
  } else {  
    set width [expr {int(([winfo width $w.textarea]-4)/[lindex [wm grid $w] 2])}]
    #set width [expr {int([winfo width $w.textarea]*100.0/[font measure dnafont [string repeat 0 100]])}]
  }
  set c_zoom_scale [expr {1.0 * [lindex [wm grid $w] 3]/$width}]


  set depthdict [tagdepth_features_window $w.textarea]
  $w.map create rectangle 0 0 0 0 -outline {} -fill {} -tags frame
  $w.map_zoom create rectangle 0 0 0 0 -outline {} -fill {} -tags frame

  $w.map create rectangle 0 0 0 0 -outline black -fill [$w.textarea tag cget sel -background] -tags selection
  $w.map_zoom create rectangle 0 0 0 0 -outline black -fill [$w.textarea tag cget sel -background] -tags selection

  set maxx 0
  foreach tag [$w.textarea tag names] {
    set type 0
    set fill [lindex [$w.textarea tag bind $tag <<Revcolors>>] [lindex [$w.textarea tag bind $tag <<Metadata>>] 3]]
    if {[$w.textarea tag cget $tag -background] eq ""} {continue}
    if {![regexp {f[0-9]+#} $tag]} {
      if {[lindex [$w.textarea tag bind $tag <<Metadata>>] 2] eq "enzyme"} {
        set type 1
      } else {
        continue
      }
    }

    set name [lindex [$w.textarea tag bind $tag <<Metadata>>] 0]
    #regsub "fn" $tag "f" tag
    if {[dict exists $depthdict $tag]} {
      set xplus [dict get $depthdict $tag]
      if {$xplus >= 10} {continue}
    } elseif {$type == 1} {
      set xplus -1
    } else {
      set xplus 0
    }

    set maxx [expr {max($maxx, $xplus)}]
    foreach {fstart fend} [$w.textarea tag ranges $tag] {
     $w.map create line [expr {3+ 2.5+ 5* $xplus}] [expr {[ix2bp $w.textarea $fstart] * $c_scale}] [expr {3+ 2.5+ 5* $xplus}] [expr {[ix2bp $w.textarea $fend] * $c_scale}] -fill $fill -width 5 -tags $tag
     $w.map_zoom create line [expr {3+ 2.5+ 5* $xplus}] [expr {[ix2bp $w.textarea $fstart] * $c_zoom_scale}] [expr {3+ 2.5+ 5* $xplus}] [expr {[ix2bp $w.textarea $fend] * $c_zoom_scale}] -fill $fill -width 5 -tags $tag
    }
    $w.map bind $tag <Enter> "$w.infobox configure -text \[lindex \[$w.textarea tag bind $tag <<Metadata>>\] 0\]"
    $w.map bind $tag <Leave> "$w.infobox configure -text {}"
    $w.map_zoom bind $tag <Enter> "$w.infobox configure -text \[lindex \[$w.textarea tag bind $tag <<Metadata>>\] 0\]"
    $w.map_zoom bind $tag <Leave> "$w.infobox configure -text {}"
    $w.map_zoom bind $tag <Button-1> "$w.tvframe.tv selection set $tag; $w.tvframe.tv see $tag; set start_end_ix \[feature_tag_start_end_ix $w $tag\]; select_region $w \[bp2ix $w.textarea \[ix2bp $w.textarea \[lindex \$start_end_ix 1\]\]\] \[bp2ix $w.textarea \[ix2bp $w.textarea \[lindex \$start_end_ix 0\]\]\] ; focus .; focus $w.textarea; unset -nocomplain start_end_ix"
    $w.map bind $tag <Button-1> "$w.tvframe.tv selection set $tag; $w.tvframe.tv see $tag; set start_end_ix \[feature_tag_start_end_ix $w $tag\]; select_region $w \[bp2ix $w.textarea \[ix2bp $w.textarea \[lindex \$start_end_ix 1\]\]\] \[bp2ix $w.textarea \[ix2bp $w.textarea \[lindex \$start_end_ix 0\]\]\] ; focus .; focus $w.textarea; unset -nocomplain start_end_ix"
  }
  set maxx [expr {3 + 3 +5 +5* $maxx}]

  $w.map coords frame 0 0 $maxx $height
  $w.map_zoom coords frame 0 0 $maxx [expr {$c_zoom_scale * $dna_length}]


  bind $w.map <Button-1> "vertscrollmanager $w moveto \[expr {\[$w.map canvasy %y\]/ \[lindex \[$w.map coords frame\] 3\] - (\[lindex \[$w.vertscroll get\] 1\] - \[lindex \[$w.vertscroll get\] 0\]) /2}\] "
  bind $w.map_zoom <MouseWheel> "vertscrollmanager $w scroll \[expr {int(1.0 * %D/-\$info(mousewheelunits))}\] units"
  bind $w.map <MouseWheel> "vertscrollmanager $w scroll \[expr {int(1.0 * %D/-\$info(mousewheelunits))}\] units"

  $w.map coords selection 0 0 $maxx 0
  $w.map_zoom coords selection 0 0 $maxx 0

  $w.map configure -scrollregion [list 0 0 $maxx $height] -width $maxx
  if {$info(inline_mode)} {
    $w.map_zoom configure -width 0
  } else {
    $w.map_zoom configure -scrollregion [list 0 0 $maxx [expr {$c_zoom_scale * $dna_length}]] -width $maxx
  }
}



##########
## sets the selection location info for the textbox (start and end of selection)
##########
proc selection_manager {w} {
  global info
  if {![winfo exists $w]} {return}
  $w.textarea tag remove tempsel 1.0 end

  if {[$w.textarea compare insert == end]} {
    $w.textarea mark set insert end-1c
  }
  if {[$w.textarea tag names end] == "sel"} {
    $w.textarea tag remove sel end 
  }
  $w.infoframe.totallen configure -text [ix2bp $w.textarea end]

  set selection_changed 0
  #resize_infoframe_fonts $w

  if {[$w.textarea tag ranges sel] != "" && [$w.textarea index sel.last] == [$w.textarea index end]} {
    $w.textarea tag remove sel end-1c end
  }

  if {[$w.textarea tag ranges sel] == ""} {
    $w.infoframe.startlabel configure -text [mc "insert@"]
    set first [expr {[ix2bp $w.textarea [$w.textarea index insert]]+1}]
    $w.infoframe.start configure -text "$first\<[expr {($first-1) % 3}]>"
    if {$info($w,insert_loc) != $first} {
      set info($w,insert_loc) $first
      set info($w,sel_start2) $first
      set info($w,sel_end2) $first
      set selection_changed 1
    }
    if {($info($w,sel_start) != 1) || ($info($w,sel_end) != [ix2bp $w.textarea end])} {
      set info($w,sel_start) 1
      set info($w,sel_end) [ix2bp $w.textarea end]
      set selection_changed 1
    }
    $w.infoframe.sellenlabel configure -text ""
    $w.infoframe.sellen configure -text ""
    $w.infoframe.endlabel configure -text ""
    $w.infoframe.end configure -text ""
    set info($w,orf_text) ""
    $w.infoframe.orflabel configure -text ""
    $w.infoframe.tm configure -text ""
    $w.infoframe.tmlabel configure -text ""
    $w.infoframe.gc configure -text ""
    $w.infoframe.gclabel configure -text ""
    set info($w,selection_Trans_rev) ""
    set info($w,selection_Trans) ""
  } else {
    foreach {first last} [$w.textarea tag ranges sel] {
      $w.textarea tag add tempsel $first $last
    }
    if {$info(selection_on_top)} {
      $w.textarea tag raise sel
    } else {
      $w.textarea tag lower sel
    }
    $w.textarea tag lower tempsel sel

    if {[llength [$w.textarea tag ranges sel]] == 2 } {
      set first [expr {1+[ix2bp $w.textarea [$w.textarea index sel.first]]}]
      set last [expr {[ix2bp $w.textarea [$w.textarea index sel.last]]}]
      set selection [textarea_get $w.textarea sel.first sel.last]
    } else {
      set first [expr {1+[ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 2]]}]
      set last [expr {[ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 1]]}]
      set selection "[textarea_get $w.textarea [lindex [$w.textarea tag ranges sel] 2] [lindex [$w.textarea tag ranges sel] 3]][textarea_get $w.textarea [lindex [$w.textarea tag ranges sel] 0] [lindex [$w.textarea tag ranges sel] 1]]"
    }
    # selection used here - ok
    $w.infoframe.startlabel configure -text [mc "Start"]
    $w.infoframe.sellenlabel configure -text [mc "Length"]
    $w.infoframe.endlabel configure -text [mc "End"]
    $w.infoframe.start configure -text "$first\<[expr {($first-1) % 3}]>"
    $w.infoframe.end configure -text "$last\<[expr {($last-1) % 3}]>"
    set length [string length $selection]
    $w.infoframe.sellen configure -text "$length\<[expr {($length) % 3}]>"
    if {$info($w,insert_loc) != [expr {[ix2bp $w.textarea [$w.textarea index insert]]+1}]} {
      set info($w,insert_loc) [expr {[ix2bp $w.textarea [$w.textarea index insert]]+1}]
      set selection_changed 1
    }
    if {($info($w,sel_start2) != $first) || ($info($w,sel_end2) != $last)} {
      set info($w,sel_start) $first
      set info($w,sel_end) $last
      set info($w,sel_start2) $first
      set info($w,sel_end2) $last
      set selection_changed 1
    }
    $w.infoframe.orflabel configure -text [mc "ORF"]
    if {[regexp -nocase "^(atg)" $selection] == 1} {
      set orftemp "M"
    } else {
      set orftemp ""
    }

    if {[regexp -nocase -indices "^(...)*?(taa|tag|tga)" $selection found] == 1} {
      if {[expr [string length $selection]- [lindex $found 1]] < 4 } {
        append orftemp ">[expr {[lindex $found 1] / 3}]*"
      } else {
        append orftemp "-"
      }
    } else {
      append orftemp ">[expr {[string length $selection] / 3}]"
    }
    append orftemp "/"

    if {[regexp -nocase -start 3 {(tca|cta|tta)(...)+$} $selection]} {
      append orftemp "-"
    } elseif {[regexp -nocase {(tca|cta|tta)(...)+$} $selection]} {
      append orftemp "*[expr {[string length $selection] / 3 -1}]<"
    } else {
      append orftemp "<[expr {[string length $selection] / 3}]"
    }
    if {[regexp -nocase {(cat)$} $selection]} {
      append orftemp "M"
    }

    set info($w,orf_text) $orftemp
    $w.infoframe.tmlabel configure -text "Tm"
    if {[string is double [set tm [Tm $selection $info(primer_dna) $info(primer_salt)]]]} {
      $w.infoframe.tm configure -text "$tm\u00B0 C"
    } else {
      $w.infoframe.tm configure -text "$tm"
    }
    $w.infoframe.gclabel configure -text "%GC"
    #$w.infoframe.gc configure -text "[format %2.0f [GC% $selection]]%"
    $w.infoframe.gc configure -text "[expr {round([GC% $selection])}]%"

    if {$info($w,selection_shows_Trans_upper)} {
      set translate_selection [regsub -all {[a-z]} $selection ""]
    } else {
      set translate_selection $selection
    }

    if {$info($w,selection_shows_Trans_dir)} {
      $w.infoframe.trans configure -textvariable info($w,selection_Trans_rev)
    } else {
      $w.infoframe.trans configure -textvariable info($w,selection_Trans)
    }


    if {[string length $translate_selection] > 99} {
      if {[string first "*" [translate [revcom [string range $translate_selection [expr {([string length $translate_selection] % 3) + 43}] end-45]]]] > -1} {
        set info($w,selection_Trans_rev) "[translate [revcom [string range $translate_selection end-44 end]]]...*...[translate [revcom [string range $translate_selection [expr {([string length $translate_selection] % 3)}] [expr {([string length $translate_selection] % 3) + 44}]]]]"
      } else {
        set info($w,selection_Trans_rev) "[translate [revcom [string range $translate_selection end-44 end]]]...[translate [revcom [string range $translate_selection [expr {([string length $translate_selection] % 3)}] [expr {([string length $translate_selection] % 3) + 44}]]]]"
      }
      if {[string first "*" [translate [string range $translate_selection 45 end-[expr {([string length $translate_selection] % 3) + 45}] ]]] > -1} {
        set info($w,selection_Trans) "[translate [string range $translate_selection 0 44]]...*...[translate [string range $translate_selection end-[expr {([string length $translate_selection] % 3) + 44}] end-[expr {[string length $translate_selection] % 3}]]]"
      } else {
        set info($w,selection_Trans) "[translate [string range $translate_selection 0 44]]...[translate [string range $translate_selection end-[expr {([string length $translate_selection] % 3) + 44}] end-[expr {[string length $translate_selection] % 3}]]]"
      }

    } else {
      set info($w,selection_Trans_rev)  [translate [revcom $translate_selection]]
      set info($w,selection_Trans) [translate $translate_selection]

    }
  }
  if {$selection_changed} {
    send_data <<SelectionChanged>> $w
  }
  mouseover_info $w [$w.textarea index insert]
  textarea_set_map_selection $w
}

#########
## Android-specific selection manager
#########
if {$info(android)} {
  rename selection_manager do_selection_manager
  proc selection_manager {w} {
    global after_idle_selection_manager
    if {[info exists after_idle_selection_manager] && $after_idle_selection_manager!="" } {
      after cancel $after_idle_selection_manager
    }
    set after_idle_selection_manager [after 50 "unset after_idle_selection_manager; do_selection_manager $w"]
  }
}

#########
## Aqua bug- too may items in a frame blocks double-button event- look for repeated single button
#########
proc double_button_manager {t} {
  global double_button tripple_button

  if {[info exists tripple_button($t)]} {
    event generate $t <<Triple-Button-1>> -x [expr {[winfo pointerx $t] - [winfo rootx $t]}] -y [expr {[winfo pointery $t] - [winfo rooty $t]}]
    array unset tripple_button $t
  }
  if {[info exists double_button($t)]} {
    event generate $t <<Double-Button-1>> -x [expr {[winfo pointerx $t] - [winfo rootx $t]}] -y [expr {[winfo pointery $t] - [winfo rooty $t]}]
    array unset double_button $t
    set tripple_button($t) 1
    after 250 "array unset tripple_button $t"
  }
  set double_button($t) 1
  after 250 "array unset double_button $t"
}


#########
## Make the infoframe items a smaller font if the window gets too narrow
#########
proc resize_infoframe_fonts {w} {


    ## check the infobox and reset the fonts if it needs to be smaller
    ## NOT used
return

    if {[set blocksize [lindex [grid bbox $w.infoframe 5 0] 2]]  == 0} {sputs resize [wm geometry $w]; return}

    if {$blocksize < [font measure labelfont Sequence]} {
       ttk::style configure InfoboxStyle.TCheckbutton -font labelfont_half
       ttk::style configure InfoboxStyle.TLabel -font labelfont_half
       ttk::style configure Chip.TButton -labelfont_half
    } else {
      if {[$w.infoframe.startlabel cget -font] != "labelfont"} {
         ttk::style configure InfoboxStyle.TCheckbutton -font labelfont
         ttk::style configure InfoboxStyle.TLabel -font labelfont
         ttk::style configure Chip.TButton -font labelfont
       }
    }
}

#########
## manages all key press events in the textbox
#########
proc keyevent_manager {w modifier k} { 
  global info toolbar_images undo
  set k [string map {asterisk *} $k]
  #$w.infobox configure -text "$modifier $k" ;#this let's you see the keypress keysyms
  if {$info(use_cocoa)} {set bugdelay 1} else {set bugdelay 1}
  switch $modifier {
    None {
      if {([string length $k] == 1)} {set k [string map $info(keysubstmap) $k]}
      if {([string length $k] == 1) && ([regexp  "\[$info(allowedkeys)\]" $k] == 1) && (![file_lock_check $w 1])}  {
        lappend undo(undo,$w) [list unlink_analysis_window $w [unlink_analysis_window $w]]
## Should add the text before deleting the selection, so that any tags that are on the first or last base are not deleted- re-tag the new base with all the tags that were on the first AND last base of the selection (same base for one base selections).
## only tags that are on both the first and last base of the selecetion are preserved, but not internal 
        if {[llength [$w.textarea tag ranges sel]] > 0} {
          set first_index [bp2ix $w.textarea [ix2bp $w.textarea  sel.first]]
          set last_index [bp2ix $w.textarea [expr {[ix2bp $w.textarea  sel.last] - 1 }]]
        } else {
          set len [expr {max (1,[ix2bp $w.textarea  end])}]
          set first_index [bp2ix $w.textarea [expr { ([ix2bp $w.textarea  insert]-1) %$len}]]
          set last_index [bp2ix $w.textarea [expr {[ix2bp $w.textarea  insert] %$len}]]
        }
        set tag_to_add [list]
        set tag_l [$w.textarea tag names $last_index]
        foreach tag_f [$w.textarea tag names $first_index] {
          if {$tag_f in $tag_l && [regexp {fn?[0-9]+#} $tag_f]} {
            lappend tag_to_add $tag_f
          }
        }
        textarea_insert $w.textarea [$w.textarea index insert] $k
        foreach tag_f $tag_to_add {
          textarea_tag_add $w.textarea $tag_f [$w.textarea index insert-1c] [$w.textarea index insert]
        }
        if {[$w.textarea index insert] == 1.0} {
          $w.textarea mark set insert 1.1
        }
        $w.textarea mark set anchor insert
        $w.textarea mark set tk::anchor$w.textarea insert
        if {[llength [$w.textarea tag ranges sel]] > 0} {
          textarea_delete $w.textarea sel.first sel.last
        } 
        $w.textarea see insert
        post_validate_seguid $w
        register_undo_separator $w [mc "Typing"]
        features_to_tree_view $w
      } else {

        switch $k {
          "BackSpace" {
            if {![file_lock_check $w 1]} {
              if {[llength [$w.textarea tag ranges sel]] > 0} {
                lappend undo(undo,$w) [list unlink_analysis_window $w [unlink_analysis_window $w]]
                textarea_delete $w.textarea sel.first sel.last
                register_undo_separator $w [mc "Delete"]
                features_to_tree_view $w
              } elseif {[$w.textarea index insert] != 1.0} {
                lappend undo(undo,$w) [list unlink_analysis_window $w [unlink_analysis_window $w]]
                if {$info(inline_mode) && [$w.textarea index insert]== [$w.textarea index "insert linestart"]} {
                 ## delete four characters (base, return, canvas, return) if inline canvases and you are deleting from the very begining of the line
                  textarea_delete $w.textarea insert-4chars
                } else {
                  textarea_delete $w.textarea insert-1chars
                }
                $w.textarea mark set anchor insert
                $w.textarea mark set tk::anchor$w.textarea insert
                $w.textarea see insert
                post_validate_seguid $w
                register_undo_separator $w [mc "Delete"]
                features_to_tree_view $w
              }
            }
          } 
          "Delete" {
            if {![file_lock_check $w 1]} {
              if {[llength [$w.textarea tag ranges sel]] > 0} {
                lappend undo(undo,$w) [list unlink_analysis_window $w [unlink_analysis_window $w]]
                textarea_delete $w.textarea sel.first sel.last
                register_undo_separator $w [mc "Delete"]
                features_to_tree_view $w
              } elseif {[$w.textarea index insert] != [$w.textarea index "1.0 lineend"]} {
                lappend undo(undo,$w) [list unlink_analysis_window $w [unlink_analysis_window $w]]
                textarea_delete $w.textarea insert
                $w.textarea mark set anchor insert+1chars
                $w.textarea mark set tk::anchor$w.textarea insert+1chars
                $w.textarea see insert
                post_validate_seguid $w
                register_undo_separator $w [mc "Delete"]
                features_to_tree_view $w
              }
            }
          }
          "space" {
            return
          } 
          default {
            #sputs "unknown key:$k"
            return
	    }
        } 
      } 
    } 
    Control {
      switch -glob -- $k {
        Control_L {return}
        Control_R {return}
        Meta_L {return}
        Alt_L {return}
        [Zz] {undo $w}
        [xX] {clip_cut_copy $w cut}
        [cC] {clip_cut_copy $w copy}
        [vV] {clip_paste $w}
        [aA] {select_all $w}
        [bB] {clipboard clear;clipboard_append [genbank_text $w]}
        [kK] {feature_scan $w}
        [jJ] {after $bugdelay jump_to $w}
        [nN] {after $bugdelay create_window; return}
        [oO] {open_file_dialog; return}
        [pP] {enz_text_map $w -1; return}
        [dD] {after $bugdelay duplicate_window $w selection; return}
        [sS] {save_file $w "Save"; return}
        [wW] {closewindow $w; return}
        [iI] {if {$info($w,circular)== "circular"} {set_origin $w} else {bell}}
        [uU] {#toggle_circ $w}
        [-] -
        minus {change_case $w lower}
        plus {change_case $w upper}
        greater {next_ORF $w}
        less {next_ORF $w reverse}

        [fF] {after $bugdelay find_dialog $w}
        [gG] {do_find $w again}
        [rR] {after $bugdelay enz_digest $w [list $info(enz_currently_selected)] $info(analyze_selection)}
        [eE] {after $bugdelay enzyme_selection_dialog $w}
        [yY] {after $bugdelay enz_graphic_map $w}
        [tT] {after $bugdelay translation_window $w}
        [lL] {after $bugdelay align_dialog2 $w}
        [qQ] {if {!$info(use_cocoa)} {exit}; return}
        [0]  {if {[info commands console] != ""} {
               console show
               global tempw
               set tempw $w
               uplevel #0 {set w $tempw
                 sputs "w= $w"
                 unset tempw
                 set info(suppress_output) 0
               }
               console eval {raise .}
              }
             }
        [1] {after $bugdelay calc}
        [2] {after $bugdelay mol_calc}
        [/] -
        slash {rev_com_window $w}
        [=] -
        equal {change_case $w exchange}
        [,] -
        comma {after $bugdelay configure_preferences $w}
        [.] -
        period {after $bugdelay add_sel_feature_file_dialog $w}
        [hH] {if {([lsearch -glob [info loaded] "*tclCarbonHICommand.dylib*"] > -1)} {
                carbon::processHICommand hide {}
                }
             }
        [mM] {if {[tk windowingsystem] == "aqua"} {
               catch {aqua_minimize $w}
               }
             }
        quoteleft {if {[tk windowingsystem] == "aqua"} {
                     catch {raise [lindex [wm stackorder .] 0]}
                   }
             }
	}
    }
    ShiftControl {
      switch -glob -- $k {
        Control_L {return}
        Shift_L {return}
        Control_R {return}
        Shift_R {return}
        Meta_L {return}
        Alt_L {return}
        [Zz] {undo $w 0}
        [xX] {clip_cut_copy $w cut rev-com}
        [cC] {clip_cut_copy $w copy rev-com}
        [Vv] {clip_paste $w rev-com}
        underscore -
        minus {change_case $w lower}
        equal -
        plus {change_case $w upper}
        period -
        greater  {next_ORF $w}
        comma -
        less {after cancel configure_preferences; next_ORF $w reverse}
        [fF] {after $bugdelay clear_find_highlight $w}
        [gG] {feature_from_found $w}
        [aA] {after $bugdelay select_from_to $w}
        [bB] {after $bugdelay NCBI_Blast $w}
        [dD] {after $bugdelay duplicate_window $w all; return}
        [kK] {feature_clear $w; sputs keyevent clear}
        [lL] {#after $bugdelay align_dialog $w}
        [rR] {after $bugdelay enz_digest_dialog2 $w}
        [sS] {after $bugdelay save_file $w "Save_as"; return}
        [tT] {after $bugdelay enz_text_map $w}
        [yY] {after $bugdelay enz_graphic_map $w {==1}}
        [eE] {set info(analyze_selection) [expr {($info(analyze_selection)=="all")?"selection":"all"}]}
	}

    }
    AltControl {
      sputs AltControl $k
      switch -glob -- $k {
        Control_L {return}
        Shift_L {return}
        Control_R {return}
        Shift_R {return}
        Meta_L {return}
        Alt_L {return}
        [zZ] {sputs key z}
	"Greek_OMEGA" {sputs key z}
        "oe" {sputs key q-oe;global option_q; set option_q 1}
        [Qq] {sputs key q;global option_q; set option_q 1}
	}

    }
  }  
  vertindexbalancer $w
  selection_manager $w
  #$w.infobox configure -text "$modifier $k" ;#this let's you see the keypress keysyms
}

###########
## limited control keys for the comment window
###########
proc comment_keyevent_manager {w modifier k} {
  global info
#todo: need to send the non-edit oriented shortcut keys to keyevent manager
  if {$info(use_cocoa)} {set bugdelay 1} else {set bugdelay 1}
  switch $modifier {
    Control {
      switch -glob $k {
        Control_L {return}
        Control_R {return}
        [cC] {event generate $w.comframe.comtextframe.text <<Copy>>}
        [xX] {event generate $w.comframe.comtextframe.text <<Cut>>}
        [vV] {event generate $w.comframe.comtextframe.text <<Paste>>}
        [zZ] {catch {$w.comframe.comtextframe.text edit undo}}
        [aA] {$w.comframe.comtextframe.text tag add sel 1.0 end-1chars; $w.comframe.comtextframe.text mark set insert end; $w.comframe.comtextframe.text mark set anchor insert; $w.comframe.comtextframe.text mark set tk::anchor$w.textarea insert}
        default {keyevent_manager $w $modifier $k}
      }
    }
    ShiftControl {
      switch -glob $k {
        Control_L {return}
        Shift_L {return}
        Control_R {return}
        Shift_R {return}
        [zZ] {catch {$w.comframe.comtextframe.text edit redo}}
        [xX] {return}
        [cC] {return}
        [Vv] {return}
        default {keyevent_manager $w $modifier $k}
      }
    }
  }  
}

###########
## change the edit menu for focus in the comment window
###########
proc update_edit_menu {w mode} {
  global modstring info
  if {$info(android)} {return}

  #if {[tk windowingsystem] == "win32"} {
  #  for {set i 0} {$i < [$w.menubar.edit index end]} {incr i} {
  #    sputs type $i [$w.menubar.edit type $i]
  #    sputs menu [$w.menubar.edit entryconfigure $i]
  #  }
  #  return
  #}
  if {$mode == "comment"} {
    if {[$w.menubar.edit entrycget 0 -label] ne [mc "Undo Comment Text"]} {
      bind $w.menubar.edit <<undostate>> [$w.menubar.edit entrycget 0 -state]
      bind $w.menubar.edit <<undolabel>> [$w.menubar.edit entrycget 0 -label]
      bind $w.menubar.edit <<redostate>> [$w.menubar.edit entrycget 1 -state]
      bind $w.menubar.edit <<redolabel>> [$w.menubar.edit entrycget 1 -label]
      $w.menubar.edit entryconfigure 0 -label [mc "Undo Comment Text"] -state normal -accelerator "$modstring+Z" -command "catch {$w.comframe.comtextframe.text edit undo}"
      $w.menubar.edit entryconfigure 1 -label [mc "Redo Comment Text"] -state normal -accelerator "$modstring+Shift+Z" -command "catch {$w.comframe.comtextframe.text edit redo}"
      $w.menubar.edit entryconfigure [mc "Cut"] -command "event generate $w.comframe.comtextframe.text <<Cut>>"
      $w.menubar.edit entryconfigure [mc "Copy"] -command "event generate $w.comframe.comtextframe.text <<Copy>>"
      $w.menubar.edit entryconfigure [mc "Paste"] -command "event generate $w.comframe.comtextframe.text <<Paste>>"
      $w.menubar.edit entryconfigure [mc "Select All"] -command "$w.comframe.comtextframe.text tag add sel 1.0 end-1chars; $w.comframe.comtextframe.text mark set insert end; $w.comframe.comtextframe.text mark set anchor insert; $w.comframe.comtextframe.text mark set tk::anchor$w.textarea insert"

      $w.menubar.edit entryconfigure [mc "Cut Rev-Com"] -state disabled
      $w.menubar.edit entryconfigure [mc "Copy Rev-Com"] -state disabled
      $w.menubar.edit entryconfigure [mc "Paste Rev-Com"] -state disabled
      $w.menubar.edit entryconfigure [mc "Copy Special"] -state disabled
    }
  } else {
    if {[$w.menubar.edit entrycget 0 -label] eq [mc "Undo Comment Text"]} {
      $w.menubar.edit entryconfigure 0 -label [bind $w.menubar.edit <<undolabel>>] -state [bind $w.menubar.edit <<undostate>>] -accelerator "$modstring+Z" -command "undo $w"
      $w.menubar.edit entryconfigure 1 -label [bind $w.menubar.edit <<redolabel>>] -state [bind $w.menubar.edit <<redostate>>] -accelerator "$modstring+Shift+Z";# -command "undo $w 0; sputs menu"
      $w.menubar.edit entryconfigure [mc "Cut"] -command "clip_cut_copy $w cut"
      $w.menubar.edit entryconfigure [mc "Copy"] -command "clip_cut_copy $w copy"
      $w.menubar.edit entryconfigure [mc "Paste"] -command "clip_paste $w"
      $w.menubar.edit entryconfigure [mc "Select All"] -command "select_all $w"
      $w.menubar.edit entryconfigure [mc "Cut Rev-Com"] -state normal
      $w.menubar.edit entryconfigure [mc "Copy Rev-Com"] -state normal
      $w.menubar.edit entryconfigure [mc "Paste Rev-Com"] -state normal
      $w.menubar.edit entryconfigure [mc "Copy Special"] -state normal
    }
  }
}


###########
## resize callback for the comment window
###########
proc comment_resize {t y {direction 1} } {
  global info
  if {!$info(android)} {
    set minsize 3
  } else {
    set minsize 1
  }
  set w [winfo toplevel $t]
  set deltaY [expr {$direction * ($y-[bind $t <<resizeY>>])}]
  set newHeight [expr {[bind $t <<resizeHeight>>] + $deltaY / [font metrics [$t cget -font] -linespace]}]
  if {[$t cget -height] != $newHeight && $newHeight >= $minsize} {
    $t configure -height $newHeight
  }
}

###########
## return the locked state of a file (when attempting to change contents)
###########
proc file_lock_check {w {checksum_preclear 0}} {
  global info toolbar_images

  if {$checksum_preclear && [info exists info(seguid_mode)] && $info(seguid_mode)== 1 && [info exists info($w,SEGUID)] && $info($w,SEGUID) ne {}} {
    tk_messageBox -message [mc "Sorry, the current mode is set to preserve all unique identifers (seguid's).\nRemove the unique identifier (in the fingerprint icon menu) to edit the file."] -icon warning -type ok  -parent $w
    return 1
  }

  #set info($w,locked) [expr {[file isfile $info($w,filename)] && ![file writable $info($w,filename)]}]
  if {$info(lock_bug)} {
    set info($w,locked) 0
  }
  if {!$info(android) && [winfo class $w.infoframe.locked] ne "TCheckbutton"} {
    $w.infoframe.locked configure -image $toolbar_images([expr {$info($w,locked)?"locked":"unlocked"}])
  }
  if {$info($w,locked)} {
    tk_messageBox -message [mc "Sorry, the file is locked"] -icon warning -type ok
  } elseif { $checksum_preclear && $info($w,phred_string) ne {}} {
    if {[tk_messageBox -title [mc "Removing Phred Data"] -message [mc {Editing the file will erase Phred data. Do you want to continue}] -type "yesno" -icon question -default no -parent $w] == "no"} {
      return 1
    } else {
      phred_remove_data $w
      return 0
    }
  }

  return $info($w,locked)
}


###########
## toggle the locked state of a file
###########
proc toggle_locked {w} {
  global info tcl_platform toolbar_images


  if {[file isfile $info($w,filename)]} {
    if {$tcl_platform(platform) == "windows"} {
      file attributes $info($w,filename) -readonly [expr {![file attributes $info($w,filename) -readonly]}]

    } elseif {$tcl_platform(platform) == "unix"} {
      if {[catch {file attributes $info($w,filename) -permissions [expr {([file attributes $info($w,filename) -permissions] ^ 000200)}]} err]} {
        tk_messageBox -type ok -message [mc "Can't set file permissions.\nError:\n%s" $err] -icon error
      }
    }
    if {!$info(lock_bug)} {
      set info($w,locked) [expr {[file isfile $info($w,filename)] && ![file writable $info($w,filename)]}]
    } else {
      set info($w,locked) 0
    }
  } else {
    if {$info($w,filename) == ""} {
      if {[tk_messageBox -title [mc "File is not saved."] -message [mc {You can't lock a file until it is saved. Do you want to save this file now?}] -type "yesno" -icon question -default no] == "no"} {
        set info($w,locked) 0
      } else {
        save_file $w "Save_as"
      }
    } else {
      if {[tk_messageBox -title [mc "File doesn't exist."] -message [mc {The file %1$s no longer exists on the disk. Do you want to save this file now?} $info($w,filename)] -type "yesno" -icon question -default no] == "no"} {
        set info($w,locked) 0
      } else {
        save_file $w "Save_as"
      }
    }
  }
  if {!$info(android) && [winfo class $w.infoframe.locked] ne "TCheckbutton"} {
    $w.infoframe.locked configure -image $toolbar_images([expr {$info($w,locked)?"locked":"unlocked"}])
  }
}

###########
## delete Phred data and remove Phred button from a sequence window
###########
proc phred_remove_data {w} {
  global info

    set info($w,phred_string) ""
    grid remove $w.infoframe.phred
    return 0
}

###########
## delete or update the seguid value after inserting, deleting or toggle_circular a window
###########
proc post_validate_seguid {w} {
  global info toolbar_images
  ##sputs post_validate_seguid
  if {![info exists info($w,SEGUID)] || $info($w,SEGUID) eq {}} {return}
  set verify_seguid [seguid $w]
  if {$info($w,SEGUID) ne $verify_seguid} {
    switch $info(seguid_mode) {
      2 {
        ## delete checksum
        set info($w,SEGUID) {}
        $w.infoframe.checksum configure -image $toolbar_images(fingerprint_off)
        if {$info(seguid_notify_on_invalid)} {
          tk_messageBox  -title [mc "Deleting Unique Identifier"] -message [mc "The unique identifier is invalid.\nRemoving unique identifier."] -type "ok"  -icon warning -parent $w
        }
      }
      3 {
       ## reset checksum
        set info($w,SEGUID) $verify_seguid
        if {$info(seguid_notify_on_invalid)} {
          tk_messageBox  -title [mc "Updating Unique Identifier"] -message [mc "The unique identifier is invalid.\nUpdating unique identifier."] -type "ok"  -icon warning  -parent $w
        }
      }
    }
  }
}

###########
## save a file
###########
proc save_file {w mode {type ""} {filename ""}} {
global info toolbar_images undo
global tcl_platform save_file_type

  set focus_win [focus]
  if {$focus_win == ""} {set focus_win .}

  while {(![file isdirectory $info(default_dnadir)]) } {
    set info(default_dnadir) [file dirname $info(default_dnadir)]
    if {[file dirname $info(default_dnadir)] == $info(default_dnadir)} {
      set info(default_dnadir) [valid_default_dir]
    }
  }

  if {$type == ""} {
    set type $info(default_file_format)
  }

  if {($mode != "Save_as") && ($info($w,filetype) != "None") && ($info($w,filetype) != $type) && $info(save_file_format_warning)} {
    set response [tk_messageBox -title [mc "Changing File Format"] -message [mc "%1\$s\nFile is currently of file type:%2\$s.\nIt will be saved as type: %3\$s.\n Do you want to change the file name?" $info($w,filename) $info($w,filetype) $type] -type "yesno"  -icon warning -default no]
    if {$response == "yes"} { 
      set mode "Save_as"
    }
  }

  if {[file tail $info($w,filename)] eq {}} {
	set initial_file [wm title $w]
  } else {
	set initial_file [file tail $info($w,filename)]
  }
  if {[file extension $initial_file] == "." || [file extension $initial_file] == ""} {
    set initial_file "$initial_file$info(default_file_extension)"
  }
  
  set save_file_type ""
      
  if {($mode == "Save_as") || ($info($w,filename) == "")} {

    if {$filename eq ""} {
      set initialdir [file dirname $info($w,filename)]
      if {($info($w,filename) == "") || (![file isdirectory $initialdir])} {
        set initialdir $info(default_dnadir)
      }
      set filename [tk_getSaveFile -title [mc "Save File As..."] -initialfile $initial_file -initialdir $info(default_dnadir) -parent $focus_win -filetypes {{"ApE" {.ape .dna .seq}} {"strider" {.str}} {"GenBank" {.gb}} {"fasta" {.fasta}} {"All files" {"*"}} } -typevariable save_file_type] 
      focus $focus_win
    }
  } else {
    set filename $info($w,filename)
  }
  if {$filename == ""} {return ""}
  #if {[file extension $filename] == ""} {set filename "$filename$info(default_file_extension)"}
sputs save type: $save_file_type
  while {!$info(lock_bug) && (([file isfile $filename] && ![file writable $filename]) && ($filename != ""))} {
    set response [tk_messageBox -title [mc "File is not writable."] -message [mc "%s\nFile is locked. Do you want to unlock it (Yes), save it with a different name (No) or cancel save (Cancel?)" $filename] -type "yesnocancel"  -icon warning -default no]
    if {$response == "yes"} {
      set info($w,filename) $filename
      toggle_locked $w
      if {![file writable $filename]} {
        set filename [tk_getSaveFile -title [mc "Sorry, couldn't unlock. Save File As..."] -initialfile $initial_file -initialdir $info(default_dnadir) -parent $focus_win -filetypes { {"ApE" {.ape .dna .seq}} {"strider" {.str}} {"GenBank" {.gb}} {"fasta" {.fasta}}  {"All files" {"*"}} } -typevariable save_file_type]
        set info($w,filename) $filename
      }
    } elseif {$response == "no"} {
      set filename [tk_getSaveFile -title [mc "Save File As..."] -initialfile $initial_file -initialdir $info(default_dnadir) -parent $focus_win -filetypes {{"ApE" {.ape .dna .seq}} {"strider" {.str}} {"GenBank" {.gb}} {"fasta" {.fasta}} {"All files" {"*"}} } -typevariable save_file_type]
    } else {
      set filename ""
    }
  }
  if {$filename == ""} {return ""}
  if {$save_file_type ne ""} {
    switch $save_file_type {
      "strider" {
        set type "DNA Strider"
      }
      "fasta" {
      set type "FASTA"
      }
      "GenBank" -
      "ApE" -
      default {
        set type "GenBank"
      }
    }
  }
sputs type: $type $filename

  if {[file extension $filename] == "."} {set filename "[file rootname $filename]$info(default_file_extension)"}
  if {[file extension $filename] == ""} {set filename "$filename$info(default_file_extension)"}

  if {$type == "DNA Strider"} {
    ######write strider format
    if {$info($w,circular) == "circular"} {set topology 1} else {set topology 0}
    set dnalength [ix2bp $w.textarea end]
    if {![catch {set fileid [open $filename w]} err_msg]} {
      fconfigure $fileid -translation binary
      puts -nonewline $fileid [binary format "cccx14cx10IIx60Ix12" 0 1 $topology $info($w,Dam_Dcm_methylated) $dnalength [expr {$info($w,startindex)-1}] [string length [$w.comframe.comtextframe.text get 1.0 end-1char]]]
      set text [textarea_get $w.textarea 1.0 [end_ix $w.textarea]]
      regsub -all -nocase "n" $text "*" text
      puts -nonewline $fileid $text
      puts -nonewline $fileid [$w.comframe.comtextframe.text get 1.0 end-1char]
      close $fileid
      set info($w,filetype) "DNA Strider"
    } else {
      tk_messageBox -title [mc "File not savable"] -message $err_msg
    }

  } elseif {$type == "GenBank"} {
    #####write genbank format
    if {![catch {set fileid [open $filename w]} err_msg]} {
      puts $fileid [genbank_text $w 1]
      close $fileid
      set info($w,filetype) "GenBank"
    } else {
      tk_messageBox -title [mc "File not savable"] -message $err_msg
    }
  } elseif {$type == "FASTA"} {
    #####write FASTA format
    if {![catch {set fileid [open $filename w]} err_msg]} {
      puts $fileid ">[file rootname [file tail $filename]]"
      set text [textarea_get $w.textarea 1.0 [end_ix $w.textarea]]
      puts $fileid $text
      close $fileid
      set info($w,filetype) "FASTA"
    } else {
      tk_messageBox -title [mc "File not savable"] -message $err_msg
      set info($w,saved) 0
      return ""
    }
  } else {
    tk_messageBox -title [mc "Filetype not savable"] -message [mc "I don't know how to save files in format:%s" $type]
      set info($w,saved) 0
      return ""
  }


  set info($w,saved) 1 
  if {[tk windowingsystem] == "aqua"} {wm attributes $w -modified 0 -titlepath $filename}
  set undo(saved_pointer,$w) 0
  set info($w,filename) $filename
  if {!$info(lock_bug)} {
    set info($w,locked) [expr {[file isfile $info($w,filename)] && ![file writable $info($w,filename)]}]
  } else {
    set info($w,locked) 0
  }
  if {!$info(android) && [winfo class $w.infoframe.locked] ne "TCheckbutton"} {
    $w.infoframe.locked configure -image $toolbar_images([expr {$info($w,locked)?"locked":"unlocked"}])
  }
  if {$info(dnadir_follows_open)} {
    set info(default_dnadir) [file dirname $filename]
  }
  wm title $w [file tail $filename]

  set info(open_previous) [linsert $info(open_previous) 0 $filename]
  update_windows_menu
  update_open_previous_menu
  return $filename
}

###########
## return GenBank file contents as text
###########
proc genbank_text {w {include_linked 0}} {
  global info genbank_qualifier_values genbank_unquoted_qualifiers

  set result ""
    set text [textarea_get $w.textarea 1.0 [end_ix $w.textarea]]
    set locus_line [lindex $info($w,genbank_header_list) 1]
    if {![regexp {LOCUS       (.*) ([0-9]*) bp (   |ss-|ds-|ms-)(NA    |DNA   |RNA   |tRNA  |rRNA  |mRNA  |uRNA  |snRNA |snoRNA)[ ]*(linear  |circular|        )[ ]*([ A-Z]{3})[ ]*(..-...-....)} $locus_line x genbank_locus_name size stranded genbank_type circular genbank_division_code date] || $circular== "        "} {
      set genbank_locus_name ""
      set genbank_division_code ""
      set stranded "   "
      if {[regexp {[Uu]} $text]} {
        set genbank_type "RNA   "
      } else {
        set genbank_type "DNA   "
      }
  
    }
    set genbank_locus_name [string trim $genbank_locus_name]
    if {$genbank_locus_name ==""} {set genbank_locus_name [file rootname [file tail $info($w,filename)]]}
    set genbank_locus_name [regsub -all {[^a-zA-Z0-9]} $genbank_locus_name _]
    if {$genbank_locus_name == ""} {set genbank_locus_name "New_DNA"}
    set genbank_locus_name [string range $genbank_locus_name 0 15]

    append result "[format "LOCUS       %-16s %+11s bp %-3s%-6s     %-8s %-3s %-11s" $genbank_locus_name [string length $text] $stranded $info($w,mol_type) $info($w,circular) $genbank_division_code [string toupper [clock format [clock seconds] -format "%d-%h-%Y"]]]\n"


   #if {$info(genbank_suppress_blank_fields)} {
   #   set temp_list [list]
   #   if {[lindex $info($w,genbank_header_list) 0]  == "LOCUS       "} {
   #     lappend temp_list [lindex $info($w,genbank_header_list) 0] [lindex $info($w,genbank_header_list) 1]
   #   }
   #   foreach {xx yy} $info($w,genbank_header_list) {
   #     if {($yy != "") && ($yy != ".")} {
   #       lappend temp_list $xx $yy
   #     }
   #   }
   #   set info($w,genbank_header_list) $temp_list
   # }


    ##strip any comment lines from the header (should be done in the genbank read, but just in case
    set header_list [list]
    foreach {type data} [lrange $info($w,genbank_header_list) 2 end] {
      if {$type != "COMMENT     "} {
        lappend header_list $type $data
      }
    }
    if {[$w.comframe.comtextframe.text get 1.0 end-1char] != ""} {
      foreach comm_line [split [$w.comframe.comtextframe.text get 1.0 end-1char] \n] {
        lappend header_list "COMMENT     " $comm_line
      }
    } else {
      lappend header_list "COMMENT     " ""
    }
    lappend header_list "COMMENT     " "ApEinfo:methylated:$info($w,Dam_Dcm_methylated)"
    if {[info exists info($w,SEGUID)] && $info($w,SEGUID) != {}} {
      if {$info($w,circular) == "circular"} {
        lappend header_list "COMMENT     " "ApEinfo:[seguid $w]"
      } else {
        lappend header_list "COMMENT     " "ApEinfo:[seguid $w]"
      }
    }
    if {$info($w,gformat_data) != {}} {
      lappend header_list "COMMENT     " "ApEinfo:graphicformat::$info($w,gformat_data)"
    }
  ##format each header field 
    foreach {type data} $header_list {
      if {(($data != "") && ($data != ".")) || (!$info(genbank_skip_blank))} {
        while {([string length $data] > 67) || ([string first \n $data] > -1)} {
          if {([set split [string first \n $data]] == -1) || ($split > 67)} {
            set split [string last " " $data 67]
          }
          if {$split < 0} {set split 67}
          set firstline [regsub -all {[ ]*$} [string range $data 0 [expr {$split-1}]] ""]
          set data [regsub {^[ ]*[\n]?} [string range $data $split end] ""]
          append result "$type$firstline\n"
          set type "            "
        } 
        append result "$type$data\n"
      }
    }



    ##ADD FEATURES HERE
    set temp_fea_list [list]
    foreach tag [$w.textarea tag names] {
      if {([regexp {f[0-9]+#} $tag]) && ([llength [$w.textarea tag ranges $tag]] > 1)} {
        lappend temp_fea_list $tag
      }
    }
    #set temp_fea_list [lsort -index 0 -integer $temp_fea_list]
    if {[llength $temp_fea_list] > 0} {
      append result "FEATURES             Location/Qualifiers\n"
    }
    set used_labels [list]
    foreach tag $temp_fea_list {
##metadata here
      set metadata [$w.textarea tag bind $tag <<Metadata>>]

      set loc [feature_coords_text $w $tag]
      if {[string first , $loc] > -1} {
        set loc "join($loc)"
      }
      if {[lindex $metadata 3]} {
        set loc "complement($loc)"
      }

      ##get sub-data lines (old style feature comments)
      set feature_comment [lindex $metadata 4]
        ##if feature comment isn't in a paired format, make it a note
      if {([llength $feature_comment] == 1) || (([llength $feature_comment] % 2) != 0)} {
        set feature_comment [list note $feature_comment]
      }
 
      ## set feature type
      set feature_type [lindex $metadata 2]
      ## set the XXX_class qualifiers for XXX:class formatted feature types 
      if {[regexp {regulatory:(.*)} $feature_type -- type_class]} {
        set feature_type "regulatory"
        lappend feature_comment regulatory_class $type_class
      } elseif {[regexp {nc_RNA:(.*)} $feature_type -- type_class]} {
        set feature_type "nc_RNA"
        lappend feature_comment ncRNA_class $type_class
      } elseif {[regexp {misc_recomb:(.*)} $feature_type -- type_class]} {
        set feature_type "misc_recomb"
        lappend feature_comment recombination_class $type_class
      }

      ##put feature definition line
      ##first the type and location indexes
      if {[string length $loc] <= 58} {
        append result "[format "     %-16s%s" $feature_type $loc]\n"
      } else {
        append result "[format "     %-16s%s" $feature_type [string range $loc 0 [string last "," $loc 58]]]\n"
        set loc [string range $loc [expr {[string last "," $loc 58]+1}] end]
        while {[string length $loc] > 58} {  
          set split [string last "," $loc 58]
          if {$split < 0} {set split 58}
          set firstline [string range $loc 0 $split]
          set loc [string range $loc [expr {$split+1}] end]
          append result "                     $firstline\n"
        }
        append result "                     $loc\n"
      }


      ##add label and colors data
      if {1} {
        set new_label [lindex $metadata 0]
        set label_i 1
        set base_label $new_label
        while {[lsearch -exact $used_labels $new_label] > -1} {
          set new_label "$base_label\($label_i)"
          incr label_i
        }
        ## change /label to /locus_tag in files
        lappend feature_comment locus_tag $new_label
        if {!$info(genbank_strict_genbank)} {
          lappend feature_comment label $new_label 
          lappend feature_comment ApEinfo_label [lindex $metadata 0]
        }
        lappend used_labels $new_label
      }
      if {!$info(genbank_strict_genbank)} {
        if {[lindex [$w.textarea tag bind $tag <<Revcolors>>] 0] != ""} {
          lappend feature_comment ApEinfo_fwdcolor [lindex [$w.textarea tag bind $tag <<Revcolors>>] 0]
        }
        if {[lindex [$w.textarea tag bind $tag <<Revcolors>>] 1] != ""} {
          lappend feature_comment ApEinfo_revcolor [lindex [$w.textarea tag bind $tag <<Revcolors>>] 1]
        }
        if {[lindex $metadata 1] != ""} {
          lappend feature_comment ApEinfo_graphicformat [lindex $metadata 1]
        }
        if {[$w.textarea tag cget $tag -background] == ""} {
          lappend feature_comment ApEinfo_hidden {}
        }
        if {[lindex $metadata 5] != ""} {
          foreach fea_group [lindex $metadata 5] {
            lappend feature_comment ApEinfo_group $fea_group
          }
        }
      }
      foreach {type data} $feature_comment {
        if {[dict exists $genbank_qualifier_values  [string tolower $type]]} {
          if {[dict get $genbank_qualifier_values  [string tolower $type]] ne "none"} {
            if {[string tolower $type] ni $genbank_unquoted_qualifiers} {
              set data "/$type=\"$data\""
            } else {
              set data "/$type=$data"
            }
          } else {
            set data "/$type"
          }
        } else {
          if {$type ne "ApEinfo_hidden"} {
            set data "/$type=\"$data\""
          } else {
            set data "/$type"
          }
        }
        while {[string length $data] > 58} {
          if {([set split [string first \n $data]] == -1) || ($split > 58)} {
            set split [string last " " $data 58]
          }
          if {$split < 0} {set split 58}
          set firstline [regsub -all {[ ]*$} [string range $data 0 [expr {$split-1}]] ""]
          set data [regsub {^[ ]*[\n]?} [string range $data $split end] ""]
          append result "                     $firstline\n"
        }
        append result "                     $data\n"
      }
    }

    append result "ORIGIN\n"

    ##sequence output
    set i 0
    while {$i < [string length $text]} {
      append result "[format "%+9s %s %s %s %s %s %s" [expr {$i+1}] [string range $text $i [expr {$i+9}]] [string range $text [expr {$i+10}] [expr {$i+19}]] [string range $text [expr {$i+20}] [expr {$i+29}]] [string range $text [expr {$i+30}] [expr {$i+39}]] [string range $text [expr {$i+40}] [expr {$i+49}]] [string range $text [expr {$i+50}] [expr {$i+59}]]]\n"
      incr i 60
    }
    append result "//"

  if {$include_linked && [info exists info($w,linked_abi_list)] && ($info($w,linked_abi_list) != {})} {
    for {set i 0} {$i < [llength $info($w,linked_abi_list)]} {incr i} {
      append result \n \n [encode_abi $w $i]
    }
  }
  return $result
}

###########
## return NCBI bankit feature table as text
## http://www.ncbi.nlm.nih.gov/WebSub/html/help/feature-table.html
###########
proc bankit_text {w} {
  global info

    set temp_fea_list [list]
    foreach tag [$w.textarea tag names] {
      if {([regexp {f[0-9]+#} $tag]) && ([llength [$w.textarea tag ranges $tag]] > 1)} {
        lappend temp_fea_list $tag
      }
    }
    #set temp_fea_list [lsort -index 0 -integer $temp_fea_list]
    if {[llength $temp_fea_list] == 0} {
      return ""
    }

    set result ""
    foreach tag $temp_fea_list {
      set metadata [$w.textarea tag bind $tag <<Metadata>>]
      set loc [feature_coords_text $w $tag]
      regsub -all {\.\.} $loc {.} loc
      ##put sub-data lines
      set name  [lindex $metadata 0]
      set type  [lindex $metadata 2]
      set dir  [lindex $metadata 3]
      set feature_comment [lindex $metadata 4]
      set loc_list [split $loc ,]
      if {$dir} {
        set loc_list [lreverse $loc_list]
      }
      set l [split [lindex $loc_list 0] "."]
      if {$dir} {
        set l [lreverse $l]
      }
      append result "[lindex $l 0]\t[lindex $l 1]\t$type\n"

      foreach l [lrange $loc_list 1 end] {
        set l [split $l "."]
        if {$dir} {
          append result "[lindex $l 1]\t[lindex $l 0]\n"
        } else {
          append result "[lindex $l 0]\t[lindex $l 1]\n"
        }
      }
      append result "\t\t\tlabel\t$name\n"
    } 
  return $result

}

###########
## cut and copy  function
###########
proc clip_cut_copy {w {function copy} {direction normal}} {
  global info undo
  global tcl_platform

  if {($function == "cut") && [file_lock_check $w 1]} {return}
  if {[llength [$w.textarea tag ranges sel]] > 0} {
    if {[llength [$w.textarea tag ranges sel]] == 2} {
      set text [textarea_get $w.textarea sel.first sel.last]
      if {$direction == "rev-com"} {
        set tags [get_tags_exact $w.textarea [list [$w.textarea index sel.first] [$w.textarea index sel.last]] reverse]
        set text [revcom $text]
      } else {
        set tags [get_tags_exact $w.textarea [list [$w.textarea index sel.first] [$w.textarea index sel.last]] forward]
      }
    } else {
      set text [textarea_get $w.textarea [lindex [$w.textarea tag ranges sel] 0] [lindex [$w.textarea tag ranges sel] 1]]
      set text2 [textarea_get $w.textarea [lindex [$w.textarea tag ranges sel] 2] [lindex [$w.textarea tag ranges sel] 3]]
      if {$direction == "rev-com"} {
        set tags [get_tags_exact $w.textarea [list [lindex [$w.textarea tag ranges sel] 0] [lindex [$w.textarea tag ranges sel] 1]] reverse]
        set tags [join_tags $tags [get_tags_exact $w.textarea [list [lindex [$w.textarea tag ranges sel] 2] [lindex [$w.textarea tag ranges sel] 3]] reverse] [string length $text]]
        set text "[revcom $text][revcom $text2]"
      } else {
        set tags [get_tags_exact $w.textarea [list [lindex [$w.textarea tag ranges sel] 2] [lindex [$w.textarea tag ranges sel] 3]] forward]
        set tags [join_tags $tags [get_tags_exact $w.textarea [list [lindex [$w.textarea tag ranges sel] 0] [lindex [$w.textarea tag ranges sel] 1]] forward] [string length $text2]]
        set text "$text2$text"
      }
    }
#selection used here - ok
    clipboard clear 
    clipboard_append -displayof $w $text
    set info(clipboard_text) $text
    set info(clipboard_tags) $tags

    if {$function == "cut" && [$w.textarea tag ranges sel] !={}} {
      lappend undo(undo,$w) [list unlink_analysis_window $w [unlink_analysis_window $w]]
      foreach {r1 r2} [$w.textarea tag ranges sel] {
        textarea_delete $w.textarea $r1 $r2
#selection used here - ok
      }
      post_validate_seguid $w
      register_undo_separator $w [mc "Cut"]
      features_to_tree_view $w
      vertindexbalancer $w
      selection_manager $w
    }
    if {($tcl_platform(platform) == "unix") && ([tk windowingsystem] != "aqua")} {
      if {$function == "copy"} {
        foreach {r1 r2} [$w.textarea tag ranges sel] {
          $w.textarea tag add tempsel $r1 $r2
          #selection used here - ok
        }
      }
      selection own -selection CUT_BUFFER0 $w
      selection own -selection CLIPBOARD $w
      if {$function == "copy"} {
        foreach {r1 r2} [$w.textarea tag ranges tempsel] {
          $w.textarea tag add sel $r1 $r2
          #selection used here - ok
        }
      }
      #warning_dialog "cutbuffer0 owned by:[selection own -displayof $w -selection CUT_BUFFER0]; primary oned by [selection own -displayof $w -selection CLIPBOARD]"
    }
  }
}

###########
## Mac clipboard bug workaround
###########
proc clipboard_append {args} {
  global info
  if {$info(bbedit_bug)} {
    exec echo -n [lindex $args end] | pbcopy
  } else {
    clipboard append {*}$args
  }
}

###########
## determine whether a text is an RNA sequence
###########
proc is_RNA {text} {
  return [expr {![regexp -nocase {[^ACGUN]} $text] && [regexp -nocase {U} $text]}]
}

###########
## paste  function
###########
proc clip_paste {w {direction normal}} {
  global info  undo
  global tcl_platform

#tk_messageBox -message [mc "clip paste"]
  if {($tcl_platform(platform) == "unix") && ([tk windowingsystem] != "aqua")} {
    if {[catch {set text [selection get -displayof $w -selection CLIPBOARD]}]} {return}
  } else {
    if {[catch {set text [clipboard get]}]} {return}
  }


  regsub -all {\r\n} $text "\n" text
  regsub -all {\r} $text "\n" text
  if {[regexp {LOCUS[[:space:]]+(.*)[[:space:]]+([0-9]*) bp.*\n.*ORIGIN.*//} $text] || ([regexp {>.*\n[ACGTNBDHKMRSUVWYacgtnbdhkmrsuvwy]+} $text])} {
    paste_file $w $text
    return
  }

  if {[file_lock_check $w 1]} {return}
  
  if {$info($w,mol_type) eq "DNA"} {
    if {[is_RNA $text]} {
      regsub -all {U} $text "T" text
      regsub -all {u} $text "t" text
    }
  } elseif {$info($w,mol_type) eq "RNA"} {
    if {![is_RNA $text]} {
      regsub -all {T} $text "U" text
      regsub -all {t} $text "u" text
    }
  }

  regsub -all {[[:space:]0-9]} $text "" text
  regsub -all {[*]} $text "N" text
  set text [atgcfilter $text $info(allowedkeys) 1]
  if {$direction == "rev-com"} {set text [revcom $text]}
  if {$text == ""} return
  

  lappend undo(undo,$w) [list unlink_analysis_window $w [unlink_analysis_window $w]]
  if {[llength [$w.textarea tag ranges sel]] > 0} {
    textarea_delete $w.textarea sel.first sel.last
  } 


###some sort of bug (maybe only on windows) when inserting at insert mark, if insert is at 1.0
  if {0 && [$w.textarea compare insert == 1.0]} {
    $w.textarea mark set insert [end_ix $w.textarea]
    $w.textarea mark set anchor [end_ix $w.textarea]
    $w.textarea mark set tk::anchor$w.textarea [end_ix $w.textarea]
    textarea_insert $w.textarea 1.0 $text
    $w.textarea mark set insert [bp2ix $w.textarea [string length $text]]
    $w.textarea mark set anchor 1.0
    $w.textarea mark set tk::anchor$w.textarea 1.0
  } else {
    textarea_insert $w.textarea [$w.textarea index insert] $text
  }
  
  set insert_first [bp2ix $w.textarea [expr {[ix2bp $w.textarea [$w.textarea index insert]]-[string length $text]}]] 
  set insert_last  [$w.textarea index insert]

  split_tags_after_insertion $w $insert_first $insert_last

  if {($direction == "rev-com") && ($text == [revcom $info(clipboard_text)])} {
    put_tags $w.textarea [list [bp2ix $w.textarea [expr {[ix2bp $w.textarea [$w.textarea index insert]]-[string length $text]}]] [$w.textarea index insert]] $info(clipboard_tags) reverse
  } elseif {($direction != "rev-com") && ($text == $info(clipboard_text))} {
    put_tags $w.textarea [list [bp2ix $w.textarea [expr {[ix2bp $w.textarea [$w.textarea index insert]]-[string length $text]}]] [$w.textarea index insert]] $info(clipboard_tags)
  } 
  post_validate_seguid $w
  register_undo_separator $w [mc "Paste"]
  features_to_tree_view $w
 
  select_region $w [bp2ix $w.textarea [expr {[ix2bp $w.textarea [$w.textarea index insert]]-[string length $text]}]] insert
  vertindexbalancer $w
} 

###########
## copy special (translated, reverse com, etc. function)
###########
proc clip_copy_special {w function {direction normal}} {
  set temp_text ""
  clipboard clear 
  if {[llength [$w.textarea tag ranges sel]] > 0} {
    if {[llength [$w.textarea tag ranges sel]] == 2} {
      set temp_text [textarea_get $w.textarea sel.first sel.last]
    } else {
      set temp_text [textarea_get $w.textarea [lindex [$w.textarea tag ranges sel] 0] [lindex [$w.textarea tag ranges sel] 1]]
      set text2 [textarea_get $w.textarea [lindex [$w.textarea tag ranges sel] 2] [lindex [$w.textarea tag ranges sel] 3]]
      set temp_text "$text2$temp_text"
    }
  } else {
    set temp_text [textarea_get $w.textarea 1.0 end]
  }
  if {$direction == "rev_com"} {
    set temp_text [revcom $temp_text]
   } 
  #selection used here - ok
  switch $function {
    upper {
      clipboard_append -displayof $w [regsub -all {[^A-Z]} $temp_text ""]
    }
    translated {
      clipboard_append -displayof $w [translate $temp_text]
    }
    translated_uc {
      clipboard_append -displayof $w [translate [regsub -all {[a-z]} $temp_text ""]]
    }
    reverse {
      clipboard_append -displayof $w [rev $temp_text]
    }
    complement {
      clipboard_append -displayof $w [com $temp_text]
    }
    rna {
      regsub -all {[t]} $temp_text "u" temp_text
      clipboard_append -displayof $w [regsub -all {[T]} $temp_text "U"]
    }
    fasta {
      if {[llength [$w.textarea tag ranges sel]] == 2} {
        clipboard_append -displayof $w ">[file rootname [wm title $w]] [ix2bp $w.textarea sel.first]-[ix2bp $w.textarea sel.last]\n$temp_text"
      } else {
        clipboard_append -displayof $w ">[file rootname [wm title $w]] [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 2]]-[ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 1]]\n$temp_text"
      }
#selection used here - ok
    }
  }
}

###########
## update the copy special: copy feature text menu to list all features in $w
###########
proc update_copy_features_menu {w} {
}

###########
## copy special: copy feature text
###########
proc clip_copy_features_text {w tag} {
  global info
  set dna ""
  set tags [list]
  foreach range [feature_coords $w $tag] {
    foreach {i1 i2} $range {}
    incr i2
    set newdna  [textarea_get $w.textarea [bp2ix $w.textarea $i1] [bp2ix $w.textarea $i2]]
    set tags [join_tags $tags [get_tags_exact $w.textarea [list [bp2ix $w.textarea $i1] [bp2ix $w.textarea $i2]] "forward"] [string length $dna]]
    append dna $newdna
  }
  clipboard clear
  clipboard_append -displayof $w $dna 
  set info(clipboard_text) $dna
  set info(clipboard_tags) $tags
}

###########
## copy special: copy feature text
###########
proc clip_copy_analysis_text_windows {t} {

  if {[info procs ::twapi::open_clipboard] =={}} {sputs no twapi; event generate $t <<Copy>>;return}
  if {[$t tag ranges sel] !={}} {
    set range [$t tag ranges sel]
  } else {
   set range [list 1.0 end]
  }
  set html_text [text_to_clipboard_html $t $range]
  set html_len [string length $html_text]
  set full_html_text [format "Version:0.9\r\nStartHTML:0000000105\r\nEndHTML:%010u\r\nStartFragment:0000000141\r\nEndFragment:%010u\r\n<html>\r\n<body>\r\n<!--StartFragment-->%s<!--EndFragment-->\r\n</body>\r\n</html>" [expr {105 +$html_len}]  [expr {141 +$html_len}] $html_text]
  
  ::twapi::open_clipboard
  ::twapi::empty_clipboard
  set f [::twapi::register_clipboard_format "HTML Format"]
  ::twapi::write_clipboard $f $full_html_text
  ::twapi::write_clipboard_text [textarea_get $t {*}$range]
  ::twapi::close_clipboard
}

###########
## send out the cut buffer for unix pastes
###########
proc unix_cubuffer_handler {{offset 0} {maxchars 1000000}} {
  global info
  #sputs "$offset $maxchars"
  #sputs [string range $info(clipboard_text) $offset [expr {$offset+$maxchars-1}]]
  return [string range $info(clipboard_text) $offset [expr {$offset+$maxchars-1}]]
}

###########
## Paste buffer contained a complete file- save the file and open it
###########
proc paste_file {w text} {
  global info

  if {([regexp  {^>([^\n]+)\n([ACGTNBDHKMRSUVWYacgtnbdhkmrsuvwy\n]+)} $text x name data])} {
    #processing for fasta format file
  } elseif {[regexp {LOCUS[[:space:]]+(.*)[[:space:]]+([0-9]+)[[:space:]]?bp} $text]} {
    if {![regexp {LOCUS       ([^\n]*) ([0-9]*) bp (   |ss-|ds-|ms-)(NA    |DNA   |RNA   |tRNA  |rRNA  |mRNA  |uRNA  |snRNA |snoRNA|dna   |rna   )[ ]*(linear  |circular|        )[ ]*([ A-Z]{3})[ ]*(..-...-....)} $text x name size stranded type circular div date]} {
      if {![regexp {LOCUS[[:space:]]+([^\n]*)[[:space:]]+([0-9]+)[[:space:]]?bp} $text x name size]} {
        set name ""
      }
      regsub -all {[^a-zA-Z0-9]} $name _ name
    }
    #processing for GenBank format file
  } else  {
    sputs unknown format
    return
  }

  set name [string trim $name " "]
  regsub -all {[\\:\./]} $name "_" name
  if {$name == ""} {set name [mc "Untitled"]}


  set filename [tk_getSaveFile -title [mc "Save File from Clipboard"] -parent $w  -initialfile "$name$info(default_file_extension)" -initialdir $info(default_dnadir) -filetypes {{"ApE" {.ape .str .dna .seq .gb}} {"All files" {"*"}}}]


  while {([file isfile $filename] && ![file writable $filename]) && ($filename != "") } {
    set response [tk_messageBox -title [mc "File is not writable."] -message [mc "%s\nFile is locked. Do you want to unlock it (Yes), save it with a different name (No) or cancel save (Cancel?)" $filename] -type "yesnocancel"  -icon warning -default no]
    if {$response == "yes"} {
      set info($w,filename) $filename
      toggle_locked $w
      if {![file writable $filename]} {
        if {$info(use_cocoa)} {
          after 200
        }
        set filename [tk_getSaveFile -title [mc "Sorry, couldn't unlock. Save File As..."] -initialdir $info(default_dnadir) -parent $w -filetypes {{"ApE" {.ape .str .dna .seq .gb}} {"All files" {"*"}}}]
        set info($w,filename) $filename
      }
    } elseif {$response == "no"} {
      set filename [tk_getSaveFile -title [mc "Save File As..."] -initialdir $info(default_dnadir) -parent $w -filetypes {{"ApE" {.ape .str .dna .seq .gb}} {"All files" {"*"}}}]
    } else {
      set filename ""
    }
  }
  if {[file extension $filename] == "."} {set filename "[file rootname $filename]$info(default_file_extension)"}
  if {([file extension $filename] == "") && ($filename != "")} {set filename "$filename$info(default_file_extension)"}

  if {$filename == ""} {return}

  if {$info(dnadir_follows_open)} {
    set info(default_dnadir) [file dirname $filename]
  }

  set fid [open $filename w]
  puts $fid $text
  close $fid
  catch {open_file $filename}
}


###########
## get tags from a selection for storage
###########
#(list of tag data pairs siutable for array get; data = list of indices, list of properties, list of bindings, list of actions bound)
#Use only for exact copy of tags for formatting -for making a copy of a region replaced with get_tags2 in wrapper below
proc get_tags_exact {text range {direction forward}} {
  set first [lindex $range 0]
  set first [$text index $first]
  set last [lindex $range 1]
  set last [$text index $last]

  set firstchar [ix2bp $text $first]
  set lastchar [ix2bp $text $last]

  foreach tagname [$text tag names $first] {
    set tags($tagname) $first
  }


  foreach {action tagname index} [$text dump -tag $first+1char $last+1chars] {
    lappend tags($tagname) $index
  }

  foreach tagname [$text tag names $last] {
    if {[info exists tags($tagname)]} {
      if {[lindex $tags($tagname) 0] != $last} {
        lappend tags($tagname) $last
      } else {
        array unset tags $tagname
      }
    } else {
      sputs doesn't exist $tagname in $text at $last [$text tag names $last]
    }
  }

  set result [list]

  foreach tagname [$text tag names] {
    if {[lsearch -exact [array names tags] $tagname] == -1} {continue}
    set indexlist [list]
    foreach index $tags($tagname) {
      if {$direction == "forward"} {
        lappend indexlist [expr {[ix2bp $text $index] - $firstchar}]
      } else {
        set indexlist [linsert $indexlist 0 [expr {$lastchar - [ix2bp $text $index] }]]
      }
    }
    set formatlist [list [$text tag cget $tagname -background] [$text tag cget $tagname -foreground] [$text tag cget $tagname -font] [$text tag cget $tagname -underline]]
    set bindlist [$text tag bind $tagname]
    set actionlist [list]
    foreach binding $bindlist {
      lappend actionlist [$text tag bind $tagname $binding]
    }

    ###change the metadata and colors if the tags are getting reversed
    if {$direction == "reverse"} {
      #change the direction data in the Features metadata
      if {[set pos [lsearch $bindlist <<Metadata>>]] != -1} {
        set metadata [lindex $actionlist $pos]
        #set dir [lindex $metadata 3]
        set metadata [lreplace $metadata 3 3 [expr {![lindex $metadata 3]}]]
        set actionlist [lreplace $actionlist $pos $pos $metadata]
      }
      #change the colors if a reverse color is provided
      if {[set pos [lsearch $bindlist <<Revcolors>>]] != -1} {
        set colorlist [lindex $actionlist $pos]
        if {[lindex $formatlist 0] != ""} {
         if {[lindex $formatlist 0] != [lindex $colorlist 0]} {
            set formatlist [lreplace $formatlist 0 0 [lindex $colorlist 0]]
          } else {
            set formatlist [lreplace $formatlist 0 0 [lindex $colorlist 1]]
          }
        }
      }
    }
    if {($tagname ne "sel") && ($tagname ne "tempsel")} {
      lappend result $tagname [list $indexlist $formatlist $bindlist $actionlist]
    }
    #set tags($tagname) [list $indexlist $formatlist $bindlist $actionlist]
    #sputs "$tagname: $tags($tagname)"
  }
  #array unset tags sel
  #array unset tags tempsel
  #return [array get tags]
  return $result
}

############
## Trial - replace get_tags with get_tags2
############
proc get_tags {text range {direction forward}} {
  foreach {a b} $range {}
  return [get_tags2 $text [ix2bp $text $a] [ix2bp $text $b] [expr {$direction eq "reverse"}]]
}

############
##
############
proc get_tags2 {text tag_first tag_last dir {end 0}} {
  set new_tags [list]
  set len [ix2bp $text end]

  if {$tag_last < 0} {
    ## sequence wraps around more than len (3' overhanging gel fragment
    set tag_last [expr {$tag_last % $len}]
    set more_than_full_circle 1
  } else {
    set more_than_full_circle 0
  }

  foreach tag [$text tag names] {
    if {($tag eq "sel") || ($tag eq "tempsel")} {continue}

    set range_list [$text tag ranges $tag]
    set newcoords [list]

    if {!$more_than_full_circle} {
      set newcoords [get_tags_get_coords $text $tag $tag_first $tag_last $dir $len $end]
    } else {
       # get the extra tail and append it
      if {$dir} {
        # get full circle from end
        set newcoords [get_tags_get_coords $text $tag $tag_last $tag_last $dir $len $end]
      } else {
        # get full circle from beginning
        set newcoords [get_tags_get_coords $text $tag $tag_first $tag_first $dir $len $end]
      }
      set newcoords_tail [get_tags_get_coords $text $tag $tag_first $tag_last $dir $len [expr {$end+ $len}]]
      if {[lindex $newcoords_tail 0] ==  [lindex $newcoords end] } {
        set newcoords [concat [lrange $newcoords 0 end-1] [lrange $newcoords_tail 1 end]]
      } else {
        set newcoords [concat $newcoords $newcoords_tail]
      }
    }

    if {$newcoords != [list]} {
      set formatlist [list [$text tag cget $tag -background] [$text tag cget $tag -foreground] [$text tag cget $tag -font] [$text tag cget $tag -underline]]
      set bindlist [$text tag bind $tag]
      set actionlist [list]
      foreach binding $bindlist {
        lappend actionlist [$text tag bind $tag $binding]
      }

      ### Need to reverse the <<Metadata>> setting if $dir
      if {$dir} {
        #change the direction data in the Features metadata
        if {[set pos [lsearch $bindlist <<Metadata>>]] != -1} {
          set metadata [lindex $actionlist $pos]
          lset metadata 3 [expr {![lindex $metadata 3]}]
          lset actionlist $pos $metadata
        }
        #change the colors if a reverse color is provided
        if {[set pos [lsearch $bindlist <<Revcolors>>]] != -1} {
          set colorlist [lindex $actionlist $pos]
          if {[lindex $formatlist 0] != ""} {
            lset formatlist 0 [lindex $colorlist 1]
          }
        }
      }
      lappend new_tags $tag [list $newcoords $formatlist $bindlist $actionlist]
    }
  }

  foreach fntag [lsearch -inline -all -regexp [dict keys $new_tags] {fn[0-9]+#}] {
    set ftag [regsub fn $fntag f]
    if {![dict exists $new_tags $ftag]} {
      dict unset new_tags $fntag
      continue
    }
    set fndata [dict get $new_tags $fntag]
    set fdata [dict get $new_tags $ftag]
    set fncoords [lsort -integer [lindex $fndata 0]]
    set fcoords [lsort -integer [lindex $fdata 0]]


    ## find tags that are now at the new ends and make them separate
  # convert to while >2 and take the last two to a new feature
    while {[llength $fncoords] >2} {
      set end_coord [lindex $fncoords end-1]
      set new_fncoords [lrange $fncoords end-1 end]
      set fncoords [lrange $fncoords 0 end-2]
      set k [lsearch $fcoords $end_coord]
      set new_fcoords [lrange $fcoords $k end]
      incr k -1
      set fcoords [lrange $fcoords 0 $k]
      set m 0
      while {[dict exists $new_tags "f$m#"] && $m < 1000000} {incr m}
      lset fndata 0 $new_fncoords
      dict set new_tags "fn$m#" $fndata
      lset fdata 0 $new_fcoords
      dict set new_tags "f$m#" $fdata

    }
    lset fndata 0 $fncoords
    dict set new_tags $fntag $fndata
    lset fdata 0 $fcoords
    dict set new_tags $ftag $fdata
  }
# here
  ## if the first part of a tag is at the end while the last has been put at the beginning, make a new tag for the last part
  ## find tags that are now at the new ends and make them separate
  foreach ftag [lsearch -inline -all -regexp $new_tags {f[0-9]+#}] {
    if {[dict exists $new_tags [regsub f $ftag fn]]} {continue}
    set fcoords [lsort -integer [lindex [dict get $new_tags $ftag] 0]]
    while {[llength $fcoords] >2} {
      set new_fcoords [lrange $fcoords end-1 end]
      set fcoords [lrange $fcoords 0 end-2]
      set fdata [dict get $new_tags $ftag]
      lset fdata 0 $fcoords
      dict set new_tags $ftag $fdata
      lset fdata 0 $new_fcoords
      set m 0
      while {[dict exists $new_tags "f$m#"] && $m < 1000000} {incr m}
      dict set new_tags "f$m#" $fdata
    }
  }

  ## take out fn tags that exactly match coordinates of their ftag
  foreach fntag [lsearch -inline -all -regexp $new_tags {fn[0-9]+#}] {
    set ftag [regsub fn $fntag f]
    if {[lindex [dict get $new_tags $fntag] 0] == [lindex [dict get $new_tags $ftag] 0]} {
      set new_tags [dict remove $new_tags $fntag]
    }
  }
  return $new_tags
}

#########
##
########
proc get_tags_get_coords {text tag  tag_first tag_last dir len end} {


  set range_list [$text tag ranges $tag]

  set newcoords [list]
  set frag_length [expr {($tag_last - $tag_first - 1) % $len +1}]
  foreach {a b} $range_list {
    set a [ix2bp $text $a]
    set b [ix2bp $text $b]

    if {$dir} {
      if { $a <= $tag_first && $tag_first < $tag_last && $tag_last <= $b} {
        set a $end
        set b [expr {$frag_length + $end}]
      } else {
        set a1 [expr {min($frag_length,($tag_last - $b) % $len) + $end}]
        set b [expr {min($frag_length,($tag_last - $a) % $len) + $end}]
        set a $a1
      }
    } else {
      if { $a <= $tag_first && $tag_first < $tag_last && $tag_last <= $b} {
        set a $end
        set b [expr {$frag_length + $end}]
      } else {
        set a [expr {min($frag_length,($a - $tag_first) % $len) + $end}]
        set b [expr {min($frag_length,($b - $tag_first) % $len) + $end}]
      }
    }

    if {$a != $b} {
      set a [expr {$a == ($frag_length + $end)? $end: $a}]
      if {$a > $b} {
        lappend newcoords $end $b
        lappend newcoords $a [expr {$frag_length  + $end}]
      } else {
        lappend newcoords $a $b
      }
    }
  }

  if {$newcoords != [list]} {
    ## sort coords and 
    set newcoords [lsort -integer $newcoords]

    ## take out junction that was the original origin (if circular)
    if {$tag_last <= $tag_first} {
      if {$dir} {
        set z [expr {(($tag_last - 0) % $len) + $end}]
      } else {
        set z [expr {((0 - $tag_first) % $len) + $end}]
      }
      if {[set a [lsearch $newcoords $z]] != -1 && [lindex $newcoords [expr {$a +1}]] == $z} {
        set newcoords [lreplace $newcoords $a [expr {$a +1}]]
      }
    }
  }
  return $newcoords
}

###########
## join taglists across origin (see get_tags)
###########
proc join_tags {taglist1 taglist2 offset} {
  set i 0
  while {$i < [llength $taglist2]} {
    if {[set pos [lsearch -exact $taglist1 [lindex $taglist2 $i]]] > -1} {
      incr pos
      set newrange [list]
      foreach bp [lindex $taglist2 [expr {$i+1}] 0] {
        lappend newrange [expr {$bp+$offset}]
      }
      lset taglist1 $pos 0 [list {*}[lindex $taglist1 $pos 0] {*}$newrange]
      set taglist2 [lreplace $taglist2 $i [expr {$i+1}]]
    } else {
      incr i 2
    }
  }
  foreach {tag data} $taglist2 {
    set newrange [list]
    foreach bp [lindex $data 0] {
      lappend newrange [expr {$bp+$offset}]
    }
    lset data 0 $newrange
    lappend taglist1 $tag $data
  }
  return $taglist1
}

###########
## put tags back onto a selection (see get_tags)
###########
proc put_tags {text range taglist {direction forward} {rename 1}} {
  global fea_info info

  set first [ix2bp $text [lindex $range 0]]
  set last [ix2bp $text [lindex $range 1]]
  set name_store [list]

  foreach {tagname tagdata} $taglist {
    set formatlist [lindex $tagdata 1]
    set bindlist [lindex $tagdata 2]
    set actionlist [lindex $tagdata 3]

    if {([regexp {f[0-9]+#} $tagname]) && ($rename == 1)} {
      set newtagname "f$fea_info([winfo parent $text],count)#"
      incr fea_info([winfo parent $text],count)
      textarea_tag_create $text $newtagname
      lappend name_store $tagname $newtagname
    } else {
      set newtagname $tagname
    }

    ###change the metadata and colors if the tags are getting reversed
    if {$direction == "reverse"} {
      #change the direction data in the Features metadata
      if {[set pos [lsearch $bindlist <<Metadata>>]] != -1} {
        set metadata [lindex $actionlist $pos]
        set metadata [lreplace $metadata 3 3 [expr {![lindex $metadata 3]}]]
        set actionlist [lreplace $actionlist $pos $pos $metadata]
      }
      #change the colors if a reverse color is provided
      if {([set pos [lsearch $bindlist <<Revcolors>>]] != -1)} {
        set colorlist [lindex $actionlist $pos]
        if {[lindex $formatlist 0] != ""} {
          if {[lindex $formatlist 0] != [lindex $colorlist 0]} {
            set formatlist [lreplace $formatlist 0 0 [lindex $colorlist 0]]
          } else {
            set formatlist [lreplace $formatlist 0 0 [lindex $colorlist 1]]
          }
        }
      }

      if {$newtagname == "foundf"} {set newtagname "foundr"} elseif {$newtagname == "foundr"} {set newtagname "foundf"}
    }

    if {($rename == 0) || (![regexp {fn[0-9]+#} $tagname])} {
      foreach {start end} [lindex $tagdata 0] {
        if {$end eq {}} {continue}
        if {$direction == "forward"} {
          if {[$text compare  [bp2ix $text [expr {$first+$end}]] > [end_ix $text]]} {
            #sputs put_tags tag past end
            textarea_tag_add $text $newtagname [bp2ix $text [expr {$first+$start}]]  [end_ix $text]
          } else {
            textarea_tag_add $text $newtagname [bp2ix $text [expr {$first+$start}]] [bp2ix $text [expr {$first+$end}]]
          }
        } else {
          if {[$text compare  [bp2ix $text [expr {$last-$start}]] > [end_ix $text]]} {
            #sputs put_tags tag past end
            textarea_tag_add $text $newtagname  [bp2ix $text [expr {$last-$end}]]  [end_ix $text]
          } else {
            textarea_tag_add $text $newtagname  [bp2ix $text [expr {$last-$end}]]  [bp2ix $text [expr {$last-$start}]]
          }
        }
      }
      textarea_tag_configure $text $newtagname -background [lindex $formatlist 0] -foreground [lindex $formatlist 1] -font [lindex $formatlist 2] -underline  [lindex $formatlist 3] 
      foreach binding $bindlist action $actionlist {
        textarea_tag_bind $text $newtagname $binding $action
      }
      if {$tagname != $newtagname} {
        catch {textarea_tag_raise $text $newtagname $tagname}
        if {[$text tag ranges $tagname] == ""} {textarea_tag_delete $text $tagname}
      }
    }
  }

  $text tag configure foundf -background $info(find_forward_highlight)
  $text tag configure foundr -background $info(find_reverse_highlight)
 
  ##make new fn# tags for split features that just got added in rename mode
  foreach {old_tag new_tag} $name_store {
    if {[regexp {f[0-9]+#} $old_tag]} {
      set old_fn_tag "fn[regexp -inline {[0-9]+} $old_tag]#"
      if {([lsearch -exact $taglist $old_fn_tag] > -1) && ([llength [lindex $taglist [expr {[lsearch -exact $taglist $old_tag]+1}] 0]] > 2)} {
        set new_fn_tag "fn[regexp -inline {[0-9]+} $new_tag]#"
        lappend name_store $old_fn_tag $new_fn_tag
        foreach {start end} [lindex $taglist [expr {[lsearch -exact $taglist $old_fn_tag]+1}] 0] {
          if {$direction == "forward"} {
            textarea_tag_add $text $new_fn_tag [bp2ix $text [expr {$first+$start}]] [bp2ix $text [expr {$first+$end}]]
          } else {
            textarea_tag_add $text $new_fn_tag [bp2ix $text [expr {$last-$end}]] [bp2ix $text [expr {$last-$start}]]
          }
        }
        catch {textarea_tag_raise $text $new_fn_tag $old_fn_tag}
        if {[$text tag ranges $old_fn_tag] == ""} {textarea_tag_delete $text $old_fn_tag}
      }
    }
  }
  

  features_to_tree_view [winfo toplevel $text]
  return $name_store
}

############
##
############
proc lappend_tags {tag_variable args} {
  upvar $tag_variable old_tags
  set used_names [list]
  foreach {name data} $old_tags {
    lappend used_names $name
  }
  set fn_tags_list [list]
  set ftags_map [dict create]
  foreach {name data} $args {
    if {[regexp  {fn([0-9]+)#} $name - number]} {
     lappend fn_tags_list $number $data
    } elseif {[regexp {f([0-9]+)#} $name - number]} {
      if {[lsearch $used_names $name] == -1} {
        lappend old_tags $name $data
        lappend used_names $name
        if {[regexp {f([0-9]+)#} $name - number]} {
          dict set ftags_map $number $number
	} 
      } else {
        set i 0
        while {[lsearch $used_names f$i\#] > -1} {
          incr i
        }
        lappend old_tags f$i\# $data
	lappend used_names f$i\#
        if {[regexp {f([0-9]+)#} $name - number]} {
          dict set ftags_map $number $i
        }
      }
    } else {
      ## not an f or fn tag- just add it
      lappend old_tags $name $data
    }
  }
  foreach {number data} $fn_tags_list {
    if {[dict exists $ftags_map $number] } {
      lappend old_tags "fn[dict get $ftags_map $number]#" $data
    }
  }
}



  
#############
## copy tags into a destination analysis window
#############
proc copy_tags {text range dest dest_index {direction forward} {tagappend ""}} {
#sputs copy_tags $text $range $dest $dest_index 
  set first [lindex $range 0]
  set last [lindex $range 1]
  if {[$text compare $first > $last]} {
    set temp $first
    set first $last
    set last $temp
    unset temp
  }
  set firstchar [ix2bp $text $first]
  set lastchar [ix2bp $text $last]
  set dest_line [$dest get $dest_index "$dest_index lineend"]
  if {$direction != "forward"} {
    set dest_line [string reverse $dest_line]
  }

  set lastindex $first
  set dest_last_index 0
  set dest_char_count 0
  foreach {type tag index} [concat [$text dump -tag $first+1char $last+1chars] 0 notag [bp2ix $text [expr {1+[ix2bp $text $last]}]]] {

    if {[$text compare $index == $lastindex]} {continue}
    set tags [lsearch -inline -all -regexp -not [$text tag names $index-1c] {sel|tempsel|(fn|trans)[0-9]+#}]

    set index_bp [expr {[ix2bp $text $index] - $firstchar}]
    #convert tag range to dest range


    while {($dest_last_index< [string length $dest_line]) && [string first [string index $dest_line $dest_last_index] "abcdghkmnrstuvwyABCDGHKMNRSTUVWY"] == -1} {
      incr dest_last_index
    }
    set dest_first_index $dest_last_index
    while {($dest_last_index< [string length $dest_line]) && ($dest_char_count < $index_bp)} {
      incr dest_last_index
      if {[string first [string index $dest_line $dest_last_index] "abcdghkmnrstuvwyABCDGHKMNRSTUVWY"] > -1} {incr dest_char_count}
    }
    #add tags to dest
    foreach tag $tags {
      set tagname "$tag$tagappend"
      if {$direction == "forward"} {
        $dest tag add  $tagname [$dest index $dest_index+[expr {$dest_first_index}]char] [$dest index $dest_index+[expr {$dest_last_index}]char]
      } else {
        $dest tag add  $tagname [$dest index "$dest_index lineend -[expr {$dest_last_index}]char"] [$dest index "$dest_index lineend -[expr {$dest_first_index}]char"]
      }
      $dest tag configure $tagname -background [$text tag cget $tag -background] -font [$text tag cget $tag -font] -underline [$text tag cget $tag -underline]
      $dest tag bind $tagname <<Metadata>> [$text tag bind $tag <<Metadata>>]
    }

    set lastindex $index
  }

}


###########
## Add features from a GFF3 file
###########
proc add_gff_annotations {w} {

  set filename [tk_getOpenFile -title [mc {Open GFF3 File}] -filetypes {{{GFF3 Files} {.gff3}} {{Text Files} {.txt}} {{All Files} *}}]
  if {![catch {open $filename r} fileid err]} {
    while {[eof $fileid] != 1} {
      lappend gff3file [gets $fileid]
    }
    close $fileid
    if {[regexp {##gff-version\s+3} [lindex $gff3file 0]]} {
      foreach {newdna filecomment circular startindex seqlength new_tags error} [parse_gff_file $gff3file] {}
      if {$error != ""} {
        tk_messageBox -message [mc "Error opening GFF file: $error"] -title [mc "Error opening GFF file"] -icon info -type ok
        set dialogblock 0
        return error
      }
      if {($seqlength > [ix2bp $w.textarea end]) && ([tk_messageBox -message [mc "GFF# file length ($seqlength) is greater than the sequence length ([ix2bp $w.textarea end]).\nTry anyway?"] -type yesno -icon info] == "no")} {
        return
      }
      put_tags $w.textarea [list 1.0 [$w.textarea index end]] $new_tags
    } else {
      tk_messageBox -message [mc "File is not a GFF3 file"] -type ok -icon info
    }

  }
}

###########
## select all function
###########
proc select_all {w} {
  $w.textarea tag add sel 1.0 [end_ix $w.textarea]
  $w.textarea mark set insert 1.0
  $w.textarea mark set anchor insert
  $w.textarea mark set tk::anchor$w.textarea insert
  selection_manager $w
}

###########
## select from_to window
###########
proc select_from_to {w} {
  global ok
  global info dialogblock
  if {$dialogblock == 1} {return}
  set s [new_dialog $w "Select from to"]
  bind $s <<Cancel>> "set ok -1"
  bind $s <<OK>> "set ok 1"
  set from 0
  set to 0
  set ok 0
  frame $s.fromtoframe  
  grid [label $s.fromtoframe.fromlabel -text [mc "Select from"]] -row 0 -column 0 -sticky w

  grid [entry $s.fromtoframe.from -width 10 -validate key -vcmd "check_char %S"] -row 0 -column 1 -sticky w
  grid [label $s.fromtoframe.tolabel -text [mc "to"]] -row 0 -column 2 -sticky w
  grid [entry $s.fromtoframe.to -width 10 -validate key -vcmd "check_char %S"] -row 0 -column 3 -sticky w
  button $s.ok -text [mc "OK"] -command "set ok 1" -default active 
  bind $s <Key-Return> "set ok 1"
  button $s.cancel -text [mc "Cancel"] -command "set ok -1"
  grid rowconfigure $s 0 -weight 0
  grid rowconfigure $s 1 -weight 0
  grid columnconfigure $s 0 -weight 1
  grid columnconfigure $s 1 -weight 1 
  grid configure $s.fromtoframe -row 0 -column 0 -columnspan 2 -sticky we
  grid configure $s.ok -row 1 -column 0 -padx 10 -pady 3
  grid configure $s.cancel -row 1 -column 1  -padx 10 -pady 3
  
  if {[llength [$w.textarea tag ranges sel]] > 0} {
    $s.fromtoframe.from insert 0 [expr {[ix2bp $w.textarea [$w.textarea index sel.first]]+1}]
    $s.fromtoframe.to insert 0 [ix2bp $w.textarea [$w.textarea index sel.last]]
#selection used here - set
  } else {
    $s.fromtoframe.from insert 0 [expr {[ix2bp $w.textarea [$w.textarea index insert]]+1}]
  }

  $s.fromtoframe.from selection range 0 end

  update idletasks
  #regexp {([0-9]*)x([0-9]*)\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $s] wgeom winw winh winx winy
  #if {[expr {$winx+$winw}] > [winfo screenwidth .]} {set winx [expr {[winfo screenwidth .]-$winw}]}
  #if {$winx < 0} {set winx 0}
  #if {[expr {$winy+$winh}] > [winfo screenheight .]} {set winy [expr {[winfo screenheight .]-$winh}]}
  #if {$winy < 0} {set winy 0}
  #wm geometry $s "+$winx+$winy"

  #grab set $s
  bind $s <Key-Return> "set ok 1"
  focus $s
  focus $s.fromtoframe.from

  vwait ok
  if {$ok == 1} {
    set from [string trimleft [$s.fromtoframe.from get] 0]
    set to [string trimleft [$s.fromtoframe.to get] 0]

    if {($from > $to) && ($from != "") && ($to != "") } {set temp $from; set from $to; set to $temp}
    if {$from == ""} {set from 1}
    incr from -1
    if {$to == ""} {set to [ix2bp $w.textarea end]}
    select_region $w [bp2ix $w.textarea $from] [bp2ix $w.textarea $to]
  }
  #grab release $s
  destroy $s
  set dialogblock 0
  bind . <<RaiseDialogs>> ""
  focus $w
  focus $w.textarea
}

###########
## jump to window
###########
proc jump_to {w} {
  global ok
  global info dialogblock
  if {$dialogblock == 1} {return}
  set s [new_dialog $w "Jump To..."]
  bind $s <<Cancel>> "set ok -1"
  bind $s <<OK>> "set ok 1"

  grid [label $s.tolabel -text [mc "Jump to:"]] -row 0 -column 0 -sticky nwe
  grid [entry $s.to -width 10 -validate key -vcmd "check_char %S" -selectforeground $info(text_select_fg_color) -selectbackground $info(text_select_bg_color) -foreground $info(text_fg_color) -background $info(text_bg_color)] -row 0 -column 1 -sticky nwe
  grid [button $s.ok -text [mc "OK"] -command "set ok 1" -default active] -row 1 -column 0 -sticky n -padx 10 -pady 3
  bind $s <Key-Return> "set ok 1"
  grid [button $s.cancel -text [mc "Cancel"] -command "set ok -1"] -row 1 -column 1 -sticky n -padx 10 -pady 3
  grid rowconfigure $s 0 -weight 0
  grid rowconfigure $s 1 -weight 0
  grid columnconfigure $s 0 -weight 1
  grid columnconfigure $s 1 -weight 1 
  $s.to insert 0 [ix2bp $w.textarea [$w.textarea index insert]]
  $s.to selection range 0 end

  update idletasks
  #regexp {([0-9]*)x([0-9]*)\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $s] wgeom winw winh winx winy
  #if {[expr {$winx+$winw}] > [winfo screenwidth .]} {set winx [expr {[winfo screenwidth .]-$winw}]}
  #if {$winx < 0} {set winx 0}
  #if {[expr {$winy+$winh}] > [winfo screenheight .]} {set winy [expr {[winfo screenheight .]-$winh}]}
  #if {$winy < 0} {set winy 0}
  #wm geometry $s "+$winx+$winy"

  #grab set $s
  bind $s <Key-Return> "$s.ok invoke"
  focus $s
  focus $s.to
  vwait ok
  set dialogblock 0
  if {$ok == 1} {
    $w.textarea tag remove sel 1.0 end
    set to [string trimleft [$s.to get] 0]
    if {$to == ""} {set to 0}
    if {$to > 0} {incr to -1}
    select_region $w [bp2ix $w.textarea $to] [bp2ix $w.textarea $to]
  }
  #grab release $s
  destroy $s
  bind . <<RaiseDialogs>> ""
  focus $w
  focus $w.textarea
  unset ok
}

###########
## Double-click on start, length, end labels in infobox
###########
proc infoframe_entry {w element} {
  set column [dict get [grid info  $element] -column]
  set col_width [lindex [grid bbox [winfo parent $element] $column 1] 2]
  if {![winfo exists $element\_entry]} {
    grid [entry $element\_entry -validate key -vcmd "check_char %S"] -row 1 -column $column
    bindtags $element\_entry [list $element\_entry Entry $w all SdlTkNumberTextInput]
    bind $element\_entry <Key-Return> "infoframe_entry_do $w $element"
    bind $element\_entry <FocusOut> "infoframe_entry_do $w $element"
  }
  $element\_entry configure -width [expr {min (6, int([$element\_entry cget -width]*1.0*$col_width/[winfo reqwidth $element\_entry]))}]
  grid configure  $element\_entry -row 1 -column $column
  switch [file extension $element] {
    .end {
      if {[llength [$w.textarea tag ranges sel]] == 2 } {
        $element\_entry insert end [expr {[ix2bp $w.textarea [$w.textarea index sel.last]]}]
      } elseif {[$w.textarea tag ranges sel] == ""} {
        sputs error- no selection in infoframe_entry
      } else {
        $element\_entry insert end [expr {[ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 1]]}]
      }
    }
    .sellen {
      if {[llength [$w.textarea tag ranges sel]] == 2 } {
        $element\_entry insert end [expr {[ix2bp $w.textarea [$w.textarea index sel.last]]-[ix2bp $w.textarea [$w.textarea index sel.first]]}]
      } elseif {[$w.textarea tag ranges sel] == ""} {
        sputs error- no selection in infoframe_entry
      } else {
        set selection "[textarea_get $w.textarea [lindex [$w.textarea tag ranges sel] 2] [lindex [$w.textarea tag ranges sel] 3]][textarea_get $w.textarea [lindex [$w.textarea tag ranges sel] 0] [lindex [$w.textarea tag ranges sel] 1]]"
        $element\_entry insert end [string length $selection]
      }
    }
    .start {
      if {[llength [$w.textarea tag ranges sel]] == 2 } {
        $element\_entry insert end [expr {1+[ix2bp $w.textarea [$w.textarea index sel.first]]}]
      } elseif {[$w.textarea tag ranges sel] == ""} {
        $element\_entry insert end [expr {[ix2bp $w.textarea [$w.textarea index insert]]+1}]
      } else {
        $element\_entry insert end [expr {1+[ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 2]]}]
      }
    }
  }
  focus $element\_entry
  #sdltk textinput on [winfo rootx $element\_entry]  [winfo rooty $element\_entry] 2
}

###########
## Set selection based on entries in infobox
###########
proc infoframe_entry_do {w element} {
  global info 

  set e "$element\_entry"
  set val [string trimleft [$e get] 0]

  switch [file extension $element] {
    .end {
      if {[$w.textarea tag ranges sel] == ""} {
        sputs error infoframe_entry_do no end pos 
        set first [expr {[ix2bp $w.textarea [$w.textarea index insert]]}]
        set last [expr {[ix2bp $w.textarea [$w.textarea index insert]]}]
      } elseif {[llength [$w.textarea tag ranges sel]] == 2 } {
        set first [expr {[ix2bp $w.textarea [$w.textarea index sel.first]]}]
        set last [expr {[ix2bp $w.textarea [$w.textarea index sel.last]]}]
      } else {
        set first [expr {[ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 2]]}]
        set last [expr {[ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 1]]}]
      }
      if {$val == ""} {set val 0}
      set last [expr {max($val, $first)}]
      if {[$w.textarea compare [bp2ix $w.textarea $last] > [end_ix $w.textarea]]} {
        set end_index [end_ix $w.textarea]
      } else {
        set end_index [bp2ix $w.textarea $last]
      }
      select_region $w [bp2ix $w.textarea $first] $end_index
    }
    .sellen {
      if {[$w.textarea tag ranges sel] == ""} {
        sputs error infoframe_entry_do no length pos 
        set first [expr {[ix2bp $w.textarea [$w.textarea index insert]]}]
        set last [expr {[ix2bp $w.textarea [$w.textarea index insert]]}]
      } elseif {[llength [$w.textarea tag ranges sel]] == 2 } {
        set first [expr {[ix2bp $w.textarea [$w.textarea index sel.first]]}]
        set last [expr {[ix2bp $w.textarea [$w.textarea index sel.last]]}]
      } else {
        set first [expr {[ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 2]]}]
        set last [expr {[ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 1]]}]
      }
      if {$val == ""} {set val 0}
      set last [expr {max(0, $first+max($val, 0))}]
      if {[$w.textarea compare [bp2ix $w.textarea $last] > [end_ix $w.textarea]]} {
        set end_index [end_ix $w.textarea]
      } else {
        set end_index [bp2ix $w.textarea $last]
      }
      select_region $w [bp2ix $w.textarea $first] $end_index
    }
    .start {
      if {$val == ""} {set val 0}
      if {[$w.textarea tag ranges sel] == ""} {
        set first [expr {$val-1}]
        set last [expr {$val-1}]
      } elseif {[llength [$w.textarea tag ranges sel]] == 2 } {
        set first [expr {[ix2bp $w.textarea [$w.textarea index sel.first]]}]
        set last [expr {[ix2bp $w.textarea [$w.textarea index sel.last]]}]
        set first [expr {max(1, min($val, $last)) - 1}]
      } else {
        set first [expr {[ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 2]]}]
        set last [expr {[ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 1]]}]
        set first [expr {max(1, min($val, $last)) - 1}]
      }
      select_region $w [bp2ix $w.textarea $first] [bp2ix $w.textarea $last]
    }
  }
  if {$info(android)} {
    #catch {sdltk textinput off 0 0 0}
  }
  destroy $e
  focus $w.textarea
}

###########
## checks for numeric character in validation of numeric entries
###########
proc check_char {c} {
  if {[string equal $c " "]} {return 0}
  if {![string is integer $c]} {return 0}
  if {[regexp {[^0-9]} $c]} {return 0}
  return  1
}

proc entry_integer {c w mode min max} {
  if {$mode != "key"} {
    if {(![string is integer -strict $c]) || ($c< $min)} {
      $w delete 0 end
      $w insert end $min
      after idle "if {\[winfo exists $w\]} {$w config -validate all}"
    } elseif {$c > $max} {
      $w delete 0 end
      $w insert end $max
      after idle "if {\[winfo exists $w\]} {$w config -validate all}"
    }
  return 1
  } else {
    if {[string equal $c " "]} {return 0}
    if {[regexp {[^0-9]} $c]} {return 0}
    return  1
  }
}

###########
## insert enzyme recognition site
###########
proc insert_enzyme_fill_cascade {w menu} {
  global enzymes enzinfo
  set count 0
  set menu_num 0

  $menu delete 0 end
  foreach enz $enzymes {
    if {[expr {$count % 15}] ==0} {
      if {$count != 0} {
        $menu entryconfigure end -label "$first_enz-$last_enz"
      }
      catch {destroy $menu.m$menu_num}
      set current_menu [menu $menu.m$menu_num]
      incr menu_num
      $menu add cascade -menu $current_menu
      set first_enz $enz
    }
    if {$enzinfo(flatpat,$enz) eq [revcom $enzinfo(flatpat,$enz)]} {
      $current_menu add command -label $enz  -command "insert_enzyme_site $w $enz"
    } else {
      $current_menu add command -label [mc {%1$s (Fowrard)} $enz]  -command "insert_enzyme_site $w $enz"
      $current_menu add command -label [mc {%1$s (Reverse)} $enz]  -command "insert_enzyme_site $w $enz 1"
    }
    set last_enz $enz
    incr count
  }
  $menu entryconfigure end -label "$first_enz-$last_enz" 
}
  
###########
## insert enzyme recognition site
###########
proc insert_enzyme_site {w enzyme {reverse 0}} {
  global info  undo enzinfo
  global tcl_platform


  if {[file_lock_check $w 1]} {return}
  set text $enzinfo(flatpat,$enzyme)
  if {$info($w,mol_type) eq "RNA"} {
    regsub -all {T} $text "U" text
    regsub -all {t} $text "u" text
  }
  set text [string map {N A W A S C R A Y C K G M A B C D A H A V A n a w a s c r a y c k g m a b c d a h a v a} $text]

  if {$reverse } {set text [revcom $text]}
  

  lappend undo(undo,$w) [list unlink_analysis_window $w [unlink_analysis_window $w]]
  if {[llength [$w.textarea tag ranges sel]] > 0} {
    textarea_delete $w.textarea sel.first sel.last
  } 


###some sort of bug (maybe only on windows) when inserting at insert mark, if insert is at 1.0
  if {0 && [$w.textarea compare insert == 1.0]} {
    $w.textarea mark set insert [end_ix $w.textarea]
    $w.textarea mark set anchor [end_ix $w.textarea]
    $w.textarea mark set tk::anchor$w.textarea [end_ix $w.textarea]
    textarea_insert $w.textarea 1.0 $text
    $w.textarea mark set insert [bp2ix $w.textarea [string length $text]]
    $w.textarea mark set anchor 1.0
    $w.textarea mark set tk::anchor$w.textarea 1.0
  } else {
    textarea_insert $w.textarea [$w.textarea index insert] $text
  }
  
  set insert_first [bp2ix $w.textarea [expr {[ix2bp $w.textarea [$w.textarea index insert]]-[string length $text]}]] 
  set insert_last  [$w.textarea index insert]

  split_tags_after_insertion $w $insert_first $insert_last
  set tags "f0# {{0 [string length $text]} {{#C90000} {} {} {}} {<<Metadata>> <<Revcolors>>} {{$enzyme {arrow_data {{0 0.5 0 -0.5} {0 .5 0 -.5} 0} width 5 offset 0} protein_bind 0 {} {}} {{#C90000} #C90000}}}"
  put_tags $w.textarea [list [bp2ix $w.textarea [expr {[ix2bp $w.textarea [$w.textarea index insert]]-[string length $text]}]] [$w.textarea index insert]] $tags [expr {$reverse?"reverse":"forward"}]

  post_validate_seguid $w
  register_undo_separator $w [mc "Insert Enzyme Site"]
  features_to_tree_view $w
 
  select_region $w [bp2ix $w.textarea [expr {[ix2bp $w.textarea [$w.textarea index insert]]-[string length $text]}]] insert
  vertindexbalancer $w
} 

###########
## Insert a repeated string of characers
###########
proc insert_repeat {w} {
  global ok
  global info dialogblock
  if {$dialogblock == 1} {return}
  set s [new_dialog $w "Insert Repeat" "INSERT"]
  bind $s <<Cancel>> "set ok -1"
  bind $s <<OK>> "set ok 1"
  set from 0
  set to 0
  set ok 0
  frame $s.fromtoframe  
  grid [label $s.fromtoframe.seqlabel -text [mc "Sequence"]] -row 0 -column 0 -sticky nw

  grid [entry $s.fromtoframe.seq -width 10 -validate key -vcmd "regexp -nocase {\[ACGTN\]} %S" -selectforeground $info(text_select_fg_color) -selectbackground $info(text_select_bg_color) -foreground $info(text_fg_color) -background $info(text_bg_color)] -row 0 -column 1 -sticky nw

  grid [label $s.fromtoframe.lenlabel -text [mc "Repeats"]] -row 1 -column 0 -sticky nw
  grid [entry $s.fromtoframe.repeats -width 10 -validate key -vcmd "check_char %S" -selectforeground $info(text_select_fg_color) -selectbackground $info(text_select_bg_color) -foreground $info(text_fg_color) -background $info(text_bg_color)] -row 1 -column 1 -sticky nw

  if {!$info(android)} {
    button $s.ok -text [mc "OK"] -command "set ok 1" -default active 
    bind $s <Key-Return> "set ok 1"
    button $s.cancel -text [mc "Cancel"] -command "set ok -1"
    grid configure $s.ok -row 1 -column 0 -padx 10 -pady 3
    grid configure $s.cancel -row 1 -column 1  -padx 10 -pady 3
  }
  grid rowconfigure $s 0 -weight 0
  grid rowconfigure $s 1 -weight 0
  grid columnconfigure $s 0 -weight 1
  grid columnconfigure $s 1 -weight 1 
  grid configure $s.fromtoframe -row 0 -column 0 -columnspan 2 -sticky we

  

  update idletasks
  #regexp {([0-9]*)x([0-9]*)\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $s] wgeom winw winh winx winy
  #if {[expr {$winx+$winw}] > [winfo screenwidth .]} {set winx [expr {[winfo screenwidth .]-$winw}]}
  #if {$winx < 0} {set winx 0}
  #if {[expr {$winy+$winh}] > [winfo screenheight .]} {set winy [expr {[winfo screenheight .]-$winh}]}
  #if {$winy < 0} {set winy 0}
  #wm geometry $s "+$winx+$winy"

  #grab set $s
  bind $s <Key-Return> "set ok 1"
  focus $s
  focus $s.fromtoframe.seq

  vwait ok
  if {$ok == 1} {
    set seq [string trimleft [$s.fromtoframe.seq get] 0]
    set rpts [string trimleft [$s.fromtoframe.repeats get] 0]
      if {![catch {set k [string repeat $seq $rpts]}] && (![file_lock_check $w 1])}  {
        if {[llength [$w.textarea tag ranges sel]] > 0} {
          foreach {r1 r2} [$w.textarea tag ranges sel] {
            textarea_delete $w.textarea $r1 $r2
          }
#selection used here - ok
        }

        if {[$w.textarea index insert] > 1.0} {
          textarea_insert $w.textarea [$w.textarea index insert] $k
          $w.textarea mark set anchor insert
          $w.textarea mark set tk::anchor$w.textarea insert
        } else {
          textarea_insert $w.textarea 1.0 $k
          $w.textarea mark set anchor 1.0
          $w.textarea mark set tk::anchor$w.textarea 1.0
          $w.textarea mark set insert [bp2ix $w.textarea [string length $k]]
        }

        set insert_first [bp2ix $w.textarea [expr {[ix2bp $w.textarea [$w.textarea index insert]]-[string length $k]}]] 
        set insert_last  [$w.textarea index insert]
        split_tags_after_insertion $w $insert_first $insert_last
        $w.textarea see insert
        post_validate_seguid $w
        register_undo_separator $w [mc "Insert Repeat"]
        features_to_tree_view $w
        vertindexbalancer $w
        selection_manager $w
      } else {
sputs error $seq $rpts [string repeat $seq $pts]
      }
  }

  destroy $s
  set dialogblock 0
  bind . <<RaiseDialogs>> ""
  focus $w
  focus $w.textarea
}

###########
## find dialog
###########
proc find_dialog {w {embed 0}} {
  global info modstring dialogblock toolbar_images modifier
  #global  ok
  if {$dialogblock == 1 && !$embed} {return}
  if {$info(android)} {
    set embed 1
  }
  if {!$embed} {
    set s [new_dialog $w "Find..."]
    bind $s <<Cancel>> "$s.action_frame.cancel invoke"
    bind $s <<OK>> "$s.action_frame.ok invoke"
    wm resizable $s 0 0
    label $s.parent_info -text [mc "Find in: %s" [wm title $w]]
  } else {
    if {[winfo exists $w.findframe]} {
      grid configure $w.findframe
      return
    }
    grid [set s [frame $w.findframe]] -row 2  -column 0 -columnspan 5 -sticky new
    if {$info(android)} {
      frame $s.buttons_frame
      label  $s.buttons_frame.edit_features -image $toolbar_images(button_edit,4x)  -borderwidth 1
      bind $s.buttons_frame.edit_features <ButtonRelease-1>  "grid remove $s; add_feature_edit_box $w" 
      bind $s.buttons_frame.edit_features <ButtonRelease-2>  "grid remove $s; add_feature_edit_box $w" 

      label  $s.buttons_frame.seq_info -image $toolbar_images(button_info,4x)  -borderwidth 1
      bind $s.buttons_frame.seq_info <ButtonRelease-1>  "grid remove $s" 
      bind $s.buttons_frame.seq_info <ButtonRelease-2>  "grid remove $s" 

      label  $s.buttons_frame.find_orf -image $toolbar_images(button_orf,4x)  -borderwidth 1
      bind $s.buttons_frame.find_orf <ButtonRelease-1>  "grid remove $s;  add_orf_search_box $w" 
      bind $s.buttons_frame.find_orf <ButtonRelease-2>  "grid remove $s;  add_orf_search_box $w" 

      grid $s.buttons_frame.edit_features -row 0 -column 0
      grid $s.buttons_frame.seq_info -row 1 -column 0
      grid $s.buttons_frame.find_orf -row 2 -column 0

      grid rowconfigure $s.buttons_frame 0 -minsize 30
      grid rowconfigure $s.buttons_frame 1 -minsize 30
      grid rowconfigure $s.buttons_frame 2 -minsize 30

    } else {
      frame $s.buttons_frame
      ttk::button $s.buttons_frame.edit_features -style Icon.MD.TButton -image $toolbar_images(button_edit) -command "grid remove $s; add_feature_edit_box $w"
      ttk::button $s.buttons_frame.seq_info -style Icon.MD.TButton -image $toolbar_images(button_info) -command "grid remove $s"
      ttk::button $s.buttons_frame.find_orf -style Icon.MD.TButton -image $toolbar_images(button_orf) -command "grid remove $s; add_orf_search_box $w"
      grid $s.buttons_frame.edit_features -row 0 -column 0 -sticky n
      grid $s.buttons_frame.seq_info -row 1 -column 0 -sticky n
      grid $s.buttons_frame.find_orf -row 2 -column 0 -sticky n

      grid rowconfigure $s.buttons_frame 0 -minsize 20
      grid rowconfigure $s.buttons_frame 1 -minsize 20
      grid rowconfigure $s.buttons_frame 2 -minsize 20
    }
  }
  #set ok 0
  entry $s.find -width 50 -textvariable info(find_pattern) -selectforeground $info(text_select_fg_color) -selectbackground $info(text_select_bg_color) -foreground $info(text_fg_color) -background $info(text_bg_color) -font dnafont
  $s.find selection range 0 end
  $s.find icursor end

  if {$embed} {
    bind $s.find <$modifier-Key-c> "event generate $s.find <<Copy>>; break"
    bind $s.find <$modifier-Key-x> "event generate $s.find <<Cut>>; break"
    bind $s.find <$modifier-Key-v> "event generate $s.find <<Paste>> ; break"
    bind $s.find <$modifier-Key-a> "event generate $s.find <<SelectAll>> ; break"
    bind $s.find <Key-Tab> "focus $w.textarea; break"\
  }

  set popupmenu [menu $s.find.popupmenu]
  $popupmenu add command -label [mc "Cut"]  -accelerator "$modstring+X" -command "event generate $s.find <<Cut>>"
  $popupmenu add command -label [mc "Copy"]  -accelerator "$modstring+C" -command "event generate $s.find <<Copy>>"
  $popupmenu add command -label [mc "Paste"]  -accelerator "$modstring+V" -command "event generate $s.find <<Paste>>"
  bind $s.find <<RightClick>> "tk_popup $popupmenu %X %Y"

  frame $s.mod_frame 
    grid [checkbutton  $s.mod_frame.casens -text [mc "case sensitive"] -onvalue 1 -offvalue 0 -variable info(find_casens) -selectcolor white -style InfoboxStyle.TCheckbutton] -row 1 -column 1 -sticky w
    grid [checkbutton  $s.mod_frame.revcom -text [mc "also find rev-com of string"] -onvalue 1 -offvalue 0 -variable info(find_revcom) -selectcolor white -style InfoboxStyle.TCheckbutton] -row 1 -column 2 -sticky w

  frame $s.mod_frame2
    grid [checkbutton  $s.mod_frame2.aa -text [mc "as amino acid"] -onvalue 1 -offvalue 0 -variable info(find_as_aa) -selectcolor white -style InfoboxStyle.TCheckbutton] -row 1 -column 1 -sticky w
    grid [checkbutton  $s.mod_frame2.exact -text [mc "as literal"] -onvalue 1 -offvalue 0 -variable info(find_as_literal) -selectcolor white -style InfoboxStyle.TCheckbutton] -row 1 -column 2 -sticky w
    set info(find_wrap) 1
    #grid [checkbutton  $s.mod_frame2.wrap -text [mc "wrap"] -onvalue 1 -offvalue 0 -variable info(find_wrap) -selectcolor white -style InfoboxStyle.TCheckbutton] -row 1 -column 3 -sticky w
 
  frame $s.mm_frame
    #grid [checkbutton  $s.mm_frame.exact  -onvalue 1 -offvalue 0 -variable info(find_allow_mm) -selectcolor white -command "$s.mm_frame.mm_entry configure -state \[expr {\$info(find_allow_mm)?\"normal\":\"disabled\"}\]; $s.mm_frame.mm_label configure -state \[expr {\$info(find_allow_mm)?\"normal\":\"disabled\"}\]"] -row 1 -column 1 -sticky w  
    grid [ttk::label $s.mm_frame.mm_label -text [mc "Allow mismatches:"]  ] -row 1 -column 1 -sticky w
    #grid [entry $s.mm_frame.mm_entry -width 5 -textvariable info(find_allow_mm_number) -validate key -vcmd "check_char %S"] -row 1 -column 2 -sticky w
    grid [menubutton $s.mm_frame.mm_button -menu $s.mm_frame.mm_button.menu -textvariable info(find_allow_mm_number) -indicatoron 1] -row 1 -column 3 -sticky w
    menu $s.mm_frame.mm_button.menu
    for {set mma 0} {$mma <26} {incr mma} {
      $s.mm_frame.mm_button.menu add radiobutton -label $mma -variable info(find_allow_mm_number) -value $mma
    }
    #$s.mm_frame.mm_entry configure -state [expr {$info(find_allow_mm)?"normal":"disabled"}]
    #$s.mm_frame.mm_label configure -state [expr {$info(find_allow_mm)?"normal":"disabled"}]

    grid [ttk::label $s.mm_frame.max_3_bases_label -text [mc "Minimum 3' bases:"] ] -row 1 -column 4 -sticky w
    grid [menubutton $s.mm_frame.max_button -menu $s.mm_frame.max_button.menu -textvariable info(find_max_3_bases) -indicatoron 1] -row 1 -column 5 -sticky w 
    menu $s.mm_frame.max_button.menu
    $s.mm_frame.max_button.menu add radiobutton -label [mc "All"] -variable info(find_max_3_bases) -value [mc "All"]
    for {set mma 10} {$mma <65} {incr mma 5} {
      $s.mm_frame.max_button.menu add radiobutton -label $mma -variable info(find_max_3_bases) -value $mma
    }

  frame $s.results_frame
    grid [label $s.results_frame.label1 -textvariable info($w,found_text)] -row 1 -column 1 -sticky we
    set info($w,found_text) ""

  frame $s.action_frame
    grid [button $s.action_frame.next -text [mc "Find Next"] -command "set info(find_action) next; do_find $w next" -default active] -row 1 -column 1 -sticky n
    grid [button $s.action_frame.prev -text [mc "Find Prev"] -command "set info(find_action) prev; do_find $w prev"] -row 1 -column 2 -sticky n
    grid [button $s.action_frame.all -text [mc "Highlight All"] -command "set info(find_action) highlight; do_find $w highlight"] -row 1 -column 3 -sticky n
    if {!$embed} {
      grid [button $s.action_frame.cancel -text [mc "Close"] -command "set dialogblock 0; destroy $s; bind . <<RaiseDialogs>> {} "] -row 1 -column 4 -sticky n
    } else {
      button $s.action_frame.cancel -text [mc "Close"] -command "set dialogblock 0; destroy $s; bind . <<RaiseDialogs>> {} "
    }

  if {!$embed} {
    grid $s.parent_info -row 0 -column 2 -sticky w
  } else {
    grid $s.buttons_frame -row 0 -column 1 -rowspan 6 -sticky nw
  }
  grid $s.find -row 1 -column 2 -sticky w
  grid $s.mod_frame -row 2 -column 2 -sticky w
  grid $s.mod_frame2 -row 3 -column 2 -sticky w
  grid $s.mm_frame -row 4 -column 2 -sticky w
  grid $s.results_frame -row 5 -column 2 -sticky w
  grid $s.action_frame -row 6 -column 2 -sticky w
 
  if {!$embed} {
    update idletasks
    #regexp {([0-9]*)x([0-9]*)\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $s] wgeom winw winh winx winy
    #if {[expr {$winx+$winw}] > [winfo screenwidth .]} {set winx [expr {[winfo screenwidth .]-$winw}]}
    #if {$winx < 0} {set winx 0}
    #if {[expr {$winy+$winh}] > [winfo screenheight .]} {set winy [expr {[winfo screenheight .]-$winh}]}
    #if {$winy < 0} {set winy 0}
    #wm geometry $s "+$winx+$winy"

    bind $s <Key-Return> "$s.action_frame.next invoke"
    focus $s
    focus $s.find
  }

  if {0} {
####### Test- don't do any of this
  if {[tk windowingsystem] == "aqua"} {
    #bind $s <Deactivate> {sputs find deactivate; set ok -1}
  } else {
    #bind $s <FocusOut> {set ok -1}
  }
  while {$ok != -1} {
    vwait ok
    if {$ok != -1} { 
      set info(find_action) $ok
      do_find $w $ok
    }
  }

  set dialogblock 0
  destroy $s
  if {[tk windowingsystem] eq "aqua"} {
    if {[set next_wind [lindex [wm stackorder .] end]] != {}} {

      wm withdraw $next_wind;wm deiconify $next_wind
    }
  }
  bind . <<RaiseDialogs>> ""
########### if 0 block
  }
}
###########
##
###########
proc clear_find_highlight {w} {
  global info
  textarea_tag_remove $w.textarea foundf 1.0 end 0
  textarea_tag_remove $w.textarea foundr 1.0 end 0
  register_undo_separator $w "Clear Find Highlighting" 0
  if {$info(inline_mode)} {
	reline $w.textarea $info($w,textwidth)
  }
}

###########
## perform find function
###########
proc do_find {w {action again}} {
  global info
  if {($action == "again") && ($info(find_pattern) == "")} {
    if {!$info(use_cocoa)} {
      set bugdelay 1
    } else {
      set bugdelay 1
    }
    after $bugdelay find_dialog $w
    return
  }
    set action $info(find_action)
    set s $info(find_pattern)

    set casens $info(find_casens)
    set revcom $info(find_revcom)
    set as_aa $info(find_as_aa)
    set as_literal $info(find_as_literal)


  if {$s == ""} return


  if {(!$as_aa) && ($info(find_allow_mm_number) > -1)} {
    # use find mm for all nucleotide searches
    do_find_mm $w
    return
  }

  if {$as_aa} {
    set pat [aa_regexp $s]

  } elseif {!$as_literal} {
    regsub -all -nocase {[^abcdghkmnrstuvwy\*\|\;\,]} $s "" s
    regsub -all -nocase {\*} $s ".*" s
    set pat [regsubpattern $s] 
    while {[regsub -all {\|\|} $pat "|" pat] > 0} {}
    regsub {^\|} $pat "" pat
    regsub {\|$} $pat "" pat
  } else {
    regsub -all -nocase {[^abcdghkmnrstuvwy\*\|\;\,]} $s "" s
    regsub -all -nocase {\*} $s "\\\*" s
    regsub -all -nocase {;|,} $s "|" s
    set pat $s 
  }

  if {$pat == ""} {
    set info(find_pattern) ""
    return
  }

  if {$revcom} {
    set rpat "($pat)|([revcom_regexp $pat])"
  } else {
    set rpat $pat
  }
  regsub -all {\(} $rpat {(?:} rpat

  if {!$casens || $as_aa} {set switch2 "-nocase"} else {set switch2 "--"}
  set found_text [list]

  switch $action {
    next {
      if {$info($w,circular) eq "circular"} {
        set matchlist [regexp -inline -indices -all $switch2 $rpat "[textarea_get $w.textarea 1.0 [end_ix $w.textarea]][textarea_get $w.textarea 1.0 [end_ix $w.textarea]]"]
        #need to convert list elements that span the origin here
        set i 0
        set seq_len [ix2bp $w.textarea end]
        while {($i < [llength $matchlist]) && ([lindex [lindex $matchlist $i] 0] <= $seq_len)} {
          if {[lindex [lindex $matchlist $i] 1] > $seq_len} {
            set matchlist [lreplace $matchlist $i $i [list [lindex [lindex $matchlist $i] 0] $seq_len]]
          }
          incr i
        }
        incr i -1
        set matchlist [lrange $matchlist 0 $i]
      } else {
        set matchlist [regexp -inline -indices -all $switch2 $rpat [textarea_get $w.textarea 1.0 end]]
      }
      if {$matchlist != [list]} {
        if {[llength [$w.textarea tag ranges sel]] > 0} {
          if {[llength [$w.textarea tag ranges sel]] == 2} {
            catch {$w.textarea mark set insert sel.first+1chars}
          } else {
            catch {$w.textarea mark set insert [lindex [$w.textarea tag ranges sel] 2]+1chars}
          }
        }
#selection used here - ok
        set ins [ix2bp $w.textarea insert]
        set i 0
        while {($i< [llength $matchlist]) && ([lindex [lindex $matchlist $i] 0] <= $ins)} {incr i}
        if {$i == [llength $matchlist]} {
          set i 0
        }
        select_region $w [bp2ix $w.textarea [lindex [lindex $matchlist $i] 0]]  [bp2ix $w.textarea [expr {1 + [lindex [lindex $matchlist $i] 1]}]]
        set found_text "Found match at [lindex [lindex $matchlist $i] 0]"
      } else {
       # tk_messageBox -message [mc "No sequence found."] -type ok -icon info -parent [expr {[winfo exists .find_dialog]?".find_dialog":$w}]
      }
    }
    prev {
      if {$info($w,circular) eq "circular"} {
        set matchlist [regexp -inline -indices -all $switch2 $rpat "[textarea_get $w.textarea 1.0 [end_ix $w.textarea]][textarea_get $w.textarea 1.0 [end_ix $w.textarea]]"]
        #need to convert list elements that span the origin here
        set i 0
        set seq_len [ix2bp $w.textarea end]
        while {($i < [llength $matchlist]) && ([lindex [lindex $matchlist $i] 0] <= $seq_len)} {
          if {[lindex [lindex $matchlist $i] 1] > $seq_len} {
            set matchlist [lreplace $matchlist $i $i [list [lindex [lindex $matchlist $i] 0] $seq_len]]
          }
          incr i
        }
        incr i -1
        set matchlist [lrange $matchlist 0 $i]
      } else {
        set matchlist [regexp -inline -indices -all $switch2 $rpat [textarea_get $w.textarea 1.0 end]]
      }
      if {$matchlist != [list]} {
        if {[llength [$w.textarea tag ranges sel]] > 0} {
          if {[llength [$w.textarea tag ranges sel]] == 2} {
            catch {$w.textarea mark set insert sel.first}
          } else {
            catch {$w.textarea mark set insert [lindex [$w.textarea tag ranges sel] 2]}
          }
        }
#selection used here - ok
        set ins [ix2bp $w.textarea insert]
        set i 1
        while {($i< [llength $matchlist]) && ([lindex [lindex $matchlist $i] 0] < $ins)} {incr i}
        incr i -1
        if {$i == 0} {
          set i [expr {[llength $matchlist] - 1}]
        }
        select_region $w [bp2ix $w.textarea [lindex [lindex $matchlist $i] 0]]  [bp2ix $w.textarea [expr {1 + [lindex [lindex $matchlist $i] 1]}]]
        set found_text "Found match at [lindex [lindex $matchlist $i] 0]"
      } else {
       # tk_messageBox -message [mc "No sequence found"] -type ok -icon info -parent [expr {[winfo exists .find_dialog]?".find_dialog":$w}]
      }
    }
    highlight {
      set cur 1.0
      textarea_tag_remove $w.textarea foundf 1.0 end 0 
      textarea_tag_remove $w.textarea foundr 1.0 end 0
      $w.textarea tag configure foundf -background $info(find_forward_highlight)
      $w.textarea tag configure foundr -background $info(find_reverse_highlight)
      set matchlist [list]
      set matchlist_r [list]
      regsub -all {\(} $pat {(?:} pat
      if {!$casens || $as_aa} {
        set switches "-nocase"
      } else {
        set switches "--"
      }
      if {$info($w,circular) eq "circular"} {
        set matchlist [regexp -inline -indices -all $switch2 $pat "[textarea_get $w.textarea 1.0 [end_ix $w.textarea]][textarea_get $w.textarea 1.0 [end_ix $w.textarea]]"]
        #need to convert list elements that span the origin here
        set i 0
        set seq_len [ix2bp $w.textarea end]
        while {($i < [llength $matchlist]) && ([lindex [lindex $matchlist $i] 0] <= $seq_len)} {
          if {[lindex [lindex $matchlist $i] 1] > $seq_len} {
            set matchlist [lreplace $matchlist $i $i [list [lindex [lindex $matchlist $i] 0] $seq_len 0 [expr {[lindex [lindex $matchlist $i] 1] - $seq_len}] ]]
          }
          incr i
        }
        incr i -1
        set matchlist [lrange $matchlist 0 $i]
      } else {
        set matchlist [regexp -inline -indices -all $switch2 $pat [textarea_get $w.textarea 1.0 end]]
      }
      foreach match $matchlist {
        textarea_tag_add $w.textarea foundf [bp2ix $w.textarea [expr {(([lindex $match 0]))}]]  [bp2ix $w.textarea [expr {(([lindex $match 1])) +1}]] 0
#sputs foundf [lrange $match 0 1]
        if {[llength $match] == 4} {
          textarea_tag_add $w.textarea foundf [bp2ix $w.textarea [expr {(([lindex $match 2]))}]]  [bp2ix $w.textarea [expr {(([lindex $match 3])) +1}]] 0
#sputs foundf [lrange $match 2 3]
        }
        textarea_tag_bind $w.textarea foundf <<Revcolors>> [list gray70 gray50]
      }
      $w.textarea tag raise foundf
      if {$revcom} {
        set cur 1.0
        set pat [revcom_regexp $pat]
        regsub -all {\(} $pat {(?:} pat
        if {$info($w,circular) eq "circular"} {
          set matchlist_r [regexp -inline -indices -all $switch2 $pat "[textarea_get $w.textarea 1.0 [end_ix $w.textarea]][textarea_get $w.textarea 1.0 [end_ix $w.textarea]]"]
          #need to convert list elements that span the origin here
          set i 0
          set seq_len [ix2bp $w.textarea end]
          while {($i < [llength $matchlist_r]) && ([lindex [lindex $matchlist_r $i] 0] <= $seq_len)} {
            if {[lindex [lindex $matchlist_r $i] 1] > $seq_len} {
              set matchlist_r [lreplace $matchlist_r $i $i [list [lindex [lindex $matchlist_r $i] 0] $seq_len 0 [expr {[lindex [lindex $matchlist_r $i] 1] - $seq_len}] ]]
            }
            incr i
          }
          incr i -1
          set matchlist_r [lrange $matchlist_r 0 $i]
        } else {
          set matchlist_r [regexp -inline -indices -all $switch2 $pat [textarea_get $w.textarea 1.0 end]]
        }
        foreach match $matchlist_r {
          textarea_tag_add $w.textarea foundr [bp2ix $w.textarea [expr {(([lindex $match 0]))}]]  [bp2ix $w.textarea [expr {(([lindex $match 1])) +1}]] 0
#sputs foundr [lrange $match 0 1]
          if {[llength $match] == 4} {
            textarea_tag_add $w.textarea foundr [bp2ix $w.textarea [expr {(([lindex $match 2]))}]]  [bp2ix $w.textarea [expr {(([lindex $match 3])) +1}]] 0
#sputs foundr [lrange $match 2 3]
          }
          textarea_tag_bind $w.textarea foundr <<Revcolors>> [list gray50 gray70]
        }
        $w.textarea tag raise foundr
      }
      set found_text "Found [llength $matchlist] forward matches. Found [llength $matchlist_r] reverse matches."
      if {[$w.textarea tag ranges foundf] != ""} {
        $w.textarea see [lindex [$w.textarea tag ranges foundf] 0]
        register_undo_separator $w "Highlight Find" 0
        vertindexbalancer $w
        selection_manager $w
      } elseif {[$w.textarea tag ranges foundr] != ""} {
        $w.textarea see [lindex [$w.textarea tag ranges foundr] 0]
        register_undo_separator $w "Highlight Find" 0
        vertindexbalancer $w
        selection_manager $w
      } else {
        set found_text "Found no match."
       # tk_messageBox -message [mc "No sequence found"] -type ok -icon info -parent [expr {[winfo exists .find_dialog]?".find_dialog":$w}]
      }
      if {$info(inline_mode)} {
        reline $w.textarea $info($w,textwidth)
      }
    }
  }

  if {[winfo exists .find_dialog]} {
    .find_dialog.results_frame.label1 configure -text $found_text
  }

  #focus $w
  #focus $w.textarea
}

###########
## perform find function
###########
proc do_find_mm {w {action again}} {
  global info

  set action $info(find_action)
  set s $info(find_pattern)
  set casens $info(find_casens)
  set revcom $info(find_revcom)
  set as_aa $info(find_as_aa)
  set as_literal $info(find_as_literal)


  set matchlist [list]

  if {$as_aa} {
    switch $action {
      next {
      }
      prev {
      }
      highlight {
      }
    }
    tk_messageBox -message [mc "Mismatch search not implemented yet"] -type ok -icon info -parent [expr {[winfo exists .find_dialog]?".find_dialog":$w}]
  } else {
   ##find nucleotide
    set text [textarea_get $w.textarea 1.0 [end_ix $w.textarea]]
    set text_length [string length $text]

    regsub -all -nocase {[^abcdghkmnrstuvwy\*\|\;\,]} $s "" s
    if {!$casens} {  
      set text [string toupper $text]
      set s [string toupper $s]
    }  
    set s_list1 [split $s "|,;"]

    set longest 0
    set s_list [list]
    foreach t $s_list1 {
      if {[string is integer -strict $info(find_max_3_bases)]} {
        set t [string range $t "end-[expr {$info(find_max_3_bases)-1}]" end]
      }
      lappend s_list [split $t ""]
      if {$revcom} {
        lappend s_list [split [revcom $t] ""]
      }
      set longest [expr { max($longest, [string length $t]) }]
    }
    if {!$info(find_as_literal)} {
      set s_list [string map {B BYSKCGT D DRWKAGT H HMWYACT K KGT M MAC N NBDHVKMRYWSACGT R RAG S SGC V VMSRACG W WAT Y YCT b byskcgt d drwkagt h hmwyact k kgt m mac n nbdhvkmrywsacgt r rag s sgc v vmsracg w wat y yct} $s_list]

    }

    switch $action {
      next {
        if {[$w.textarea tag ranges sel] != ""} {
          if {[llength [$w.textarea tag ranges sel]] > 0} {
            if {[llength [$w.textarea tag ranges sel]] == 2} {
              set ins [ix2bp $w.textarea sel.first+1chars]
            } else {
              set ins [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 2]+1chars]
            }
          }
#selection used here - ok
        } else {
          set ins [ix2bp $w.textarea insert]
        }
        set text2 [string range $text $ins end]
        if {$info($w,circular) eq "circular"} {
          append text2 [string range $text 0 [expr {$ins -1}]] [string range $text[string range $text 0 $longest] $ins [expr {$ins + $longest -1}]]
       } elseif {$info(find_wrap)} {
          append text2 \t [string range $text 0 [expr {$ins -1}]] [string range $text $ins [expr {$ins + $longest -1}]]
        }
        set text_list [split $text2 ""]
        set found -1
        for {set i 0} {$i <= [expr {[llength $text_list] - $longest}]} {incr i} {
          set found_direction 0
          foreach st $s_list {
            set mm 0
            foreach s1 $st c2 [lrange $text_list $i [expr {$i+[llength $st]-1}]] {
              if {[string first $c2 $s1] == -1} {
                incr mm
                if {$mm > $info(find_allow_mm_number)} break
              }
            }
            if {$mm <= $info(find_allow_mm_number)} {
              set found $i
              break
            }
            set found_direction [expr {($found_direction +1) %2}]
          }
          if {$found > -1} break
        }
        if {$found > -1} {
          if {($info($w,circular) eq "linear") && $info(find_wrap) && (($found + $ins) > $text_length )} {
            incr found -1
          }
          select_region $w [bp2ix $w.textarea [expr {($found + $ins) % $text_length}]]  [bp2ix $w.textarea [expr {($found + $ins) % $text_length + [llength $st]}]]
          set info($w,found_text) "Found [expr {($revcom && $found_direction)?"reverse" : "forward"}] match at [expr {($found + $ins) % $text_length +1}]."
          if {[llength [$w.textarea tag ranges sel]] > 0} {
            if {[llength [$w.textarea tag ranges sel]] == 2} {
              catch {$w.textarea mark set insert sel.first+1chars}
            } else {
              catch {$w.textarea mark set insert [lindex [$w.textarea tag ranges sel] 2]+1chars}
            }
          }
#selection used here - ok 
          lappend matchlist [expr {($found + $ins)% $text_length }]
        } else {
          set info($w,found_text) "Found no match."
        #  tk_messageBox -message [mc "No sequence found"] -type ok -icon info -parent [expr {[winfo exists .find_dialog]?".find_dialog":$w}]
        }

      }
      prev {
       if {[$w.textarea tag ranges sel] != ""} {
          if {[llength [$w.textarea tag ranges sel]] > 0} {
            if {[llength [$w.textarea tag ranges sel]] == 2} {
              set ins [ix2bp $w.textarea sel.first]
            } else {
              set ins [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 2]]
            }
          }
#selection used here - ok
        } else {
          set ins [ix2bp $w.textarea insert]
        }
        set text2 [string range $text 0 [expr {$longest + $ins -1}]]
        if {$info($w,circular) eq "circular"} {
          set text2 [string range $text$text[string range $text 0 $longest] [expr {$ins}] [expr {[string length $text] + $ins + $longest-1}]]
        } elseif {$info(find_wrap) } {
          set text2 [string range $text [expr {$ins}] end]\t[string range $text 0 [expr {$longest + $ins -2}]]
        }
        set text_list [split $text2 ""]

        set found -1
        for {set i [expr {[llength $text_list] - 1 -$longest}]} {$i >= 0} {incr i -1} {
          set found_direction 0
          foreach st $s_list {
            set mm 0
            foreach s1 $st c2 [lrange $text_list $i [expr {$i+[llength $st]-1}]] {
              if {[string first $c2 $s1] == -1} {
                incr mm
                if {$mm > $info(find_allow_mm_number)} break
              }
            }
            if {$mm <= $info(find_allow_mm_number)} {
              set found $i
              break
            }
            set found_direction [expr {($found_direction +1) %2}]
          }
          if {$found > -1} break
        }
        if {$found > -1} {
          if {$info($w,circular) eq "circular"} {
            select_region $w [bp2ix $w.textarea [expr {($found + $ins) % $text_length}]]  [bp2ix $w.textarea [expr {($found + $ins) % $text_length + [llength $st]}]]
            set info($w,found_text) "Found [expr {($revcom && $found_direction)?"reverse" : "forward"}] match at [expr {($found + $ins) % $text_length +1}]."
          } elseif {$info(find_wrap)} {
            set gap [string first \t $text2]
            if {$found > $gap} {
              select_region $w [bp2ix $w.textarea [expr {($found - $gap - 1)}]]  [bp2ix $w.textarea [expr {($found - $gap -1) + [llength $st]}]] 
              set info($w,found_text) "Found [expr {($revcom && $found_direction)?"reverse" : "forward"}] match at [expr {($found - $gap - 1)}]."
            } else {
              select_region $w [bp2ix $w.textarea [expr {($found + $ins)}]]  [bp2ix $w.textarea [expr {($found + $ins) + [llength $st]}]]
              set info($w,found_text) "Found [expr {($revcom && $found_direction)?"reverse" : "forward"}] match at [expr {($found + $ins + 1)}]."
            }
          } else {
            select_region $w [bp2ix $w.textarea [expr {($found)}]]  [bp2ix $w.textarea [expr {($found) + [llength $st]}]]
            set info($w,found_text) "Found [expr {($revcom && $found_direction)?"reverse" : "forward"}] match at [expr {($found +1)}]."
          }
          lappend matchlist $found
        } else {
        #  tk_messageBox -message [mc "No sequence found"] -type ok -icon info -parent [expr {[winfo exists .find_dialog]?".find_dialog":$w}]
          set info($w,found_text) "Found no match."
        }

      }
      highlight {
        textarea_tag_remove $w.textarea foundf 1.0 end 0
        textarea_tag_remove $w.textarea foundr 1.0 end 0
        $w.textarea tag configure foundf -background $info(find_forward_highlight)
        $w.textarea tag configure foundr -background $info(find_reverse_highlight)

        set text2 $text
        if {$info($w,circular) eq "circular"} {
          append text2  [string range $text 0 [expr {$longest -1}]]
        }
        set text_list [split $text2 ""]

        set found -1
        for {set i 0} {$i <= [expr {[llength $text_list] - 1}]} {incr i} {
          set dir 0
          foreach st $s_list {
            set mm 0
            foreach s1 $st c2 [lrange $text_list $i [expr {$i+[llength $st]-1}]] {
              if {[string first $c2 $s1] == -1} {
                incr mm
                if {$mm > $info(find_allow_mm_number)} break
              }
            }
            if {$mm <= $info(find_allow_mm_number)} {
              # add tag here       
              textarea_tag_add $w.textarea [expr {$dir?"foundr":"foundf"}] [bp2ix $w.textarea [expr {($i)}]]  [bp2ix $w.textarea [expr {min ($text_length,($i +  [llength $st]))}]] 0
#sputs found_mm $dir $i  [expr {min ($text_length,($i +  [llength $st]))}]
              if {[expr {($i + [llength $st])}] > $text_length} {
                textarea_tag_add $w.textarea [expr {$dir?"foundr":"foundf"}] [bp2ix $w.textarea 0]  [bp2ix $w.textarea [expr {($i + [llength $st]) % $text_length }]] 0
#sputs found_mm $dir 0 [expr {($i + [llength $st]) % $text_length }]
              }
              lappend matchlist $i
            }
            if {$info(find_revcom)} {
              set dir [expr {($dir + 1) % 2}]
            }
          }
        }
        set info($w,found_text) "Found [llength $matchlist] matches."
        if {[$w.textarea tag ranges foundf] != ""} {
          $w.textarea tag raise foundf
          #textarea_tag_bind $w.textarea foundf <<Revcolors>> [list gray70 gray50]
          $w.textarea see [lindex [$w.textarea tag ranges foundf] 0]
          register_undo_separator $w "Highlight Find" 0
          vertindexbalancer $w
          selection_manager $w
        } elseif {[$w.textarea tag ranges foundr] != ""} {
          $w.textarea tag raise foundr
          #textarea_tag_bind $w.textarea foundr <<Revcolors>> [list gray50 gray70]
          $w.textarea see [lindex [$w.textarea tag ranges foundr] 0]
          register_undo_separator $w "Highlight Find" 0
          vertindexbalancer $w
          selection_manager $w
        } else {
          set info($w,found_text) "Found no match."
        #  tk_messageBox -message [mc "No sequence found"] -type ok -icon info -parent [expr {[winfo exists .find_dialog]?".find_dialog":$w}]
        }
        if {$info(inline_mode)} {
          reline $w.textarea $info($w,textwidth)
        }
      }
    }
  }

  #focus $w
  #focus $w.textarea

}

###########
##  find all occurrences of s in text with # mismatches
###########
proc search_with_mm {s text {mm_allowed 0}} {
  set s [string toupper $s]
  set s_list [split $s ""]
  set longest [string length $s]
  set text [string toupper $text]
  set text_list [split $text ""]

  set result [list]
  set found -1
  for {set i 0} {$i <= [expr {[llength $text_list] - $longest}]} {incr i} {
    set mm 0
    foreach s1 $s_list c2 [lrange $text_list $i [expr {$i+[llength $s_list]-1}]] {
      if {[string first $c2 $s1] == -1} {
        incr mm
        if {$mm > $mm_allowed} break
      }
    }
    if {$mm <= $mm_allowed} {
      lappend result $i
    }
  }
  return $result
}

############
##
############
proc find_phred_dialog {w} {
  global info modstring dialogblock  

  if {$dialogblock} {return}

  set s [new_dialog $w "Find Phred Values..."]
  bind $s <<Cancel>> "$s.action_frame.cancel invoke"
  bind $s <<OK>> "$s.action_frame.cancel invoke"
  wm resizable $s 0 0
  label $s.parent_info -text [mc "Find in: %s" [wm title $w]]

  if {![info exists info(find_phred_cutoff)]} {
    set info(find_phred_cutoff) 30
  }
  frame $s.cutoff_frame
  grid [label $s.cutoff_frame.l1 -text [mc "Find Phred less than:"]] -row 0 -column 0 -sticky nw
  grid [label $s.cutoff_frame.phred_value -textvariable info(find_phred_cutoff)] -row 0 -column 1 -sticky nw
  grid [ttk::scale $s.cutoff_frame.phred_scale -from 0 -to 93 -command "set info($w,find_phred_text) {}; set info(find_phred_cutoff) \[expr {round(\$info(find_phred_cutoff))}\];#" -orient horizontal -variable info(find_phred_cutoff)] -row 0 -column 2 -sticky nwe
  grid columnconfigure $s.cutoff_frame 2 -weight 1

  frame $s.results_frame
  grid [label $s.results_frame.label1 -textvariable info($w,find_phred_text)] -row 1 -column 1 -sticky we
  set info($w,find_phred_text) ""

  frame $s.add_feature_frame
  grid [button $s.add_feature_frame.add -text [mc "Add Feature"] -command "do_find_phred $w add_feature" ] -row 1 -column 1 -sticky n
  set info($w,find_phred_color) #3483ff
  grid [color_button $s.add_feature_frame.color info($w,find_phred_color) [expr {6+[font metrics labelfont -linespace]}]] -row 1 -column 2 -sticky n


  frame $s.action_frame
  grid [button $s.action_frame.next -text [mc "Find Next"] -command "do_find_phred $w next" -default active] -row 1 -column 1 -sticky n
  grid [button $s.action_frame.prev -text [mc "Find Prev"] -command "do_find_phred $w prev"] -row 1 -column 2 -sticky n
  grid [button $s.action_frame.all -text [mc "Highlight All"] -command "do_find_phred $w highlight"] -row 1 -column 3 -sticky n
  grid [button $s.action_frame.cancel -text [mc "Close"] -command "set dialogblock 0; destroy $s; bind . <<RaiseDialogs>> {} "] -row 1 -column 4 -sticky n

  
  grid $s.cutoff_frame -row 1 -column 2 -sticky we
  grid $s.results_frame -row 4 -column 2 -sticky we
  grid $s.add_feature_frame -row 5 -column 2 -sticky we
  grid $s.action_frame -row 6 -column 2 -sticky we
   grid columnconfigure $s 2 -weight 1
  update idletasks

  bind $s <Key-Return> "$s.action_frame.next invoke"
  focus $s 
}


###########
## perform find function
###########
proc do_find_phred {w action} {
  global info fea_info

  switch $action {
    next {
      if {[$w.textarea tag ranges sel] != ""} {
        if {[llength [$w.textarea tag ranges sel]] == 2} {
          set ins [ix2bp $w.textarea sel.first+1chars]
        } else {
          set ins [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 2]+1chars]
        }
      } else {
        set ins [ix2bp $w.textarea insert]
      }

      set s "[string range $info($w,phred_string) $ins end][string range $info($w,phred_string) 0 $ins]"

      for {set i 0} {$i < [string length $s] && [expr {[scan [string index $s $i] %c] -33 }] > $info(find_phred_cutoff)} {incr i} {lappend j $i [expr {[scan [string index $s $i] %c] -33 }]}
      if {$i < [string length $s]} {
        select_region $w [bp2ix $w.textarea [expr {($ins+$i)%[string length $info($w,phred_string)]}] ] [bp2ix $w.textarea [expr {($ins+$i)%[string length $info($w,phred_string)]+1}]]
        set info($w,find_phred_text) "[expr {($ins+$i)%[string length $info($w,phred_string)]+1}], Phred:[expr {[scan [string index $s $i] %c] -33 }] "
      } else {
        set info($w,find_phred_text) "Nothing found"
      }
    }
    prev {
      if {[$w.textarea tag ranges sel] != ""} {
        if {[llength [$w.textarea tag ranges sel]] == 2} {
          set ins [ix2bp $w.textarea sel.first]
        } else {
          set ins [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 2]]
        }
      } else {
        set ins [ix2bp $w.textarea insert]
      }
      set ins [expr {($ins-1) % [string length $info($w,phred_string)]}]
      set s "[string range $info($w,phred_string) $ins end][string range $info($w,phred_string) 0 $ins]"
      for {set i [string length $s]} {$i >0 && [expr {[scan [string index $s $i-1] %c] -33 }] > $info(find_phred_cutoff)} {incr i -1} {}
      if {$i > 0} {
        select_region $w [bp2ix $w.textarea [expr {($ins+$i-1)%[string length $info($w,phred_string)]}]] [bp2ix $w.textarea [expr {($ins+$i-1)%[string length $info($w,phred_string)]+1 }]]
        set info($w,find_phred_text) "[expr {($ins+$i)%[string length $info($w,phred_string)]}], Phred:[expr {[scan [string index $s $i-1] %c] -33 }] "
      } else {
        set info($w,find_phred_text) "Nothing found"
      }
    }
    add_feature {
      set tagname "f$fea_info($w,count)#"
      incr fea_info($w,count)
      #selection used here 
      textarea_tag_create $w.textarea $tagname 0
      for {set i 0} {$i < [string length $info($w,phred_string)] } {incr i} {
        if {[expr {[scan [string index $info($w,phred_string) $i] %c] -33 }] <= $info(find_phred_cutoff)} {
          textarea_tag_add $w.textarea $tagname [bp2ix $w.textarea [expr {($i)}]]  [bp2ix $w.textarea [expr {($i+1)}]]  0
        }
      }
      ##metadata here
       $w.textarea tag bind $tagname <<Metadata>> [list "Phred <= $info(find_phred_cutoff)" $info(feature_default_gformat) "misc_feature" 0 ""]
       $w.textarea tag bind $tagname <<Revcolors>> [list $info($w,find_phred_color) $info($w,find_phred_color)]
      $w.textarea tag configure $tagname -background $info($w,find_phred_color)
      features_to_tree_view $w
    }
    highlight {
      textarea_tag_remove $w.textarea foundf 1.0 end 0 
      textarea_tag_remove $w.textarea foundr 1.0 end 0
      $w.textarea tag configure foundf -background $info(find_forward_highlight)
      $w.textarea tag configure foundr -background $info(find_reverse_highlight)
      for {set i 0} {$i < [string length $info($w,phred_string)] } {incr i} {
        if {[expr {[scan [string index $info($w,phred_string) $i] %c] -33 }] <= $info(find_phred_cutoff)} {
          textarea_tag_add $w.textarea "foundf" [bp2ix $w.textarea [expr {($i)}]]  [bp2ix $w.textarea [expr {($i+1)}]]  0
        }
      }
    }
    default {
    }
  }
}


###########
## returns regexp pattern for aa input 
###########
proc aa_regexp {pattern} {
  set temp [list]
  set lookup [list A (GC.) C (TG\[CT\]) D (GA\[CT\]) E (GA\[AG\]) F (TT\[CT\]) G (GG.) H (CA\[CT\]) I (AT\[ACT\]) K (AA\[AG\]) L ((CT.)|(TT\[AG\])) M (ATG) N (AA\[CT\]) P (CC.) Q (CA\[AG\]) R ((CG.)|(AG\[AG\])) S ((TC.)|(AG\[CT\])) T (AC.) V (GT.) W (TGG) X (...) Y (TA\[CT\]) * ((TA\[AG\])|(TGA))]  

  foreach seq [split $pattern " ;,"] {
    lappend temp [string map -nocase $lookup $seq]
  }
  return [join $temp |]
}

if {[catch {string reverse a}]} {
####use old revcom if using Tcl 8.4
###########
## returns revrse complement of simple regexp patterns
###########
proc revcom_regexp {pattern} {
  set temp ""
  set length [string length $pattern]
  for {set i [expr {$length-1}]} {$i >= 0} {incr i -1} {
      append temp [string map {A T C G G C T A a t c g g c t a \[ \] \] \[ ) ( ( )} [string index $pattern $i]]
  }
  return $temp
}


##########
## returns the reverse complement of the input
##########
proc revcom {pattern} {
  set temp ""
  set length [string length $pattern]
  for {set i [expr {$length-1}]} {$i >= 0} {incr i -1} {
    append temp [string map {A T B V C G D H G C H D K M M K N N * * R Y S S T A V B W W Y R a t b v c g d h g c h d k m m k n n r y s s t a v b w w y r} [string index $pattern $i]]
  }
  return $temp
}

##########
## returns the reverse of the input
##########
proc rev {args} {
  set temp ""
  set pattern [join $args " "]
  foreach char [split $pattern ""] {
    set temp "$char$temp"
  }
  return $temp
}
} else {
########################################use new revcom if using Tcl 8.5 (string reverse)
###########
## returns revrse complement of simple regexp patterns
###########
proc revcom_regexp {pattern} {
  return [string map {A T C G G C T A a t c g g c t a \[ \] \] \[ ) ( ( )} [string reverse $pattern]]
}


##########
## returns the reverse complement of the input
##########
proc revcom {pattern} {
  return [string map {A T B V C G D H G C H D K M M K N N * * R Y S S T A V B W W Y R a t b v c g d h g c h d k m m k n n r y s s t a v b w w y r} [string reverse $pattern]]
}

##########
## returns the reverse of the input
##########
proc rev {args} { 
  return [string reverse [join $args " "]]
}
#end of if {catch [string reverse a]}
}


##########
## returns the complement of the input
##########
proc com {args} {
   return [string map {A T B V C G D H G C H D K M M K N N * * R Y S S T A V B W W Y R a t b v c g d h g c h d k m m k n n r y s s t a v b w w y r} [join $args " "]]
}



################
## Generate a translation map string from a string of 64 single letter codes
################
proc gen_translation_map {code} {
  set codon_list [list]
  foreach first {t c a g} {
    foreach second {t c a g} {
      foreach third {t c a g} {
        lappend codon_list "$first$second$third"
      }
    }
  }

  set str "xxx X "
  foreach aa [split $code ""] codon $codon_list {
    append str "$codon $aa "
  }
  lappend result $str
  set str_r "xxx X "
  foreach aa [split $code ""] codon $codon_list {
    append str_r "[revcom $codon] $aa "
  }
  lappend result $str_r
  lappend result [string map {X Xxx F Phe L Leu S Ser Y Tyr C Cys * End W Trp P Pro H His Q Gln R Arg I Ile M Met T Thr N Asn K Lys V Val A Ala D Asp E Glu G Gly} $str]
  lappend result [string map {X Xxx F Phe L Leu S Ser Y Tyr C Cys * End W Trp P Pro H His Q Gln R Arg I Ile M Met T Thr N Asn K Lys V Val A Ala D Asp E Glu G Gly} $str_r]
  return $result
}

################
## Returns the current translation code (uses info(translation_code) to determine)
################
proc get_ncbi_translation_code {code} {
  global info
  set i [lsearch $info(NCBI_translation_code_list) $code]
  if {$i > 0} {
    return [lindex $info(NCBI_translation_code_list) [expr {$i -1}]]
  } else {
    return {Custom}
  }
}

################
## Translate dna, 1 or 3 characters, direction:1 forward, 0 reverse, spacing between characters
################
proc translate {dna {chars 1} {direction 1} {spacing 0}} {
  global info

  set i [string range $dna 0 [expr [string length $dna]/3*3-1]]

  regsub -all {U} $i "T" i
  regsub -all {u} $i "t" i

  #while {[regsub -nocase "((...)*)((.\[bdhkmnrsuvwy*\].)|(..\[bdhkmnrsuvwy*\])|(\[bdhkmnrsuvwy*\]..))(.*)" $i {\1xxx\7} i]} {}
  if {[regexp -nocase {[^acgt]} $i]} {
    for {set n 0} {$n < [string length $i]} {incr n 3} {
      set codon [string range $i $n [expr {$n+2}]]
      if {[regexp -nocase {[^acgt]} $codon]} {
        lappend i_list "xxx"
      } else {
        lappend i_list $codon
      }
    }
    set i $i_list
  } else {
    set i [regexp -inline -all {...} $i]
  }


  if {$chars == 1} {
    if {$direction == 1} {
      set result [string map -nocase [lindex $info(translation_map_lists) 0] $i]
    } else {
      set result [string map -nocase [lindex $info(translation_map_lists) 1] $i]
    }
  } else {
    if {$direction == 1} {
      set result [string map -nocase [lindex $info(translation_map_lists) 2] $i]
    } else {
      set result [string map -nocase [lindex $info(translation_map_lists) 3] $i]
    }
  }
  return [join $result [string repeat " " $spacing]]
}


################
## Translate dna, 1 or 3 characters, direction:1 forward, 0 reverse, spacing between characters
################
proc reverse_translate {protein} {
  global info
  set tr_map [list]
  foreach {codon aa} [lindex $info(translation_map_lists) 0] {
    if {[lsearch -exact $tr_map $aa] < 0} {
      lappend tr_map $aa [string toupper $codon] [string tolower $aa] $codon
    } 
  }
  regsub -all -nocase {[^ACDEFGHIKLMNPQRSTVWXY*]} $protein "" protein
  return [string map $tr_map $protein]
  
}

proc reverse_translate2 {protein} {
  global info
  set tr_map [list]
  foreach {codon aa} [lindex $info(translation_map_lists) 0] {
    if {[set site [lsearch -exact $tr_map $aa]] < 0} {
      lappend tr_map $aa [string toupper $codon] [string tolower $aa] $codon
    } else {
      set tr_map [lreplace $tr_map $site [expr {$site+3}] $aa [string toupper $codon] [string tolower $aa] $codon]
    }
  }
  regsub -all -nocase {[^ACDEFGHIKLMNPQRSTVWXY*]} $protein "" protein
  return [string map $tr_map $protein]
  
}

################
## Returns cds features as concatenated text
################
proc get_cds {w tag} {

##use get_feature_exons_indexes instread- also, use it for linear feature draw
  global info
  set fn_tag [string replace $tag 0 0 fn]
  set tag_range [$w.textarea tag ranges $tag]
  set text ""
  if {[lsearch -exact [$w.textarea tag names] $fn_tag] != -1} {
    set fn_tag_range [$w.textarea tag ranges $fn_tag]
    if {[llength $fn_tag_range] == 4} {
      set break [lsearch $tag_range [lindex $fn_tag_range 2]]
      set tag_range [concat [lrange $tag_range $break end] [lrange $tag_range 0 [expr {$break -1}]]] 
    } 
    set text ""
    foreach {f0 f1} $tag_range {
      set text "$text[textarea_get $w.textarea $f0 $f1]"
    } 
  } else {
    if {[llength $tag_range] == 4} {
      set text "[textarea_get $w.textarea [lindex $tag_range 2] [lindex $tag_range 3]][textarea_get $w.textarea [lindex $tag_range 0] [lindex $tag_range 1]]"
    } elseif {[llength $tag_range] == 2} {
      set text [textarea_get $w.textarea [lindex $tag_range 0] [lindex $tag_range 1]]
    }
  }
  set text [regsub -all \n $text ""]
  return $text
}

##############
## returns list of start and end index of each exon L and R for indexes outside of start and end
##############
proc get_feature_exons_indexes {w tag {start 1.0} {end end}} {
  global info
  set fn_tag [string replace $tag 0 0 fn]
  set tag_range [$w.textarea tag ranges $tag]
  if {[lsearch -exact [$w.textarea tag names] $fn_tag] != -1} {
    set fn_tag_range [$w.textarea tag ranges $fn_tag]
    if {[llength $fn_tag_range] == 4} {
      set break [lsearch $tag_range [lindex $fn_tag_range 2]]
      set tag_range [concat [lrange $tag_range $break end] [lrange $tag_range 0 [expr {$break -1}]]] 
    } 
  } elseif {[llength $tag_range] == 4} {
    set tag_range [list [lindex $tag_range 2] [lindex $tag_range 3] [lindex $tag_range 0] [lindex $tag_range 1]]
  }
  set temp $tag_range
  set tag_range [list]
  foreach {a b} $temp {
    lappend tag_range [list $a $b]
  }

  if {$start != 1.0 || $end ne "end"} {
    for {set i 0} {$i < [llength $tag_range]} {incr i} {
      if {[$w.textarea compare [lindex $tag_range $i 0] < $start]} {
        if {[$w.textarea compare [lindex $tag_range $i 1] < $start]} {
          set tag_range [lreplace $tag_range $i $i [list "L" "L"]]
          continue
        } else {
          set tag_range [lreplace $tag_range $i $i [list "L" [lindex $tag_range $i 1]]]
        }
      }
      if {[$w.textarea compare [lindex $tag_range $i 1] > $end]} {
        if {[lindex $tag_range $i 0] == "L"} {
          set tag_range [lreplace $tag_range $i $i [list "L" "R"]]
        } elseif {[$w.textarea compare [lindex $tag_range $i 0] > $end]} {
          set tag_range [lreplace $tag_range $i $i [list "R" "R"]]
        } else {
          set tag_range [lreplace $tag_range $i $i [list [lindex $tag_range $i 0] "R"]]
        }
      }
    }
  }
  return $tag_range
}

################
## Returns list of tag string (length of full sequence, space padded)
################
proc cds_trans_lines {w} {
  set result [list]
  foreach tag [$w.textarea tag names] {
    if {[regexp {f[0-9]+#} $tag]} {
      set metadata  [$w.textarea tag bind $tag <<Metadata>>]
      set type [lindex $metadata 2]
      if {[string toupper $type] == "CDS"} {
        set dir [lindex $metadata 3]
        set cds_text [get_cds $w $tag]
        set cds_case ""

        foreach {a b c d e f} [split $cds_text ""] {          append cds_case [string toupper $a] [string toupper $b] [string toupper $c] [string tolower $d] [string tolower $e] [string tolower $f]        }
##use get_feature_exons_indexes
        set cds_trans " [translate $cds_text 1 [expr {$dir?-1:1}] 2]  "

        set fn_tag [string replace $tag 0 0 fn]
        set tag_range [$w.textarea tag ranges $tag]
        if {[lsearch -exact [$w.textarea tag names] $fn_tag] != -1} {
          set fn_tag_range [$w.textarea tag ranges $fn_tag]
          if {[llength $fn_tag_range] == 4} {
            set break [lsearch $tag_range [lindex $fn_tag_range 2]]
            set tag_range [concat [lrange $tag_range $break end] [lrange $tag_range 0 [expr {$break -1}]]] 
          }  
        } elseif {[llength $tag_range] == 4} {
          set tag_range [list [lindex $tag_range 2] [lindex $tag_range 3] [lindex $tag_range 0] [lindex $tag_range 1]]
        }
        set prstring [string repeat " " [ix2bp $w.textarea end]]
        set cdnastring [string repeat " " [ix2bp $w.textarea end]]
        set i 0
        foreach {f0 f1} $tag_range {
          set f0 [ix2bp $w.textarea $f0]
          set f1 [expr {[ix2bp $w.textarea $f1]-1}]
          set flen [expr {$f1 -$f0}]
          set prstring [string replace $prstring $f0 $f1 [string range $cds_trans $i [expr {$i+$flen}]]]
          set cdnastring [string replace $cdnastring $f0 $f1 [string range $cds_case $i [expr {$i+$flen}]]]
          incr i [expr {$flen+1}]
        }
        lappend result [list $tag $prstring $cdnastring]
      }
    }
  }
  return $result
}


###############
## finds the melting temperature of a sequence, [dna] in nM, [Na] in mM
###############
#Option for the table of Nearest-Neighbor thermodynamic parameters and for the method of melting temperature calculation. Two different tables of thermodynamic parameters are available:
#   1. Breslauer et al. 1986, DOI:10.1073/ pnas.83.11.3746 In that case the formula for melting temperature calculation suggested by Rychlik et al. 1990 is used (this is used until Primer3 version 1.0.1). This is the default value of Primer3 (for backward compatibility).
#   2. SantaLucia 1998, DOI:10.1073/pnas.95.4.1460 This is the recommended value. 
## see also http://onlinelibrary.wiley.com/doi/10.1002/(SICI)1097-0282(1997)44:3%3C217::AID-BIP3%3E3.0.CO;2-Y/epdf

#Option for specifying the salt correction formula for the melting temperature calculation.

#   There are three different options available: 
#   1. Schildkraut and Lifson 1965, DOI:10.1002/bip.360030207 (this is used until the version 1.0.1 of Primer3).The default value of Primer3 version 1.1.0 (for backward compatibility)
#   2. SantaLucia 1998, DOI:10.1073/pnas.95.4.1460 This is the recommended value.
#   3. Owczarzy et al. 2004, DOI:10.1021/bi034621r

proc Tm {seq {dna_conc 250} {salt_conc 50}} {
  set seq [regsub -all \n $seq ""]
  if {[string length $seq] > 100} {return "---"}
  regsub -nocase -all {[^acgt]} $seq "t" seq
  set seq [string tolower $seq]
#parameters from SantaLucia J., Proc. Nat. Acad. Sci. 95: 1460-1465 (1998)
  array set s {aa 222 tt 222 at 204 ta 213 ca 227 tg 227 gt 224 ac 224 ct 210 ag 210 ga 222 tc 222 cg 272 gc 244 gg 199 cc 199}
  array set h {aa 79 tt 79 at 72 ta 72 ca 85 tg 85 gt 84 ac 84 ct 78 ag 78 ga 82 tc 82 cg 106 gc 98 gg 80 cc 80}
  
#parameters from Breslauer et al. 1986
#  array set s {aa 240 tt 240 at 239 ta 169 ca 129 tg 129 gt 173 ac 173 ct 208 ag 208 ga 135 tc 135 cg 278 gc 267 gg 266 cc 266}
#  array set h {aa 91 tt 91 at 86 ta 60 ca 58 tg 58 gt 65 ac 65 ct 78 ag 78 ga 56 tc 56 cg 119 gc 111 gg 110 cc 110}

# initiation parameters from SantaLucia J., Proc. Nat. Acad. Sci. 95: 1460-1465 (1998)
  if {[string first [string index $seq 0] "at"] > -1} {
    set htot -23
    set stot -41
  } else {
    set htot -1
    set stot 28
  }
  if {[string first [string index $seq end] "at"] > -1} {
    incr htot -23
    incr stot -41
  } else {
    incr htot -1
    incr stot 28
  }

#calculate total deltah and deltas
  set l [expr [string length $seq]-1]
  for {set i 0} {$i < $l} {incr i} {
    incr htot $h([string range $seq $i [expr $i+1]])
    incr stot $s([string range $seq $i [expr $i+1]])
  }

## new monovalent and divalent ion calculations can be found at http://pubs.acs.org/doi/abs/10.1021/bi702363u

##salt correction from SantaLucia, J., Jr., Allawi, H. T., and Seneviratne, P. A. (1996)
#Tm=dH/(dS + R ln [DNA])
#R= 1.987
  set log_dna [expr {1.987 * log( $dna_conc / 1000000000.0)}]
  set log_salt [expr {12 * log10($salt_conc / 1000.0)}]
  set result [expr {$htot * 100.0 / ($stot * 0.1 - $log_dna) - 273.15 + $log_salt}]

  return [expr {round(max(0,$result)*10)/10.0}]
}


##########
## finds the %GC of a sequence
##########
proc GC% {seq} {
  set seq [regsub -all \n $seq ""]
  set gc [string map -nocase {a "" t "" n "" b "" d "" h "" k "" m "" r "" v "" w "" y "" * ""} $seq]
  if {[string length $seq] <= 0} {return 0}
  return [expr {100.0*[string length $gc]/[string length $seq]}] 
}

##########
## finds the extinction coeff (L/Mmole/cm) of a sequence
##########
proc extinction {seq} {
  set seq [regsub -all \n $seq ""]
  array set edata [list A 15.4 C 7.4 G 11.5 T 8.7 AA 13.7 AC 10.6 AG 12.5 AT 11.4 CA 10.6 CC 7.3 CG 9.0 CT 7.6 GA 12.6 GC 8.8 GG 10.8 GT 10.0 TA 11.7 TC 8.1 TG 9.5 TT 8.4]
  set seq [string toupper $seq]
  set e $edata([string range $seq 0 0])
  for {set i 0} {$i <= [expr {[string length $seq]-2}]} {incr i} {
    set e [expr {$e + 2.0 * $edata([string range $seq $i [expr {$i+1}]]) - $edata([string range $seq $i $i])}]
  }
  return $e
}

##########
## find ORF- finds the next ATG-Stop after the cursor
### NOT USED
##########
proc next_ORF1 {w {direction forward}} {
  global info 
  set c [list]
  if {$direction == "forward"} {
    if {[$w.textarea tag ranges sel] != {}} {
      set text [textarea_get $w.textarea sel.first+1chars [end_ix $w.textarea]]
#selection used here -not used
      set i [$w.textarea index sel.first+1chars]
    } else {
      set text [textarea_get $w.textarea insert [end_ix $w.textarea]]
      set i [$w.textarea index insert]
    }

    regsub -all {[uU]} $text "T" text

    if {$info(find_orf_starts) == "Met"} {
      set c [lindex [lindex [regexp -nocase -indices -inline {ATG} $text] 0] 0]
    } elseif {[$w.textarea compare 1.3 > $i]} {
      set c 0
    } else {
      set c [lindex [lindex [regexp -nocase -indices -inline "(?:taa|tag|tga|tar)" $text] 0] 0]
      if {$c != [list]} {
        incr c 3
      }
    }
    if {$c != [list]} {
      set text [string range $text $c end]
      set d [lindex [lindex [regexp -nocase -indices -inline "^(?:...)*?(?:taa|tag|tga|tar)" $text] 0] 1]
     if {$d == [list]} {set d [expr {3*(([string length $text])/3)}]}
     lappend c [expr {$c+$d+1}]
    }
  } else {
#find previous
    if {[$w.textarea tag ranges sel] != {}} {
      set text [textarea_get $w.textarea 1.0 sel.last-1chars]
#selection used here - not used
    } else {
      set text [textarea_get $w.textarea 1.0 insert]
    }
    set stoplist [lsort -decreasing -integer -index 0 [regexp -inline -all -nocase -indices {(?:taa|tag|tga|tar)} $text]]
    set stoplist [concat $stoplist [list {2 4} {1 3} {0 2}]]
    if {((([$w.textarea tag ranges sel] != {}) && ([$w.textarea compare end-4chars < sel.last])) || ([$w.textarea compare end-4chars < insert])) && ([string length $text] > 2)} {
#selection used here -not used
      set stoplist [concat [list [list [expr {[string length $text]-3}] [expr {[string length $text]-1}]]] $stoplist]
    }
    set startlist [lsort -decreasing -integer -index 0 [regexp -inline -all -nocase -indices {(?:atg)} $text]]
    set c [list]
    foreach stop2 $stoplist {
      foreach stop1 $stoplist {
        if {([lindex $stop1 0] < [lindex $stop2 0]) &&([expr {fmod([lindex $stop2 0] - [lindex $stop1 0], 3)}]==0.0)} {
          if {$info(find_orf_starts) == "Met"} {
             if {[regexp -nocase -indices {(?:atg)(?:...)*$} [string range $text [lindex $stop1 0] [lindex $stop2 1]] start] == 1} {
               set c [list [expr {[lindex $start 0]+[lindex $stop1 0]}] [lindex $stop2 1]]
             }
          } else {
            set c [list [expr {3+[lindex $stop1 0]}] [lindex $stop2 1]]
          }
          break
        }
      }
      if {$c != [list]} break
    }

    set i 1.0

  }
  if {$c == [list]} {
    bell
    return
  } else {
    $w.textarea tag remove sel 1.0 end
    set i [ix2bp $w.textarea $i]
    select_region $w [bp2ix $w.textarea [expr {$i +[lindex $c 0]}]] [bp2ix $w.textarea [expr {$i +[lindex $c 1]}]]
     # selection used here - set - not used
  }
}

###########
## NOT used
###########
proc next_ORF2 {w {direction forward}} {
  global info
  if {$direction eq "all"} {

  } else {
    if {$direction eq "forward"} {
      set text [textarea_get $w.textarea 1.0 [end_ix $w.textarea]]
      if {[$w.textarea tag ranges sel] != {}} {
        set i [ix2bp $w.textarea sel.first+1chars]
#selection used here - not used
      } else {
        set i [ix2bp $w.textarea insert]
      }
      set res [find_orf $text $i $info(find_orf_strand)]
    } else {
      set text [revcom [textarea_get $w.textarea 1.0 [end_ix $w.textarea]]]
      if {[$w.textarea tag ranges sel] != {}} {
        set i [ix2bp $w.textarea sel.last-2chars]
#selection used here - not used 
      } else {
        set i [ix2bp $w.textarea insert-1char]
      }
      set i [expr {[string length $text] - $i -1}]
      set res [find_orf $text $i [expr {-1*$info(find_orf_strand)}]]
      if {$res != [list]} {
        set res [list [expr {[string length $text] - [lindex $res 1] -1}] [expr {[string length $text] - [lindex $res 0]-1}]]
      }
    }
    if {$res == [list]} {
      bell
      return
    } else {
      $w.textarea tag remove sel 1.0 end
      select_region $w [bp2ix $w.textarea [expr {[lindex $res 0]}]] [bp2ix $w.textarea [expr {1 + [lindex $res 1]}]]
    }
  }
}

###########
## NOT used
###########
set info(find_orf_min) 90
#use this to find next orf on top or bottom strand
#search with this until the result is past the insertion point to find previous
# find orf in $w that starts after index i and is find_orf_min bp minimum
# top_strand is -1 for bottom, 1 for top and 0 for both
# set text [textarea_get $w.textarea 1.0 [end_ix $w.textarea]]
proc find_orf {text i strand} {
  global info
  set c ""
  set e ""
  if {$strand > -1} {
    set found_orf 0
    while {!$found_orf} {
      if {$info(find_orf_starts) == "Met"} {
        set c [lindex [lindex [regexp -nocase -indices -inline -start $i $info(start_codons) $text] 0] 0]
      } else {
        set c [lindex [lindex [regexp -nocase -indices -inline -start [expr {$i-3}] "(?:taa|tag|tga|tar)" $text] 0] 0]
        if {$c != [list]} {
          incr c 3
        }
      }
      if {$c != [list]} {
        set d [lindex [lindex [regexp -nocase -indices -inline -start $c "\\A(?:...)*?(?:taa|tag|tga|tar)" $text] 0] 1]
        if {$d == [list]} {
          set d [expr {$c+ 3*(([string length $text]-$c)/3)}]
        }
        if {[expr {$d - $c}] >= $info(find_orf_min)} {
          set found_orf 1
          set top_result [list $c $d]
        } else {
          set i [expr {$c+1}]
        }
      } else {
        set top_result [list]
        set found_orf 1
      }
    }
  } else {
    set top_result [list]
  }
  if {$strand < 1} {
    set found_orf 0
    while {!$found_orf} {
      set e [lindex [lindex [regexp -nocase -indices -inline -start $i "(?:tta|cta|tca|yta)" $text] 0] 0]
      if {$e != [list]} {
        if {$info(find_orf_starts) == "Met"} {
          set g  [lindex [lindex [regexp -nocase -indices -inline -start [expr {$e+3}] "\\A(?:...)*?(?:tta|cta|tca|yta)" $text] 0] 1]
          if {$g == [list]} {
            set g [string length $text]
          }
          set j $e
          set f -1
          while {([set tempf [lindex [lindex [regexp -nocase -indices -inline -start $j "\\A(?:...)*?(?:[revcom_regexp $info(start_codons)])" $text] 0] 1]] < $g) && ($tempf ne "")} {
            set f $tempf
            set j [expr {$f+1}]
          }
          #if there is a stop before the start, it's not an orf
          if {$f > $g} {
            set i [expr {$e+1}]
            continue
          }
        } else {
          set f [lindex [lindex [regexp -nocase -indices -inline -start [expr {$e+3}] "\\A(?:...)*?(?:tta|cta|tca|yta)" $text] 0] 1]
          if {$f != [list]} {
            incr f -3
          }
        }
        if {$f == [list]} {
          set bottom_result [list]
          set found_orf 1
          continue
        }
        if {[expr {$f - $e}] >= $info(find_orf_min)} {
          set found_orf 1
          set bottom_result [list $e $f]
        } else {
          set i [expr {$e+1}]
        }
      } else {
        set bottom_result [list]
        set found_orf 1
      }
    }
  } else {
    set bottom_result [list]
  }
  #return the first of top_result and bottom_result
  if { ($bottom_result == [list]) || (($c ne "") && $c < $e)} {
    return $top_result
  } else {
    return $bottom_result
  } 
}

###########
## Generate a list of all ORFs in the sequence longer than $min
###########
proc next_ORF {w {direction forward}} {
  global info
  set text [textarea_get $w.textarea 1.0 [end_ix $w.textarea]]

  if {1} {
    if {[$w.textarea tag ranges sel] != {}} {
      if {[llength [$w.textarea tag ranges sel]] > 2} {
        set i [ix2bp $w.textarea "[lindex [$w.textarea tag ranges sel] 2]"]
      } else {
        set i [ix2bp $w.textarea sel.first]
      }
      if {$direction ne "forward"} {
        set i [expr {($i-1) % [string length $text]}]
      } else {
        set i [expr {($i+1) % [string length $text]}]
      }
#selection used here - ok
    } else {
      set i [ix2bp $w.textarea insert]

    }

    set reslist [orf_list $text [expr {$info($w,circular)=="circular"?1:0}] $info(find_orf_strand) $info(find_orf_min) $info(find_orf_starts)]
    set reslist [lsort -integer -index 0 $reslist]

    for {set j 0} {($j < [llength $reslist]) && ($i> [lindex $reslist $j 0])} {incr j} {
    }
    if {$direction ne "forward"} {
      incr j -1
    }

    if {[llength $reslist] > 0} {
      set res [lindex $reslist [expr {$j % [llength $reslist]}]] 
    } else {
      set res [list]
    }

  } else {
   ## this branch isn't used now
    if {[$w.textarea tag ranges sel] != {}} {
      if {[llength [$w.textarea tag ranges sel]] > 2} {
        set i [ix2bp $w.textarea "[lindex [$w.textarea tag ranges sel] 1]"]
      } else {
        set i [ix2bp $w.textarea sel.last]
      }
      set i [expr {($i-2) % [string length $text]}]
#selection used here - ok
    } else {
      set i [ix2bp $w.textarea insert]
      set i [expr {($i-1) % [string length $text]}]
    }
    set reslist [orf_list $text [expr {$info($w,circular)=="circular"?1:0}] $info(find_orf_strand) $info(find_orf_min) $info(find_orf_starts)]
    set reslist [lsort -integer -index 1 $reslist]
    for {set j 0} {$j < [llength $reslist] && $i >= [lindex $reslist $j 1]} {incr j} {
    }
    incr j -1
    set res [lindex $reslist [expr {$j % [llength $reslist]}]] 
  }

  if {$res == [list]} {
    bell
    return
  } else {
    ## remove this if selection is allowed through the origin
    if {[lindex $res 0] > [lindex $res 1]} {
      lset res 1 [string length $text]
    }
    select_region $w [bp2ix $w.textarea [expr {[lindex $res 0]}]] [bp2ix $w.textarea [expr {1 + [lindex $res 1]}]]
  }

}

###########
## Generate a list of all ORFs in the sequence longer than $min
###########
proc orf_list {text circular strand min starts} {
  set end [string length $text]
  if {$circular} {
    set text "$text$text"
  }

  set result [list]
  if {$strand > -1} {
    if {$starts == "Met"} {
      set first_list [regexp -all -nocase -inline -indices -- {ATG} $text]
    } else {
      set first_list [regexp -all -nocase -inline -indices -- {TGA|TAA|TAG} $text]
      for {set i 0} {$i < [llength $first_list]} {incr i} {
        lset first_list $i [expr {[lindex $first_list $i 0]+3}]
      }
    }
    set second_list [regexp -all -nocase -inline -indices -- {TGA|TAA|TAG} $text]
    for {set i 0} {$i< [llength $first_list] && [lindex $first_list $i 0] <= $end} {incr i} {
      set b [lindex $first_list $i 0]
      set frame [expr {$b % 3}]
      set j 0
      while {($j < [llength $second_list]) && (([set c [lindex $second_list $j 0]] < $b) || ([expr {$c %3}] != $frame))} {
        incr j
      }
      if {[expr {$c+2-$b}] > $min} {
        if {([expr {$c %3}] == $frame)} {
          lappend result [list [expr {$b % $end}] [expr {($c+2) % $end}] 1]
        } else {
          lappend result [list [expr {$b % $end}] [expr {$end}] 1]
        }
      }
    }
  }
  if {$strand < 1} {
    set text [revcom $text]
    if {$starts == "Met"} {
      set first_list [regexp -all -nocase -inline -indices -- {ATG} $text]
    } else {
      set first_list [regexp -all -nocase -inline -indices -- {TGA|TAA|TAG} $text]
      for {set i 0} {$i < [llength $first_list]} {incr i} {
        lset first_list $i [expr {[lindex $first_list $i 0]+3}]
      }
    }
    set second_list [regexp -all -nocase -inline -indices -- {TGA|TAA|TAG} $text]
    for {set i 0} {$i< [llength $first_list] &&  [lindex $first_list $i 0] <= $end} {incr i} {
      set b [lindex $first_list $i 0]
      set frame [expr {$b % 3}]
      set j 0
      while {($j < [llength $second_list]) && (([set c [lindex $second_list $j 0]] < $b) || ([expr {$c %3}] != $frame))} {
        incr j
      }
      if {[expr {$c+2-$b}] > $min} {
        lappend result [list [expr {($end-$c-3) % $end}] [expr {($end-$b-1) % $end}] -1]
      }
    }
  }
  return $result
}

##########
## changes case of the selection (or window if no selection)
##########
proc change_case {w {action "upper"}} { 
  global info


  ## change case doesn't affect the cheksum, so don't pre-clear checksum
  if {[file_lock_check $w 0]} {return}

  set insertstore [$w.textarea index insert]
  set scrollstore [lindex [$w.textarea yview] 0]
  set tag_order [$w.textarea tag names]
  if {[$w.textarea tag ranges sel] == ""} {
    set first 1.0
    set last [end_ix $w.textarea]
    set reset 0
  } else {
    set first [lindex [$w.textarea tag ranges sel] 0]
    set last [lindex [$w.textarea tag ranges sel] 1]
    catch {set anchorstore [$w.textarea index tk::anchor$w.textarea]}
    set reset 1
 
    if {[llength [$w.textarea tag ranges sel]] > 2} {
      set first2 [lindex [$w.textarea tag ranges sel] 2]
      set last2 [lindex [$w.textarea tag ranges sel] 3]
      set textstore2 [textarea_get $w.textarea $first2 $last2]
      set tagstore2 [get_tags_exact $w.textarea [list $first2 $last2]]
      textarea_delete $w.textarea $first2 $last2 0
    }
#selection used here - ok
  }
  set textstore [textarea_get $w.textarea $first $last]
  set tagstore [get_tags_exact $w.textarea [list $first $last]]
  textarea_delete $w.textarea $first $last 0
  switch $action {
    upper {
      textarea_insert $w.textarea $first [string toupper $textstore] 0
      if {[info exists first2]} {
        textarea_insert $w.textarea $first2 [string toupper $textstore2] 0
      }
    }
    lower {
      textarea_insert $w.textarea $first [string tolower $textstore] 0
      if {[info exists first2]} {
        textarea_insert $w.textarea $first2 [string tolower $textstore2] 0
      }
    }
    exchange {
      textarea_insert $w.textarea $first [swap $textstore] 0
      if {[info exists first2]} {
        textarea_insert $w.textarea $first2 [swap $textstore2] 0
      } 
    }
    default {
      textarea_insert $w.textarea $first $textstore 0
      if {[info exists first2]} {
        textarea_insert $w.textarea $first2 $textstore2 0
      }
    }
  }
  $w.textarea yview moveto $scrollstore
  put_tags $w.textarea [list $first $last] $tagstore forward 0
  if {[info exists first2]} {
    put_tags $w.textarea [list $first2 $last2] $tagstore2 forward 0
  }

  foreach tag $tag_order {
    textarea_tag_raise $w.textarea $tag
  }
  
  switch $action {
    upper {
      register_undo_separator $w [mc "To Upper Case"]
    }
    lower {
      register_undo_separator $w [mc "To Lower Case"]
    }
    exchange {
      register_undo_separator $w [mc "Exchange Case"]
    }
    default {
      register_undo_separator $w [mc "Change Case"]
    }
  }

  if {$reset} {
    $w.textarea tag add sel $first $last
    if {[info exists first2]} {
      $w.textarea tag add sel $first2 $last2
    }
    catch {$w.textarea mark set anchor $anchorstore; $w.textarea mark set tk::anchor$w.textarea $anchorstore}
  } 

  $w.textarea mark set insert $insertstore
}

##########
## returns the case swap of the input
##########
proc swap {pattern} {
  return [string map {A a B b C c D d G g H h K k M m N n R r S s T t V v W w Y y a A b B c C d D g G h H k K m M n N r R s S t T v V w W y Y} $pattern]
}


##########
## rotates the origin of a circular sequence to the insertion point- uses tag ccordinates and rotates the tag list
##########
proc set_origin {w} {
  global info undo
  if {([$w.textarea index insert] == 1.0) ||[file_lock_check $w 0]} {return}
  set before [textarea_get $w.textarea 1.0 insert]
  foreach tag [$w.textarea tag names] {
    lappend stacking_store $tag 
    set coords [list]
    foreach a [$w.textarea tag ranges $tag] {
      lappend coords [ix2bp $w.textarea $a]
    }
    lappend tagstore $tag $coords
    textarea_tag_remove $w.textarea $tag 1.0 end 0
  }
  set len [string length [textarea_get $w.textarea 1.0 end]]
  lappend undo(undo,$w) [list unlink_analysis_window $w [unlink_analysis_window $w]]
  textarea_delete $w.textarea 1.0 insert 0
  set end_0 [ix2bp $w.textarea end]
  textarea_insert $w.textarea [end_ix $w.textarea] $before 0
  set end [ix2bp $w.textarea end] 
  set new_tags [list]
  foreach {tag coords} $tagstore {
    set newcoords [list]  
    foreach {a b} $coords {
      set a [expr {$a +$end_0}]
      set b [expr {$b +$end_0}]
      if {$b <= $end} {
        lappend newcoords $a $b
      } elseif {$a >= $end} {
        lappend newcoords [expr {$a-$end}] [expr {$b-$end}]
      } elseif {$b > $end} {
        lappend newcoords $a [expr {$end}]
        lappend newcoords 0 [expr {$b-$end}]
      } 
    }
    if {$newcoords != [list]} {
      foreach {a b} $newcoords {
        textarea_tag_add $w.textarea $tag [bp2ix $w.textarea $a] [bp2ix $w.textarea $b] 0
      }
    }
  }

  foreach tag $stacking_store {
    catch {$w.textarea tag raise $tag}
  }
  selection_manager $w
  features_to_tree_view $w
  set info($w,scanned) 0
  register_undo_separator $w [mc "Set Origin"]
  vertindexbalancer $w
}


##########
## toggle circular to linear
##########
proc toggle_circ {w} {
  global info toolbar_images undo

  if {[file_lock_check $w 1]} {return}

  lappend undo(undo,$w) [list unlink_analysis_window $w [unlink_analysis_window $w]]
  lappend undo(undo,$w) [list change_topology $info($w,circular)]
  register_undo_separator $w [mc "Circular<->Linear"]
  if {($info($w,circular) == "linear") } {
    set info($w,circular) circular
    $w.menubar.edit  entryconfigure [mc "Set Origin"] -state normal
    $w.menubar.edit  entryconfigure [mc "Linearize @ insert site"] -state normal
    #$w.infoframe.circular configure -image $toolbar_images(circular)
  } else {
    set info($w,circular) linear
    $w.menubar.edit  entryconfigure [mc "Set Origin"] -state disabled
    $w.menubar.edit  entryconfigure [mc "Linearize @ insert site"] -state disabled
    #$w.infoframe.circular configure -image ""
  }
  post_validate_seguid $w

  features_to_tree_view $w
  set info($w,scanned) 0
  set info($w,circular_text) [mc $info($w,circular)]
}

##########
## linearize at insert site
##########
proc linearize {w} {
  set_origin $w
  toggle_circ $w
}

##########
## reverse complements the selection if there is one, or the whole dna if not -needs to deal with tags
##########
proc rev_com_window {w} {
  global info undo

  if {[$w.textarea tag ranges sel] == "" || ([$w.textarea compare sel.first == 1.0] && [$w.textarea compare sel.last >= [end_ix $w.textarea]])} {
    ## rev_com full window, so don't pre-clear checksum
    if {[file_lock_check $w 0]} {return}
    # turn off checksum checks after this, since it's revcom the whole window.
    set mode_store $info(seguid_mode)
    set info(seguid_mode) 0
  } else {
   ## not the full window, so pre-clear the checksum if necessary
    if {[file_lock_check $w 1]} {return}
  }

  lappend undo(undo,$w) [list unlink_analysis_window $w [unlink_analysis_window $w]]
  set tag_order [$w.textarea tag names]
  if {[$w.textarea tag ranges sel] == ""} {
    set first 1.0
    set last [end_ix $w.textarea]
    set reset 0
  } else {
    set first [lindex [$w.textarea tag ranges sel] 0]
    set last [lindex [$w.textarea tag ranges sel] 1]
    set anchorstore $first
    catch {set anchorstore [$w.textarea index tk::anchor$w.textarea]}
    if {[llength [$w.textarea tag ranges sel]] > 2} {
      set first2 [lindex [$w.textarea tag ranges sel] 2]
      set last2 [lindex [$w.textarea tag ranges sel] 3]
      set selected [textarea_get $w.textarea $first2 $last2]
      set tagstore [get_tags_exact $w.textarea [list $first2 $last2]]
      textarea_delete $w.textarea $first2 $last2 0
      textarea_insert $w.textarea $first2 [revcom $selected] 0
      put_tags $w.textarea [list $first2 $last2] $tagstore reverse 1
      $w.textarea tag add sel $first2 $last2
    }
    set reset 1
  }
  set insertstore [$w.textarea index insert]


  #selection used here - ok
  set selected [textarea_get $w.textarea $first $last]
  set tagstore [get_tags_exact $w.textarea [list $first $last]]
  textarea_delete $w.textarea $first $last 0
  textarea_insert $w.textarea $first [revcom $selected] 0
  put_tags $w.textarea [list $first $last] $tagstore reverse 1

  if {$reset} {
    $w.textarea tag add sel $first $last
    $w.textarea mark set insert $insertstore
    $w.textarea mark set anchor $anchorstore
    $w.textarea mark set tk::anchor$w.textarea $anchorstore
  } else {
    $w.textarea mark set insert [bp2ix $w.textarea [expr {int([ix2bp $w.textarea end]- [ix2bp $w.textarea $insertstore])}]]
    $w.textarea see insert
  }
  
  foreach tag $tag_order {
    if {[$w.textarea tag ranges $tag] != {}} {
      textarea_tag_raise $w.textarea $tag
    }
  }
  post_validate_seguid $w
  register_undo_separator $w [mc "Reverse Complement"]

  if {[info exists mode_store]} {
    set info(seguid_mode) $mode_store
  }
  vertindexbalancer $w
  selection_manager $w
}

##############
## enzyme selection dialog
##############
proc enzyme_selection_dialog {w} {
  global info
  global enzinfo
  global enzymes
  global enz_select_window old_enz_select_window
  global enz_select_location enz_select_location_text enz_select_location2
  global enz_select_groups wins wins_title
  global select_numsites_lab select_numsites_comp
  global dialogblock modstring modifier tk_patchLevel
  if {$dialogblock == 1} {return}
  set dialogblock 1

  set s ".enz_selector"

  foreach window [dnawindows_list] {
    findenzymes $window
  }

  if {[winfo exists $s]} {wm deiconify $s; raise $s; return}
  toplevel $s -background $info(bg_color)
  if {$info(android)} {
    wm attributes $s -fullscreen 1
  } else {
    bind . <<RaiseDialogs>> "after 100 {catch {wm deiconify $s; raise $s}}"
    bind $s <FocusIn> "event generate . <<RaiseDialogs>>"
    bind $s <Map> "event generate . <<RaiseDialogs>>"
    bind $s <Activate> "event generate . <<RaiseDialogs>>"

    regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $w] wgeom winx winy
    wm geometry $s "+[expr (($winx<0)?0:$winx)+3]+[expr (($winy<0)?0:$winy)+50]"
    wm transient $s $w
    if {[tk windowingsystem] == "aqua"} {
      #::tk::unsupported::MacWindowStyle style $s document {closeBox resizable}
      ::tk::unsupported::MacWindowStyle style $s document {closeBox horizontalZoom verticalZoom}
    }
    wm protocol $s WM_DELETE_WINDOW "$s.actionframe.cancel invoke"
    bind $s <KeyPress-Escape> "$s.actionframe.cancel invoke"
  }


  bind $s <<Cancel>> "$s.actionframe.cancel invoke"
  wm title $s [mc "Enzyme Selection..."]
  menu $s.menubar

  menu $s.menubar.filemenu 
  $s.menubar add cascade -menu $s.menubar.filemenu -label [mc "File"] -underline 0
  $s.menubar.filemenu add command -label [mc "Open new enzymes file"] -command "reload_enzymes"
  $s.menubar.filemenu add command -label [mc "Save enzymes file"] -command {save_enzymes "" 0; wm deiconify .enz_selector}
  $s.menubar.filemenu add separator
  $s.menubar.filemenu add command -label [mc "Save current enzymes as Default"] -command {save_enzymes "" 1; wm deiconify .enz_selector}
  $s.menubar.filemenu add separator
  $s.menubar.filemenu add command -label [mc "Import Enzymes From DNA Strider..."] -command "import_strider_enzymes .enz_selector"
  $s.menubar.filemenu add separator
  $s.menubar.filemenu add command -label [mc "Close Selection Dialog"] -accelerator "$modstring+W" -command "$s.actionframe.cancel invoke"

  menu $s.menubar.enzmenu 
  $s.menubar add cascade -menu $s.menubar.enzmenu -label [mc "Edit Enzymes"] -underline 1
  $s.menubar.enzmenu add command -label [mc "Edit Current Enzyme Set"] -command "enz_edit_curent_enzymes $s"
  $s.menubar.enzmenu add separator
  $s.menubar.enzmenu add command -label [mc "New Enzyme..."] -command "add_enzyme_dialog $s"
  $s.menubar.enzmenu add command -label [mc "Delete Selected Enzymes"] -command {delete_selected $info(enz_currently_selected)}
  $s.menubar.enzmenu add separator
  $s.menubar.enzmenu add command -label [mc "New Group..."] -command "add_enz_group $s \$info(enz_currently_selected)"
  $s.menubar.enzmenu add command -label [mc "Delete Groups..."] -command "delete_enz_group $s"
  $s.menubar.enzmenu add command -label [mc "Read Groups File..."] -command "read_enz_groups $s"
 $s.menubar.enzmenu add command -label [mc "Save Groups File..."] -command "save_enz_groups $s"

  #menu $s.menubar.editmenu 
  #$s.menubar add cascade -menu $s.menubar.editmenu -label [mc "Edit "] -underline 0
  #$s.menubar.editmenu add command -label [mc "Copy Selected Enzymes"] -command "copy_enz_seleted $s"
  #$s.menubar.editmenu add command -label [mc "Paste Selected Enzymes"] -command "paste_enz_seleted $s"


  menu $s.menubar.listmenu
  $s.menubar add cascade -menu $s.menubar.listmenu -label [mc "List"] -underline 0
  $s.menubar.listmenu add command -label [mc "List enzymes"] -command "list_enzymes_window \$enz_select_window 0 selected; enzyme_selection_dialog_do 1"
  $s.menubar.listmenu add command -label [mc "List enzymes + #sites"] -command "list_enzymes_window \$enz_select_window 1 selected; enzyme_selection_dialog_do 1"
  $s.menubar.listmenu add command -label [mc "List enzymes + site positions"] -command "list_enzymes_window \$enz_select_window 2 selected; enzyme_selection_dialog_do 1 "
  $s.menubar.listmenu add command -label [mc "List enzyme + recognition sequences"] -command "list_enzymes_window \$enz_select_window 3 selected; enzyme_selection_dialog_do 1"

  if {[tk windowingsystem] == "aqua"} {
    if {!$info(use_cocoa) && ![catch {menu $s.menubar.apple}]} {
      $s.menubar add cascade -menu $s.menubar.apple
      $s.menubar.apple add command -label [mc "About ApE"] -command "about_dialog $s"
      $s.menubar.apple add separator
    } else {
    }
  }

  if {$info(android)} {
    $s.menubar delete 0 end
    bind $s <KeyPress-Break> "$s.actionframe.cancel invoke"
    $s.menubar add command -label [mc "Graphic Map"] -command "enz_graphic_map \$enz_select_window ; enzyme_selection_dialog_do 1"
    $s.menubar add command -label [mc "Graphic Map +U"] -command "enz_graphic_map \$enz_select_window {==1} ;enzyme_selection_dialog_do 1"
    $s.menubar add command -label [mc "Digest"] -command "if \{\$info(enz_currently_selected) != {}\} \{enz_digest \$enz_select_window \$info(enz_currently_selected) all\}; enzyme_selection_dialog_do 1"
    $s.menubar add command -label [mc "Digest with All"] -command "if \{\$info(enz_currently_selected) != {}\} \{enz_digest_window_with_current_enz \$enz_select_window\}; enzyme_selection_dialog_do 1"
    $s.menubar add command -label [mc "Highlight"] -command "highlight_enzymes \$enz_select_window \$info(enz_currently_selected); enzyme_selection_dialog_do 1"
    $s.menubar add command -label [mc "Text"] -command "enz_text_map \$enz_select_window 0; enzyme_selection_dialog_do 1"

    $s.menubar add cascade -menu $s.menubar.listmenu -label [mc "List"]
    $s.menubar add command -label [mc "Close"] -command "enzyme_selection_dialog_do 0"

    menu $s.overflow 
    $s.overflow add command -label [mc "Open new enzymes file"] -command "reload_enzymes"
    android_action_bar $s
  } else {
    $s configure -menu $s.menubar
  }

  bind $s <$modifier-KeyPress-w> "$s.actionframe.cancel invoke"
  bind $s <$modifier-KeyPress-y> "$s.actionframe.graphic invoke"
  bind $s <$modifier-KeyPress-Y> "$s.actionframe.graphicU invoke" 
  bind $s <$modifier-KeyPress-g> "$s.actionframe.digest invoke" 
  bind $s <$modifier-KeyPress-T> "$s.actionframe.textmap invoke"

##Region of interest frame###
  grid [frame $s.location -relief ridge -borderwidth 3] -row 1 -column 0 -sticky nwe
  grid [label $s.location.label -text [mc "Window"] -font boldlabelfont] -row 0 -column 0 -sticky wns
  menubutton $s.location.win_button
    menu $s.location.win_button.menu 
    foreach window [dnawindows_list 1] {
      $s.location.win_button.menu add radiobutton -command "change_enz_select_window" -label [wm title $window] -variable enz_select_window -value $window 
    }
    $s.location.win_button configure -text [wm title $w] -menu $s.location.win_button.menu  -indicatoron 1 -relief raised -width 50 
    bind $s.location.win_button <<MenuSelect>> "focus $s"

  set enz_select_window $w
  set old_enz_select_window $w
  grid $s.location.win_button -row 0 -column 1 -sticky wens

  #grid [checkbutton $s.location.local -height 1 -width 0 -variable enz_select_location -onvalue "selection" -offvalue "all" -indicator on -selectcolor white -command "fill_enzymes_box .enz_selector.textframe.textbox .enz_selector.enz_comment \$enz_select_window" -justify right] -row 0 -column 2 -sticky wns 
  #grid [label $s.location.labelssel -text  [mc "Selection: "] -font labelfont -justify right] -row 0 -column 3 -sticky wns
  #grid [label $s.location.labelss -textvariable info($w,sel_start) -font labelfont] -row 0 -column 4 -sticky wns
  #grid [label $s.location.labesdashl -text "-" -font labelfont] -row 0 -column 5 -sticky wns
  #grid [label $s.location.labelse -textvariable info($w,sel_end) -font labelfont] -row 0 -column 6 -sticky wns

  grid [menubutton $s.location.local -menu $s.location.local.menu -textvariable enz_select_location_text] -row 0 -column 2 -sticky wns 
  menu $s.location.local.menu
  $s.location.local.menu add radiobutton -label [mc "All"] -variable enz_select_location -value "all" -command "enz_selection_dialog_sel_changed \$enz_select_window"
  $s.location.local.menu add radiobutton -label [mc "Selection"] -variable enz_select_location -value "selection" -command "enz_selection_dialog_sel_changed \$enz_select_window"
  $s.location.local.menu add radiobutton -label [mc "All But Selection"] -variable enz_select_location -value "all_but_selection" -command "enz_selection_dialog_sel_changed \$enz_select_window"
  set enz_select_location "all"

  register_data_receiver $s <<SelectionChanged>> "enz_selection_dialog_sel_changed"
  
  grid [checkbutton $s.location.methylation -text Dam/Dcm -variable info($enz_select_window,Dam_Dcm_methylated) -onvalue 1 -offvalue 0 -command {toggle_methylation $enz_select_window; fill_enzymes_box .enz_selector.textframe.textbox .enz_selector.enz_comment $enz_select_window} -selectcolor white] -row 0 -column 7 -sticky wns
  tooltip_install $s.location.methylation [mc "Methylation state of the DNA.\nSet for plasmids, unset for PCR."]
  grid columnconfigure $s.location 1 -weight 1

###Enzyme list frame ######
  grid [frame $s.textframe] -row 2 -column 0 -sticky nswe
  grid [ttk::scrollbar $s.textframe.scroll -command "$s.textframe.textbox yview"] -row 0 -column 1 -sticky nsw
  grid [text $s.textframe.textbox -yscrollcommand "optionscrollbar $s.textframe.scroll" -height 20 -background $info(text_bg_color) -foreground $info(text_fg_color) -font labelfont -wrap none -insertontime 0 -insertofftime 1000] -row 0 -column 0 -sticky nswe
  set tabwidth [font measure [$s.textframe.textbox cget -font] "HpyCH4III(200) "]
  $s.textframe.textbox configure -tabs "$tabwidth left" -width [expr {0+$tabwidth* $info(enz_selector_width)/[font measure [$s.textframe.textbox cget -font] "0"]}]
  #grid [scrollbar $s.textframe.scrollx -command "$s.textframe.textbox xview" -orient horizontal] -row 1 -column 0 -sticky nwe


  grid columnconfigure $s.textframe 0 -weight 1
  grid rowconfigure $s.textframe 0 -weight 1

##Enzyme Comment box
  grid [label $s.enz_comment -justify center] -row 3 -column 0 -sticky nswe

###Select_enzymes frame 
  set enz_select_groups "All"

  grid [frame $s.groupsframe -relief ridge -borderwidth 3] -row 4 -column 0 -sticky nwe
  grid [label $s.groupsframe.label -text [mc "Select Enzymes"] -font boldlabelfont] -row 1 -column 0 -sticky w

  #number of sites menu button
  menubutton $s.groupsframe.numsites 
    menu $s.groupsframe.numsites.menu 
    foreach label [list [mc "unique (1)"] [mc any] [mc "absent (0)"] [mc "present (>0)"] [mc "not unique (>1)"]] comparison [list "==1" ">-1" "==0" ">0" ">1"] {
      $s.groupsframe.numsites.menu add radiobutton -label $label -value $comparison -command "set select_numsites_lab {$label}; tagmanage .enz_selector.textframe.textbox display {}" -variable select_numsites_comp 
    }
    menu $s.groupsframe.numsites.menu.lt 
    foreach label [list <2 <3 <4 <5 <6 <7 <8 <9 <10 <11 <12 <13 <14 <15 <16] comparison [list <2 <3 <4 <5 <6 <7 <8 <9 <10 <11 <12 <13 <14 <15 <16] {
      $s.groupsframe.numsites.menu.lt add radiobutton -label $label -value $comparison -command "set select_numsites_lab {$label}; tagmanage .enz_selector.textframe.textbox display {}" -variable select_numsites_comp 
    }
    menu $s.groupsframe.numsites.menu.et 
    foreach label [list =2 =3 =4 =5 =6 =7 =8 =9 =10 =11 =12 =13 =14 =15 =16] comparison [list ==2 ==3 ==4 ==5 ==6 ==7 ==8 ==9 ==10 ==11 ==12 ==13 ==14 ==15 ==16] {
      $s.groupsframe.numsites.menu.et add radiobutton -label $label -value $comparison -command "set select_numsites_lab {$label}; tagmanage .enz_selector.textframe.textbox display {}" -variable select_numsites_comp
    }
    menu $s.groupsframe.numsites.menu.gt 
    foreach label [list >2 >3 >4 >5 >6 >7 >8 >9 >10 >11 >12 >13 >14 >15 >16] comparison [list >2 >3 >4 >5 >6 >7 >8 >9 >10 >11 >12 >13 >14 >15 >16] {
      $s.groupsframe.numsites.menu.gt add radiobutton -label $label -value $comparison -command "set select_numsites_lab {$label}; tagmanage .enz_selector.textframe.textbox display {}" -variable select_numsites_comp
    }
    $s.groupsframe.numsites.menu add cascade -label [mc "less than"] -menu $s.groupsframe.numsites.menu.lt
    $s.groupsframe.numsites.menu add cascade -label [mc "equal to"] -menu $s.groupsframe.numsites.menu.et
    $s.groupsframe.numsites.menu add cascade -label [mc "greater than"] -menu $s.groupsframe.numsites.menu.gt
    # $s.groupsframe.numsites.menu add command -label [mc "Other..."] -command "enzyme_count_dialog" 
    $s.groupsframe.numsites configure -indicatoron 1 -relief raised -width 12 -textvariable select_numsites_lab -menu $s.groupsframe.numsites.menu
    $s.groupsframe.numsites.menu invoke 0
    bind $s.groupsframe.numsites.menu <<MenuSelect>> "focus $s"
  grid $s.groupsframe.numsites -row 1 -column 1 -sticky w 

  grid [frame $s.groupsframe.sec_window_frame] -row 0 -column 0 -columnspan 7 -sticky ew 
  grid [label $s.groupsframe.sec_window_frame.label -text [mc "Diff Window"] -font boldlabelfont] -row 2 -column 0 -sticky w
  menubutton $s.groupsframe.sec_window_frame.win -menu $s.groupsframe.sec_window_frame.win.win_menu -textvariable wins_title
  menu $s.groupsframe.sec_window_frame.win.win_menu -background $info(menu_bg_color) -foreground $info(menu_fg_color) -activebackground $info(menu_select_bg_color) -activeforeground $info(menu_select_fg_color)
  foreach window [dnawindows_list 1] {
      $s.groupsframe.sec_window_frame.win.win_menu add radiobutton -label [wm title $window] -variable wins -value $window -command "set wins_title \{[wm title $window]\}; tagmanage .enz_selector.textframe.textbox display {}"
  }
  set wins $w
  set wins_title "[wm title $w]"
  grid $s.groupsframe.sec_window_frame.win -row 2 -column 1 -sticky we

  grid [checkbutton $s.groupsframe.sec_window_frame.local2 -height 1 -variable enz_select_location2 -text [mc "Selection Only"] -onvalue "selection" -offvalue "all" -indicator on -selectcolor white -command "tagmanage .enz_selector.textframe.textbox display {}"] -row 2 -column 2 -sticky wns 
  set enz_select_location2 all
  grid remove $s.groupsframe.sec_window_frame


  #enzyme groups menu button
  menubutton $s.groupsframe.groups_button
    menu $s.groupsframe.groups_button.menu 
    foreach element $enzinfo(enz_groups_list) {
      $s.groupsframe.groups_button.menu add radiobutton -label $element -variable enz_select_groups -value $element -command "tagmanage .enz_selector.textframe.textbox display {}"
    }
    $s.groupsframe.groups_button configure -indicatoron 1 -relief raised -width 10 -textvariable enz_select_groups -menu $s.groupsframe.groups_button.menu
    $s.groupsframe.groups_button.menu invoke 0
    trace add variable enz_select_groups write   "global enz_select_groups; if {\$enz_select_groups == \"Difference...\"} {grid configure .enz_selector.groupsframe.sec_window_frame} else { grid remove .enz_selector.groupsframe.sec_window_frame}; #"

  grid $s.groupsframe.groups_button -row 1 -column 2 -sticky w

  #select functions button set
  grid [button $s.groupsframe.plus -text [mc "Select"] -command {tagmanage .enz_selector.textframe.textbox add [enz_site_usage_filter $enz_select_window $enzinfo(enz_groups,$enz_select_groups) $select_numsites_comp $enz_select_location]}] -row 1 -column 3 -sticky w
  grid [button $s.groupsframe.minus -text [mc "De-select"] -command {tagmanage .enz_selector.textframe.textbox remove [enz_site_usage_filter $enz_select_window $enzinfo(enz_groups,$enz_select_groups) $select_numsites_comp $enz_select_location]}] -row 1 -column 4 -sticky w
  grid [button $s.groupsframe.and -text [mc "AND"] -command {tagmanage .enz_selector.textframe.textbox booland [enz_site_usage_filter $enz_select_window $enzinfo(enz_groups,$enz_select_groups) $select_numsites_comp $enz_select_location]}] -row 1 -column 5 -sticky w
  grid [button $s.groupsframe.clearall -text [mc "clear all"] -command {tagmanage .enz_selector.textframe.textbox booland {}}] -row 1 -column 6 -sticky w
  grid [button $s.groupsframe.memplus -text [mc "Sel to Mem"] -command {set enzinfo(enz_groups,Mem\ Recall) $info(enz_currently_selected)}] -row 1 -column 7 -padx {10 0} -sticky w
  grid columnconfigure $s.groupsframe 7 -weight 1

##Perfom Action frame######
  if {!$info(android)} {
    grid [frame $s.actionframe -relief ridge  -borderwidth 3] -row 5 -column 0 -sticky nsew
    grid [label $s.actionframe.label -text [mc "Perform Action"] -font boldlabelfont] -row 0 -column 0 -sticky w
    grid [button $s.actionframe.graphic -text [mc "Graphic Map"] -command "enz_graphic_map \$enz_select_window ; enzyme_selection_dialog_do 1"] -row 0 -column 1
    grid [button $s.actionframe.graphicU -text [mc "Graphic Map +U"] -command "enz_graphic_map \$enz_select_window {==1} ;enzyme_selection_dialog_do 1"] -row 0 -column 2
    grid [button $s.actionframe.digest -text [mc "Digest"] -command "if \{\$info(enz_currently_selected) != {}\} \{enz_digest \$enz_select_window \$info(enz_currently_selected) all\}; enzyme_selection_dialog_do 1"] -row 0 -column 3
    grid [button $s.actionframe.digest_w_all -text [mc "Digest with All"] -command "if \{\$info(enz_currently_selected) != {}\} \{enz_digest_window_with_current_enz \$enz_select_window\}; enzyme_selection_dialog_do 1"] -row 0 -column 4
    grid [button $s.actionframe.hilight -text [mc "Highlight"] -command "highlight_enzymes \$enz_select_window \$info(enz_currently_selected); enzyme_selection_dialog_do 1"]  -row 0 -column 5
    grid [button $s.actionframe.textmap -text [mc "Text"] -command "enz_text_map \$enz_select_window 0; enzyme_selection_dialog_do 1"]  -row 0 -column 6
    grid [button $s.actionframe.cancel -text [mc "Close"] -command "enzyme_selection_dialog_do 0"]  -row 0 -column 7
    grid [checkbutton $s.actionframe.keep_open -text [mc "Keep Selector Dialog Open"] -variable info(enz_selector_keep_open)] -row 1 -column 0 -columnspan 3 -sticky w
    grid columnconfigure $s.actionframe 1 -weight 1
    grid columnconfigure $s.actionframe 2 -weight 1
    grid columnconfigure $s.actionframe 3 -weight 1
    grid columnconfigure $s.actionframe 4 -weight 1
    grid columnconfigure $s.actionframe 5 -weight 1
    grid columnconfigure $s.actionframe 6 -weight 1
  }

  .enz_selector.textframe.textbox tag configure pre_current_selection -background "" -underline 1
  .enz_selector.textframe.textbox tag configure current_selection -background red
  .enz_selector.textframe.textbox tag configure pre_overlap_current_selection -background "" -underline 1

   enz_selection_dialog_sel_changed $enz_select_window
  #fill_enzymes_box .enz_selector.textframe.textbox .enz_selector.enz_comment $enz_select_window

  menu .enz_selector.textframe.textbox.popupmenu
  .enz_selector.textframe.textbox.popupmenu add command -label [mc "REBASE: enzyme search"]
  .enz_selector.textframe.textbox.popupmenu add command -label [mc "REBASE: isoschizomer search"]
  .enz_selector.textframe.textbox.popupmenu add command -label [mc "REBASE: supplier search"]

  grid columnconfigure $s 0 -weight 1

  grid rowconfigure $s 0 -weight 0
  grid rowconfigure $s 1 -weight 0
  grid rowconfigure $s 2 -weight 1
  grid rowconfigure $s 3 -weight 0
  grid rowconfigure $s 4 -weight 0
  grid rowconfigure $s 5 -weight 0

  if {$info(android)} {
    ## enzyme selector modifications
    grid remove $s.location.label
    grid $s.location.win_button -row 0 -column 0 -columnspan 6
    grid $s.location.local -row 1 -column 0
    grid $s.location.labelssel -row 1 -column 1
    grid $s.location.labelss  -row 1 -column 2
    grid $s.location.labesdashl  -row 1 -column 3
    grid $s.location.labelse  -row 1 -column 4
    grid $s.location.methylation  -row 1 -column 5
    grid columnconfigure $s.location 1 -weight 0
    grid columnconfigure $s.location 4 -weight 1

    grid remove $s.groupsframe.label
    grid $s.groupsframe.numsites -column 0 -columnspan 2  -sticky we 
    grid $s.groupsframe.groups_button -columnspan 2 -sticky we
    grid $s.groupsframe.plus -row 2 -column 0 -sticky we
    grid $s.groupsframe.minus -row 2 -column 1 -columnspan 2 -sticky we
    grid $s.groupsframe.and -row 2 -column 3 -sticky we
    grid $s.groupsframe.clearall -row 3 -column 0 -sticky we
    grid $s.groupsframe.memplus -row 3 -column 1 -padx {0 0} -columnspan 2 -sticky we
    grid  $s.groupsframe.sec_window_frame.local2 -row 3 -column 1
    grid columnconfigure $s.groupsframe 7 -weight 0
    grid columnconfigure $s.groupsframe 0 -weight 1
    grid columnconfigure $s.groupsframe 1 -weight 1
    grid columnconfigure $s.groupsframe 2 -weight 1
    grid columnconfigure $s.groupsframe 3 -weight 1

    bind $s.textframe.textbox <Button-1> "$s.textframe.textbox scan mark \[expr {%x}\]  \[expr {%y}\]"
    bind $s.textframe.textbox <Button1-Motion> "$s.textframe.textbox scan dragto \[expr {%x}\]  \[expr {%y}\]"
    bind $s.textframe.textbox <Button-2> "$s.textframe.textbox scan mark \[expr {%x}\]  \[expr {%y}\]"
    bind $s.textframe.textbox <Button2-Motion> "$s.textframe.textbox scan dragto \[expr {%x}\]  \[expr {%y}\]"
  } else {
    update idletasks
    regexp {([0-9]*)x([0-9]*)\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $s] wgeom winw winh winx winy
    if {[expr {$winx+$winw}] > [winfo screenwidth .]} {set winx [expr {[winfo screenwidth .]-$winw}]}
    if {$winx < 0} {set winx 0}
    if {[expr {$winy+$winh}] > [winfo screenheight .]} {set winy [expr {[winfo screenheight .]-$winh}]}
    if {$winy < 0} {set winy 0}
    wm geometry $s "+$winx+$winy"
  }

  #tagmanage .enz_selector.textframe.textbox display $info(enz_currently_selected)
#sputs here1 [.enz_selector.textframe.textbox tag ranges current_selection]
  $s.textframe.textbox configure -state disabled -cursor arrow
  bind $s <Any-MouseWheel> "$s.textframe.textbox yview scroll \[expr {int(1.0 * %D/-\$info(mousewheelunits))}] units"
  bind $s <Any-Button-1> {}


  bindtags $s.textframe.textbox [list "$s.textframe.textbox" .enz_selector]
  #grab set $s
  bind $s <Key-Return> "$s.actionframe.cancel invoke"
  bind $s <Configure> "if {\[winfo width .enz_selector.textframe.textbox\]> 20 && \[bind .enz_selector.textframe.textbox <<Columns>>\] != \[expr {\[winfo width .enz_selector.textframe.textbox\] / $tabwidth}\]} {bind .enz_selector.textframe.textbox <<Columns>> \[expr {\[winfo width .enz_selector.textframe.textbox\] / $tabwidth}\]; fill_enzymes_box .enz_selector.textframe.textbox .enz_selector.enz_comment $enz_select_window}"
  focus $s
}

#################
## NOT USED
#################
proc enz_selection_dialog_sel_changed {changed_window} {
  global info enz_select_window
  if {($info(analyze_selection) eq "selection") && $enz_select_window == $changed_window} {
    fill_enzymes_box .enz_selector.textframe.textbox .enz_selector.enz_comment $enz_select_window
    ## bug in window update code, so force a redraw
    if {[tk windowingsystem] == "aqua"} {
      grid remove .enz_selector.location.labelss
      grid configure .enz_selector.location.labelss
    }
  }
}

#################
##
#################
proc enz_selection_dialog_sel_changed {changed_window} {
  global info enz_select_window    enz_select_location    enz_select_location_text
  if {$enz_select_window == $changed_window} {
    fill_enzymes_box .enz_selector.textframe.textbox .enz_selector.enz_comment $enz_select_window
    if {$enz_select_location == "all"} {
     set enz_select_location_text [mc "All"]
    } elseif {$enz_select_location == "selection"} {
      if {[$enz_select_window.textarea tag ranges sel] != ""} {
       set enz_select_location_text [mc "Selection: %1\$s - %2\$s" $info($enz_select_window,sel_start) $info($enz_select_window,sel_end)]
      } else {
       set enz_select_location_text [mc "All (No Selection)"]
     }
    } else {
      if {[$enz_select_window.textarea tag ranges sel] != ""} {
        set enz_select_location_text [mc "All But Selection: %1\$s - %2\$s" $info($enz_select_window,sel_start) $info($enz_select_window,sel_end)]
      } else {
       set enz_select_location_text [mc "All (No Selection)"]
      }
    }
  }
}


#################
## execute ok or cancel for enzyme_selection_dialog
#################
proc enzyme_selection_dialog_do {ok} {
  global info dialogblock info select_numsites_lab select_numsites_comp enz_select_groups enz_select_window old_enz_select_window

  set dialogblock 0
  bind . <<RaiseDialogs>> ""

  if {$ok && $info(enz_selector_keep_open)} {return}
  if {$info(enzymes_saved) == 0} {
    if {[tk_messageBox -message [mc "Do you want to save changes to the current enzyme set?"] -type yesno -icon question] == "yes"} {
      save_enzymes "" 0
    } else {
      set info(enzymes_saved) -1
    }
  }

  unset -nocomplain select_numsites_lab select_numsites_comp 
  trace remove variable enz_select_groups write  "global enz_select_groups; if {\$enz_select_groups == \"Difference...\"} {grid configure .enz_selector.groupsframe.sec_window_frame} else { grid remove .enz_selector.groupsframe.sec_window_frame}; #"
  set enz_select_groups "All"

  unset -nocomplain enz_select_window old_enz_select_window
  destroy .enz_selector.menubar
  destroy .enz_selector
}

#################
## insert enzymes into the enzyme selector text box
#################
proc change_enz_select_window {} {
  global enz_select_window old_enz_select_window info


  ## when individual label elements:
  ##.enz_selector.location.labelss configure -textvariable info($enz_select_window,sel_start)
  ##.enz_selector.location.labelse configure -textvariable info($enz_select_window,sel_end)


  .enz_selector.location.win_button configure -text [wm title $enz_select_window]
  .enz_selector.location.methylation configure -variable info($enz_select_window,Dam_Dcm_methylated)
  enz_selection_dialog_sel_changed $enz_select_window
  set old_enz_select_window $enz_select_window
  enz_selection_dialog_sel_changed $enz_select_window
  #fill_enzymes_box .enz_selector.textframe.textbox .enz_selector.enz_comment $enz_select_window
}

#################
## insert enzymes into the enzyme selector text box
#################
proc fill_enzymes_box {textbox commentbox w } {
  global enzymes modifier
  global enzinfo
  global info enz_select_location

  if {[set columns [bind $textbox <<Columns>>]] eq ""} {
    set columns $info(enz_selector_width)
  } else {
    set info(enz_selector_width) $columns
  }

  set enzymelist $enzymes
  if {$columns <= 0} {set columns 1}
  while {[expr {[llength $enzymelist] % $columns}] > 0} {
    lappend enzymelist ""
  }
  set rows [expr int([llength $enzymelist]/$columns)]

  $textbox configure -state normal
  $textbox delete 1.0 end
  for {set i 0} {$i < $rows} {incr i} {
    set prepend " "
    for {set j 0} {$j < $columns} {incr j} {
      set beginenz [$textbox index "end-1 chars"]
      set enzyme [lindex $enzymelist [expr $j*$rows+$i]]
      if {$enzyme != ""} {
        $textbox insert end "$prepend$enzyme ([enz_count $w $enzyme $enz_select_location]) "
        $textbox tag add $enzyme "$beginenz+1 chars" "end-1 chars"
        if {$enzinfo(compat,$enzyme) != ""} {
          if {[llength $enzinfo(compat,$enzyme)] < 11} {
            $textbox tag bind $enzyme <Any-Enter> "$commentbox configure -text {$enzyme: $enzinfo(enz_comment,$enzyme) (compat w/: $enzinfo(compat,$enzyme))}"
          } else {
            $textbox tag bind $enzyme <Any-Enter> "$commentbox configure -text {$enzyme: $enzinfo(enz_comment,$enzyme) (compat w/: [lrange $enzinfo(compat,$enzyme) 0 9]+[expr {[llength $enzinfo(compat,$enzyme)]-10}] others)}"
          }
        } else {
          $textbox tag bind $enzyme <Any-Enter> "$commentbox configure -text {$enzyme: $enzinfo(enz_comment,$enzyme)}"
        }
        $textbox tag bind $enzyme <Any-Leave> "$commentbox configure -text {}"
        $textbox tag bind $enzyme <Button-1> "tagmanage $textbox click \{\{$enzyme\}\}"
        if {!$info(android)} {
          $textbox tag bind $enzyme <Double-Button-1> "tagmanage $textbox click \{\{$enzyme\}\}; edit_enzyme \{$enzyme\} .enz_selector"
        }
        $textbox tag bind $enzyme <Shift-Button-1> "tagmanage $textbox booland {}; tagmanage $textbox click \{\{$enzyme\}\}"
        if {[tk windowingsystem] != "aqua"} {
          $textbox tag bind "$enzyme" <Button-3> "
             $textbox.popupmenu entryconfigure \"REBASE: enzyme search\" -command \"rebase_query \\\"$enzyme\\\" main\"
             $textbox.popupmenu entryconfigure \"REBASE: isoschizomer search\" -command \"rebase_query \\\"$enzyme\\\" similar\"
             $textbox.popupmenu entryconfigure \"REBASE: supplier search\" -command \"rebase_query \\\"$enzyme\\\" suppliers\"
             tk_popup $textbox.popupmenu %X %Y 0"
          $textbox tag bind $enzyme <Shift-Key-F10> [$textbox tag bind $enzyme <Button-3>]
        } else {
          $textbox tag bind "$enzyme" <Button-2>  "
             $textbox.popupmenu entryconfigure \"REBASE: enzyme search\" -command \"rebase_query \\\"$enzyme\\\" main\"
             $textbox.popupmenu entryconfigure \"REBASE: isoschizomer search\" -command \"rebase_query \\\"$enzyme\\\" similar\"
             $textbox.popupmenu entryconfigure \"REBASE: supplier search\" -command \"rebase_query \\\"$enzyme\\\" suppliers\"
             tk_popup $textbox.popupmenu %X %Y 0" 
          $textbox tag bind $enzyme <Button-3> [$textbox tag bind $enzyme <Button-2>]
          $textbox tag bind $enzyme <Control-Button-1> [$textbox tag bind $enzyme <Button-2>]
        }
        set prepend "\t"
      } else {
        $textbox insert end "$prepend$enzyme "
      }
    }
    $textbox insert end "\n"
  }
  tagmanage $textbox display $info(enz_currently_selected)
  $textbox delete end-1char end
  $textbox configure -state disabled
  unset enzymelist
}


#################
## filter an incoming group for site number and return remaining elements
#################
proc enz_site_usage_filter {w {enzlist [list]} {comparison "==1"} {region all}} {
  global info 

  set templist [list]
  if {$enzlist != "Difference..."} {
    foreach enzyme $enzlist {
      if "[enz_count $w $enzyme $region] $comparison" {lappend templist $enzyme}
    }
  } else {
    foreach enzyme [enzyme_diffs $w] {
      if "[enz_count $w $enzyme $region] $comparison" {lappend templist $enzyme}
    }
  }
  return $templist
}

#################
## return the number of sites for enzyme in window
#################
proc enz_count {w enzyme region} {
  global info
  if {[$w.textarea tag ranges sel] == ""} {set region "all"}
  if {$region == "all" || $info($w,$enzyme) == {}} {
    return [llength $info($w,$enzyme)]
  } else {
#selection used here - ok
    set start [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 0]]
    incr start
    set end [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 1]]
    if {[llength [$w.textarea tag ranges sel]] > 2} { 
      set start2 [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 2]]
      incr start2
    }
    set i 0
    foreach site $info($w,$enzyme) {
      if {$site > $end} {
        if {![info exists start2]} {
          break
        } else {
          if {$site >= $start2} {incr i}
          continue
        }
      }
      if {$site >= $start} {incr i}
    }
    if {$region eq "selection"} {
      return $i
    } elseif {$region eq "all_but_selection"} {
      return [expr {[llength $info($w,$enzyme)] - $i}]
    }
  }
}

#################
## retrun enzymes that have diff # cuts from w
## NOT USED
#################
proc enzyme_diffs2 {w} {
  global ok2 wins wins_title analyze_selection info enzymes

  set a [toplevel .dialog -background $info(bg_color)]
  wm title $a [mc "Enzyme Difference..."]
  set ok 0
  wm protocol $a WM_DELETE_WINDOW "set ok2 -1"
  bind $a <KeyPress-Escape>  "set ok2 -1"
  set bindstore [bind . <<RaiseDialogs>>]
  bind . <<RaiseDialogs>> "wm deiconify $a; raise $a"
  bind $a <KeyPress-Escape>  "set ok2 -1"
  if {[winfo exists .enz_selector]} {
    regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry .enz_selector] wgeom winx winy
    wm geometry $a "+[expr (($winx<0)?0:$winx)+3]+[expr (($winy<0)?0:$winy)+50]"
    if {[tk windowingsystem] != "aqua"} {
      wm transient $a .enz_selector
    } else {
      ::tk::unsupported::MacWindowStyle style $a document {closeBox}
    }
  }

  grid [label $a.l1 -text [mc "Window 1:"] -font labelfont] -row 1 -column 0 -sticky w
  grid [label $a.l2 -text "[wm title $w]" -font labelfont] -row 1 -column 1 -sticky w
  grid [label $a.l3 -text  $info(analyze_selection) -font labelfont] -row 1 -column 2 -columnspan 3 -sticky w
  grid [label $a.l4 -text [mc "Window 2:"] -font labelfont] -row 2 -column 0 -sticky w

  set maxwidth 10
  menubutton $a.win -menu $a.win.win_menu -textvariable wins_title
  menu $a.win.win_menu -background $info(menu_bg_color) -foreground $info(menu_fg_color) -activebackground $info(menu_select_bg_color) -activeforeground $info(menu_select_fg_color)
  foreach window [dnawindows_list 1] {
      $a.win.win_menu add radiobutton -label [wm title $window] -variable wins -value $window -command "set wins_title \{[wm title $window]\}"
      if {[string length [wm title $window]] > $maxwidth} {set maxwidth [string length [wm title $window]]}   
  }
  if {$maxwidth > 200} {set maxwidth 200}
  incr maxwidth 3
  $a.win configure -width $maxwidth

  set wins $w
  set wins_title "[wm title $w]"
  grid $a.win -row 2 -column 1 -sticky we

  grid [checkbutton $a.local2 -height 1 -width 10 -variable analyze_selection -text [mc "Selection Only"] -onvalue "selection" -offvalue "all" -indicator on -selectcolor white] -row 2 -column 2 -sticky wns 
  set analyze_selection all

  grid [button $a.ok -text [mc "OK"] -command "set ok2 1" -default active] -row 3 -column 1 -padx 10 -pady 3
  grid columnconfigure $a 1 -weight 1

  bind $a <Key-Return> "$a.ok invoke"
  wm deiconify $a; raise $a; focus $a
  vwait ok2

  set templist [list]
  if {$ok2 == 1} {
    foreach enzyme $enzymes {
      if {[enz_count $w $enzyme $enz_select_location] != [enz_count $wins $enzyme $analyze_selection]} {lappend templist $enzyme}
    }
  }
  bind . <<RaiseDialogs>> $bindstore
  destroy $a
  unset ok2 wins wins_title analyze_selection
  set templist
}


#################
## retrun enzymes that have diff # cuts from w
#################
## this one uses an internal Window 2 menubutton
proc enzyme_diffs {w} {
  global wins info enzymes enz_select_location enz_select_location2

  set templist [list]
  foreach enzyme $enzymes {
    if {[enz_count $w $enzyme $enz_select_location] != [enz_count $wins $enzyme $enz_select_location2]} {lappend templist $enzyme}
  }

  return $templist
}

#################
## enter a different enzyme count condition
#################
proc enzyme_count_dialog {} {
  global ok2 info enzymes select_numsites_comp select_numsites_lab

  set a [toplevel .dialog -background $info(bg_color)]
  wm title $a [mc "Enzyme Count..."]
  set ok 0
  set ok2 0
  wm protocol $a WM_DELETE_WINDOW "set ok2 -1"
  set bindstore [bind . <<RaiseDialogs>>]
  bind . <<RaiseDialogs>> "wm deiconify $a; raise $a"
  bind $a <KeyPress-Escape>  "set ok2 -1"
  if {[winfo exists .enz_selector]} {
    regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry .enz_selector] wgeom winx winy
    wm geometry $a "+[expr (($winx<0)?0:$winx)+3]+[expr (($winy<0)?0:$winy)+50]"
    if {[tk windowingsystem] != "aqua"} {
      wm transient $a .enz_selector
    } else {
      ::tk::unsupported::MacWindowStyle style $a document {closeBox}
    }
  } else {
    return
  }

  grid [label $a.l1 -text [mc "Count (ex <6  ==8):"] -font labelfont] -row 1 -column 0 -sticky w
  grid [entry $a.l2 -font labelfont -width 10 -textvariable comparison] -row 1 -column 1 -sticky w


  grid [button $a.ok -text [mc "OK"] -command "set ok2 1" -default active] -row 3 -column 1 -padx 10 -pady 3
  grid columnconfigure $a 1 -weight 1

  bind $a <Key-Return> "$a.ok invoke"
  wm deiconify $a; raise $a; focus $a
  while {$ok2 == 0} {
    vwait ok2
    if {$ok2 == 1} {
      if {[catch {if "1 $comparison" {}}]} {
        set ok2 0
        set comparison "==1"
      } else {
        set select_numsites_comp
        set select_numsites_lab  $comparison
      }
    }
  }
  bind . <<RaiseDialogs>> $bindstore
  destroy $a
  unset ok2
}

#################
## manage the enzyme selector dialog enzyme textbox tags
#################
proc tagmanage2 {textbox action {taglist [list]}} {
  global enzymes
  global info

  switch $action {
    click {
       foreach etag $taglist {
          if {[$textbox tag cget $etag -background] == "red"} {
            $textbox tag configure $etag -background white
          } else {
            $textbox tag configure $etag -background red
          }
       }
    }
    add {
       foreach etag $taglist {
          $textbox tag configure $etag -background red
       }
    }
    remove {
       foreach etag $taglist {
          $textbox tag configure $etag -background white
       }
    }
    booland {
       foreach etag $enzymes {
          if {[lsearch -exact $taglist $etag] == -1} {
             $textbox tag configure $etag -background white  
          }
       }
    }
    display {
       foreach etag $taglist {
          $textbox tag configure $etag -background red
       }
    }
  }
  set info(enz_currently_selected) [list]
  foreach etag $enzymes {
    if {[$textbox tag cget $etag -background] == "red"} {
      lappend info(enz_currently_selected) $etag
    }
  }
}

#################
## manage the enzyme selector dialog enzyme textbox tags
#################
proc tagmanage {textbox action {taglist [list]}} {
  global enzymes
  global info 
  global enzinfo enz_select_groups enz_select_window select_numsites_comp enz_select_location

  switch $action {
    click {
       foreach enz $taglist {
          if {[set i [lsearch $info(enz_currently_selected) $enz]] > -1} {
            set info(enz_currently_selected) [lreplace $info(enz_currently_selected) $i $i]
          } else {
            lappend info(enz_currently_selected) $enz
          }
       }
    }
    add {
       foreach enz $taglist {
          lappend info(enz_currently_selected) $enz
       }
    }
    remove {
       foreach enz $taglist {
          if {[set i [lsearch $info(enz_currently_selected) $enz]] > -1} {
            set info(enz_currently_selected) [lreplace $info(enz_currently_selected) $i $i]
          }
       }
    }
    booland {
       foreach enz $enzymes {
          if {[lsearch -exact $taglist $enz] == -1} {
             if {[set i [lsearch $info(enz_currently_selected) $enz]] > -1} {
              set info(enz_currently_selected) [lreplace $info(enz_currently_selected) $i $i]
            }  
          }
       }
    }
    display {
    }
  }
  set info(enz_currently_selected) [lsort -unique $info(enz_currently_selected)]



  $textbox tag remove current_selection 1.0 end
  foreach enz $info(enz_currently_selected) {
    if {[set enz_range [$textbox tag ranges $enz]] != ""} {
      $textbox tag add current_selection {*}$enz_range
    }
  }


  $textbox tag remove pre_current_selection 1.0 end
  $textbox tag remove pre_overlap_current_selection 1.0 end
  if {[info exists enz_select_window]} {
    foreach enz [enz_site_usage_filter $enz_select_window $enzinfo(enz_groups,$enz_select_groups) $select_numsites_comp $enz_select_location] {
      if {[set enz_range [$textbox tag ranges $enz]] != ""} {
        $textbox tag add pre_current_selection {*}$enz_range
        if {[lsearch -exact $info(enz_currently_selected) $enz] > -1} {
          $textbox tag add pre_overlap_current_selection {*}$enz_range
        }
      }
    }
  }
}


##############
## Web query of Rebase for enzyme name
##############
proc rebase_query {enz {type main}} {
  regsub -all " " $enz "" enz
  switch $type {
    "main" {
      if {[set error [open_url "http://rebase.neb.com/cgi-bin/reb_get.pl?[::http::formatQuery enzname $enz]"]] != ""} {

      } 
    }
    "suppliers" {
      if {[set error [open_url "http://rebase.neb.com/cgi-bin/ecget?$enz"]] != ""} {

      }
    }
    "similar" {
      if {[set error [open_url "http://rebase.neb.com/cgi-bin/isoget?$enz"]] != ""} {

      }
    }
    "methylation" {
      if {[set error [open_url "http://rebase.neb.com/cgi-bin/msget?$enz"]] != ""} {

      }
    }
    "name" {
      #could get the html and check it for error before showing the page
      if {[set error [open_url "http://rebase.neb.com/rebase/enz/$enz.html"]] != ""} {

      }
    }
  }
}

##############
## Delete selected enzymes from the enzyme library
##############
proc delete_selected {enzyme_list} {
  global info
  global enz_select_window

  if {([llength $enzyme_list] == 0) || ([tk_messageBox -message [mc "Are you sure you want to delete these %s enzymes?"  [llength $enzyme_list]] -type okcancel -default cancel  -icon question] == "cancel")} {
    return
  }
  wm deiconify .enz_selector
  .enz_selector configure -cursor watch
  .enz_selector.textframe.textbox configure -cursor watch
  update idletasks

  foreach enzyme $enzyme_list {
    delete_enzyme $enzyme
  }
  set info(enzymes_saved) 0
  foreach window [dnawindows_list] {
    set info($window,scanned) 0
    findenzymes $window
  }

  fill_enzymes_box .enz_selector.textframe.textbox .enz_selector.enz_comment $enz_select_window
  .enz_selector configure -cursor arrow
  .enz_selector.textframe.textbox configure -cursor arrow
  .enz_selector.textframe.textbox configure -cursor arrow
  update idletasks
}

##############
## List enzymes Dialog
##############
proc list_enzymes_dialog {w} {
  global info
  global ok
  global analyze_selection
  global enzymes dialogblock
  if {$dialogblock == 1} {return}
  set dialog [new_dialog $w "List Enzymes..." "ANALYZE"]
  bind $dialog <<Cancel>> "set ok -1"
  bind $dialog <<OK>> "set ok 1"

  set modelist [list [mc "Name"] [mc "Name, #Sites"] [mc "Name, Site, #Sites, Positions"] [mc "Site, Name"]]
  grid [frame $dialog.f1 -relief ridge -borderwidth 3] -row 0 -column 0  -sticky nwe
  grid [label $dialog.f1.label1 -text [mc "Format:"] ] -row 0 -column 0 -sticky w
  grid [menubutton $dialog.f1.formatmbutton -direction below -indicatoron 1 -textvariable info(enz_list_mode) -menu $dialog.f1.formatmbutton.menu] -row 0 -column 1 -sticky w
  menu $dialog.f1.formatmbutton.menu 
  foreach mode $modelist number {0 1 2 3} state {normal normal disabled disabled} {
    $dialog.f1.formatmbutton.menu add radiobutton -label $mode -variable info(enz_list_mode_number) -value $number -command "set info(enz_list_mode) \"$mode\"; $dialog.f1.colentry configure -state $state; $dialog.f1.label2 configure -state $state "
  }
  set info(enz_list_mode) [lindex $modelist $info(enz_list_mode_number)]
  bind $dialog.f1.formatmbutton.menu <<MenuSelect>> "focus $dialog"

  grid [label $dialog.f1.label2 -text [mc "Columns:"] ] -row 0 -column 2 -sticky w
  tk_optionMenu $dialog.f1.colentry info(enz_list_columns) 1 2 3 4 5 6 7 8 9 10
  $dialog.f1.colentry configure -state [lindex {normal normal disabled disabled} $info(enz_list_mode_number)]
  $dialog.f1.label2 configure -state  [lindex {normal normal disabled disabled} $info(enz_list_mode_number)]
  grid $dialog.f1.colentry -row 0 -column 3 -sticky w

  grid [frame $dialog.f3 -relief ridge -borderwidth 3] -row 1 -column 0  -sticky nwe
  grid [label $dialog.f3.label1 -text [mc "Enzymes:"] ] -row 0 -column 0 -sticky w
  grid [radiobutton $dialog.f3.allenz -text [mc "All"] -value "all" -variable info(enz_list_enz) -selectcolor white] -row 0 -column 1 -sticky w
  grid [radiobutton $dialog.f3.selenz -text [mc "Selected Enzymes Only"] -value "selected" -variable info(enz_list_enz) -selectcolor white] -row 0 -column 2 -sticky w
  grid [radiobutton $dialog.f3.absenz -text [mc "Absent Enzymes"] -value "absent" -variable info(enz_list_enz) -selectcolor white] -row 0 -column 3 -sticky w
  grid [radiobutton $dialog.f3.unienz -text [mc "Unique Enzymes"] -value "unique" -variable info(enz_list_enz) -selectcolor white] -row 0 -column 4 -sticky w

  set analyze_selection $info(analyze_selection)
  grid [frame $dialog.f4 -relief ridge -borderwidth 3] -row 2 -column 0  -sticky nwe
  grid [label $dialog.f4.label1 -text [mc "DNA:"]] -row 0 -column 0 -sticky w
  grid [radiobutton $dialog.f4.selall -text [mc "All"] -value "all" -variable analyze_selection -selectcolor white] -row 0 -column 1 -sticky w
  grid [radiobutton $dialog.f4.selonly -text [mc "Selected DNA only"] -value "selection" -variable analyze_selection -selectcolor white] -row 0 -column 2 -sticky w

  if {!$info(android)} {
    grid [button $dialog.ok -command {set ok 1} -text [mc "OK"]  -default active] -row 3 -column 0 -sticky n -padx 10 -pady 3
    bind $dialog <Key-Return> "set ok 1"
    grid columnconfigure $dialog 0 -weight 1
  }

  update idletasks
  regexp {([0-9]*)x([0-9]*)\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry [winfo toplevel $dialog] ] wgeom winw winh winx winy
  if {[expr {$winx+$winw}] > [winfo screenwidth .]} {set winx [expr {[winfo screenwidth .]-$winw}]}
  if {$winx < 0} {set winx 0}
  if {[expr {$winy+$winh}] > [winfo screenheight .]} {set winy [expr {[winfo screenheight .]-$winh}]}
  if {$winy < 0} {set winy 0}
  wm geometry [winfo toplevel $dialog] "+$winx+$winy"
  wm resizable [winfo toplevel $dialog] 0 0
  focus $dialog
  #grab $dialog
  vwait ok

  set dialogblock 0

  if {$ok == 1} {
    list_enzymes_window $w $info(enz_list_mode_number) $info(enz_list_enz) $analyze_selection
  }
  destroy $dialog
  bind . <<RaiseDialogs>> ""
  unset ok 

}


##############
## Make a list enzymes analysis window
##############
proc list_enzymes_window {w {mode ""} {enz_list_type ""} {region ""}} {
  global info

  if {$enz_list_type == ""} {
    set enz_list_type $info(enz_list_enz)
  }
  switch $enz_list_type {
    "all" {
      set title "All Enzymes"
    }
    "selected" {
      set title "Selected Sites"
    }
    "absent" {
      set title "Absent Sites"
    }
    "unique" {
      set title "Unique Sites"
    }
  }
  if {$region == ""} {
    set region $info(analyze_selection)
  }
  if {([$w.textarea tag ranges sel] == "") && ($region == "selection")} {set region "all"}
  if {$region == "all"} {
    set start 0
    set end [ix2bp $w.textarea end]
  } else {
    if {[llength [$w.textarea tag ranges sel]] == 2} {
#selection used here - ok
      set start [ix2bp $w.textarea [$w.textarea index sel.first]]
      set end [ix2bp $w.textarea [$w.textarea index sel.last]]
    } else {
      set start [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 2]]
      set end [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 1]]
    }
  }

  set a [new_analysis_window $w $title list_enzymes]
  create_textframe $a 120
    
  catch {$a.textframe.text insert end "[clock format [clock seconds] -format $info(clock_format)]\n"}
  $a.textframe.text insert end "[wm title $w] \n"
  $a.textframe.text insert end "[mc From] $start [mc to] $end\. \n\n"
  $a.textframe.text insert end "[mc $title]\n\n"
  set text [list_enzymes_text $w $mode $enz_list_type $region]
#mode: (sorted by *)
#0:*name    
#1:*name, #_of_sites       
#2:name, comment, *#_of_sites, position  
#3:*comment, name
  switch $mode {
    0 {
      #$a.textframe.text configure -tabs "2.5c" -width 75
    }
    1 {
      #$a.textframe.text configure -tabs "3c 4c 7c 8c 11c 12c 15c 16c 19c 20c 21c 24c 25c 28c" -width 100
    }
    2 {
      #$a.textframe.text configure -tabs "2.5c 5.5c 6c" -width 100
    }
    3 {
      #$a.textframe.text configure -tabs "6c " -width 50
    }
  }
  $a.textframe.text insert end $text
  $a.textframe.text configure -state disabled

  set outputmenu [add_output_menu $a.textframe.text "Text" text $w]
  bind $a <Button-1> "focus $a.textframe.text" 
  bindtags $a.textframe.text [list $a.textframe.text AnalysisText $a . all]
  wm deiconify $a
  if {[info exists info(last_analysis_xy)]} {
    wm geometry [winfo toplevel $a] [textbox_geometry $a.textframe.text {*}$info(last_analysis_xy)]
  } else {
    scan [wm geometry [winfo toplevel $a]] "%dx%d+%d+%d" w h x y
    wm geometry [winfo toplevel $a] [textbox_geometry $a.textframe.text $x $y]
  }
  window_on_screen $a
  focus $a.textframe.text
}

##############
## Make a list enzymes analysis text
##############
proc list_enzymes_text {w {mode ""} {enz_list_type ""} {region "all"} } {
  global info enzinfo
  global analyze_selection
  global enzymes
  if {$enz_list_type == ""} {
    set enz_list_type $info(enz_list_enz)
  }
  if {$mode == ""} {
    set mode $info(enz_list_mode_number)
  }
  if {([$w.textarea tag ranges sel] == "") && ($region == "selection")} {
    set region "all"
  }
  if {$region == "all"} {
    set start 0
    set end [ix2bp $w.textarea end]
  } else {
#selection used here -ok
    set start [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 0]]
    set end [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 1]]
    if {[llength [$w.textarea tag ranges sel]] > 2} { 
      set start2 [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 2]]
    }
  }
  findenzymes $w
  switch $enz_list_type {
    "all" {
      set enz_list $enzymes
    }
    "selected" {
      set enz_list $info(enz_currently_selected)
    }
    "absent" {
      set enz_list [enz_site_usage_filter $w $enzymes "==0" $region]
    }
    "unique" {
      set enz_list [enz_site_usage_filter $w $enzymes "==1" $region]
    }
  }
  set templist [list]
  foreach enzyme $enz_list {
    set sitelist [list]
    foreach site $info($w,$enzyme) {
      if {$site > $end} {
        if {![info exists start2]} {
          break
        } else {
          if {$site >= $start2} {lappend sitelist $site}
          continue
        }
      }
      if {$site >= $start} {lappend sitelist $site}
    }
    lappend templist [list $enzyme [llength $sitelist] $sitelist $enzinfo(enz_pattern,$enzyme) [lindex $sitelist 0]]
  }
  set result ""
#mode: (sorted by *)
#0:*name    
#1:*name, #_of_sites       
#2:name, comment, *#_of_sites, position  
#3:*comment, name
  switch $mode {
    0 {
      set templist [lsort -index 0 $templist]
      set rows [expr {ceil(1.0*[llength $templist]/$info(enz_list_columns))}]
      set columns [expr {$info(enz_list_columns) - 1 }]
      set colwidth 15
      for {set i 0} {$i < $rows} {incr i} {
        set format "%-*s"
        for {set j 0} {$j <= $columns} {incr j} {
          if {$j == $columns} {set format "%-*s\n"}
          if {[set enzyme [lindex $templist [expr {$i*$info(enz_list_columns)+$j}]]] != ""} {
            append result [format $format $colwidth [lindex $enzyme 0]]
          }
        }
      } 
    }
    1 {
      set templist [lsort -index 0 $templist]
      set rows [expr {ceil(1.0*[llength $templist]/$info(enz_list_columns))}]
      set columns [expr {$info(enz_list_columns) - 1 }]
      for {set i 0} {$i < $rows} {incr i} {
        set format "%-*s%-*s"
        set colwidth 12
        set colwidth2 8
        for {set j 0} {$j <= $columns} {incr j} {
          if {$j == $columns} {set format "%-*s%-*s\n"}
          if {[set enzyme [lindex $templist [expr {$i*$info(enz_list_columns)+$j}]]] != ""} {
            append result [format $format $colwidth [lindex $enzyme 0] $colwidth2 [lindex $enzyme 1]]
          }
        }
      }
    }
    2 {
      set templist [lsort -integer -index 1 $templist]
      set colwidth 15
      set colwidth2 15
      set colwidth3 7
      set colwidth4 7
      foreach enzyme $templist {
        append result [format "%-*s%-*s%-*s%-*s\n" $colwidth [lindex $enzyme 0] $colwidth2 [lindex $enzyme 3] $colwidth3 [lindex $enzyme 1] $colwidth4 [lindex $enzyme 2]]
      }
    }
    3 {
      set templist [lsort -index 3 $templist]
      set colwidth 15
      set colwidth2 15
      foreach enzyme $templist {
        append result [format "%-*s%-*s\n" $colwidth [lindex $enzyme 3] $colwidth2 [lindex $enzyme 0]]
      }
    }
  }
  return $result
}



##############
## Highlights the enzymes in list enz_list in window w
##############
proc highlight_enzymes {w enz_list} {
  global enzymes
  global enzinfo
  global info
  if {$info(enzyme_highlight_transparent)} {
    set bg_color {}
  } else {
    set bg_color $info(enzyme_highlight_color)
  }
  set font $info(enzyme_highlight_font)
  set underline $info(enzyme_highlight_underline)
  findenzymes $w


  set seq_end [ix2bp $w.textarea end]
  incr seq_end

  foreach tag [lsearch -inline -regexp -all -not [$w.textarea tag names] {trans[0-9]+#|f[0-9]+#|fn[0-9]+#|tempsel|sel|foundf|foundr}] {
    textarea_tag_delete $w.textarea $tag 0
  }

  foreach enzyme $enz_list { 
    set length [string length $enzinfo(flatpat,$enzyme)]
    #set comment $enzinfo(enz_comment,$enzyme)
    if {$info($w,circular) == "circular"} {
      foreach site $info($w,$enzyme) {
        textarea_tag_add $w.textarea $enzyme [bp2ix $w.textarea [expr {$site -1}]] [bp2ix $w.textarea [expr {$site + $length -1}]] 0
        if {[expr {$site+$length}] > $seq_end} {
          textarea_tag_add $w.textarea $enzyme 1.0 [bp2ix $w.textarea [expr ($site + $length- $seq_end)]]      
        }
        textarea_tag_configure $w.textarea $enzyme -background $bg_color -font $font -underline $underline
        lappend undo(undo,$w) [list textarea_tag_bind $enzyme <<Metadata>>  [$w.textarea tag bind enzyme <<Metadata>>]]
        $w.textarea tag bind $enzyme <<Metadata>>  [list $enzyme {} enzyme 0 $enzinfo(enz_comment,$enzyme)]
        #$w.textarea tag bind $enzyme <Any-Enter> "\[winfo parent %W\].infobox configure -text \"$enzyme: $comment\""
        #$w.textarea tag bind $enzyme <Any-Leave> "\[winfo parent %W\].infobox configure -text {}"
      }

    } else {
      foreach site $info($w,$enzyme) {
        textarea_tag_add $w.textarea $enzyme [bp2ix $w.textarea [expr {$site -1}]] [bp2ix $w.textarea [expr {$site + $length -1}]] 0
        ## don't use textarea_tag_configure proc here- it'll do the lock check.
        textarea_tag_configure $w.textarea $enzyme -background $bg_color -font $font -underline $underline
        #metadat format: (0)name, (1)special_info, (2)type, (3)fwd/rev, (4)annotations_string
        #textarea_tag_bind $w.textarea $enzyme <<Metadata>> [list $enzyme {} enzyme 0 $enzinfo(enz_comment,$enzyme)]
        lappend undo(undo,$w) [list textarea_tag_bind $enzyme <<Metadata>>  [$w.textarea tag bind enzyme <<Metadata>>]]
        $w.textarea tag bind $enzyme <<Metadata>>  [list $enzyme {} enzyme 0 $enzinfo(enz_comment,$enzyme)]
        #$w.textarea tag bind $enzyme <Any-Enter> "\[winfo parent %W\].infobox configure -text \"$enzyme: $comment\""
        #$w.textarea tag bind $enzyme <Any-Leave> "\[winfo parent %W\].infobox configure -text {}"
      }
    }
  }
  register_undo_separator $w "Highlight Enzymes" 0
  textarea_fill_map $w
  if {$info(inline_mode)} {
    reline $w.textarea $info($w,textwidth)
  }
}

##############
## Highlights the enzymes in list enz_list in window w
##############
proc highlight_enzymes_clear {w} {
  global info
  foreach tag [lsearch -inline -regexp -all -not [$w.textarea tag names] {trans[0-9]+#|f[0-9]+#|fn[0-9]+#|tempsel|sel|foundf|foundr}] {
    textarea_tag_delete $w.textarea $tag 0
  }
  register_undo_separator $w "Clear Enzymes Highlight" 0
  textarea_fill_map $w
  if {$info(inline_mode)} {
    reline $w.textarea $info($w,textwidth)
  }
}

##############
## Make a new dialog window
##############
proc new_dialog {w title {doit_text "CREATE"}} {
  global dialogblock info
  if {!$info(android)} {
    set dialogblock 1
    if {[winfo exists .dialog]} {destroy .dialog}
    set s [toplevel .dialog -background $info(bg_color)]
    wm transient $s $w
    if { [tk windowingsystem] == "aqua"} {
      ::tk::unsupported::MacWindowStyle style $s document {closeBox}
    }
    wm title $s [mc $title]
    if {[tk windowingsystem] == "aqua"} {
      add_menubar_to_dialog_mac $w $s
    }
    wm protocol $s WM_DELETE_WINDOW "event generate $s <<Cancel>>"
    bind $s <KeyPress-Escape> "event generate $s <<Cancel>>"
    raise $s
    bind . <<RaiseDialogs>> "wm deiconify $s; raise $s"
    if {[regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $w] wgeom winx winy]} {
      wm geometry $s "+[expr (($winx<0)?0:$winx)+3]+[expr (($winy<0)?0:$winy)+50]"
    }
    set wgeomlist [split [wm geometry $w] "x+"]
    set sgeom "+[expr [lindex $wgeomlist 2]+3]+[expr [lindex $wgeomlist 3]+150]"
    wm geometry $s $sgeom
    bind $s <<CloseWindow>> {

    }

    return $s
  } else {
    ## android
    global toolbar_images
    set s [toplevel .dialog]
    wm attributes $s -fullscreen 1

    grid [frame $s.toolbar -borderwidth 0 -height 400 -relief flat] -row 0 -column 0 -sticky new

    grid [label $s.toolbar.cancel -text "\u2190" -font "helvetica 16"] -row 0 -column 0 -sticky nsw
    grid [label $s.toolbar.title -text "[wm title $w]" -font "helvetica 14"] -row 0 -column 1 -sticky nsw
    grid [frame $s.toolbar.extra_icons] -row 0 -column 2 -sticky nsw
    grid [label $s.toolbar.ok -text $doit_text -font "helvetica 12"] -row 0 -column 3 -sticky nse

    bind $s <KeyPress-Break> "event generate $s.mainframe.scrollframe <<Cancel>>"
    bind $s.toolbar.ok <ButtonRelease-3> "event generate $s.mainframe.scrollframe <<OK>>"
    bind $s.toolbar.ok <ButtonRelease-1> "event generate $s.mainframe.scrollframe <<OK>>"
    bind $s.toolbar.ok <ButtonRelease-2> "event generate $s.mainframe.scrollframe <<OK>>"
    bind $s.toolbar.cancel <ButtonRelease-3> "event generate $s.mainframe.scrollframe <<Cancel>>"
    bind $s.toolbar.cancel <ButtonRelease-1> "event generate $s.mainframe.scrollframe <<Cancel>>"
    bind $s.toolbar.cancel <ButtonRelease-2> "event generate $s.mainframe.scrollframe <<Cancel>>"

    grid columnconfigure $s.toolbar 1 -weight 1
    grid columnconfigure $s.toolbar 0 -minsize 70
    grid columnconfigure $s.toolbar 3 -minsize 100
    grid rowconfigure $s.toolbar 0 -minsize 100

    grid [frame $s.mainframe -borderwidth 0 -relief flat] -row 1 -column 0 -sticky nsew
    grid rowconfigure $s 1 -minsize 100 -weight 1
    grid columnconfigure $s 0 -minsize 100 -weight 1

    place [frame $s.mainframe.scrollframe] -x 0 -y 0
    bind $s.mainframe.scrollframe <Destroy> "destroy $s"
    return $s.mainframe.scrollframe
  }
}

##############
## Copy disabled menubar to dialog windows on the mac (should use the . menubar?)
##############
proc add_menubar_to_dialog_mac {w s} {
  $s configure -menu [menu $s.menubar]
  if {$w == "."} {set w ""}
  for {set i 0} {$i < [$w.menubar index end]} {incr i} {
    set original_cascade [$w.menubar entrycget $i -menu]
    regexp {\.[^\.]*(\..+)} $original_cascade - new_cascade
    set m [menu $s$new_cascade]
    $s.menubar add cascade -menu $m -label [$w.menubar entrycget $i -label]
    if {[$original_cascade index end] eq "" || [$original_cascade index end] eq "none"} {continue}
    for {set j 0} {$j < [$original_cascade index end]} {incr j} {
      set cascade_type [$original_cascade type $j]
      if {$cascade_type ne "separator"} {
        $m add $cascade_type -label [$original_cascade entrycget $j -label] -state disabled
      } else {
        $m add $cascade_type
      }
    }
  }
}

##############
## Make a new window to contain an analysis result
##############
proc new_analysis_window {winlist title {type generic}} {
  global info toolbar_images
  global modifier

  set w [lindex $winlist 0]
  set childlist [winfo children .]
  set i 0
  while {[lsearch -exact $childlist "$w\_analysis$i"] > -1 } {incr i}
  set a [toplevel "$w\_analysis$i"]
  if {$info(android)} {
    wm attributes $a -fullscreen 1
  } else {
    foreach {w_width w_height w_x w_y} [split [wm geometry $w] +x] {}
    wm geometry $a +[expr {$w_x + ([winfo width $w] / 8)}]+[expr {$w_y + ([winfo height $w] / 8)}]
  }
  if {[tk windowingsystem] == "aqua"} {
    after 50 "catch \"tk::unsupported::MacWindowStyle tabbingid $a $w\""
  }
  bind $a <FocusIn> "event generate . <<RaiseDialogs>>"
  bind $a <Map> "event generate . <<RaiseDialogs>>"
  bind $a <Activate> "event generate . <<RaiseDialogs>>"
  bind $a <$modifier-Key-n> "create_window"
  bind $a <$modifier-Key-q> "if {!$info(use_cocoa)} {exit}"
  bind $a <Configure> "if {%x!= 0 && %y !=0} {set info(last_analysis_xy) \[list %x %y\];# set info(last_analysis_hw,$type) \[list %h %w\]}"
  if {[tk windowingsystem] == "aqua"} {
      bind $a <$modifier-Key-m> "catch \{aqua_minimize $a\}"
      bind $a <$modifier-Key-quoteleft> "catch {raise \[lindex \[wm stackorder .\] 0\]}"
  } 
  wm protocol $a WM_DELETE_WINDOW "closewindow $a"
  if {[llength [lsort -unique $winlist]] < 2} {
    wm title $a "[wm title $w] [mc $title]"
  } else {
    wm title $a "[mc {%1$s Windows} [llength [lsort -unique $winlist]]] [mc $title]"
  }

  set info($a,linked_windows) $winlist
  update_windows_menu
  return $a
}


##############
## Add a double scrolled text ananysis frame
##############
proc create_textframe {a width {row 2} {column 0}} {
  global info
  set screen_fraction 0.5
  set text_height [expr {int([winfo screenheight .]*$screen_fraction/[font metrics dnafont -linespace])}]
  grid [frame $a.textframe] -row $row -column $column -sticky nswe
  grid [text $a.textframe.text -yscrollcommand "optionscrollbar $a.textframe.scrolly" -xscrollcommand "optionscrollbar $a.textframe.scrollx" -wrap none -width $width -height $text_height -font dnafont -setgrid 1 -insertontime 0 -insertofftime 1000] -row 0 -column 0 -rowspan 2 -sticky nswe

  grid [frame $a.textframe.spacer -width 2 -height 17] -row 2 -column 0 -sticky nswe
  grid [ttk::scrollbar $a.textframe.scrollx -orient horizontal -command "$a.textframe.text xview"] -row 2 -column 0 -sticky swe
  grid rowconfigure $a.textframe 2 -minsize [expr {[winfo reqheight $a.textframe.scrollx]+4}]
  grid [ttk::scrollbar $a.textframe.scrolly -orient vertical -command "$a.textframe.text yview"] -row 0 -column 1 -sticky nse
  grid columnconfigure $a.textframe 1 -minsize [expr {[winfo reqwidth $a.textframe.scrolly]+4}]

  grid columnconfigure $a.textframe 0 -weight 1
  grid rowconfigure $a.textframe 0 -weight 1

  grid columnconfigure $a $column -weight 1
  grid rowconfigure $a $row -weight 1
}

##############
## return a geometry specifier for setting a toplevel to the size of the textbox
##############
proc textbox_geometry {t xpos ypos} {
  set x 0 
  for {set line 1} {[$t compare $line.0 < end]} {incr line} {
    scan [$t index $line.0lineend] "%d.%d" l c
    set x [expr {max($x, $c)}]
  }
  if {[scan [wm grid [winfo toplevel $t]] "%d %d %d %d" bw bh wi hi] == 4} {
    scan [wm maxsize .] "%d %d" maxx maxy
    set x [expr {max(4,min($x, (($maxx-$xpos)/ $wi)-2))}]
    set y [expr {max(4,min(int([$t index end]), (($maxy-$ypos)/ $hi)-2))}]
  } else {
    set y 40
  }
  return "$x\x$y\+$xpos\+$ypos"
}

##############
## Add the output menu to an analysis window
##############
proc add_output_menu {w label type return_window} {
  global info modifier modstring tk_patchLevel

  set top [winfo toplevel $w]
  if {0 && [tk windowingsystem] != "aqua" && !$info(android)} {
    set outputmenu [menu $w.outputmenu]
    bind $w <<RightClick>> "tk_popup $outputmenu %X %Y"
    #bind $top <Button-1> "if \{\[winfo ismapped $outputmenu\]\} \{$outputmenu unpost\}"
  } elseif {!$info(android)} {
  # aqua, windows, linux
    menu $top.menubar

    set filemenu [menu $top.menubar.filemenu]
    $top.menubar add cascade -menu $filemenu -label [mc "File"] -underline 0
    $top.menubar.filemenu add command -label [mc "New"] -accelerator "$modstring+N" -command "create_window"
    $top.menubar.filemenu add command -label [mc "Open..."] -accelerator "$modstring+O"  -command "open_file_dialog"
    menu $top.menubar.filemenu.open_previous
    $top.menubar.filemenu add cascade -label [mc "Open Recent Files"] -menu $top.menubar.filemenu.open_previous
    if {[catch {update_open_previous_menu} err]} {tk_messageBox  -message [mc "open previous: %s" $err]}
    $top.menubar.filemenu add command -label [mc "Close"] -accelerator "$modstring+W" -command "closewindow $top"
    bind $top <$modifier-KeyPress-w> "closewindow $top"
    $top.menubar.filemenu add command -label [mc "Save"] -accelerator "$modstring+S" -command "event generate $w <<Save>>"
    bind $top <$modifier-KeyPress-s> "event generate $w <<Save>>"

    set outputmenu [menu $top.menubar.outputmenu]
    $top.menubar add cascade -menu $outputmenu -label [mc $label] -underline 0


    if { $info(use_aqua_system_windows_menu) && [tk windowingsystem] == "aqua"} {
      ## aqua system windows menu
      $top.menubar add cascade -menu [menu $top.menubar.view] -label [mc "View"]
      menu  $top.menubar.view.darkmodemenu
      $top.menubar.view.darkmodemenu add radiobutton -label [mc "Dark Mode"] -variable info(user_set_dark_mode) -value 1 -command "darkmode_set -1"
      $top.menubar.view.darkmodemenu add radiobutton -label [mc "Light Mode"] -variable info(user_set_dark_mode) -value 0 -command "darkmode_set -1"
     if { [bind . <<DarkAqua>> ] ne {} || ([tk windowingsystem] == "win32" && ![catch {registry get {HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Themes\Personalize} "AppsUseLightTheme"}])} {
         $top.menubar.view.darkmodemenu add radiobutton -label [mc "Match System Mode"] -variable info(user_set_dark_mode) -value -1 -command "darkmode_set -1"
      }
      $top.menubar.view add cascade -label [mc "Dark Mode"] -menu  $top.menubar.view.darkmodemenu
      $top.menubar.view add separator
      $top.menubar add cascade -menu [menu $top.menubar.window] -label [mc "Window"]
    } else {
      ## Standard ApE windows menu
      $top.menubar add cascade -menu [menu $top.menubar.windows] -label [mc "Window"] -underline 0
      update_windows_menu
    }


    menu $top.menubar.help
    $top.menubar add cascade -menu $top.menubar.help -label [mc "Help"] -underline 0
    $top.menubar.help add command -label [mc "Standard Genetic Code"] -command "genetic_code_dialog $top"
    $top.menubar.help add command -label [mc "Amino Acid Info"] -command "aa_info_dialog $top"
    if {[tk windowingsystem] == "aqua" && !$info(use_cocoa)} {
      menu $top.menubar.apple 
      $top.menubar add cascade -menu $top.menubar.apple
      $top.menubar.apple add command -label [mc "About ApE"] -command "about_dialog $top"
      $top.menubar.apple add separator
        #$top.menubar.apple add command -label [mc "Preferences..."]  -command "configure_preferences $top" -accelerator "$modstring+,"
    } 


    $top configure -menu $top.menubar
    bind $w <<RightClick>> "tk_popup $outputmenu %X %Y"
  } else {
    ## android 
    bind $w <<Cancel>>  "event generate $w <<Return>>"
    bind $w <KeyPress-Break>  "event generate $w <<Return>>"
    set outputmenu [menu $top.menubar]
    menu $top.windowsmenu
    android_update_windows_menu
    android_action_bar $top
    ##bind $w <<RightClick>> "tk_popup $outputmenu %X %Y"
  }


  switch $type {
    text {
      $outputmenu add command -label [mc "Copy"] -accelerator "$modstring+C" -command "event generate $w <<Copy>>"
      if {$info(use_cocoa) || [info exists info(twapi_cf_html)]} {
        $outputmenu add command -label [mc "Copy Formatted"] -accelerator "$modstring+Shift+C" -command "event generate $w <<CopyFormatted>>"
      }
      #$outputmenu add command -label [mc "Save"] -accelerator "$modstring+S" -command "event generate $w <<Save>>"
      $outputmenu add command -label [mc "Print..."] -accelerator "$modstring+P" -command "event generate $w <<Print>>"
      if {([lsearch -glob [info loaded] "*MacCarbonPrint.dylib*"] > -1) ||  ([lsearch [package names] "wmf"] > -1)} {
        $outputmenu add separator
        $outputmenu add command -label [mc "Page Setup"] -accelerator "$modstring+Shift+P" -command "page_setup_dialog $top"
        bind $w <$modifier-KeyPress-P> "event generate $w <<Print-Setup>>"
        bind $w <<Print-Setup>> "page_setup_dialog $top"
        #$outputmenu add checkbutton -label [mc "Print with Color Formatting"] -variable info(print_formatted) -onvalue 1 -offvalue 0
      } 
      $outputmenu add separator
      $outputmenu add command -label [mc "Raise Parent"] -accelerator "$modstring+Space" -command "event generate $w <<Return>>"

      bind $w <$modifier-KeyPress-c> "event generate $w <<Copy>>"
      bind $w <$modifier-Shift-KeyPress-c> "event generate $w <<CopyFormatted>>"

      bind $w <$modifier-KeyPress-p> "event generate $w <<Print>>"

      bind $w <$modifier-KeyPress-space> "event generate $w <<Return>>"
      bind $w <Double-Button-1> "event generate $w <<Return>>; break"
      bind $w <<Save>> "text_save $w"
      bind $w <<Print>> "print_text $w"
      bind $w <<Return>> "wm deiconify $return_window; raise $return_window; focus $return_window.textarea"
      lappend info($return_window,linked_events) [list $w <<Return>>]
      if {$info(android)} {
        $outputmenu delete 0 end
        $outputmenu add command -label [mc "Close"]  -command "closewindow $top"
        bind $w <<PinchToZoom>> "android_pinch_text_analysis_font %x %s $w"
        bind $w <Button-2> "$w scan mark  %x %y"
        bind $w <Button2-Motion> "$w scan dragto  %x %y"
        bind $w <$modifier-Button-2> "$w scan mark  %x %y"
        bind $w <$modifier-Button2-Motion> "$w scan dragto  %x %y "
      }
    }
    image {
      set c $w
      if {([lsearch -exact [package names] "wmf"] > -1)} {
## this is too ugly- fix
        $outputmenu add command -label [mc "Copy Metafile"] -accelerator "$modstring+C" -command "event generate $c <<CopyEMF>>"
        bind $c <$modifier-KeyPress-c> "event generate $c <<CopyEMF>>"
        bind $c <<CopyEMF>> "canvas_to_metafile copy $c both"
      }
      #$outputmenu add command -label [mc "Save"] -accelerator "$modstring+S" -command "event generate $c <<Save>>"
      $outputmenu add command -label [mc "Print"] -accelerator "$modstring+P" -command "event generate $c <<Print>>"
      if {([lsearch -glob [info loaded] "*MacCarbonPrint.dylib*"] > -1) ||  ([lsearch -exact [package names] "wmf"] > -1)} {
        $outputmenu add separator
        $outputmenu add command -label [mc "Page Setup"] -accelerator "$modstring+Shift+P" -command "page_setup_dialog $top"
        bind $c <$modifier-KeyPress-P> "event generate $c <<Print-Setup>>"
        bind $c <<Print-Setup>> "page_setup_dialog $top"
      }
      $outputmenu add separator
      #menu $outputmenu.scale
      #$outputmenu add cascade -label [mc "Scale"] -menu $outputmenu.scale
       # $outputmenu.scale add radiobutton -label [mc "50%"] -command "scale_canvas $c" -variable info($top,new_scale) -value 50
       # $outputmenu.scale add radiobutton -label [mc "75%"] -command "scale_canvas $c" -variable info($top,new_scale) -value 75
       # $outputmenu.scale add radiobutton -label [mc "100%"] -command "scale_canvas $c" -variable info($top,new_scale) -value 100
       # $outputmenu.scale add radiobutton -label [mc "125%"] -command "scale_canvas $c" -variable info($top,new_scale) -value 125
       # $outputmenu.scale add radiobutton -label [mc "150%"] -command "scale_canvas $c" -variable info($top,new_scale) -value 150
       # $outputmenu.scale add radiobutton -label [mc "200%"] -command "scale_canvas $c" -variable info($top,new_scale) -value 200
       # $outputmenu.scale add radiobutton -label [mc "300%"] -command "scale_canvas $c" -variable info($top,new_scale) -value 300
      #$outputmenu add separator
      $outputmenu add command -label [mc "Raise Parent"] -accelerator "$modstring+Space" -command "event generate $c <<Return>>"
      #$outputmenu add command -label [mc "Close"] -accelerator "$modstring+W" -command "closewindow $top"
      bind $c <$modifier-KeyPress-s> "event generate $c <<Save>>"
      bind $c <$modifier-KeyPress-p> "event generate $c <<Print>>"
      bind $c <$modifier-KeyPress-space> "event generate $c <<Return>>"
      #bind $c <$modifier-KeyPress-w> "closewindow $top"
      bind $c <Double-Button-1> "event generate $c <<Return>>; break"
      bind $c <<Save>> "canvas_save $c"
      bind $c <<Print>> "print_canvas $c $c"
      bind $c <<Return>> "wm deiconify $return_window; raise $return_window; focus $return_window.textarea; break"
      lappend info($return_window,linked_events) [list $c <<Return>>]
      if {$info(android)} {
        $outputmenu delete 0 end
        $outputmenu add command -label [mc "Close"] -accelerator "$modstring+W" -command "closewindow $top"
        bind $w <Button-1> "$w scan mark  %x %y"
        bind $w <Button1-Motion> "$w scan dragto  %x %y 2"
        bind $w <Button-2> "$w scan mark  %x %y"
        bind $w <Button2-Motion> "$w scan dragto %x %y 2"
      }   
    }
    list {
      $outputmenu add command -label [mc "Copy"] -accelerator "$modstring+C" -command "event generate $w <<Copy>>"
      #$outputmenu add command -label [mc "Save"] -accelerator "$modstring+S" -command "event generate $w <<Save>>"
      #$outputmenu add separator
      #$outputmenu add command -label [mc "Print"] -accelerator "$modstring+P" -command "event generate $w <<Print>>"
      #if {([lsearch -glob [info loaded] "*MacCarbonPrint.dylib*"] > -1) ||  ([lsearch [package names] "wmf"] > -1)} {
      #  $outputmenu add command -label [mc "Page Setup"] -accelerator "$modstring+Shift+P" -command "page_setup_dialog $top"
      #  bind $w <$modifier-KeyPress-P> "event generate $w <<Print-Setup>>"
      #  bind $w <<Print-Setup>> "page_setup_dialog $top"
      #  $outputmenu add checkbutton -label [mc "Print with Color Formatting"] -variable info(print_formatted) -onvalue 1 -offvalue 0
      #}
      $outputmenu add separator
      $outputmenu add command -label [mc "Raise Parent"] -accelerator "$modstring+Space" -command "event generate $w <<Return>>"
      #$outputmenu add command -label [mc "Close"] -accelerator "$modstring+W" -command "closewindow $top"
      bind $w <$modifier-KeyPress-c> "event generate $w <<Copy>>"
      bind $w <$modifier-KeyPress-s> "event generate $w <<Save>>"
      #bind $w <$modifier-KeyPress-p> "event generate $w <<Print>>"
      #bind $w <$modifier-KeyPress-w> "closewindow $top"
      bind $w <$modifier-KeyPress-space> "event generate $w <<Return>>"
      bind $w <Double-Button-1> "event generate $w <<Return>>; break"
      bind $w <<Copy>> "treeview_copy $w"
      bind $w <<Save>> "treeview_save $w"
      bind $w <<Print>> "treeview_print $w"
      bind $w <<Return>> "wm deiconify $return_window; raise $return_window; focus $return_window.textarea"
      lappend info($return_window,linked_events) [list $w <<Return>>]
      if {$info(android)} {
        $outputmenu delete 0 end
        $outputmenu add command -label [mc "Close"] -accelerator "$modstring+W" -command "closewindow $top"
      }
    }
    none {
    }
  }
  return $outputmenu
}

##############
## Add the output menu to an analysis window
##############
proc add_help_menubar {w } {
  global  modifier modstring tk_patchLevel info

    if {[tk windowingsystem] != "aqua"} {return}

    set top $w
    menu $top.menubar
    $top configure -menu $top.menubar
    set filemenu [menu $top.menubar.filemenu]
    $top.menubar add cascade -menu $filemenu -label [mc "File"] -underline 0
    $top.menubar.filemenu add command -label [mc "New"] -accelerator "$modstring+N" -command "create_window"
    $top.menubar.filemenu add command -label [mc "Open..."] -accelerator "$modstring+O"  -command "open_file_dialog"
    menu $top.menubar.filemenu.open_previous
    $top.menubar.filemenu add cascade -label [mc "Open Recent Files"] -menu $top.menubar.filemenu.open_previous
    if {[catch {update_open_previous_menu} err]} {tk_messageBox  -message [mc "open previous:%s" $err]}
    $top.menubar.filemenu add command -label [mc "Close"] -accelerator "$modstring+W" -command "closewindow $top"
    bind $top <$modifier-KeyPress-w> "closewindow $top"

    if {$info(use_aqua_system_windows_menu) && [tk windowingsystem] == "aqua"} {
      ## aqua system windows menu
      $top.menubar add cascade -menu [menu $top.menubar.view] -label [mc "View"]
      menu  $top.menubar.view.darkmodemenu
      $top.menubar.view.darkmodemenu add radiobutton -label [mc "Dark Mode"] -variable info(user_set_dark_mode) -value 1 -command "darkmode_set -1"
      $top.menubar.view.darkmodemenu add radiobutton -label [mc "Light Mode"] -variable info(user_set_dark_mode) -value 0 -command "darkmode_set -1"
      if { [bind . <<DarkAqua>> ] ne {} } {
         $top.menubar.view.darkmodemenu add radiobutton -label [mc "Match System Mode"] -variable info(user_set_dark_mode) -value -1 -command "darkmode_set -1"
      }
      $top.menubar.view add cascade -label [mc "Dark Mode"] -menu  $top.menubar.view.darkmodemenu
      $top.menubar.view add separator
      $top.menubar add cascade -menu [menu $top.menubar.window] -label [mc "Window"]
    } else {
      ## Standard ApE windows menu
      $top.menubar add cascade -menu [menu $top.menubar.windows] -label [mc "Window"] -underline 0
      update_windows_menu
    }




    menu $top.menubar.help
    $top.menubar add cascade -menu $top.menubar.help -label [mc "Help"] -underline 0
    $top.menubar.help add command -label [mc "Standard Genetic Code"] -command "genetic_code_dialog $top"
    $top.menubar.help add command -label [mc "Amino Acid Info"] -command "aa_info_dialog $top"


}


##############
## Make a digest window
##############
proc enz_digest {w enz_list region {partial_list ""}} {
  global enzymes info modifier modstring toolbar_images

  if {!$info(android)} {
    set bandwidth 50
    set bandspacing 0.1
    set bandheight 3
    set bandheightincr 1
  } else {
    set bandwidth 100
    set bandspacing 0.4
    set bandheight 9
    set bandheightincr 3
  }

  #if {$enz_list == [list]} {
  #  enzyme_selection_dialog $w
  #  return 
  #}


  if {[$w.textarea tag ranges sel] == ""} {set region "all"}
  if {$region == "all"} {
    set start 1
    set total_length [ix2bp $w.textarea end]
    set end $total_length
  } else {
#selection used here 
    set start [ix2bp $w.textarea [$w.textarea index sel.first]]
    incr start 
    set end [ix2bp $w.textarea [$w.textarea index sel.last]]
    set total_length [expr {$end - $start+1}]
  }
  if {$total_length == 0} return
  incr end
  findenzymes $w


  set templist [list]
  foreach enzyme $enz_list {
    if {($region != "all") || ($info($w,circular) != "circular")} {
      ##on linear fragments reject sites that CUT outside the range
      foreach site $info($w,$enzyme) dir $info($w,enzdir,$enzyme) {
        if {$site >= $end} {break}
        if {$site >= $start} {
          set cutsitelist [enz_cut_offset $enzyme $site $dir]
          if {([lindex $cutsitelist 0] >= $start) && ([lindex $cutsitelist 1] >= $start) && ([lindex $cutsitelist 0] <= $end) && ([lindex $cutsitelist 1] <= $end)} {
            lappend templist [list $site $enzyme $dir]
          }
        }
      }
    } else {
      foreach site $info($w,$enzyme) dir $info($w,enzdir,$enzyme) {
        if {$site >= $end} {break}
        if {$site >= $start} {lappend templist [list $site $enzyme $dir]}
      }
    }
  }
  if {($region != "all") || ($info($w,circular) != "circular")} {
    lappend templist [list $start "Start" 0]
    lappend templist [list $end "End" 0]
  }
  set templist [lsort -integer -index 0 $templist]
  set fraglist [list]
###################new digest routine
  set circular [expr {($info($w,circular) == "circular") && ($region == "all")}]
  set maxmassperc 1
  if {$partial_list == ""} {
    foreach enz $enz_list {
      set part($enz) 1.0
    }
  } else {
      array set part $partial_list
  }
  set part(Start) 1.0
  set part(End) 1.0
  set part(uncut) 1.0
  set count 0
  #check here for overlapping identical or degenerate sites
  set i 1
  while {$i < [llength $templist]} {
   if {[lindex $templist [expr {$i-1}] 0] == [lindex $templist $i 0]} {
     set enz1 [lindex $templist [expr {$i-1}] 1]
     set enz2 [lindex $templist $i 1]
     set newname "$enz1 + $enz2"
     set templist [lreplace $templist [expr {$i-1}] $i [list [lindex $templist $i 0] $newname 0]]
     set part($newname) [expr 1.0 - ((1.0-$part($enz1)) * (1.0-$part($enz2)))]
   } else {
     incr i
   }
  }
  for {set i 0} {$i < [llength $templist]} {incr i} {
    for {set j2 [expr {$i +1}]} {$j2 < [expr {[llength $templist] +($circular ? (1+$i) : 0)}]} {incr j2} {
      set j [expr {$j2 % [llength $templist]}]
      if {$i==$j} {
        set perc [expr {$part([lindex [lindex $templist $j] 1])}]
      } else {
        set perc [expr {$part([lindex [lindex $templist $i] 1]) * $part([lindex [lindex $templist $j] 1])}]
      }
      for {set k2 [expr {$i+1}]} {$k2 < $j2} {incr k2} {
        set k [expr {$k2 % [llength $templist]}]
        set perc [expr {$perc* (1.00-$part([lindex [lindex $templist $k] 1]))}]
      }
      if {$perc > 0} {
        if {[expr {([lindex [lindex $templist $j] 0] - [lindex [lindex $templist $i] 0]) % $total_length}] > 0} {
          set mass_perc [expr {round(max(1,(100.0*$perc* (([lindex [lindex $templist $j] 0] - [lindex [lindex $templist $i] 0]) % $total_length) / $total_length)))}]
        } else {
          set mass_perc [expr {round(max(1,(100.0*$perc)))}]
        }
        set maxmassperc [expr {max($maxmassperc, $mass_perc)}]
        lappend fraglist [list [expr {(([lindex [lindex $templist $j] 0] - [lindex [lindex $templist $i] 0]) % $total_length)==0 ? $total_length : (([lindex [lindex $templist $j] 0] - [lindex [lindex $templist $i] 0]) % $total_length)}] [lindex [lindex $templist $i] 1] [lindex [lindex $templist $i] 0] [lindex [lindex $templist $j] 1] [lindex [lindex $templist $j] 0] $count $mass_perc [lindex [lindex $templist $i] 2] [lindex [lindex $templist $j] 2]]
        incr count
      }
    }
  }
  if {$circular && $region == "all"} {
    set perc 1.0
    foreach e $templist {
      set perc [expr {$perc * (1.00-$part([lindex $e 1])) }]
    }
    if {$perc > 0} {
      lappend fraglist [list  $total_length uncut 0 "" 0 $count [expr {round(100*$perc)}] 0 0]
        set maxmassperc [expr {max($maxmassperc, round(100*$perc))}]
    }
  }
  if {$fraglist == [list]} {
    lappend fraglist [list  $total_length uncut 0 "" 0 0 100 0 0]
  }

  set fraglist [lsort -integer -index 0 -decreasing $fraglist]
  set enz_list_label [join [lrange $enz_list 0 2] +]
  if {[llength $enz_list] > 3} {
    append enz_list_label " et al."
  }

  set a [new_analysis_window $w "[mc Digest] $enz_list_label" digest] 
  grid [set c [canvas $a.canvas -yscrollcommand "optionscrollbar $a.s" -xscrollcommand "optionscrollbar $a.s2" -width 500 -height 250 -background $info(graphic_bg_color)]] -row 1 -column 0 -rowspan 2 -sticky nswe

  set outputmenu [add_output_menu $c "Image" image $w]

  grid [scrollbar $a.s -orient vertical -command "$c yview"] -row 2 -column 1 -sticky nsw

  if {!$info(android)} {
    grid [label $a.infobutton -image $toolbar_images(button_info) -width 20 -relief flat -borderwidth 0] -row 1 -column 1 -sticky nsw
    bind $a.infobutton <Button-1> "$c itemconfigure !band -state hidden ; $c itemconfigure infotext -state normal"
    tooltip_install $a.infobutton [mc "Show lane info"]
  } else {
    grid [label $a.toolbar.extra_icons.infobutton -image $toolbar_images(button_info,4x) -width 65 -relief flat -borderwidth 0] -row 0 -column 0 -sticky w
    bind $a.toolbar.extra_icons.infobutton <Button-1> "$c itemconfigure !band -state hidden ; $c itemconfigure infotext -state normal"
  }

  grid [scrollbar $a.s2 -orient horizontal -command "$c xview"] -row 3 -column 0 -sticky nwe
  grid rowconfigure $a 2 -weight 1
  grid columnconfigure $a 0 -weight 1
  grid columnconfigure $a 1 -minsize 17

  #draw file info
  #set timestring ""
  #catch {set timestring [clock format [clock seconds] -format $info(clock_format)]}

  #$c create text 0 0 -text "$timestring" -anchor nw -font [list $info(graphicfontfamily) $info(graphicfontsize)]-tags [list time table] 
  #set textheight [expr {[lindex [$c bbox time] 3] - [lindex [$c bbox time] 1]}]
  set textheight 0

  $c create text 0 [expr {$textheight}] -text "[wm title $w]" -anchor nw -font [list $info(graphicfontfamily) $info(graphicfontsize)]  -fill $info(graphic_fg_color) -tags [list filename table text lane1]
  set textheight [expr {[lindex [$c bbox filename] 3] - [lindex [$c bbox filename] 1]}]

  #create dummy text to allow table coords and text properties to persist
  $c create text 0 [expr {$textheight}] -text [mc "Dummy Text"] -anchor nw -font [list $info(graphicfontfamily) $info(graphicfontsize)] -fill $info(graphic_fg_color) -tags [list dummy text] -state hidden


  set i 1
  #draw table header
  set colswidth [font measure [list $info(graphicfontfamily) $info(graphicfontsize)] "HindIII          "]
  set cols [list]
  for {set cw 0} {$cw < 6} {incr cw} {
    lappend cols [expr {$cw * $colswidth}]
  } 
  foreach ttext [list [mc "Size"] [mc "site1"] "" [mc "site2"] "" [mc "Mass %"]] tx $cols {
    $c create text $tx [expr {$i*$textheight}] -text $ttext -anchor nw -font [list $info(graphicfontfamily) $info(graphicfontsize)] -fill $info(graphic_fg_color) -tags [list table title text lane1]
  }
  incr i
  set textright [lindex [$c bbox title] 2]
  $c create line 0 [lindex [$c bbox title] 3] [lindex [$c bbox title] 2] [lindex [$c bbox title] 3] -fill $info(graphic_fg_color) -tags {table title line lane1}

  

  #draw map area tick marks
  foreach site $templist {
    $c create line [expr {$textright + 5}] [expr {30+ ([lindex $site 0]-$start)* 210 / ($end - $start)}] [expr {$textright + 15}] [expr {30+ ([lindex $site 0]-$start)* 210 / ($end - $start)}] -fill $info(graphic_fg_color) -tags  {scalable map line lane1}
    $c create text [expr {$textright + 17}] [expr {30+ ([lindex $site 0]-$start)* 210 / ($end - $start)}] -anchor w -text "[lindex $site 0] [lindex $site 1]" -fill $info(graphic_fg_color) -tags {scalable map text lane1}
  }




  #draw map area fetaure lines
  set depthdict [tagdepth_features $w.textarea [bp2ix $w.textarea $start] [bp2ix $w.textarea $end]]

## use get_feature_exons_indexes
  foreach {name tag} [feature_find $w $start $end] {
    regsub "fn" $tag "f" tag
    if {[dict exists $depthdict $tag]} {
      set yplus [dict get $depthdict $tag]
    } else {
      set yplus 0
    }
    foreach {fstart fend} [$w.textarea tag ranges $tag] {
      set fend [ix2bp $w.textarea $fend]
      if {$fend < $start} {continue}
      set fstart [ix2bp $w.textarea $fstart]
      if {$fstart > $end} {break}
      if {$fstart < $start} {set fstart $start}
      if {$fend > $end} {set fend $end}
      $c create line [expr {$textright  - 5* $yplus}] [expr {30+ ($fstart-$start)* 210 / ($end - $start)}] [expr {$textright  -5 * $yplus}] [expr {30+ ($fend-$start)* 210 / ($end - $start)}] -tags {scalable map feature lane1} -fill [lindex [$w.textarea tag bind $tag <<Revcolors>>] [lindex [$w.textarea tag bind $tag <<Metadata>>] 3]] -width 5
    }
  }




  set mapright [lindex [$c bbox map] 2]
  if {$mapright == ""} {
    set mapright [expr {$textright + 5}]
  }

  #create an empty info text item
  $c create text 0 0 -anchor nw -font [list $info(graphicfontfamily) $info(graphicfontsize)] -width [expr {$mapright-15}] -fill $info(graphic_fg_color) -tags [list infotext text] -state hidden

  #find short and long fragments for the canvas
  if {$info(ladderlist) != [list]} {
    set dig_ladder $info(ladder,$info(current_ladder))
  } else {
    set dig_ladder [list]
  }

  if {($dig_ladder != [list]) && ([lindex [lindex $fraglist end] 0] > [lindex $dig_ladder end])} {
    set shortfrag [lindex $dig_ladder end]
  } else {
    set shortfrag [lindex [lindex $fraglist end] 0]
  }
  if {$shortfrag < 10} {
    set shortfrag 10
  }

  if {($dig_ladder != [list]) && ([lindex [lindex $fraglist 0] 0] < [lindex $dig_ladder 0])} {
    set longfrag [lindex $dig_ladder 0]
  } else {
    set longfrag [lindex [lindex $fraglist 0] 0]
  }


  if {[lindex [lindex $fraglist 0] 0] > $shortfrag} {
    set gelscale [expr {210.0/(log10($longfrag)- log10($shortfrag))}]
  } else {
    set gelscale 20
  }
  set gelorigin [expr {30.0 + $gelscale * log10($longfrag) }]

  bind $c <<Info>> [list min_size [expr {round(10**(($gelorigin - 240)/$gelscale))}] max_size [expr {round(10**(($gelorigin - 30)/$gelscale))}] band_spacing $bandspacing]

  ##draw ladder
  set bandleft [expr {$mapright + ($bandwidth*$bandspacing)}]
  if {$dig_ladder != [list]} {
    set lastladderband 0
    foreach band $dig_ladder {
      if {$lastladderband != $band} {
        #draw new band
        if {[lindex $band 0] > 0} {
          set last_band_item [$c create line [expr {$bandleft}] [expr {$gelorigin - $gelscale * log10($band)}] [expr {$bandleft+$bandwidth}] [expr {$gelorigin - $gelscale *log10($band)}] -width $bandheight -capstyle round -activefill red -fill $info(graphic_fg_color) -tags [list scalable band lane0]]
        }
        $c bind $last_band_item <<Size>> $band
        $c bind $last_band_item <<Gray_fill>> 100
        set lastladderband $band
      } else {
        #make last band wider
        $c itemconfigure $last_band_item -width [expr {[$c itemcget $last_band_item -width]+ $bandheightincr}]
      }
    }
    $c create text [expr {$bandleft+$bandwidth/2}] 30 -text 1 -anchor s -font [list $info(graphicfontfamily) $info(graphicfontsize)] -fill $info(graphic_fg_color) -tags [list infotext lanelabel]

    set bandleft [expr {$bandleft + ($bandspacing+1) * $bandwidth}]

    set ladder_text "$info(current_ladder)\n[mc Sizes:] [join [lsort -unique -integer $dig_ladder] {, }]"
    $c bind lane0 <<Info>> [list info_text $ladder_text min_size [lindex $dig_ladder end] max_size [lindex $dig_ladder 0]]
  }




  ##draw digest items
  set fragnum 0
  set fragtexts [list]
    #draw lane label
    $c create text [expr {$bandleft+$bandwidth/2}] 30 -text 2 -anchor s -font [list $info(graphicfontfamily) $info(graphicfontsize)] -fill $info(graphic_fg_color) -tags [list infotext lanelabel]

  foreach fragment $fraglist {

    #draw table entry for the band
    foreach ttext [list [lindex $fragment 0] [lindex $fragment 1] [format %7d [lindex $fragment 2]] [lindex $fragment 3] [format %7d [lindex $fragment 4]] [format %5d [lindex $fragment 6]]] tx $cols   {
      $c create text $tx [expr {$i*$textheight}] -font [list $info(graphicfontfamily) $info(graphicfontsize)] -anchor nw -text $ttext -fill $info(graphic_fg_color) -tags [list table table_text frag$fragnum lane1 action_item]
    }
    incr i



    #draw gel bands
    if {[lindex $fragment 0] > 0} {
      set band_gray [expr {round(max($info(gel_min_gray),(100.0*[lindex $fragment 6]/$maxmassperc)))}]
      set band_item [$c create line [expr {$bandleft}] [expr {$gelorigin - $gelscale * log10([lindex $fragment 0])}] [expr {$bandleft+$bandwidth}] [expr {$gelorigin - $gelscale *log10([lindex $fragment 0])}] -width $bandheight -capstyle round -tags [list frag$fragnum band lane1 scalable action_item] -activefill red -fill [mix_color $info(graphic_fg_color) $info(graphic_bg_color) $band_gray] ]
        $c bind $band_item <<Size>> [lindex $fragment 0]
        $c bind $band_item <<Gray_fill>> $band_gray
        $c bind $band_item <<Mass_perc>> [lindex $fragment 6]
    }

    #draw map area line highlight
    if {[lindex $fragment 2] < [lindex $fragment 4]} {
      $c create line [expr {$textright + 5}] [expr {30+ ([lindex $fragment 2]-$start)* 210 / ($end - $start)}] [expr {$textright + 5}] [expr {30+ ([lindex $fragment 4]-$start)* 210 / ($end - $start)}] -width $bandheight -fill $info(graphic_fg_color) -tags [list frag$fragnum map lane1 scalable action_item]
    } else {
      #needs to deal with band button presses for circular fragments
      $c create line [expr {$textright + 5}] 30 [expr {$textright + 5}] [expr {30+ ([lindex $fragment 4]-$start)* 210 / ($end - $start)}] -width $bandheight -fill $info(graphic_fg_color) -tags  [list frag$fragnum map lane1 scalable action_item]
      $c create line [expr {$textright + 5}] [expr {30+ ([lindex $fragment 2]-$start)* 210 / ($end - $start)}] [expr {$textright + 5}] 240 -width $bandheight -fill $info(graphic_fg_color) -tags  [list frag$fragnum map map_line2 lane1 scalable action_item]
    }

    foreach item [$c find withtag frag$fragnum] {
      #get top and bottom cut sites for each end (send enzyme_name, location, direction; get top and bottom cut locations)
      set cutsites_list1 [enz_cut_offset [lindex $fragment 1] [lindex $fragment 2] [lindex $fragment 7]]
      set cutsites_list2 [enz_cut_offset [lindex $fragment 3] [lindex $fragment 4] [lindex $fragment 8]]
      $c bind $item <<Link>> [list $w [expr {[lindex $cutsites_list1 0]-1}] [expr {[lindex $cutsites_list2 0]-1}] [expr {[lindex $cutsites_list1 1]-1}] [expr {[lindex $cutsites_list2 1]-1}] [lindex $fragment 1] [lindex $fragment 7] [lindex $fragment 3] [lindex $fragment 8]]

      lappend info($w,linked_events) [list $c $item "<<Link>>"]
    }
    if {[lindex $fragment 3] ne ""} {
      if {[llength $enz_list] > 1} {
        lappend fragtexts "[lindex $fragment 0]([lindex $fragment 1]-[lindex $fragment 3])"
      } else {
        lappend fragtexts "[lindex $fragment 0]"
      }
    } else {
      lappend fragtexts "[lindex $fragment 0]([lindex $fragment 1])"
    }
    incr fragnum
  }

  #create hidden map line dummy for aligning incoming lanes to
  $c create line [expr {$textright + 5}] 30 [expr {$textright + 5}] 240 -tags [list dummy line scalable] -fill $info(graphic_fg_color) -state hidden
 
  set info_text "[file root [wm title $w]] "
  if {($enz_list == [list])  || $enz_list == [list no_digest]} {
    append info_text [mc "uncut"]
  } else {
    append info_text "[mc {digested with:}] "
    if {[llength $enz_list] <=3} {
      if {$partial_list != [list]} {
        set enz_text_list [list]
        foreach ea [lrange $enz_list 0 2] {
          lappend enz_text_list "$ea\([expr {int(100*$part($ea))}]%)"
        }
        append info_text "[join [lrange $enz_text_list 0 2] { + }]\n"
      } else {
        append info_text "[join [lrange $enz_list 0 2] { + }]\n"
      }
    } else {
        append info_text "[mc {>3 enzymes}]\n"
    }
    append info_text [join $fragtexts {, }] 
  } 


  ## make feature bands thicker on Andoid
  if {$info(android)} {
    $c itemconfigure feature -width 12
  }

  $c bind lane1 <<Info>> [list info_text $info_text min_size [lindex [lindex $fraglist end] 0] max_size [lindex [lindex $fraglist 0] 0]]

  #need to use an update_infotext proc here
  catch {$c itemconfigure infotext&&text -text [wrap_text "[mc {Lane %1$s:} 1] [dict get [$c bind lane0 <<Info>>] info_text]\n\n[mc {Lane %1$s:} 2] [dict get [$c bind lane1 <<Info>>] info_text]" [$c itemcget infotext&&text -font] [$c itemcget infotext&&text -width]]}

  #$c bind lane0 <Any-Enter> "%W itemconfigure !band -state hidden ; %W itemconfigure infotext -state normal"
  $c bind lane1 <Any-Enter> "%W itemconfigure !band -state hidden ;%W itemconfigure lane1 -state normal"

  $c bind band  <Any-Enter> "if {\[winfo exists .bandtooltip\]} {destroy .bandtooltip}; toplevel .bandtooltip -borderwidth 1 -background $info(graphic_fg_color); if {(\[tk windowingsystem\] == \"aqua\")} {tk::unsupported::MacWindowStyle style .bandtooltip help {noActivates noUpdates}} else { wm overrideredirect .bandtooltip 1}; catch {wm attributes .bandtooltip -alpha .7}; wm geometry .bandtooltip +\[expr {%X + 2}\]+\[expr {%Y - 20}\];  pack \[label .bandtooltip.l -background $info(graphic_bg_color) -foreground $info(graphic_fg_color) -text \[$c bind \[$c find withtag current\] <<Size>>\]\]; raise .bandtooltip"
  $c bind band  <Any-Motion> "if {\[winfo exists .bandtooltip\]} {wm geometry .bandtooltip +\[expr {%X + 2}\]+\[expr {%Y - 20}\]}"
  $c bind band  <Any-Leave> "if {\[winfo exists .bandtooltip\]} {destroy .bandtooltip}"


  $c bind band <B1-Motion> "if {\[winfo exists .bandtooltip\]} {destroy .bandtooltip}; digest_peel_bands $c %X %Y"
  $c bind band <ButtonRelease-1> "catch {unset tooltip_x tooltip_y}; if {(\[winfo containing %X %Y\] != \"\") && \[winfo exists .w_tooltip\]} {destroy .w_tooltip; digest_move_lane $c %X %Y move} else {digest_action_item_manager $c button-1}"
  $c bind band <Shift-ButtonRelease-1> "catch {unset tooltip_x tooltip_y}; if {(\[winfo containing %X %Y\] != \"\") && \[winfo exists .w_tooltip\]} {destroy .w_tooltip; digest_move_lane $c %X %Y move} else {digest_action_item_manager $c shift-button-1}"
  $c bind band <$modifier-ButtonRelease-1> "catch {unset tooltip_x tooltip_y}; if {(\[winfo containing %X %Y\] != \"\") && \[winfo exists .w_tooltip\]} {destroy .w_tooltip; digest_move_lane $c %X %Y copy} else {digest_action_item_manager $c button-1}"
  if {[tk windowingsystem] eq "aqua"} {$c bind band <Option-ButtonRelease-1> [$c bind band <$modifier-ButtonRelease-1>]}
  bind $c <KeyPress-BackSpace> "digest_action_item_manager $c delete"
  bind $c <KeyPress-Delete> "digest_action_item_manager $c delete"

  bind $c <$modifier-Button1-Motion> "if {\[info exists info(y_scale_size)\] && !\[info exists tooltip_y\]} {$c scale band 0 30 1 \[expr \{1.0 * max(10, \$info(y_scale_size)+%y-\$info(y_scale_mark))/(\[lindex \[$c bbox band\] 3\]-\[lindex \[$c bbox band\] 1\])\}\]}; $c configure -scrollregion \[$c bbox all\]; digest_color_bands $a"
  bind $c <$modifier-Button-1> "set info(y_scale_mark) %y;set info(y_scale_size) \[expr \{(\[lindex \[$c bbox band\] 3\]-\[lindex \[$c bbox band\] 1\])\}\]"
  bind $c <ButtonRelease-1> "unset -nocomplain info(y_scale_mark) info(y_scale_size)"

  $c bind action_item <Any-Enter> "digest_action_item_manager $c enter"
  $c bind action_item <Any-Leave> "digest_action_item_manager $c leave"
  $c bind action_item&&!band <Button-1> "digest_action_item_manager $c button-1"
  $c bind action_item&&!band <Shift-ButtonRelease-1> "digest_action_item_manager $c shift-button-1"

  if {$info(android)} {
    $c bind lane1 <Button-1> "%W itemconfigure !band -state hidden ;%W itemconfigure lane1 -state normal"

    $c bind band  <Any-Enter> ""
    $c bind band  <Any-Motion> ""
    $c bind band  <Any-Leave> ""


    $c bind band <B1-Motion> ""
    $c bind band <ButtonRelease-1> ""
    $c bind band <Shift-ButtonRelease-1> ""
    $c bind band <$modifier-ButtonRelease-1> ""

    bind $c <KeyPress-BackSpace> ""
    bind $c <KeyPress-Delete> ""

    $c bind action_item <Button-1> "digest_action_item_manager $c enter"
    $c bind action_item <ButtonRelease-1> "digest_action_item_manager $c leave"
    $c bind action_item&&!band <Double-Button-1> "digest_action_item_manager $c button-1"
    $c bind action_item&&!band <Shift-ButtonRelease-1> ""
  }

  $c configure -scrollregion [$c bbox all]

  #bind $c <Configure> "if {\[winfo height $c\] > 80} {$c scale scalable \[lindex \[$c bbox scalable\] 0\] \[lindex \[$c bbox scalable\] 1\] 1 \[expr \{(\[winfo height $c\]-60.0)/(\[lindex \[$c bbox scalable\] 3\]-\[lindex \[$c bbox scalable\] 1\])\}\]}; $c configure -scrollregion \[$c bbox all\]; digest_color_bands $a"

  #bind $c <Configure> "if {\[winfo height $c\] > 80} {$c scale scalable 0 30 1 \[expr \{(\[winfo height $c\]-60.0)/(\[lindex \[$c bbox scalable\] 3\]-\[lindex \[$c bbox scalable\] 1\])\}\]}; $c configure -scrollregion \[$c bbox all\]; digest_color_bands $a"
  bind $c <Configure> "if {\[winfo height $c\] > 80} {$c scale scalable 0 30 1 \[expr \{(\[winfo height $c\]-60.0)/(\[lindex \[$c coords dummy&&line\] 3\]-\[lindex \[$c coords  dummy&&line\] 1\])\}\]}; $c configure -scrollregion \[$c bbox all\]; digest_color_bands $a"


  set info($a,scale) 100
  set info($a,new_scale) 100

  bind $c <<Return>> "digest_action_item_manager $c return"
  bind $c <<Parent>> $w
  $outputmenu insert 0 command -label [mc "Copy Text"] -accelerator "$modstring+Shift+C" -command "event generate $c <<CopyText>>"
  bind $c <$modifier-KeyPress-C> "event generate $c <<CopyText>>"
  bind $c <<CopyText>> "clipboard clear;clipboard_append \[enz_digest_get_table_text $c\]"
  bindtags $c [list $c $a all]
  bind $a <Button-1> "focus $c" 
  wm deiconify $a
  foreach {x0 y0 x1 y1} [$c bbox all] {}
  if {[info exists info(last_analysis_xy)]} {
    wm geometry [winfo toplevel $a] [expr {min ($x1 - $x0 + 30, ([winfo vrootwidth $a]-100))}]x[expr {min ($y1 - $y0 + 25, ([winfo vrootheight $a]-150))}]+[lindex $info(last_analysis_xy) 0]+[lindex $info(last_analysis_xy) 1]
  } else {
    wm geometry [winfo toplevel $a] [expr {min ($x1 - $x0 + 30, ([winfo vrootwidth $a]-100))}]x[expr {min ($y1 - $y0 + 25, ([winfo vrootheight $a]-150))}]
  }
  window_on_screen $a
  focus $c
  return $c
}



#############
## get the table text from a canvas as tab separated text
#############
proc enz_digest_get_table_text {c} {
  if {[$c itemcget infotext&&text -state] eq "normal"} {
    return [$c itemcget infotext&&text -text]
  }
  set result ""
  set t [list]
  foreach item [$c find withtag table&&(title)&&text] {
    if {[$c itemcget $item -state] eq "normal"} {
      lappend t [$c itemcget $item -text]
    }
  }
  set result "[join $t \t]\n"
  set fraglist [list]
  unset -nocomplain line
  foreach item [$c find withtag table&&(table_text)] {
    if {[$c itemcget $item -state] eq "normal"} {
      set frag [lsearch -inline -regexp [$c itemcget $item -tags] {frag.*}]
      if {[lsearch -exact $fraglist $frag] == -1} {lappend fraglist $frag}
      lappend line($frag) [$c itemcget $item -text] 
    }
  }
  if {$fraglist != [list]} {
    set t ""
    foreach frag $fraglist {
      lappend t [join $line($frag) \t]
    }
    set result "$result[join $t \n]"
    return $result
  } 
  return ""
}

#############
## partial digest dialog
#############
## need to implement maximizing a fragment starting at enz_site1 going to enz_site2 (use menubuttons to select sites)
##if 1==2 solve for p*(1-p)^n, set any other site to 0
##if 1 and 2 are same enz but different sites solve p^2*(1-p)^n, set any other site between to 0, not between to 100
##different enz solve p(1-p)^n*q(1-q)^m, set any other site between to 0, not between to 100
## NOT USED
proc enz_digest_partial_dialog {w} {
  global info modifier dialogblock
  global ok part

  if {$dialogblock == 1} {return}
  if {$info(enz_currently_selected) == {}} {
    enz_digest $w $info(enz_currently_selected) $info(analyze_selection)
    return
  }
  set a [new_dialog $w "Partial Digest..." "DIGEST"]
  bind $a <<Cancel>> "set ok -1"
  bind $a <<OK>> "set ok 1"
  set ok 0

  grid [frame $a.enz_frame] -row 0 -column 1 -sticky nswe
  set r 0
  foreach enz $info(enz_currently_selected) {
    grid [label $a.enz_frame.label_$enz -text $enz] -row $r -column 0 -sticky nw
    grid [entry $a.enz_frame.entry_$enz -textvariable part($enz) -validate key -vcmd "check_char %S" -width 3 -justify right] -row $r -column 1 -sticky nw
    if {$info(use_tile)} {
      grid [ttk::scale $a.enz_frame.scale_$enz -from 0 -to 100 -command "set part($enz) \[expr {round(\$part($enz))}\];#" -orient horizontal -variable part($enz)] -row $r -column 2 -sticky nswe
    } else {
      grid [scale $a.enz_frame.scale_$enz -from 0 -to 100 -sliderrelief raised -showvalue 0 -resolution 1 -troughcolor white -background $info(bg_color) -width 10  -command "set part($enz) \[expr {round(\$part($enz))}\];#" -orient horizontal -variable part($enz)] -row 0 -column 1 -sticky nswe 
    }
    set part($enz) 100
    incr r
  }


  grid [frame $a.okframe] -row 3 -column 1 -sticky nswe
  grid [button $a.okframe.cancel -text [mc "Cancel"] -command "set ok -1"] -row 1 -column 0 -sticky nw -padx 10 -pady 3
  grid [button $a.okframe.ok -text [mc "OK"] -command "set ok 1" -default active] -row 1 -column 1 -sticky nw -padx 10 -pady 3
  vwait ok

  destroy $a
  set dialogblock 0
  bind . <<RaiseDialogs>> ""

  if {$ok == 1} {
    foreach enz $info(enz_currently_selected) {
      set part($enz) [expr {max(0,min($part($enz)/100.0, 1.0))}]
    }
    enz_digest $w $info(enz_currently_selected) $info(analyze_selection) [array get part]
  }
  unset ok part
}

#################
##
#################
proc enz_digest_dialog2 {w} {
  global info ok dialogblock enzymes digarray

  if {$dialogblock == 1} {return}
  set enz_currently_selected $info(enz_currently_selected)
  set cached_percents_list [list]
  if {$info(enz_digest_dialog_preserve_info) && [info exists info(digest_dialog_enzymes_list)]} {
      set enz_currently_selected $info(digest_dialog_enzymes_list)
      set cached_percents_list $info(digest_dialog_percents_list)
  } 
  if {$enz_currently_selected == [list] } {
      set enz_currently_selected [list "No Digest"]
  } 
  set enz_currently_selected [lrange $enz_currently_selected 0 9]
  set info(digest_dialog_enzymes_list) $enz_currently_selected
  set cached_percents_list [lrange $cached_percents_list 0 9]
  set info(digest_dialog_percents_list) $cached_percents_list

  set s [new_dialog $w "Digest DNA" "DIGEST"]
  bind $s <<Cancel>> "set ok -1"
  bind $s <<OK>> "set ok 1"
  wm resizable [winfo toplevel $s] 0 0

  #add enzymes to the top
  grid [frame $s.row0 -relief ridge -bd 2] -row 0 -column 0
  grid columnconfigure $s.row0 0 -minsize 200 -weight 0
  set i 1
  bind $s <<ShowPartial>> 0

  ## fill all of the stored or currently selected enzymes
  foreach enz $enz_currently_selected  percent $cached_percents_list {
    grid [frame $s.row0.enz$i] -row 0 -column $i
    #grid columnconfigure $s.row0 $i -minsize 150 -weight 0
    #grid [label $s.row0.enz$i.label -text $enz] -row 0 -column 0
    grid [menubutton $s.row0.enz$i.enzbutton -textvariable digarray(enz$i) -menu $s.row0.enz$i.enzbutton.menu] -row 0 -column 0
    menu $s.row0.enz$i.enzbutton.menu

    set submenu [menu $s.row0.enz$i.enzbutton.menu.actionmenu ]
    $s.row0.enz$i.enzbutton.menu add cascade -menu $submenu -label [mc "Select"]
    $submenu add command -label [mc "Select All In Column"] -command "foreach e \[array names digarray $s.row*.enz$i\] {set digarray(\$e) 1;enz_digest_dialog2_process_checkbox \$e}"
    $submenu add command -label [mc "Deselect All In Column"] -command "foreach e \[array names digarray $s.row*.enz$i\] {set digarray(\$e) 0;enz_digest_dialog2_process_checkbox \$e}"
    $s.row0.enz$i.enzbutton.menu add separator

    $s.row0.enz$i.enzbutton.menu add radiobutton -label [mc "No Digest"] -value "No Digest" -variable digarray(enz$i)
    set j 0
    for {set k 0} {$k < [llength $enzymes]} {incr k} {
      if {[expr {$k % 20}] ==0} {
        set submenu [menu $s.row0.enz$i.enzbutton.menu.menu$j]
        $s.row0.enz$i.enzbutton.menu add cascade -menu $submenu -label "[lindex $enzymes $k]-[lindex $enzymes [expr {min($k+19,[llength $enzymes]-1)}]]"
        incr j
      }
      $submenu add radiobutton -label [lindex $enzymes $k] -value [lindex $enzymes $k] -variable digarray(enz$i)
    }
 
    set digarray(enz$i) $enz

    grid [entry $s.row0.enz$i.percent -width 3 -textvariable digarray(enz$i,percent)] -row 1 -column 0
    if {$percent eq {}} {
      set digarray(enz$i,percent) 100
      grid remove $s.row0.enz$i.percent
    } else {
      set digarray(enz$i,percent) $percent
      bind $s <<ShowPartial>> 1
    }

    set columnwidth [expr {int(1.2*[winfo reqwidth $s.row0.enz$i.enzbutton])}]
    grid columnconfigure $s.row0 $i -minsize $columnwidth -weight 0

    incr i
  }

  # add enzyme and show percents buttons
  grid [frame $s.row0.f1] -row 0 -column $i -sticky we
  grid [button $s.row0.f1.showpartial -text [mc "%" ]  -command "enz_digest_dialog2_show_percent $s"] -row 1 -column 0

  grid [button $s.row0.f1.addcol -text [mc "+"]  -command "enz_digest_dialog2_add_column $s"] -row 0 -column 0 -sticky e
  grid columnconfigure $s.row0.f1 1 -weight 1
  register_data_receiver $s.row0 <<EnzymeClick>> "enz_digest_dialog2_enzyme_click $s"


  ## data frame
  grid [frame $s.fnframe] -row 1 -column 0 -sticky we

  grid [frame $s.fnframe.okframe] -row 2 -column 0
  grid [button $s.fnframe.okframe.ok -text [mc "OK"] -command "set ok 1" -default active] -row 0 -column 0
  bind $s <Key-Return> "set ok 1"
  grid [button $s.fnframe.okframe.cancel -text [mc "Cancel"] -command "set ok -1"] -row 0 -column 1
   
  grid [frame $s.fnframe.f1] -row 3 -column 0
  grid [checkbutton $s.fnframe.f1.keep_data -text [mc "Keep Dialog Data on Close"] -variable info(enz_digest_dialog_preserve_info)] -row 1 -column 0 -columnspan 3 -sticky w

 # grid [menubutton $s.fnframe.okframe.actions -text [mc "Actions"] -menu $s.fnframe.okframe.actions.menu] -row 0 -column 2
  #menu $s.fnframe.okframe.actions.menu
  #  $s.fnframe.okframe.actions.menu add command -label [mc "Do Partial Digests"]  -command "enz_digest_dialog2_show_percent $s"
  #  $s.fnframe.okframe.actions.menu add command -label [mc "Add Column"] -command "enz_digest_dialog2_add_column $s"
   # $s.fnframe.okframe.actions.menu add command -label [mc "Add All Open DNA Windows"] -command "enz_digest_dialog2_add_all_dnas $s"

  grid [frame $s.fnframe.f2] -row 4 -column 0
  if {$info(android)} {
    grid [label $s.fnframe.f2.l1 -text [mc "Drag Rows to change the order, Long Press-Drag to duplicate a row.\n Click an enzyme in a graphic map to add a digest."]] -row 1 -column 0
  }  elseif {[tk windowingsystem] == "aqua"} {
    grid [label $s.fnframe.f2.l1 -text [mc "Drag Rows to change the order, Option-Drag to duplicate a row.\n Click an enzyme in a graphic map to add a digest."]] -row 1 -column 0
  } else {
    grid [label $s.fnframe.f2.l1 -text [mc "Drag Rows to change the order, Alt-Drag to duplicate a row.\n Click an enzyme in a graphic map to add a digest."]] -row 1 -column 0
  }
  grid  columnconfigure $s.fnframe 0 -weight 1

  enz_digest_fill_dialog $s

  enz_digest_dialog2_color_rows $s

  vwait ok
  set j 1
  set info(digest_dialog_enzymes_list) [list]
  set info(digest_dialog_percents_list) [list]
  while {[winfo exists $s.row0.enz$j]} {
      lappend info(digest_dialog_enzymes_list) $digarray(enz$j)
      lappend info(digest_dialog_percents_list) $digarray(enz$j,percent)
    incr j
  }
  if {![bind $s <<ShowPartial>>]} {
    set info(digest_dialog_percents_list) [list]
  }

  if {$ok == 1} {
    set data [enz_digest_dialog2_process_output $s]
    if {$info(enz_digest_dialog_preserve_info)} {
      set info(digest_dialog_data_store) $data
    } else {
      set info(digest_dialog_data_store) [list]
    }
    enz_digest2 $w $data
  }
  set dialogblock 0
  destroy $s
  bind . <<RaiseDialogs>> ""
  unset ok digarray
}

#################
##
#################
proc enz_digest_fill_dialog {s} {
  global info digarray
  if {![info exists info(digest_dialog_data_store)] ||$info(digest_dialog_data_store) == [list]} {
    enz_digest_dialog2_add_row $s 1  $info(current_ladder) ""
    set dnawindows_list [dnawindows_list 1]
    set num 1
    while {[winfo exists $s.row$num]} {incr num}
    foreach window [lrange $dnawindows_list 0 9] {
      if {[winfo exists $window.textarea] && [textarea_get $window.textarea 1.0 [end_ix $window.textarea]] ne {}} {
        enz_digest_dialog2_add_row $s $num  $window ""
        incr num
      }
    }
  } else {
    set enz_dict [dict create]
    set num 1
    while {[info exists digarray(enz$num)]} {
      if {$digarray(enz$num) eq "No Digest"} {
        dict set enz_dict no_digest "enz$num"
      } else {
        dict set enz_dict $digarray(enz$num) "enz$num"
      }
      incr num
    }
    set num 1
    while {[winfo exists $s.row$num]} {incr num}
    foreach lane $info(digest_dialog_data_store) {
      if {[lindex $lane 0] eq "ladder"} {
        if {[lindex $lane 1] in $info(ladderlist)} {
          enz_digest_dialog2_add_row $s $num [lindex $lane 1] ""
          incr num
        } 
      } else {
        set window [lindex $lane 0]
        if {[winfo exists $window.textarea] && [textarea_get $window.textarea 1.0 [end_ix $window.textarea]] ne {}} {
          enz_digest_dialog2_add_row $s $num  $window ""
          foreach enz [lindex $lane 1] {
            set digarray($s.row$num.[dict get $enz_dict $enz]) 1
          }
          incr num
        }
      }
    }
  }
}

#################
##
#################
proc enz_digest_dialog2_show_percent {s} {
  global digarray
  set j 1
  if {[grid info $s.row0.enz1.percent] != {}} {
    for {set j 1} {[winfo exists $s.row0.enz$j.percent]} {incr j} {
      grid remove $s.row0.enz$j.percent
      set digarray(enz$j,percent) 100
    }
    bind $s <<ShowPartial>> 0
  } else {
    for {set j 1} {[winfo exists $s.row0.enz$j.percent]} {incr j} {
      grid configure $s.row0.enz$j.percent
    }
    bind $s <<ShowPartial>> 1
  }
}

#################
##
#################
proc enz_digest_dialog2_add_all_dnas {s} {
  set dnawindows_list [dnawindows_list 1]
  set num 1
  while {[winfo exists $s.row$num]} {incr num}
  foreach window $dnawindows_list {
    if {[winfo exists $window.textarea] && [textarea_get $window.textarea 1.0 [end_ix $window.textarea]] ne {}} {
      enz_digest_dialog2_add_row $s $num  $window ""
      incr num
    }
  }
}

#################
##
#################
proc enz_digest_dialog2_add_dna_diagonal {s row} {
  global digarray info listmove
  
  #reset current row to first enzyme selected
  for {set j 1} {[winfo exists $s.row0.enz$j]} {incr j} {
    set  digarray($s.row$row.enz$j) 0
  }
  set  digarray($s.row$row.enz1) 1
  enz_digest_dialog2_show_checkbox $s.row$row 1
  enz_digest_dialog2_recolor_row $s.row$row

  set type_info $digarray($s.row$row.lanedata) 
  set grid_row [dict get [grid info $s.row$row] -row]
  for {set j 2} {[winfo exists $s.row0.enz$j]} {incr j} {
    set new_row [enz_digest_dialog2_add_row $s [expr {$grid_row + $j -1}]  $type_info ""]
    set  digarray($s.row$new_row.enz$j) 1
    enz_digest_dialog2_recolor_row $s.row$new_row
  }
}

#################
##
#################
proc enz_digest_dialog2_clone_row {s row_frame} {
  global digarray  

  set type_info $digarray($row_frame.lanedata) 
  set grid_row [dict get [grid info $row_frame] -row]
  enz_digest_dialog2_add_row $s [expr {$grid_row +1}] $type_info $row_frame
}

#################
##
#################
proc enz_digest_dialog2_delete_row {s row_frame} {
  global digarray  
  #sputs here delete  $row_frame
  set grid_row [dict get [grid info $row_frame] -row]
  for {set i [expr {$grid_row}]} {$i < [expr {[llength [grid slaves $s]]-2}]} {incr i} {
   grid configure [grid slaves $s -row [expr {$i+1}]] -row $i
  }
  destroy $row_frame
  if {[llength [grid slaves $s]] == 3} {
    set last_row [grid slaves $s -row 1]
    $last_row.lanebuttonframe.action_button_frame.close configure -state disabled
  }
}


#################
## better add row- adds ladders and dnas as menu items
#################
proc enz_digest_dialog2_add_row {s row type_info clone_data_from_row} {
  global digarray info listmove
  if {$row eq "end" || $row> [expr {[llength [grid slaves $s]]-1}]} {
    set row [expr {[lindex [grid size $s] 1]-1}]
  }
  if {$row < 1 } {
    set row 1
  }

  if {[llength [grid slaves $s]] == 3} {
    set last_row [grid slaves $s -row 1]
    $last_row.lanebuttonframe.action_button_frame.close configure -state normal
  }

  #set i [expr {[llength [grid slaves $s]]-1}]
  for {set i 0} {[winfo exists $s.row$i]} {incr i} {}

  grid [set new_frame [frame $s.row$i]] -row [expr {[llength [grid slaves $s]]-1}] -column 0 -sticky we

  grid [frame $s.row$i.lanebuttonframe ] -row 0 -column 0 -sticky w; # maybe -sticky we
  grid [frame $s.row$i.lanebuttonframe.action_button_frame] -row 0 -column 0 -sticky e

  grid [button $s.row$i.lanebuttonframe.action_button_frame.dup -text "+" -width 1 -command "enz_digest_dialog2_clone_row $s $s.row$i"] -row 0 -column 0 -sticky e
  grid [button $s.row$i.lanebuttonframe.action_button_frame.close -text "-"  -width 1 -command "enz_digest_dialog2_delete_row $s $s.row$i; enz_digest_dialog2_color_rows $s"] -row 0 -column 1 -sticky e

  grid [label $s.row$i.lanebuttonframe.lanelabel -text [mc "Lane %s" $i]] -row 0 -column 1 -sticky e

  grid [menubutton $s.row$i.lanebuttonframe.lanebutton -textvariable digarray($s.row$i.lanelabel) -menu $s.row$i.lanebuttonframe.lanebutton.menu] -row 0 -column 2 -sticky we
  menu $s.row$i.lanebuttonframe.lanebutton.menu 
  $s.row$i.lanebuttonframe.lanebutton.menu add radiobutton -label [mc "None"] -value "None" -variable digarray($s.row$i.lanelabel) -command "set digarray($s.row$i.lanedata) {}; enz_digest_dialog2_show_checkbox $s.row$i 0"
  $s.row$i.lanebuttonframe.lanebutton.menu add cascade -label [mc "Ladder"] -menu $s.row$i.lanebuttonframe.lanebutton.menu.laddermenu
  menu $s.row$i.lanebuttonframe.lanebutton.menu.laddermenu
  foreach entry $info(ladderlist) {
   $s.row$i.lanebuttonframe.lanebutton.menu.laddermenu add radiobutton -label $entry -value $entry -variable digarray($s.row$i.lanelabel) -command "set digarray($s.row$i.lanedata) \{$entry\}; enz_digest_dialog2_show_checkbox $s.row$i 0"
  }

  $s.row$i.lanebuttonframe.lanebutton.menu add cascade -label [mc "DNA"] -menu $s.row$i.lanebuttonframe.lanebutton.menu.dnamenu
  menu $s.row$i.lanebuttonframe.lanebutton.menu.dnamenu
  set dnawindows_list [dnawindows_list 1]
  foreach window $dnawindows_list {
    if {[winfo exists $window.textarea] && [textarea_get $window.textarea 1.0 [end_ix $window.textarea]] ne {}} {
      $s.row$i.lanebuttonframe.lanebutton.menu.dnamenu add radiobutton -label [wm title $window] -value [wm title $window] -variable digarray($s.row$i.lanelabel) -command "set digarray($s.row$i.lanedata) $window; enz_digest_dialog2_show_checkbox $s.row$i 1;after 100 \{enz_digest_dialog2_color_rows $s\}"
    }
  }

  $s.row$i.lanebuttonframe.lanebutton.menu add cascade -label [mc "Digest with Each Enzyme"] -menu $s.row$i.lanebuttonframe.lanebutton.menu.digallmenu
  menu $s.row$i.lanebuttonframe.lanebutton.menu.digallmenu
  set dnawindows_list [dnawindows_list 1]
  foreach window $dnawindows_list {
    if {[winfo exists $window.textarea] && [textarea_get $window.textarea 1.0 [end_ix $window.textarea]] ne {}} {
      $s.row$i.lanebuttonframe.lanebutton.menu.digallmenu add command -label [wm title $window] -command "set digarray($s.row$i.lanedata) $window; set digarray($s.row$i.lanelabel) \{[wm title $window]\}; enz_digest_dialog2_add_dna_diagonal $s $i"
    }
  }

  $s.row$i.lanebuttonframe.lanebutton.menu add command -label [mc "Add All Open DNA Windows"] -command "enz_digest_dialog2_add_all_dnas $s"

  if {[lsearch -exact $dnawindows_list $type_info] > -1} {
    set digarray($s.row$i.lanedata) $type_info
    set digarray($s.row$i.lanelabel) [wm title $type_info]
    set type "window"
  } elseif {[lsearch -exact $info(ladderlist) $type_info] > -1} {
    set digarray($s.row$i.lanedata) $type_info
    set digarray($s.row$i.lanelabel) $type_info
    set type "ladder"
  } else {
    set digarray($s.row$i.lanedata) {}
    set digarray($s.row$i.lanelabel) "None"
    set type "none"
  }


    if {([tk windowingsystem] == "aqua")} {set pluscursor "copyarrow"} else {set pluscursor "plus"}

    bind $s.row$i <B1-Motion> "if {!\[info exists listmove\]} {set listmove $s.row$i; toplevel .w_tooltip -borderwidth 1 -background $info(graphic_fg_color); if {(\[tk windowingsystem\] == \"aqua\")} {tk::unsupported::MacWindowStyle style .w_tooltip help {noActivates noUpdates}} else { wm overrideredirect .w_tooltip 1}; catch {wm attributes .w_tooltip -alpha .4}; wm geometry .w_tooltip +%X+%Y; raise .w_tooltip; grid \[label .w_tooltip.l -text \"\$digarray($s.row$i.lanelabel)\"\]} else {wm geometry .w_tooltip +%X+%Y; raise .w_tooltip; $s configure -cursor arrow}"

    bind $s.row$i <ButtonRelease-1> "if {\[winfo exists .w_tooltip\]} {destroy .w_tooltip}; if {\[info exists listmove\]} {enz_digest_dialog2_move_row $s \[dict get \[grid info $s.row$i\] -row\] \[lindex \[grid location $s \[expr {%X-\[winfo rootx $s\]}] \[expr {%Y-\[winfo rooty $s\]}]\] 1\];unset listmove}; $s configure -cursor arrow"

    bind $s.row$i <Option-ButtonRelease-1> "if {\[winfo exists .w_tooltip\]} {destroy .w_tooltip}; if {\[info exists listmove\]} {enz_digest_dialog2_add_row $s \[lindex \[grid location $s \[expr {%X-\[winfo rootx $s\]}] \[expr {%Y-\[winfo rooty $s\]}]\] 1\]  \{$type_info\} $s.row$i;unset listmove}; $s configure -cursor arrow"
    bind $s.row$i <Alt-ButtonRelease-1> [bind $s.row$i <Option-ButtonRelease-1>]

    bind $s.row$i <Option-B1-Motion> "if {!\[info exists listmove\]} {set listmove $s.row$i; toplevel .w_tooltip -borderwidth 1 -background $info(graphic_fg_color) -cursor $pluscursor; if {(\[tk windowingsystem\] == \"aqua\")} {tk::unsupported::MacWindowStyle style .w_tooltip help {noActivates noUpdates}} else { wm overrideredirect .w_tooltip 1}; catch {wm attributes .w_tooltip -alpha .4}; wm geometry .w_tooltip +%X+%Y; grid \[label .w_tooltip.l -text \{$digarray($s.row$i.lanelabel)\}\]} else {wm geometry .w_tooltip +%X+%Y; $s configure -cursor $pluscursor}"

    bind $s.row$i <Alt-B1-Motion> [bind $s.row$i <Option-B1-Motion> ]

    if {$info(android)} {
      bind $s.row$i <B2-Motion>  [bind $s.row$i <B1-Motion>]
      bind $s.row$i <ButtonRelease-2>  [bind $s.row$i <ButtonRelease-1>]
      bind $s.row$i <B3-Motion>  "if {!\[info exists listmove\]} {set listmove $s.row$i; $s.row$i configure -bg green; toplevel .w_tooltip -borderwidth 1 -background $info(graphic_fg_color); wm overrideredirect .w_tooltip 1; catch {wm attributes .w_tooltip -alpha .4}; wm geometry .w_tooltip +%X+%Y; grid \[label .w_tooltip.l -text \{$digarray($s.row$i.lanelabel)\}\]} else {wm geometry .w_tooltip +%X+%Y; ; $s.row$i configure -bg green}"

      bind $s.row$i <ButtonRelease-3>  "if {\[winfo exists .w_tooltip\]} {destroy .w_tooltip}; if {\[info exists listmove\]} {enz_digest_dialog2_add_row $s \[lindex \[grid location $s \[expr {%X-\[winfo rootx $s\]}] \[expr {%Y-\[winfo rooty $s\]}]\] 1\]  \{$type_info\} $s.row$i;unset listmove}"
    }

     # let the lane label also act as a drag hndle
    bindtags $s.row$i.lanebuttonframe.lanelabel [list $s.row$i.lanebuttonframe.lanelabel $s.row$i Frame .dialog all]

    if {$clone_data_from_row != ""} {
      set digarray($s.row$i.lanelabel) $digarray($clone_data_from_row.lanelabel)
      set digarray($s.row$i.lanedata) $digarray($clone_data_from_row.lanedata)
    }

    update idletasks
    set j 1
    while {[winfo exists $s.row0.enz$j]} {

      set col [grid slave $s.row0 -column $j]
      set columnwidth [lindex [grid bbox $s.row0 $j 0] 2]

      regsub "row0" $col "row$i" new_col
      #grid [tk_checkbutton $new_col -variable digarray($new_col) -command "enz_digest_dialog2_process_checkbox $new_col"] -row 0 -column $j
      grid [checkbutton $new_col -variable digarray($new_col) -command "enz_digest_dialog2_process_checkbox $new_col"] -row 0 -column $j
      set clone_checked 0
      if {$clone_data_from_row != ""} {
        set digarray($new_col) $digarray($clone_data_from_row[file extension $new_col]) 
        set clone_checked [expr {$clone_checked | $digarray($new_col)}]
      } else {
        set digarray($new_col) 0
      }
      grid columnconfigure $s.row$i $j -minsize $columnwidth -weight 0
      if {$type ne "window"} {grid remove $new_col}
      incr j
    }

  grid [ttk::separator $s.row$i.sep] -row 1 -column 0 -columnspan $j -sticky we
  enz_digest_dialog2_move_row $s $i $row
  update idletasks
  set mincol0 [expr {0+max([lindex [grid bbox $s.row$i 0 0] 2], [lindex [grid bbox $s.row0 0 0] 2])}]
  if {[lindex [grid bbox $s.row$i 0 0] 2] > [lindex [grid bbox $s.row0 0 0] 2]} {
    foreach srow [grid slaves $s] {
      if {$srow ne "$s.fnframe"} {
        grid columnconfigure $srow 0 -minsize $mincol0 -weight 0
      }
    }
  } else {
    grid columnconfigure $s.row$i 0 -minsize $mincol0 -weight 0
  }
  enz_digest_dialog2_color_rows $s
  return $i
}


#################
##
#################
proc enz_digest_dialog2_color_rows {s} {
  global info digarray
  set max 0
  foreach row [grid slaves $s] {
    if {[regexp {.row[0-9]+} $row] && ($row ne "$s.row0")} {
      enz_digest_dialog2_recolor_row $row
      set max [expr {max( $max, int(1*[winfo reqwidth $row.lanebuttonframe]))}]
    }
  }
  foreach row [grid slaves $s] {
    if {[regexp {.row[0-9]+} $row] && ($row ne "$s.row0")} {
      grid columnconfigure $row 0 -minsize $max
    }
  }
  grid columnconfigure $s.row0 0 -minsize $max
}

#################
##
#################
proc enz_digest_dialog2_recolor_row {row} {
  global digarray info
  if {![winfo exists $row]} {return}
  set color [expr {[dict get [grid info $row] -row]%2?"#d0d0ff":$info(bg_color)}]

  set row_0 [regsub {[0-9+]+} $row 0]
  
  set i 1
  while {[winfo exists $row.enz$i]} {
    set columnwidth [expr {int(1.2*[winfo reqwidth $row_0.enz$i.enzbutton])}]
     grid columnconfigure $row $i -minsize $columnwidth -weight 0
    incr i
  }
  grid configure $row.sep -columnspan $i

  $row.lanebuttonframe.lanelabel configure -text [mc "Lane %s" [dict get [grid info $row] -row]]
  grid columnconfigure $row.lanebuttonframe 1 -minsize [font measure labelfont "Lane 100"]
  #      set columnwidth [expr {int(1.2*[winfo reqwidth $row_0.enz$i.enzbutton])}]
 # grid columnconfigure $s.row0 $i -minsize $columnwidth -weight 0
  

  if {$digarray($row.lanedata) == ""} {
    #set color gray40
    $row.lanebuttonframe.lanelabel configure -text "           "
  } else {
    set i 1
    while {[winfo exists $row.enz$i] && [info exists digarray($row.enz$i)] && ([grid info $row.enz$i]!="") && !$digarray($row.enz$i)} {
      incr i
    }
    if {![info exists digarray($row.enz$i)]} {
      # set color gray40
      $row.lanebuttonframe.lanelabel configure -text "           "
    }
  }
  #set color $info(bg_color)
  #$row configure -bg $color
  #$row.lanebuttonframe.lanelabel configure # -bg $color
  #$row.lanebuttonframe.lanebutton configure -bg $color
  #foreach ch [winfo children $row] {
   # $ch configure -bg $color
  #}
}

#################
##
#################
proc enz_digest_dialog2_add_column {s} {
  global enzymes digarray
    set i 1
    while {[winfo exists $s.row0.enz$i]} {incr i}
    grid [frame $s.row0.enz$i] -row 0 -column $i
    grid  $s.row0.f1 -column [expr {1+$i}]

    grid [menubutton $s.row0.enz$i.enzbutton -textvariable digarray(enz$i) -menu $s.row0.enz$i.enzbutton.menu] -row 0 -column 0
    menu $s.row0.enz$i.enzbutton.menu


    set submenu [menu $s.row0.enz$i.enzbutton.menu.actionmenu]
    $s.row0.enz$i.enzbutton.menu add cascade -menu $submenu -label [mc "Select"]
    $submenu add command -label [mc "Select All In Column"] -command "foreach e \[array names digarray $s.row*.enz$i\] {set digarray(\$e) 1}"
    $submenu add command -label [mc "Deselect All In Column"] -command "foreach e \[array names digarray $s.row*.enz$i\] {set digarray(\$e) 0}"
    $s.row0.enz$i.enzbutton.menu add separator

    $s.row0.enz$i.enzbutton.menu add radiobutton -label [mc "No Digest"] -value "No Digest" -variable digarray(enz$i)
    set j 0
    for {set k 0} {$k < [llength $enzymes]} {incr k} {
      if {[expr {$k % 20}] ==0} {
        set submenu [menu $s.row0.enz$i.enzbutton.menu.menu$j]
        $s.row0.enz$i.enzbutton.menu add cascade -menu $submenu -label "[lindex $enzymes $k]-[lindex $enzymes [expr {min($k+19,[llength $enzymes]-1)}]]"
        incr j
      }
      $submenu add radiobutton -label [lindex $enzymes $k] -value [lindex $enzymes $k] -variable digarray(enz$i)
    }
    set digarray(enz$i) "No Digest"

    grid [entry $s.row0.enz$i.percent -width 3 -textvariable digarray(enz$i,percent)] -row 1 -column 0
    if {[bind $s <<ShowPartial>>] eq 0} {
      grid remove $s.row0.enz$i.percent
    }
    set digarray(enz$i,percent) 100

    set columnwidth [expr {int(1.2*[winfo reqwidth $s.row0.enz$i.enzbutton])}]
    grid columnconfigure $s.row0 $i -minsize $columnwidth -weight 0

    set dnawindows_list [dnawindows_list 1]
    for {set j 1} {$j < [expr {[llength [grid slaves $s]]-1}]} {incr j} {
      #grid [tk_checkbutton $s.row$j.enz$i -variable digarray($s.row$j.enz$i) -command "enz_digest_dialog2_process_checkbox $s.row$j.enz$i"] -row 0 -column $i
      grid [checkbutton $s.row$j.enz$i -variable digarray($s.row$j.enz$i) -command "enz_digest_dialog2_process_checkbox $s.row$j.enz$i"] -row 0 -column $i
      set digarray($s.row$j.enz$i) 0
      grid columnconfigure $s.row$j $i -minsize $columnwidth -weight 0
      if {[lsearch -exact $dnawindows_list $digarray($s.row$j.lanedata)] == -1} {
        grid remove $s.row$j.enz$i
      }
    }

  enz_digest_dialog2_color_rows $s
  return $i
}

#################
##
#################
proc enz_digest_dialog2_enzyme_click {s enz canvas} {
  global enzymes digarray
  if {$enz in $enzymes} {
    if {$digarray(enz1) eq "No Digest" && ![info exists digarray(enz2)]} {
      set i 1
    } else {
      set i [enz_digest_dialog2_add_column $s]
    }
    set digarray(enz$i) $enz
  }
}

#################
##
#################
proc enz_digest_dialog2_move_row {s from_row to_row} {
  #sputs here enz_digest_dialog2_move_row $from_row $to_row [llength [grid slaves $s]]
  grid configure $s.fnframe -row [expr {[llength [grid slaves $s]]-1}]
  if {($to_row< 1) || ($to_row >= [expr {[llength [grid slaves $s]]-1}])} {return}
  set from_slave [grid slave $s -row $from_row]
  if {$from_row < $to_row} {
    for {set i $from_row} {$i <= $to_row} {incr i} {
      grid configure [grid slaves $s -row $i] -row [expr {$i-1}]
    }
    grid configure $from_slave -row [expr {$to_row}]
  } elseif {$from_row > $to_row} {
    for {set i $from_row} {$i >= $to_row} {incr i -1} {
      grid configure [grid slaves $s -row $i] -row [expr {$i+1}]
    }
    grid configure $from_slave -row [expr {$to_row}]
  }
enz_digest_dialog2_color_rows $s
}

#################
##
#################
proc enz_digest_dialog2_process_checkbox {checkbox} {
  #global digarray
  set row [file rootname $checkbox]

  #set i 1
  #while {[winfo exists $row.enz$i] && [info exists digarray($row.enz$i)]} {
  #  incr i
  #}
  enz_digest_dialog2_recolor_row $row
  #can check for duplicate enzymes here

}



#################
##
#################
proc enz_digest_dialog2_show_checkbox {row show} {
  global digarray
  set i 1
  while {[winfo exists $row.enz$i] && [info exists digarray($row.enz$i)]} {
    if {$show} {
      grid configure $row.enz$i
    } else {
      grid remove $row.enz$i
    }
    incr i
  }
  #update
  set s [winfo parent $row]
  set mincol0 [expr {0+max([lindex [grid bbox $row 0 0] 2], [lindex [grid bbox $s.row0 0 0] 2])}]

  if {[lindex [grid bbox $row 0 0] 2] > [lindex [grid bbox $s.row0 0 0] 2]} {
    foreach srow [grid slaves $s] {
      if {$srow ne "$s.fnframe"} {
        grid columnconfigure $srow 0 -minsize $mincol0 -weight 0
      }
    }
  } else {
    grid columnconfigure $row 0 -minsize $mincol0 -weight 0
  }
  enz_digest_dialog2_recolor_row $row
}

#################
##
#################
proc enz_digest_dialog2_process_output {s} {
  global digarray info
  set reslist [list]
  set dnawindows_list [dnawindows_list]

  for {set i 1} {$i < [expr {[llength [grid slaves $s]]-1}]} {incr i} {
    set framerow [grid slaves $s -row $i]
    if {[lsearch -exact $dnawindows_list $digarray($framerow.lanedata)] > -1} {
      set enzlist [list]
      set partlist [list]
      set usepartlist 0
      set j 1
      while {[winfo exists $s.row0.enz$j] && [info exists digarray($framerow.enz$j)]} {
        if {$digarray($framerow.enz$j)} {
          if {$digarray(enz$j) ne "No Digest" && ([lsearch -exact $enzlist $digarray(enz$j)]== -1)} {
            lappend enzlist $digarray(enz$j)
            lappend partlist $digarray(enz$j) [expr {1.0*$digarray(enz$j,percent)/100}]
            if {$digarray(enz$j,percent) != 100} {set usepartlist 1}
          } elseif {$digarray(enz$j) eq "No Digest"} {
            lappend enzlist no_digest
            lappend partlist 1.0
	  }
        }
        incr j
      }
      set enzlist [lsort -unique $enzlist]
      if {$enzlist != [list]} {
        if {$usepartlist} {
          lappend reslist [list $digarray($framerow.lanedata) $enzlist all $partlist]
        } else  {
          lappend reslist [list $digarray($framerow.lanedata) $enzlist all {}]
        }
      } else {
       # lappend reslist [list $digarray($framerow.lanedata) {} all {}]
      }
    } elseif {[lsearch -exact $info(ladderlist) $digarray($framerow.lanedata)] > -1} {
      lappend reslist [list ladder $digarray($framerow.lanedata)]
    }
  }
  unset digarray
  return $reslist
}


#################
##
#################
proc enz_digest_window_with_current_enz {w} {
  global info
  set lane_list [list [list ladder $info(current_ladder)]]
  set count 1
  foreach enz $info(enz_currently_selected) {
    lappend lane_list [list $w $enz $info(analyze_selection) {}]
    incr count
    if {$count > 16} {break}
  }
  enz_digest2 $w $lane_list
}


#################
##
#################
proc enz_digest2 {w lane_list} {
  global enzymes info modifier modstring toolbar_images bandwidth bandspacing
  #lanelist list of {w enz_list region {partial_list ""}} or {"ladder" ladder_name}
  if {$lane_list == [list]} return
#sputs here $lane_list
  ##make output window
  #find linked window list
  set wlist [list]
  foreach lane_info $lane_list {
    if {[lindex $lane_info 0] ne "ladder"} {
      lappend wlist [lindex $lane_info 0]
    }
  }
  if {$wlist != [list]} {
    set a [new_analysis_window $wlist "[mc Digest]" digest]  
  } else {
    set a [new_analysis_window $w "[mc Digest]" digest]  
  }


  grid [set canvas [canvas $a.canvas -yscrollcommand "optionscrollbar $a.s" -xscrollcommand "optionscrollbar $a.s2" -width 500 -height 250 -background $info(graphic_bg_color)]] -row 1 -column 0 -rowspan 2 -sticky nswe
  grid [scrollbar $a.s -orient vertical -command "$canvas yview"] -row 2 -column 1 -sticky nsw

  set outputmenu [add_output_menu $canvas "Image" image $w]
  if {!$info(android)} {
    grid [label $a.infobutton -image $toolbar_images(button_info) -width 17 -relief flat -borderwidth 0] -row 1 -column 1 -sticky nsw
    bind $a.infobutton <Button-1> "$canvas itemconfigure !band -state hidden ; $canvas itemconfigure infotext -state normal"
    tooltip_install $a.infobutton [mc "Show lane info"]
  } else {
    grid [label $a.toolbar.extra_icons.infobutton -image $toolbar_images(button_info,4x) -width 65 -relief flat -borderwidth 0] -row 0 -column 0 -sticky w
    bind $a.toolbar.extra_icons.infobutton <Button-1> "$canvas itemconfigure !band -state hidden ; $canvas itemconfigure infotext -state normal"
  }
  grid [scrollbar $a.s2 -orient horizontal -command "$canvas xview"] -row 3 -column 0 -sticky nwe
  grid rowconfigure $a 2 -weight 1
  grid columnconfigure $a 0 -weight 1
  grid columnconfigure $a 1 -minsize 17



  set lanenum 0
  set info_text_list [list]
  foreach lane_info $lane_list {
    if {[lindex $lane_info 0] ne "ladder"} {
      digest_draw_digest_lane $a $lane_info $lanenum
    } else {
      digest_draw_ladder $a [lindex $lane_info 1] $lanenum
    }
    lappend info_text_list "[mc {Lane %1$s:} [expr {1+$lanenum}]] [dict get [$canvas bind "lane$lanenum" <<Info>>] info_text]"
    incr lanenum
  }
#xxx bbox map
  $canvas move band [expr {[lindex [$canvas bbox map] 2]+10}] 0
  $canvas move lanelabel [expr {[lindex [$canvas bbox map] 2]+10}] 0
  
  digest_manage_band_migration $a

  #create hidden map line dummy for aligning incoming lanes to
#xxx bbox title
  set textright [lindex [$canvas bbox title] 2]
  $canvas create line [expr {$textright + 5}] 30 [expr {$textright + 5}] 240 -tags [list dummy line scalable] -state hidden
 
  #create the info text item
  $canvas create text 0 0 -anchor nw -font [list $info(graphicfontfamily) $info(graphicfontsize)] -fill $info(graphic_fg_color) -width [expr {[lindex [$canvas bbox map] 2]+10}] -tags [list infotext text] -state hidden
  catch {$canvas itemconfigure infotext&&text -text [wrap_text [join $info_text_list "\n\n"] [$canvas itemcget infotext&&text -font] [$canvas itemcget infotext&&text -width]]}


  $canvas bind band  <Any-Enter> "if {\[winfo exists .bandsizetooltip\]} {destroy .bandsizetooltip}; toplevel .bandsizetooltip -borderwidth 1 -background $info(graphic_fg_color); if {(\[tk windowingsystem\] == \"aqua\")} {tk::unsupported::MacWindowStyle style .bandsizetooltip help {noActivates noUpdates}} else { wm overrideredirect .bandsizetooltip 1}; catch {wm attributes ..bandsizetooltip -alpha .7}; wm geometry .bandsizetooltip +\[expr {%X + 2}\]+\[expr {%Y - 20}\];  grid \[label .bandsizetooltip.l -background $info(graphic_bg_color) -foreground $info(graphic_fg_color) -text \[$canvas bind \[$canvas find withtag current\] <<Size>>\]\]; raise .bandsizetooltip"
  #$canvas bind band  <Any-Motion> "if {\[winfo exists .bandsizetooltip\]} {wm geometry .bandsizetooltip +\[expr {%X + 2}\]+\[expr {%Y - 20}\]}"
  $canvas bind band  <Any-Leave> " if {\[winfo exists .bandsizetooltip\]} {destroy .bandsizetooltip}"

  $canvas bind band <B1-Motion> "digest_peel_bands $canvas %X %Y"
  $canvas bind band <ButtonRelease-1> "catch {unset tooltip_x tooltip_y}; if {(\[winfo containing %X %Y\] != \"\") && \[winfo exists .w_tooltip\]} {destroy .w_tooltip; digest_move_lane $canvas %X %Y move} else {digest_action_item_manager $canvas button-1}"
  $canvas bind band <Shift-ButtonRelease-1> "catch {unset tooltip_x tooltip_y}; if {(\[winfo containing %X %Y\] != \"\") && \[winfo exists .w_tooltip\]} {destroy .w_tooltip; digest_move_lane $canvas %X %Y move} else {digest_action_item_manager $canvas shift-button-1}"
  $canvas bind band <$modifier-ButtonRelease-1> "catch {unset tooltip_x tooltip_y}; if {(\[winfo containing %X %Y\] != \"\") && \[winfo exists .w_tooltip\]} {destroy .w_tooltip; digest_move_lane $canvas %X %Y copy} else {digest_action_item_manager $canvas button-1}"
  if {[tk windowingsystem] eq "aqua"} {$canvas bind band <Option-ButtonRelease-1> [$canvas bind band <$modifier-ButtonRelease-1>]}
  bind $canvas <KeyPress-BackSpace> "digest_action_item_manager $canvas delete"
  bind $canvas <KeyPress-Delete> "digest_action_item_manager $canvas delete"

  $canvas bind action_item <Any-Enter> "digest_action_item_manager $canvas enter"
  $canvas bind action_item <Any-Leave> "digest_action_item_manager $canvas leave"
  $canvas bind action_item&&!band <Button-1> "digest_action_item_manager $canvas button-1"
  $canvas bind action_item&&!band <Shift-ButtonRelease-1> "digest_action_item_manager $canvas shift-button-1"

  bind $canvas <$modifier-Button1-Motion> "if {\[info exists info(y_scale_size)\] && !\[info exists tooltip_y\]} {$canvas scale band 0 30 1 \[expr \{1.0 * max(10, \$info(y_scale_size)+%y-\$info(y_scale_mark))/(\[lindex \[$canvas bbox band\] 3\]-\[lindex \[$canvas bbox band\] 1\])\}\]}; $canvas configure -scrollregion \[$canvas bbox all\]; digest_color_bands $a"
  bind $canvas <$modifier-Button-1> "set info(y_scale_mark) %y;set info(y_scale_size) \[expr \{(\[lindex \[$canvas bbox band\] 3\]-\[lindex \[$canvas bbox band\] 1\])\}\]"
  bind $canvas <ButtonRelease-1> "unset -nocomplain info(y_scale_mark) info(y_scale_size)"

  if {$info(android)} {
    $canvas  bind lane1 <Button-1> "%W itemconfigure !band -state hidden ;%W itemconfigure lane1 -state normal"

    $canvas bind band  <Any-Enter> ""
    $canvas bind band  <Any-Motion> ""
    $canvas bind band  <Any-Leave> ""


    $canvas bind band <B1-Motion> ""
    $canvas bind band <ButtonRelease-1> ""
    $canvas bind band <Shift-ButtonRelease-1> ""
    $canvas bind band <$modifier-ButtonRelease-1> ""

    bind $canvas <KeyPress-BackSpace> ""
    bind $canvas <KeyPress-Delete> ""

    $canvas bind action_item <Button-1> "digest_action_item_manager $canvas enter"
    $canvas bind action_item <ButtonRelease-1> "digest_action_item_manager $canvas leave"
    $canvas bind action_item&&!band <Double-Button-1> "digest_action_item_manager $canvas button-1"
    $canvas bind action_item&&!band <Shift-ButtonRelease-1> ""
  }

  $canvas configure -scrollregion [$canvas bbox all]

  #bind $canvas <Configure> "if {\[winfo height $canvas\] > 80} {$canvas scale scalable \[lindex \[$canvas bbox scalable\] 0\] \[lindex \[$canvas bbox scalable\] 1\] 1 \[expr \{(\[winfo height $canvas\]-60.0)/(\[lindex \[$canvas bbox scalable\] 3\]-\[lindex \[$canvas bbox scalable\] 1\])\}\]}; $canvas configure -scrollregion \[$canvas bbox all\]; digest_color_bands $a"

  #bind $canvas <Configure> "if {\[winfo height $canvas\] > 80} {$canvas scale scalable 0 30 1 \[expr \{(\[winfo height $canvas\]-60.0)/(\[lindex \[$canvas bbox scalable\] 3\]-\[lindex \[$canvas bbox scalable\] 1\])\}\]}; $canvas configure -scrollregion \[$canvas bbox all\]; digest_color_bands $a"

  bind $canvas <Configure> "if {\[winfo height $canvas\] > 80} {$canvas scale scalable 0 30 1 \[expr \{(\[winfo height $canvas\]-60.0)/(\[lindex \[$canvas coords  dummy&&line\] 3\]-\[lindex \[$canvas coords  dummy&&line\] 1\])\}\]}; $canvas configure -scrollregion \[$canvas bbox all\]; digest_color_bands $a"

  set info($a,scale) 100
  set info($a,new_scale) 100

  bind $canvas <<Return>> "digest_action_item_manager $canvas return"
  bind $canvas <<Parent>> $w
  $outputmenu insert 0 command -label [mc "Copy Text"] -accelerator "$modstring+Shift+C" -command "event generate $canvas <<CopyText>>"
  bind $canvas <$modifier-KeyPress-C> "event generate $canvas <<CopyText>>"
  bind $canvas <<CopyText>> "clipboard clear;clipboard_append \[enz_digest_get_table_text $canvas\]"
  bindtags $canvas [list $canvas $a all]
  bind $a <Button-1> "focus $canvas" 
  $canvas itemconfigure !band -state hidden ; $canvas itemconfigure infotext -state normal
  wm deiconify $a
  foreach {x0 y0 x1 y1} [$canvas bbox all] {}
  if {[info exists info(last_analysis_xy)]} {
    wm geometry [winfo toplevel $a] [expr {min ($x1 - $x0 + 30, ([winfo vrootwidth $a]-100))}]x[expr {min ($y1 - $y0 + 25, ([winfo vrootheight $a]-150))}]+[lindex $info(last_analysis_xy) 0]+[lindex $info(last_analysis_xy) 1]
  } else {
    wm geometry [winfo toplevel $a] [expr {min ($x1 - $x0 + 30, ([winfo vrootwidth $a]-100))}]x[expr {min ($y1 - $y0 + 25, ([winfo vrootheight $a]-150))}]
  }
  window_on_screen $a
  focus $canvas
}

#################
##
#################
proc digest_make_fraglist {w enz_list region {partial_list ""}} {
  global info
  if {[$w.textarea tag ranges sel] == ""} {set region "all"}
  if {$region == "all"} {
    set start 1
    set total_length [ix2bp $w.textarea end]
    set end $total_length
  } else {
#selection used here 
    set start [ix2bp $w.textarea [$w.textarea index sel.first]]
    incr start 
    set end [ix2bp $w.textarea [$w.textarea index sel.last]]
    set total_length [expr {$end - $start+1}]
  }
  if {$total_length == 0} return
  incr end
  findenzymes $w

  set templist [list]
  foreach enzyme $enz_list {
    if {$enzyme eq "no_digest" } {
      continue
    }
    if {($region != "all") || ($info($w,circular) != "circular")} {
      ##on linear fragments reject sites that CUT outside the range
      foreach site $info($w,$enzyme) dir $info($w,enzdir,$enzyme) {
        if {$site >= $end} {break}
        if {$site >= $start} {
          set cutsitelist [enz_cut_offset $enzyme $site $dir]
          if {([lindex $cutsitelist 0] >= $start) && ([lindex $cutsitelist 1] >= $start) && ([lindex $cutsitelist 0] <= $end) && ([lindex $cutsitelist 1] <= $end)} {
            lappend templist [list $site $enzyme $dir]
          }
        }
      }
    } else {
      foreach site $info($w,$enzyme) dir $info($w,enzdir,$enzyme) {
        if {$site >= $end} {break}
        if {$site >= $start} {lappend templist [list $site $enzyme $dir]}
      }
    }
  }

  if {($region != "all") || ($info($w,circular) != "circular")} {
    lappend templist [list $start "Start" 0]
    lappend templist [list $end "End" 0]
  }
  if {$templist == [list]} {
    lappend templist [list  $total_length uncut 0 "" 0 0 100 0 0]
  }
  set templist [lsort -integer -index 0 $templist]

  set fraglist [list]

  # digest routine
  set circular [expr {($info($w,circular) == "circular") && ($region == "all")}]
  set maxmassperc 1
  if {$partial_list == ""} {
    foreach enz $enz_list {
      set part($enz) 1.0
    }
  } else {
    array set part $partial_list
  }
  set part(Start) 1.0
  set part(End) 1.0
  set part(uncut) 1.0
  set count 0
  #check here for overlapping identical or degenerate sites
  set i 1
  while {$i < [llength $templist]} {
   if {[lindex $templist [expr {$i-1}] 0] == [lindex $templist $i 0]} {
     set enz1 [lindex $templist [expr {$i-1}] 1]
     set enz2 [lindex $templist $i 1]
     set newname "$enz1 + $enz2"
     set templist [lreplace $templist [expr {$i-1}] $i [list [lindex $templist $i 0] $newname 0]]
     set part($newname) [expr 1.0 - ((1.0-$part($enz1)) * (1.0-$part($enz2)))]
   } else {
     incr i
   }
  }
  for {set i 0} {$i < [llength $templist]} {incr i} {
    for {set j2 [expr {$i +1}]} {$j2 < [expr {[llength $templist] +($circular ? (1+$i) : 0)}]} {incr j2} {
      set j [expr {$j2 % [llength $templist]}]
      if {$i==$j} {
        set perc [expr {$part([lindex [lindex $templist $j] 1])}]
      } else {
        set perc [expr {$part([lindex [lindex $templist $i] 1]) * $part([lindex [lindex $templist $j] 1])}]
      }
      for {set k2 [expr {$i+1}]} {$k2 < $j2} {incr k2} {
        set k [expr {$k2 % [llength $templist]}]
        set perc [expr {$perc* (1.00-$part([lindex [lindex $templist $k] 1]))}]
      }
      if {$perc > 0} {
        if {[expr {([lindex [lindex $templist $j] 0] - [lindex [lindex $templist $i] 0]) % $total_length}] > 0} {
          set mass_perc [expr {round(max(1,(100.0*$perc* (([lindex [lindex $templist $j] 0] - [lindex [lindex $templist $i] 0]) % $total_length) / $total_length)))}]
        } else {
          set mass_perc [expr {round(max(1,(100.0*$perc)))}]
        }
        set maxmassperc [expr {max($maxmassperc, $mass_perc)}]
        lappend fraglist [list [expr {(([lindex [lindex $templist $j] 0] - [lindex [lindex $templist $i] 0]) % $total_length)==0 ? $total_length : (([lindex [lindex $templist $j] 0] - [lindex [lindex $templist $i] 0]) % $total_length)}] [lindex [lindex $templist $i] 1] [lindex [lindex $templist $i] 0] [lindex [lindex $templist $j] 1] [lindex [lindex $templist $j] 0] $count $mass_perc [lindex [lindex $templist $i] 2] [lindex [lindex $templist $j] 2]]
        incr count
      }
    }
  }
  if {$circular && $region == "all"} {
    set perc 1.0
    foreach e $templist {
      set perc [expr {$perc * (1.00-$part([lindex $e 1])) }]
    }
    if {$perc > 0} {
      lappend fraglist [list  $total_length uncut 0 "" 0 $count [expr {round(100*$perc)}] 0 0]
        set maxmassperc [expr {max($maxmassperc, round(100*$perc))}]
    }
  }
  if {$fraglist == [list]} {
    lappend fraglist [list  $total_length uncut 0 "" 0 0 100 0 0]
  }
  # new digest routine
  set fraglist [lsort -integer -index 0 -decreasing $fraglist]
  return [list $fraglist $templist $start $end $maxmassperc]
}

#################
##
#################
proc digest_draw_digest_lane {a lane_info lane_num} {
global info

  if {!$info(android)} {
    set bandwidth 50
    set bandspacing 0.1
  } else {
    set bandwidth 100
    set bandspacing 0.4
  }
  #lane is list of {w enz_list region {partial_list ""}}
  foreach {w enz_list region partial_list} $lane_info {}
  #draw file info line
  set lane "lane$lane_num"
  set canvas $a.canvas
  set bandleft [expr {(1.0+$bandspacing)* $lane_num* $bandwidth}]
  $canvas create text 0 [expr {0}] -text "[wm title $w]" -anchor nw -font [list $info(graphicfontfamily) $info(graphicfontsize)] -fill $info(graphic_fg_color) -tags [list filename table text $lane]
  set textheight [expr {[lindex [$canvas bbox filename] 3] - [lindex [$canvas bbox filename] 1]}]

  #create dummy text to allow table coords and text properties to persist
  $canvas create text 0 [expr {$textheight}] -text "Dummy Text" -anchor nw -font [list $info(graphicfontfamily) $info(graphicfontsize)] -fill $info(graphic_fg_color) -tags [list dummy text] -state hidden

  set i 1
  #draw table header
  set colswidth [font measure [list $info(graphicfontfamily) $info(graphicfontsize)] "HindIII          "]
  set cols [list]
  for {set cw 0} {$cw < 6} {incr cw} {
    lappend cols [expr {$cw * $colswidth}]
  } 
  foreach ttext [list [mc "Size"] [mc "site1"] "" [mc "site2"] "" [mc "Mass %"]] tx $cols {
    $canvas create text $tx [expr {$i*$textheight}] -text $ttext -anchor nw -font [list $info(graphicfontfamily) $info(graphicfontsize)] -fill $info(graphic_fg_color) -tags [list table title text $lane]
  }
  incr i
  $canvas create line 0 [lindex [$canvas bbox title&&text] 3] [lindex [$canvas bbox title&&text] 2] [lindex [$canvas bbox title&&text] 3] -fill $info(graphic_fg_color) -tags [list table title line $lane]

  #draw lane label
  $canvas create text [expr {$bandleft+$bandwidth/2}] 30 -text [expr {1+$lane_num}] -anchor s -font [list $info(graphicfontfamily) $info(graphicfontsize)] -fill $info(graphic_fg_color) -tags [list infotext lanelabel]

  ##draw fragment items
  set fragnum 0
  set fragtexts [list]
  set datalist [digest_make_fraglist $w $enz_list $region $partial_list]

  foreach {fraglist templist start end maxmassperc} $datalist {}
  set textright [lindex [$canvas bbox title] 2]

  #draw map area tick marks
  foreach site $templist {
    $canvas create line [expr {$textright + 5}] [expr {30+ ([lindex $site 0]-$start)* 210 / ($end - $start)}] [expr {$textright + 15}] [expr {30+ ([lindex $site 0]-$start)* 210 / ($end - $start)}]  -fill $info(graphic_fg_color) -tags  "scalable map line $lane"
    $canvas create text [expr {$textright + 17}] [expr {30+ ([lindex $site 0]-$start)* 210 / ($end - $start)}] -anchor w -text "[lindex $site 0] [lindex $site 1]" -fill $info(graphic_fg_color) -tags "scalable map text $lane"
  }

  #draw map area fetaure lines
  set depthdict [tagdepth_features $w.textarea [bp2ix $w.textarea $start] [bp2ix $w.textarea $end]]
## use get_feature_exons_indexes
  foreach {name tag} [feature_find $w $start $end] {
    regsub "fn" $tag "f" tag
    if {[dict exists $depthdict $tag]} {
      set yplus [dict get $depthdict $tag]
    } else {
      set yplus 0
    }
    foreach {fstart fend} [$w.textarea tag ranges $tag] {
      if {$start < $end} {
        set fend [ix2bp $w.textarea $fend]
        if {$fend < $start} {continue}
        set fstart [ix2bp $w.textarea $fstart]
        if {$fstart > $end} {break}
        if {$fstart < $start} {set fstart $start}
        if {$fend > $end} {set fend $end}
        $canvas create line [expr {$textright  - 5* $yplus}] [expr {30+ ($fstart-$start)* 210 / ($end - $start)}] [expr {$textright  -5 * $yplus}] [expr {30+ ($fend-$start)* 210 / ($end - $start)}] -tags "scalable map feature $lane" -fill [lindex [$w.textarea tag bind $tag <<Revcolors>>] [lindex [$w.textarea tag bind $tag <<Metadata>>] 3]] -width 5
      } else {
        ## work here for around the origin
      }

    }
  }

  foreach fragment $fraglist {
    #draw table entry for the band
    foreach ttext [list [lindex $fragment 0] [lindex $fragment 1] [format %7d [lindex $fragment 2]] [lindex $fragment 3] [format %7d [lindex $fragment 4]] [format %5d [lindex $fragment 6]]] tx $cols   {
      $canvas create text $tx [expr {$i*$textheight}] -font [list $info(graphicfontfamily) $info(graphicfontsize)] -anchor nw -text $ttext -fill $info(graphic_fg_color) -tags [list table table_text frag$fragnum $lane action_item]
    }
    incr i

    #draw gel bands
    if {[lindex $fragment 0] > 0} {
      set band_gray [expr {round(max($info(gel_min_gray),(100.0*[lindex $fragment 6]/$maxmassperc)))}]
      set band_item [$canvas create line [expr {$bandleft}] 0 [expr {$bandleft+$bandwidth}] 0 -width 3 -capstyle round -activefill red -fill [mix_color $info(graphic_fg_color) $info(graphic_bg_color) $band_gray] -tags [list frag$fragnum band $lane scalable action_item]]
        $canvas bind $band_item <<Size>> [lindex $fragment 0]
        $canvas bind $band_item <<Gray_fill>> $band_gray
        $canvas bind $band_item <<Mass_perc>> [lindex $fragment 6]
    }



    #draw map area line highlight
    if {[lindex $fragment 2] < [lindex $fragment 4]} {
      $canvas create line [expr {$textright + 5}] [expr {30+ ([lindex $fragment 2]-$start)* 210 / ($end - $start)}] [expr {$textright + 5}] [expr {30+ ([lindex $fragment 4]-$start)* 210 / ($end - $start)}] -width 3 -fill $info(graphic_fg_color) -tags [list frag$fragnum map $lane scalable action_item]
    } else {
      #needs to deal with band button presses for circular fragments
      $canvas create line [expr {$textright + 5}] 30 [expr {$textright + 5}] [expr {30+ ([lindex $fragment 4]-$start)* 210 / ($end - $start)}] -width 3 -fill $info(graphic_fg_color) -tags  [list frag$fragnum map $lane scalable action_item]
      $canvas create line [expr {$textright + 5}] [expr {30+ ([lindex $fragment 2]-$start)* 210 / ($end - $start)}] [expr {$textright + 5}] 240 -width 3 -fill $info(graphic_fg_color) -tags  [list frag$fragnum map map_line2 $lane scalable action_item]
    }

    #set link to sequence bindings

    foreach item [$canvas find withtag $lane&&frag$fragnum] {
      #get top and bottom cut sites for each end (send enzyme_name, location, direction; get top and bottom cut locations)
      set cutsites_list1 [enz_cut_offset [lindex $fragment 1] [lindex $fragment 2] [lindex $fragment 7]]
      set cutsites_list2 [enz_cut_offset [lindex $fragment 3] [lindex $fragment 4] [lindex $fragment 8]]
      $canvas bind $item <<Link>> [list $w [expr {[lindex $cutsites_list1 0]-1}] [expr {[lindex $cutsites_list2 0]-1}] [expr {[lindex $cutsites_list1 1]-1}] [expr {[lindex $cutsites_list2 1]-1}] [lindex $fragment 1] [lindex $fragment 7] [lindex $fragment 3] [lindex $fragment 8]]

      lappend info($w,linked_events) [list $canvas $item "<<Link>>"]
    }
    if {[lindex $fragment 3] ne ""} {
      if {[llength $enz_list] > 1} {
        lappend fragtexts "[lindex $fragment 0]([lindex $fragment 1]-[lindex $fragment 3])"
      } else {
        lappend fragtexts "[lindex $fragment 0]"
      }
    } else {
      lappend fragtexts "[lindex $fragment 0]([lindex $fragment 1])"
    }
    incr fragnum
  }

  # create infotext item
  set info_text "[file root [wm title $w]] "

  if {[set pos [lsearch $enz_list "no_digest"]] > -1} {
    set enz_list [lreplace $enz_list $pos $pos]
  }
  if {($enz_list == [list])} {
    append info_text [mc "uncut"]
  } else {
    append info_text "[mc {digested with:}] "
    if {[llength $enz_list] <=3} {
      if {$partial_list != [list]} {
        array set part $partial_list
        set enz_text_list [list]
        foreach ea [lrange $enz_list 0 2] {
          lappend enz_text_list "$ea\([expr {int(100*$part($ea))}]%)"
        }
        append info_text "[join [lrange $enz_text_list 0 2] { + }]\n"
      } else {
        append info_text "[join [lrange $enz_list 0 2] { + }]\n"
      }
    } else {
        append info_text "[mc {>3 enzymes}]\n"
    }
    append info_text [join $fragtexts {, }] 
  } 

  if {$info(android)} {
    $canvas itemconfigure band -width 8
    $canvas itemconfigure feature -width 12
  }

  $canvas bind $lane <<Info>> [list info_text $info_text min_size [lindex [lindex $fraglist end] 0] max_size [lindex [lindex $fraglist 0] 0]]
  $canvas bind $lane <Any-Enter> "%W itemconfigure !band -state hidden ;%W itemconfigure $lane -state normal"
}




################
##
################
proc digest_draw_ladder {a ladder_name lane_num} {
  global info 
  ##draw ladder
  if {!$info(android)} {
    set bandwidth 50
    set bandspacing 0.1
    set bandheight 3
    set bandheightincr 1
  } else {
    set bandwidth 100
    set bandspacing 0.4
    set bandheight 9
    set bandheightincr 3
  }
  set canvas $a.canvas
  set dig_ladder $info(ladder,$ladder_name)
  if {$dig_ladder != [list]} {
    set lastladderband 0
    set lane "lane$lane_num"

    #draw dummy table header and map line
    set colswidth [font measure [list $info(graphicfontfamily) $info(graphicfontsize)] "HindIII          "]
    set cols [list]
    for {set cw 0} {$cw < 6} {incr cw} {
      lappend cols [expr {$cw * $colswidth}]
    } 
    foreach ttext [list [mc "Size"] [mc "site1"] "" [mc "site2"] "" [mc "Mass %"]] tx $cols {
      $canvas create text $tx [expr {0}] -text $ttext -anchor nw -font [list $info(graphicfontfamily) $info(graphicfontsize)] -fill $info(graphic_fg_color) -tags [list table title text delete $lane]
    }
    set textright [lindex [$canvas bbox title] 2]
    $canvas create line [expr {$textright + 5}] 30 [expr {$textright + 5}] 240 -width $bandheight -fill $info(graphic_fg_color) -tags [list delete map $lane scalable ]


    set bandleft [expr {(1.0+$bandspacing)* $lane_num* $bandwidth}]
    foreach band $dig_ladder {

      if {$lastladderband != $band} {
        #draw new band
        if {[lindex $band 0] > 0} {
          set last_band_item [$canvas create line [expr {$bandleft}] 0 [expr {$bandleft+$bandwidth}] 0 -width $bandheight -fill $info(graphic_fg_color) -capstyle round -activefill red -tags [list scalable band $lane]]
        }
        $canvas bind $last_band_item <<Size>> $band
        $canvas bind $last_band_item <<Gray_fill>> 100
        set lastladderband $band
      } else {
        #make last band wider
        $canvas itemconfigure $last_band_item -width [expr {[$canvas itemcget $last_band_item -width]+$bandheightincr}]
      }
    }
    $canvas create text [expr {int($bandleft+$bandwidth/2)}] 30 -text 1 -anchor s -font [list $info(graphicfontfamily) $info(graphicfontsize)] -fill $info(graphic_fg_color) -tags [list infotext lanelabel]

    set bandleft [expr {$bandleft + ($bandspacing+1) * $bandwidth}]

    set ladder_text "$ladder_name\n[mc Sizes:] [join [lsort -unique -integer $dig_ladder] {, }]"
    $canvas bind $lane <<Info>> [list info_text $ladder_text min_size [lindex $dig_ladder end] max_size [lindex $dig_ladder 0]]
 
  }
}

################
##
################
proc digest_manage_band_migration {a {gel_bottom 10}} {
  global info

  if {!$info(android)} {
    set bandwidth 50
    set bandspacing 0.1
  } else {
    set bandwidth 100
    set bandspacing 0.4
  }
  #find short and long fragments for the canvas
  set shortfrag 1000000
  set longfrag 0
  set canvas $a.canvas
  foreach band_item [$canvas find withtag band] {
    set size [$canvas bind $band_item <<Size>>]
    set shortfrag [expr {min($shortfrag,$size)}]
    set longfrag [expr {max($longfrag,$size)}]
  }
  if {$shortfrag < $gel_bottom} {
    set shortfrag $gel_bottom
  }

  if {$longfrag > $shortfrag} {
    set gelscale [expr {210.0/(log10($longfrag)- log10($shortfrag))}]
  } else {
    set gelscale 20
  }
  set gelorigin [expr {30.0 + $gelscale * log10($longfrag) }]
  foreach band [$canvas find withtag band] {
    set size [$canvas bind $band <<Size>>]
    $canvas move $band 0 [expr {-[lindex [$canvas coords $band] 1] + $gelorigin - $gelscale * log10($size)}]
  }

  bind $canvas <<Info>> [list min_size [expr {round(10**(($gelorigin - 240)/$gelscale))}] max_size [expr {round(10**(($gelorigin - 30)/$gelscale))}] band_spacing $bandspacing]
}


#############
## implement item linking and higlighting on digest windows
#############
proc enz_cut_offset {enz loc dir} {
  global enzinfo

  if {[info exists enzinfo(enz_cut_sites,$enz)] && [info exists enzinfo(flatpat,$enz)]} {
    if {$dir} {
      #reverse site
      return [list [expr {$loc + [string length $enzinfo(flatpat,$enz)]- [lindex $enzinfo(enz_cut_sites,$enz) 1]}]  [expr {$loc  + [string length $enzinfo(flatpat,$enz)] - [lindex $enzinfo(enz_cut_sites,$enz) 0]}]]
    } else {
      #forward site
      return [list [expr {$loc + [lindex $enzinfo(enz_cut_sites,$enz) 0]}]  [expr {$loc + [lindex $enzinfo(enz_cut_sites,$enz) 1]}]]
    }
  } else {
      return [list $loc $loc]
  }
}

#############
## implement item linking and higlighting on digest windows
#############
proc wrap_text {text font width} {

  set result_list [list]
  foreach line [split $text \n] {
    set newline ""
    foreach word [split $line " "] {
      if {($newline == "")} {
        set newline $word
      } elseif {([font measure $font "$newline $word"] < $width)} {
        set newline "$newline $word"
      } else {
        lappend result_list $newline
        set newline $word
      }
    }
    lappend result_list $newline
  }
  return [join $result_list \n]
}

#############
## implement item linking and higlighting on digest windows
#############
proc digest_action_item_manager {c event} {
  if {[set item [$c find withtag current]] == ""} {
    if {$event ne "return"} {
      return
    } else {
      set parent [bind $c <<Parent>>]
      wm deiconify $parent; raise $parent; focus $parent.textarea
    }
  }
  global info

  if {!$info(android)} {
    set bandheight 3
    set bandhighlightheight 5
    set bandheightincr 1
  } else {
    set bandheight 9
    set bandhighlightheight 15
    set bandheightincr 3
  }

  set tag_list [$c itemcget current -tags]
  set fragstring [lsearch -regexp -inline $tag_list {frag[0-9]+}]
  set lanestring [lsearch -regexp -inline $tag_list {lane[0-9]+}]
  if {(($fragstring == "") && ($event ne "delete")) || ($lanestring == "")} {return}
  switch $event {
    enter {
      $c itemconfigure $lanestring&&$fragstring&&map -fill red -width $bandhighlightheight
      #$c itemconfigure $lanestring&&$fragstring&&band -fill red -width $bandhighlightheight
      $c itemconfigure $lanestring&&$fragstring&&band -fill red
      $c itemconfigure $lanestring&&$fragstring&&table_text -fill red
      $c raise $fragstring 
    }
    leave {
      $c itemconfigure $lanestring&&$fragstring&&map -fill $info(graphic_fg_color) -width $bandheight
      if {[$c bind [$c find withtag $lanestring&&$fragstring&&band] <<Gray_fill>>] != ""} {
        $c itemconfigure $lanestring&&$fragstring&&band -fill [mix_color $info(graphic_fg_color) $info(graphic_bg_color) [$c bind [$c find withtag $lanestring&&$fragstring&&band] <<Gray_fill>>]] -width $bandheight    
      } else {
        $c itemconfigure $lanestring&&$fragstring&&band -fill $info(graphic_fg_color) -width $bandheight
      }
      $c itemconfigure $lanestring&&$fragstring&&table_text -fill $info(graphic_fg_color)
    }
    button-1 {
      set link_list [$c bind $item <<Link>>]
      if {[string first tk_messageBox $link_list] > -1} {return}
      foreach {w first last first_bottom last_bottom enz1 e1d enz2 e2d} $link_list {}
      if {$link_list == {}} {
      } else {
	send_data <<GelLaneClick>> $link_list
        if {$first < $last} {
          select_region $w [bp2ix $w.textarea $first] [bp2ix $w.textarea $last]
        } elseif {[$c find withtag current&&$lanestring&&map_line2] != ""} {
          select_region $w [bp2ix $w.textarea $first] [end_ix $w.textarea]
        } else {
          select_region $w 1.0 [bp2ix $w.textarea $last]
	}
      }
    }
    shift-button-1 {
      set link_list [$c bind $item <<Link>>]
      if {[string first tk_messageBox $link_list] > -1} {return}
      foreach {w first last first_bottom last_bottom enz1 e1d enz2 e2d} $link_list {}
      if {$link_list == {}} {
      } elseif {$first < $last} {
        select_region $w [bp2ix $w.textarea $first] [bp2ix $w.textarea $last]
      } elseif {[$c find withtag current&&$lanestring&&map_line2] != ""} {
        select_region $w 1.0 [bp2ix $w.textarea $last]
      } else {
        select_region $w [bp2ix $w.textarea $first] [end_ix $w.textarea]
      }
    }
    delete {
      if {[$c find withtag $lanestring] != ""} {
        global from_lane
        set from_lane $lanestring
        digest_move_lane $c [winfo pointerx .] [winfo pointery .] delete
      }
    }
    return {
      set link_list [$c bind $item <<Link>>]
      if {[string first tk_messageBox $link_list] > -1} {return}
      foreach {w first last first_bottom last_bottom enz1 e1d enz2 e2d} $link_list {}
      if {$link_list == {}} {
      } elseif {$first < $last} {
        select_region $w [bp2ix $w.textarea $first] [bp2ix $w.textarea $last]
      } elseif {[$c find withtag current&&$lanestring&&map_line2] != ""} {
        select_region $w [bp2ix $w.textarea $first] [end_ix $w.textarea]
      } else {
        select_region $w 1.0 [bp2ix $w.textarea $last]
      }
      wm deiconify $w; raise $w; focus $w.textarea
    }
  }
}

#############
## move a lane from one digest canvas to another
#############
proc digest_move_lane {from_canvas X Y {mode move}} {

  global from_lane current_band info
  
  set to_canvas ""
  if {[catch {set to_window [winfo toplevel [winfo containing $X $Y]]}]} {
    set to_window ""
  }

  if {[info exists current_band] && ((![winfo exists $to_window.canvas]) || ([[set to_canvas $to_window.canvas] coords dummy&&line] == "") || (![info exists from_lane]))} {
    event generate [winfo containing $X $Y] <<GelLaneDrop>> -data "canvas $from_canvas band $current_band" -x $X -y $Y
    unset -nocomplain from_lane current_band
    return
  }

  if {$to_canvas eq {}} {
    set to_canvas $from_canvas
  }

  if {($mode == "copy") || (($to_canvas != $from_canvas) && ($mode == "move"))} {
    #copy lane to the canvas
    set i 0
    while {([$to_canvas find withtag lane$i] != "") && ($i < 10000) } {incr i}
    set to_lane "lane$i"


    if {[$from_canvas find withtag table&&$from_lane] != ""} {
      #digest table items
      $to_canvas create text 0 0 -text [$from_canvas itemcget filename&&$from_lane -text] -anchor nw -font [$to_canvas itemcget dummy&&text -font] -fill $info(graphic_fg_color) -tags [list filename table text $to_lane]
      set textheight [expr {[lindex [$to_canvas bbox filename] 3] - [lindex [$to_canvas bbox filename] 1]}]
      set colswidth [font measure [$to_canvas itemcget dummy&&text -font] "HindIII          "]
      set cols [list]
      for {set cw 0} {$cw < 6} {incr cw} {
        lappend cols [expr {$cw * $colswidth}]
      } 

      #draw the table header
      foreach ttextitem [$from_canvas find withtag table&&title&&text&&$from_lane] tx $cols {
        $to_canvas create text $tx $textheight -text [$from_canvas itemcget $ttextitem -text] -anchor nw -font [$to_canvas itemcget dummy&&text -font] -fill $info(graphic_fg_color) -tags [list table title text $to_lane]
      }

      set textright [lindex [$to_canvas bbox title&&$to_lane] 2]
      $to_canvas create line 0  [lindex [$to_canvas bbox title&&$to_lane] 3] [lindex [$to_canvas bbox title&&$to_lane] 2] [lindex [$to_canvas bbox title&&$to_lane] 3]  -tags [list table title line $to_lane]

      set i 2
      set txi 0
      foreach table_item [lsort -integer [$from_canvas find withtag table_text&&$from_lane]] {
        if {[set fragnum [lsearch -regexp -inline [$from_canvas itemcget $table_item -tags] {frag[0-9]+}]] != ""} {
          set item [$to_canvas create text [lindex $cols $txi] [expr {$i*$textheight}] -font [$to_canvas itemcget dummy&&text -font] -anchor nw -text [$from_canvas itemcget $table_item -text] -fill $info(graphic_fg_color) -tags [list table table_text $fragnum $to_lane action_item]]
          $to_canvas bind $item <<Link>> [$from_canvas bind $table_item <<Link>>]
          incr txi
          if {$txi == 6} {
            incr i
            set txi 0
          }
        }
      }
    }
    if {[$from_canvas find withtag map&&line&&$from_lane] != ""} {
      #draw map area tick marks
      foreach {map_x map_min_y map_x2 map_max_y} [$to_canvas coords dummy&&line] {}
      foreach {from_map_x from_map_min_y from_map_x2 from_map_max_y} [$from_canvas coords dummy&&line] {}
      set mapscale [expr {1.0 * ($map_max_y - $map_min_y) / ($from_map_max_y - $from_map_min_y)}]
      foreach from_tic [$from_canvas find withtag map&&line&&$from_lane] {
        $to_canvas create line $map_x [set tic_y [expr {1.0 * $map_min_y + $mapscale * ([lindex [$from_canvas coords $from_tic] 1] - $from_map_min_y)}]] [expr {$map_x + 10}] $tic_y -fill $info(graphic_fg_color)  -tags  [list {*}[lsearch -all -inline -regexp -not [$from_canvas itemcget $from_tic -tags] {lane[0-9]+}] $to_lane]
        # text is next item 
        incr from_tic
        $to_canvas create text [expr {$map_x + 12}] $tic_y -anchor w -text [$from_canvas itemcget $from_tic -text] -fill $info(graphic_fg_color) -tags  [list {*}[lsearch -all -inline -regexp -not [$from_canvas itemcget $from_tic -tags] {lane[0-9]+}] $to_lane]
      }

      #draw map area fetaure lines
      foreach from_feature [$from_canvas find withtag map&&feature&&$from_lane] {
        $to_canvas create line [expr {$map_x + [lindex [$from_canvas coords $from_feature] 0] - $from_map_x}] [expr {1.0 * $map_min_y + $mapscale * ([lindex [$from_canvas coords $from_feature] 1] - $from_map_min_y)}] [expr {$map_x + [lindex [$from_canvas coords $from_feature] 0] - $from_map_x}] [expr {1.0 * $map_min_y + $mapscale * ([lindex [$from_canvas coords $from_feature] 3] - $from_map_min_y)}] -tags  [list {*}[lsearch -all -inline -regexp -not [$from_canvas itemcget $from_feature -tags] {lane[0-9]+}] $to_lane] -fill [$from_canvas itemcget $from_feature -fill]  -width [$from_canvas itemcget $from_feature -width]
      } 

      #draw map area fragment lines
      foreach from_map_line [$from_canvas find withtag map&&action_item&&$from_lane] {
        set item [$to_canvas create line $map_x [expr {1.0 * $map_min_y + $mapscale * ([lindex [$from_canvas coords $from_map_line] 1] - $from_map_min_y)}] $map_x [expr {1.0 * $map_min_y + $mapscale * ([lindex [$from_canvas coords $from_map_line] 3] - $from_map_min_y)}]  -width 3 -tags [list {*}[lsearch -all -inline -regexp -not [$from_canvas itemcget $from_map_line -tags] {lane[0-9]+}] $to_lane]]
        $to_canvas bind $item <<Link>> [$from_canvas bind $from_map_line <<Link>>]
      }
    }

    #draw bands
    foreach {map_x map_min_y map_x2 map_max_y} [$to_canvas coords dummy&&line] {}
    #foreach {band_x band_min_y band_x2 band_max_y} [$to_canvas bbox band] {}

    set band_max_y 0 
    set band_min_y 100000000
    foreach b [$to_canvas find withtag band] {
      set band_max_y [expr {max($band_max_y, [lindex [$to_canvas coords $b] 1])}] 
      set band_min_y [expr {min($band_min_y, [lindex [$to_canvas coords $b] 1])}] 
    }

    set to_info_dict [bind $to_canvas <<Info>>]
    set to_long_frag [dict get $to_info_dict max_size]
    set to_short_frag [dict get $to_info_dict min_size]
    #set to_gelscale [expr {1.0* ($map_max_y - $map_min_y)/(log10($to_long_frag)- log10($to_short_frag))}]
    set to_gelscale [expr {1.0* ($band_max_y - $band_min_y)/(log10($to_long_frag)- log10($to_short_frag))}]
    #set to_gelorigin [expr {1.0* $map_min_y + $to_gelscale * log10($to_long_frag) }]
    set to_gelorigin [expr {1.0* $map_min_y + $to_gelscale * log10($to_long_frag) }]
#sputs here [$to_canvas coords dummy&&line] [$to_canvas bbox band] $band_y_max $band_y_min $to_gelscale $to_gelorigin [expr {30.0 + $to_gelscale * log10($to_long_frag) }]
    if {[winfo exists $to_canvas]} {
      foreach {band_x1 band_y band_x2 band_y2} [$to_canvas coords band] {}
      set bandwidth [expr {$band_x2 - $band_x1}]
    } else {

    }
    if {[dict exists $to_info_dict band_spacing]} {
      set band_spacing [dict get $to_info_dict band_spacing]
    } else {
      set band_spacing 0
    }
    set new_band_x1 [expr {[lindex [$to_canvas bbox band] 2] + $band_spacing * $bandwidth }]
    set new_longfrag $to_long_frag
    set new_shortfrag $to_short_frag
    foreach from_band [$from_canvas find withtag band&&$from_lane] {
      set band_size [$from_canvas bind $from_band <<Size>>]
      set band_gray [$from_canvas bind $from_band <<Gray_fill>>]
      if {$band_gray == ""} {set band_gray 100}
      set new_band [$to_canvas create line $new_band_x1 [expr {$to_gelorigin - $to_gelscale * log10($band_size)}] [expr {$new_band_x1 + $bandwidth}] [expr {$to_gelorigin - $to_gelscale *log10($band_size)}] -width [$from_canvas itemcget $from_band -width] -capstyle round -activefill red -fill [mix_color $info(graphic_fg_color) $info(graphic_bg_color) $band_gray] -tags [list {*}[lsearch -all -inline -regexp -not [$from_canvas itemcget $from_band -tags] {lane[0-9]+}] $to_lane]]
      set new_longfrag [expr {max ($new_longfrag, $band_size) }]
      set new_shortfrag [expr {min ($new_shortfrag, $band_size) }]
      $to_canvas bind $new_band <<Size>> $band_size
      $to_canvas bind $new_band <<Gray_fill>> $band_gray
      $to_canvas bind $new_band <<Mass_perc>> [$from_canvas bind $from_band <<Mass_perc>>]
      $to_canvas bind $new_band <<Link>> [$from_canvas bind $from_band <<Link>>]
    }

    #move band items to the right of the new map texts and down to the same y position as the old band items had
    if {[$to_canvas find withtag map] != ""} {
      $to_canvas itemconfigure map -state normal
      $to_canvas move band [expr {[lindex [$to_canvas bbox map] 2] - [lindex [$to_canvas bbox band] 0]}] [expr {($to_gelorigin - $to_gelscale * log10($to_long_frag)) - ($to_gelorigin - $to_gelscale * log10($new_longfrag))}]
    } else {
      $to_canvas move band [expr {[lindex [$to_canvas bbox infotext&&text] 2] - [lindex [$to_canvas bbox band] 0]}] [expr {($to_gelorigin - $to_gelscale * log10($to_long_frag)) - ($to_gelorigin - $to_gelscale * log10($new_longfrag))}]
    }

    #scale bands to the same total height as old band items
    $to_canvas scale band 0 [expr {($to_gelorigin - $to_gelscale * log10($to_long_frag))}] 1.0 [expr {(log10($to_short_frag) - log10($to_long_frag)) / (log10($new_shortfrag) - log10($new_longfrag)) }]

    $to_canvas bind $to_lane <<Info>> [$from_canvas bind $from_lane <<Info>>]
    $to_canvas bind $to_lane <Any-Enter> [regsub -all $from_lane [$from_canvas bind $from_lane <Any-Enter>] $to_lane]
    dict set to_info_dict max_size $new_longfrag
    dict set to_info_dict min_size $new_shortfrag
    bind $to_canvas <<Info>> $to_info_dict

    $to_canvas configure -scrollregion [$to_canvas bbox all]
    set a [winfo toplevel $to_canvas]
    foreach {x0 y0 x1 y1} [$to_canvas bbox all] {}
    wm geometry $a [expr {max (min($x1 - $x0 + 25, ([winfo vrootwidth $a]-100)), [winfo width $a] )}]x[winfo height $a]
    $to_canvas dtag current current
    $from_canvas dtag current current
    $to_canvas itemconfigure !band -state hidden ; $to_canvas itemconfigure infotext -state normal
    set to_lane_old_x [lindex [$to_canvas coords [lindex [$to_canvas find withtag $to_lane&&band] 0]] 0] 
  } else {
    #make the to_lane == $from_lane- move the lane only
    set to_lane $from_lane
    set to_lane_old_x [lindex [$from_canvas coords [lindex [$from_canvas find withtag $from_lane&&band] 0]] 0] 
    set to_info_dict [bind $to_canvas <<Info>>]
    if {[dict exists $to_info_dict band_spacing]} {
      set band_spacing [dict get $to_info_dict band_spacing]
    } else {
      set band_spacing 0
    }
    if {[winfo exists $to_canvas]} {
      foreach {band_x1 band_y band_x2 band_y2} [$to_canvas coords band] {}
      set bandwidth [expr {$band_x2 - $band_x1}]

      ## move to_lane bands into proper x position 
      set to_canvasx [expr {$X - [winfo rootx $to_canvas] + [$to_canvas canvasx 0]}]
      set to_canvasy [expr {$Y - [winfo rooty $to_canvas] + [$to_canvas canvasy 0]}]

      #move all bands right of the location moving band is coming from one space left
      foreach band [$to_canvas find withtag band] {
        set lane [lsearch -regexp -inline [$to_canvas gettags $band] {lane[0-9+]}]
        if {($lane != $to_lane) && ([lindex [$to_canvas coords $band] 0] > $to_lane_old_x)} {
          $to_canvas move $band [expr {(1.0 + $band_spacing) * -$bandwidth }] 0
        }
      }
    }
  }


  if {$mode != "delete"} {
    #move all bands right of the location moving band is going to one space right
    set all_x [list]
    set right_x [list]
    foreach band [$to_canvas find withtag band] {
      set lane [lsearch -regexp -inline [$to_canvas gettags $band] {lane[0-9+]}]
      if {($lane != $to_lane)} {
        lappend all_x [lindex [$to_canvas coords $band] 0] 
        if {![info exists to_canvasx]} {
          set to_canvasx [expr {$X - [winfo rootx $to_canvas] + [$to_canvas canvasx 0]}]
        }
        if {([lindex [$to_canvas coords $band] 2] > $to_canvasx)} {
          lappend right_x [lindex [$to_canvas coords $band] 0]
          $to_canvas move $band [expr {(1.0+$band_spacing) * $bandwidth }] 0
        }
      }
    }
    # move the band from where it is to where its going
    if {$right_x != [list]} {
      set dest_x [lindex [lsort -real $right_x] 0]
      $to_canvas move band&&$to_lane [expr {$dest_x - $to_lane_old_x}] 0
    } elseif {$all_x != [list]} {
        set dest_x [lindex [lsort -real $all_x] end]
        $to_canvas move band&&$to_lane [expr {$dest_x - $to_lane_old_x+(1.0+$band_spacing) * $bandwidth }] 0
    }
  } else {
    #delete to_lane
    $to_canvas delete $to_lane
    catch {destroy .bandtooltip}
    if {[$to_canvas find withtag map] != ""} {
      $to_canvas itemconfigure map -state normal
      $to_canvas move band [expr {[lindex [$to_canvas bbox map] 2] - [lindex [$to_canvas bbox band] 0]}] 0
    } elseif {[$to_canvas find withtag band] != ""} {
      $to_canvas itemconfigure infotext&&text -state normal
      $to_canvas move band [expr {[lindex [$to_canvas bbox infotext&&text] 2] - [lindex [$to_canvas bbox band] 0]}] 0
    } else {
      closewindow [winfo toplevel $to_canvas]
      unset -nocomplain from_lane current_band
      return
    }
  }

  set bandinfo [list]
  foreach band [$to_canvas find withtag band] {
    lappend bandinfo [list [lsearch -regexp -inline [$to_canvas gettags $band] {lane[0-9+]}] [lindex [$to_canvas coords $band] 0]]
  }
  set bandinfo [lsort -unique -real -index 1 $bandinfo]
  set infotext [list]
  set lanenum 1
  foreach band $bandinfo lanelabel [$to_canvas find withtag infotext&&lanelabel] {
    if {$band != ""} {
      lappend infotext "[mc {Lane %1$s:} $lanenum] [dict get [$to_canvas bind [lindex $band 0] <<Info>>] info_text]"
      if {$lanelabel == ""} {
        $to_canvas create text [expr {[lindex $band 1]+$bandwidth/2}] 30  -anchor s -font [list $info(graphicfontfamily) $info(graphicfontsize)] -fill $info(graphic_fg_color) -text $lanenum -anchor s -tags [list infotext lanelabel]
      } else {
        $to_canvas coords $lanelabel [expr {[lindex $band 1]+$bandwidth/2}] 30
        $to_canvas itemconfigure $lanelabel -text $lanenum
      }
    } else {
      $to_canvas delete $lanelabel
    }
    incr lanenum
  }
  catch {$to_canvas itemconfigure infotext&&text -text [wrap_text [join $infotext "\n\n"] [$to_canvas itemcget infotext&&text -font] [$to_canvas itemcget infotext&&text -width]]}
  digest_color_bands $to_window
  unset -nocomplain from_lane current_band
}

#############
## bindings to implement a canvas drag and drop
#############
proc digest_peel_bands {c x y} {
  global tooltip_x tooltip_y from_lane current_band info
  if {[winfo exists .w_tooltip]} {
    wm geometry .w_tooltip +[expr {$x-$tooltip_x}]+[expr {$y-$tooltip_y}]
    if {[winfo containing $x $y] == $c} {
     # $c configure -cursor copyarrow
    } else {
     # $c configure -cursor {}
    }
  } elseif {![info exists tooltip_x]} {
    set tooltip_x $x
    set tooltip_y $y
  } elseif {([expr {abs($x - $tooltip_x)}] > 3) || ([expr {abs($y - $tooltip_y)}] > 3)} {
    if {[set from_lane [lsearch -regexp -inline [$c itemcget current -tags] {lane[0-9]+}]] == ""} {return}
    set current_band [$c find withtag current]

    toplevel .w_tooltip -borderwidth 1 -background $info(graphic_fg_color)
    if {([tk windowingsystem] == "aqua")} {
     # tk::unsupported::MacWindowStyle style .w_tooltip help {noActivates noUpdates}
      tk::unsupported::MacWindowStyle style .w_tooltip help {}; after 40 raise .w_tooltip
    } else { 
      wm overrideredirect .w_tooltip 1
    }
    catch {wm attributes .w_tooltip -alpha .4}
    pack [canvas .w_tooltip.c]
    foreach band [$c find withtag band&&$from_lane] {
      .w_tooltip.c create line {*}[$c coords $band] -width 3
    }
    .w_tooltip.c configure -scrollregion [$c bbox band&&$from_lane] -width [expr {[lindex [$c bbox band&&$from_lane] 2] - [lindex [$c bbox band&&$from_lane] 0]}] -height [expr {[lindex [$c bbox band&&$from_lane] 3] - [lindex [$c bbox band&&$from_lane] 1]}] 
    set tooltip_x [expr {round($x - [winfo rootx $c] + [$c canvasx 0] - [lindex [$c bbox band&&$from_lane] 0])}]
    set tooltip_y [expr {round($y -  [winfo rooty $c] + [$c canvasy 0]- [lindex [$c bbox band&&$from_lane] 1])}]
    wm geometry .w_tooltip +[expr {$x-$tooltip_x}]+[expr {$y-$tooltip_y}]
  }
}


#############
## recolor bands to represent the total mass percent of all overlapping bands
#############
proc digest_color_bands {a} {
  global info
  set halo 1
  set canvas $a.canvas
  foreach b [$canvas find withtag band] {
    set mp [$canvas bind $b <<Mass_perc>>]
    if {$mp != ""} {
      set lane [lsearch -regexp -inline [$canvas itemcget $b -tags] {lane[0-9]+}]
      set lanearr($b) $lane
      foreach {x0 y0 x1 y1} [$canvas coords $b] {}
      set effmassperc($b) 0
      foreach b2 [$canvas find overlapping [expr {($x0+$x1)/2}] [expr {$y0-$halo}] [expr {($x0+$x1)/2}] [expr {$y0+$halo}]] {
        if {[$canvas bind $b2 <<Mass_perc>>] ne ""} {
          set effmassperc($b) [expr {$effmassperc($b) + [$canvas bind $b2 <<Mass_perc>>]}]
        }
      }
      if {![info exists maxmasperc($lane)]} {
        set maxmasperc($lane) $effmassperc($b)
      } else {
        set maxmasperc($lane) [expr {max($effmassperc($b), $maxmasperc($lane))}]
      }
    }
  }
  foreach b [array names effmassperc] {
    set gray_fill [expr {round(max($info(gel_min_gray),(100.0* $effmassperc($b)/ $maxmasperc($lanearr($b)) )))}]
    $canvas itemconfigure $b -fill [mix_color $info(graphic_fg_color) $info(graphic_bg_color) $gray_fill]
    $canvas bind $b <<Gray_fill>> $gray_fill
  }
}


#############
## bindings to implement a canvas drag and drop
#############
proc drag_canvas {} {
#####under_construction
set c .dna_window1_analysis0.t
bind $c <Button-1> {toplevel .w_tooltip -borderwidth 1 -background black; if {([tk windowingsystem] == "aqua")} {tk::unsupported::MacWindowStyle style .w_tooltip help {noActivates noUpdates}} else { wm overrideredirect .w_tooltip 1}; catch {wm attributes .w_tooltip -alpha .4}; wm geometry .w_tooltip +%X+%Y; grid [canvas .w_tooltip.c]}
bind $c <B1-Motion> "wm geometry .w_tooltip +%X+%Y"
bind $c <ButtonRelease-1> {destroy .w_tooltip; if {[winfo containing %X %Y] != ""} {sputs [winfo toplevel [winfo containing %X %Y]]}}


#listbox bindings
toplevel .t
grid [set l [listbox .t.l]]
.t.l insert end aaa
.t.l insert end bbb
.t.l insert end ccc
.t.l insert end ddd
bind $l <B1-Motion> {if {![info exists listmove]} {set listmove [.t.l index @%x,%y]; toplevel .w_tooltip -borderwidth 1 -background black; if {([tk windowingsystem] == "aqua")} {tk::unsupported::MacWindowStyle style .w_tooltip help {noActivates noUpdates}} else { wm overrideredirect .w_tooltip 1}; wm attributes .w_tooltip -alpha .4; wm geometry .w_tooltip +%X+%Y; grid [label .w_tooltip.l -text [.t.l get $listmove]]} else {wm geometry .w_tooltip +%X+%Y}}
bind $l <ButtonRelease-1> {if {[info exists listmove]} {destroy .w_tooltip; if {[winfo containing %X %Y] == ".t.l"} {if {[.t.l index @%x,%y] <= $listmove} {.t.l insert @%x,%y [.t.l get $listmove]; incr listmove ; .t.l delete $listmove} else {.t.l insert [expr {[.t.l index @%x,%y] +1}] [.t.l get $listmove] ; .t.l delete $listmove}}; unset listmove}}



}

### treeview drag and drop moves
#bind $t <B1-Motion> "treeview_move $t %x %y"
proc treeview_move {t x y} {
  global listmove

  if {(![info exists listmove])} {
    set g [$t identify row $x $y]
    if {$g == {} || ([lsearch [$t children {}] $g] == -1) } return
    set listmove $g
    toplevel .w_tooltip -borderwidth 1 -background black
    if {([tk windowingsystem] == "aqua")} {
      tk::unsupported::MacWindowStyle style .w_tooltip help {}; after 40 "catch {raise .w_tooltip}"
    } else {
      wm overrideredirect .w_tooltip 1
    }
    wm attributes .w_tooltip -alpha .4
    wm geometry .w_tooltip +[expr {[winfo rootx $t]+$x}]+[expr {[winfo rooty $t]+$y}]
    grid [label .w_tooltip.l -text [$t item $g -text]] -row 0 -column 0 -sticky nswe
  } else {
    wm geometry .w_tooltip +[expr {[winfo rootx $t]+$x}]+[expr {[winfo rooty $t]+$y}]
    if {$y < 0} {
      $t yview scroll -1 unit
    } elseif {$y > [winfo height $t]} {
      $t yview scroll 1 unit
    }
  }
}

#bind $t <ButtonRelease-1> "treeview_release $t %x %y"
proc treeview_release {t x y} {
  global listmove
  if {[info exists listmove]} {
    destroy .w_tooltip
    if {[set g [$t identify row $x $y]] != {}} {
      while {[$t parent $g] != {}} {
        set g [$t parent $g]
      }
      $t move $listmove {} [lsearch [$t children {}] $g]
    }
    unset listmove
  }
}

#############
##
#############
proc enz_text_map {w {dialog 1}} {
  #dialog 0 is no dialog, dialog -1 is no dialog+ print
  global info
  global enzymes
  global ok
  global modifier
  global modstring
  global analyze_selection dialogblock


  if {$info(enz_text_width) == ""} {set info(enz_text_width) 100}

##open configuration dialog
  if {$dialog==1} {
    if {$dialogblock == 1} {return}
      set dialog [new_dialog $w "Text Map..." "MAP"]
      bind $dialog <<Cancel>> "set ok -1"
      bind $dialog <<OK>> "set ok 1"
    set i 0

    foreach frame $info(enz_text_dialog_order) {
      switch $frame {
        enzymes {
          grid [labelframe $dialog.enzymes -relief ridge -borderwidth 3 -text [mc "Enzymes"]] -row $i -column 0  -sticky nwe
          set show_variable "enz_text_show_enz"
          grid [radiobutton $dialog.enzymes.allenz -text [mc "All"] -value "all" -variable info(enz_text_enz) -selectcolor white -activebackground $info(bg_color)] -row 1 -column 0 -sticky w
          grid [radiobutton $dialog.enzymes.selenz -text [mc "Selected Enzymes Only"] -value "selected" -variable info(enz_text_enz) -selectcolor white -activebackground $info(bg_color)] -row 1 -column 1 -sticky w
          grid columnconfigure $dialog.enzymes 1 -weight 1 -pad 0
        }

        space {
          grid [labelframe $dialog.space -relief ridge -borderwidth 3 -text [mc "Space"]] -row $i -column 0  -sticky nwe
          set show_variable "enz_text_show_space"
          grid [label $dialog.space.numlabel -text [mc "Lines:"]] -row 1 -column 0 -sticky w
          grid [ttk::spinbox $dialog.space.num -width 4 -textvariable info(enz_text_space) -from 1 -to 7 -validate key -validatecommand "check_char %S"] -row 1 -column 1 -sticky w
          grid columnconfigure $dialog.space 1 -weight 1 -pad 0
        }

        dna {
          set analyze_selection $info(analyze_selection)
          grid [labelframe $dialog.dna -relief ridge -borderwidth 3 -text [mc "DNA"] -font labelfont] -row $i -column 0  -sticky nwe
          grid [frame $dialog.dna.showframe -relief flat] -row 0 -column 0 -columnspan 2 -sticky w
          grid [radiobutton $dialog.dna.showframe.selall -text [mc "All"] -value "all" -variable analyze_selection -selectcolor white -activebackground $info(bg_color)] -row 0 -column 2 -sticky w
          grid [radiobutton $dialog.dna.showframe.selonly -text [mc "Selected DNA only"] -value "selection" -variable analyze_selection -selectcolor white -activebackground $info(bg_color)] -row 0 -column 3 -sticky w
          grid [checkbutton $dialog.dna.copyhighlight -text [mc "Copy Highlighting"] -onvalue 1 -offvalue 0 -variable info(enz_text_copy_highlight) -selectcolor white -activebackground $info(bg_color)] -row 1 -column 0 -sticky w
          grid [frame $dialog.dna.lineframe -relief flat] -row 2 -column 0 -columnspan 2
          grid [label $dialog.dna.lineframe.widthlabel -text [mc "Characters/line:"]] -row 0 -column 0 -sticky w
          grid [ttk::spinbox $dialog.dna.lineframe.width -width 4 -textvariable info(enz_text_width) -from 10 -to 5000 -validate key -validatecommand "check_char %S"] -row 0 -column 1 -sticky w
          grid [label $dialog.dna.lineframe.numberslabel -text [mc "Line Numbers:"]] -row 0 -column 2 -sticky e
          #need line #s on left for alignlink to work, but not for alignlink2
          set line_num_menu [tk_optionMenu $dialog.dna.lineframe.numbers info(enz_text_dna_numbers) None Left Right Both]
          #set line_num_menu [tk_optionMenu $dialog.dna.lineframe.numbers info(enz_text_dna_numbers) Left Both]
          grid $dialog.dna.lineframe.numbers -row 0 -column 3 -sticky e
          grid columnconfigure $dialog.dna.lineframe 2 -weight 1 -pad 0
          #grid columnconfigure $dialog.dna 0 -weight 1 -pad 0
          #grid columnconfigure $dialog.dna 1 -weight 1 -pad 0
          grid columnconfigure $dialog.dna 2 -weight 1 -pad 0
        }

        sec_strand {
          grid [labelframe $dialog.sec_strand -relief ridge -borderwidth 3 -text [mc "2nd Strand"]] -row $i -column 0 -sticky nwe
          set show_variable "enz_text_2nd"
          grid columnconfigure $dialog.sec_strand 0 -weight 1 -pad 0
        }

        translation {
          grid [labelframe $dialog.translation -relief ridge -borderwidth 3 -text [mc "Translation"]] -row $i -column 0  -sticky nwe
          set show_variable "enz_text_show_trans"
          grid [radiobutton $dialog.translation.11 -text [mc "1 frame 1 letter"] -value "1_1" -variable info(enz_text_trans) -selectcolor white -activebackground $info(bg_color)] -row 1 -column 1 -sticky w
          grid [radiobutton $dialog.translation.31 -text [mc "3 frame 1 letter"] -value "3_1" -variable info(enz_text_trans) -selectcolor white -activebackground $info(bg_color)] -row 1 -column 2 -sticky w
          grid [radiobutton $dialog.translation.61 -text [mc "6 frame 1 letter"] -value "6_1" -variable info(enz_text_trans) -selectcolor white -activebackground $info(bg_color)] -row 1 -column 3 -sticky w
          grid [radiobutton $dialog.translation.13 -text [mc "1 frame 3 letter"] -value "1_3" -variable info(enz_text_trans) -selectcolor white -activebackground $info(bg_color)] -row 2 -column 1 -sticky w
          grid [radiobutton $dialog.translation.33 -text [mc "3 frame 3 letter"] -value "3_3" -variable info(enz_text_trans) -selectcolor white -activebackground $info(bg_color)] -row 2 -column 2 -sticky w
          grid [radiobutton $dialog.translation.63 -text [mc "6 frame 3 letter"] -value "6_3" -variable info(enz_text_trans) -selectcolor white -activebackground $info(bg_color)] -row 2 -column 3 -sticky w
          grid columnconfigure $dialog.translation 0 -weight 1 -pad 0
        }

        graphic_map {
          grid [labelframe $dialog.graphic_map -relief ridge -borderwidth 3 -text [mc "Graphic Map"]] -row $i -column 0 -sticky nwe
          set show_variable "enz_text_graphic_map"
          grid columnconfigure $dialog.graphic_map 0 -weight 1 -pad 0
        }

        genes {
          grid [labelframe $dialog.genes -relief ridge -borderwidth 3 -text [mc "Uppercase as Genes"]] -row $i -column 0 -sticky nwe
          set show_variable "enz_text_genes"
          grid columnconfigure $dialog.genes 0 -weight 1 -pad 0
        }

        index {
          grid [labelframe $dialog.index -relief ridge -borderwidth 3 -text [mc "Index Line"]] -row $i -column 0  -sticky nwe
          set show_variable "enz_text_show_index"
          if {[tk windowingsystem] == "aqua"} {
            set char1_menu [tk_optionMenu $dialog.index.char1 info(enz_text_index_char1) " " "+" "*" ":" "|" "." "^" "\b-"]
          } else {
            set char1_menu [tk_optionMenu $dialog.index.char1 info(enz_text_index_char1) " " "+" "*" ":" "|" "." "^" "-"]
          }
          grid $dialog.index.char1 -row 1 -column 0 -sticky w
          #grid [entry $dialog.index.char1 -width 1  -textvariable info(enz_text_index_char1)] -row 1 -column 0 -sticky w
          grid [label $dialog.index.l1a -text [mc "character every"]] -row 1 -column 1 -sticky w
          grid [ttk::spinbox $dialog.index.spacing1 -width 3  -textvariable info(enz_text_index_spacing1) -from 0 -to 5000 -validate key -validatecommand "check_char %S"] -row 1 -column 2 -sticky w
          grid [label $dialog.index.l1b -text [mc "bases."]] -row 1 -column 3 -sticky w
          grid [checkbutton $dialog.index.nums -text [mc "Numbers"]  -onvalue 1 -offvalue 0 -variable info(enz_text_index_nums) -selectcolor white -activebackground $info(bg_color)] -row 1 -column 4 -sticky w

          if {[tk windowingsystem] == "aqua"} {
            set char2_menu [tk_optionMenu $dialog.index.char2 info(enz_text_index_char2) " " "+" "*" ":" "|" "." "^" "\b-"]
          } else {
            set char2_menu [tk_optionMenu $dialog.index.char2 info(enz_text_index_char2) " " "+" "*" ":" "|" "." "^" "-"]
          }
          grid $dialog.index.char2 -row 2 -column 0 -sticky w
          #grid [entry $dialog.index.char2 -width 1  -textvariable info(enz_text_index_char2)] -row 2 -column 0 -sticky w
          grid [label $dialog.index.l2a -text [mc "character every"]] -row 2 -column 1 -sticky w
          grid [ttk::spinbox $dialog.index.spacing2 -width 3  -textvariable info(enz_text_index_spacing2) -from 0 -to 5000 -validate key -validatecommand "check_char %S"] -row 2 -column 2 -sticky w
          grid [label $dialog.index.l2b -text [mc "bases."]] -row 2 -column 3 -sticky w
          #set char3_menu [tk_optionMenu $dialog.index.char3 info(enz_text_index_char3) " " "+" "*" ":" "|" "." "^" " -"]
          #grid $dialog.index.char3 -row 3 -column 0 -sticky w
          ##grid [entry $dialog.index.char3 -width 1  -textvariable info(enz_text_index_char3)] -row 3 -column 0 -sticky w
          #grid [label $dialog.index.l3a -text [mc "character every base."]] -row 3 -column 1 -columnspan 2 -sticky w
          grid columnconfigure $dialog.index 4 -weight 1 -pad 0
        }

        features {
          grid [labelframe $dialog.features -relief ridge -borderwidth 3 -text [mc "Features"]] -row $i -column 0  -sticky nwe
          set show_variable "enz_text_show_features"
          grid [checkbutton $dialog.features.crop -text [mc "Crop Labels to Sequence Width"]  -onvalue 1 -offvalue 0 -variable info(enz_text_crop_features) -selectcolor white -activebackground $info(bg_color)] -row 1 -column 1 -sticky w
          grid [checkbutton $dialog.features.showhidden -text [mc "Show Hidden Features"]  -onvalue 1 -offvalue 0 -variable info(enz_text_show_hidden_features) -selectcolor white -activebackground $info(bg_color)] -row 1 -column 2 -sticky w
          grid columnconfigure $dialog.features 1 -weight 1 -pad 0
        }
        default {
          set del_index [lsearch -exact $info(enz_text_dialog_order) $frame]
          sputs deleting invalid text map frame:$frame
          set info(enz_text_dialog_order) [lreplace $info(enz_text_dialog_order) $del_index $del_index]
        }
      }
      if {($frame != "dna") && [winfo exists $dialog.$frame] } {
        $dialog.$frame configure -fg [expr {$info($show_variable)?$info(label_fg_color):"gray35"}] -font labelfont -bd 3
        foreach e [winfo children $dialog.$frame] {
          catch {$e configure -state [expr {$info($show_variable)?"normal":"disabled"}]}
          catch {$e state [expr {$info($show_variable)?"!disabled":"disabled"}]}
        }
        grid [frame $dialog.$frame.showframe -relief flat] -row 0 -column 0 -columnspan 2 -sticky w
        grid [checkbutton $dialog.$frame.showframe.check1 -text [mc "Show"] -onvalue 1 -offvalue 0 -variable info($show_variable) -selectcolor white -activebackground $info(bg_color)] -row 0 -column 2 -sticky w
        $dialog.$frame.showframe.check1 configure -command "
          $dialog.$frame configure -fg \[expr {\$info($show_variable)?\"black\":\"gray35\"}\]
          foreach e \[winfo children $dialog.$frame\] {
            if {\$e != \"$dialog.$frame.showframe.check1\"} {
              catch {\$e configure -state \[expr {\$info($show_variable)?\"normal\":\"disabled\"}\]}
              catch {\$e state \[expr {\$info($show_variable)?\"!disabled\":\"disabled\"}\]}
            }
          }"
      }
      incr i

bind $dialog.$frame <B1-Motion> "if {!\[info exists listmove\]} {set listmove $dialog.$frame; toplevel .w_tooltip -borderwidth 1 -background black; if {(\[tk windowingsystem\] == \"aqua\")} {tk::unsupported::MacWindowStyle style .w_tooltip help {noActivates noUpdates}; after 40 raise .w_tooltip} else { wm overrideredirect .w_tooltip 1}; catch {wm attributes .w_tooltip -alpha .4}; wm geometry .w_tooltip +%X+%Y; grid \[label .w_tooltip.l -text \[$dialog.$frame cget -text\]\]} else {wm geometry .w_tooltip +%X+%Y}"
bind $dialog.$frame <ButtonRelease-1> {if {[winfo exists .w_tooltip]} {destroy .w_tooltip}; if {[info exists listmove]} {text_map_frame_drag $listmove %X %Y;unset listmove}}
    }

    if {!$info(android)} {
      grid [frame $dialog.okframe -relief flat -borderwidth 1] -row $i -column 0  -sticky nwe
      #grid [button $dialog.okframe.raise_dialog -command text_map_dialog_frame_listbox -text [mc "Stacking Order"]] -padx 10 -row 1 -column 0 -sticky n -pady 3 
      grid [label $dialog.okframe.raise_instr -text [mc "Drag frames to set the display order"]] -row 0 -column 0 -sticky n -columnspan 3
      grid [button $dialog.okframe.cancel -command {set ok -1} -text [mc "Cancel"]] -padx 10  -pady 3 -row 1 -column 1 -sticky n
      grid [button $dialog.okframe.ok -command {set ok 1} -text [mc "OK"]  -default active] -padx 10  -pady 3 -row 1 -column 2 -sticky n -padx 10 -pady 3
      bind $dialog <Key-Return> "set ok 1"
    }
    grid columnconfigure $dialog 0 -weight 1
    wm resizable [winfo toplevel $dialog] 0 0

    update idletasks
    regexp {([0-9]*)x([0-9]*)\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry [winfo toplevel $dialog] ] wgeom winw winh winx winy
    if {[expr {$winx+$winw}] > [winfo screenwidth .]} {set winx [expr {[winfo screenwidth .]-$winw}]}
    if {$winx < 0} {set winx 0}
    if {[expr {$winy+$winh}] > [winfo screenheight .]} {set winy [expr {[winfo screenheight .]-$winh}]}
    if {$winy < 0} {set winy 0}
    wm geometry [winfo toplevel $dialog]  "+$winx+$winy"

    focus $dialog
    vwait ok
    set dialogblock 0
    destroy $dialog
    bind . <<RaiseDialogs>> ""
    if {$ok != 1} {return}
    unset ok
    if {$info(enz_text_enz) == "selected"} {
      set enzlist $info(enz_currently_selected)
    } else {
      set enzlist $enzymes
    }
  } else {
    ###No dialog
    set analyze_selection $info(analyze_selection)
     if {$info(enz_currently_selected) != {}} {
      set enzlist $info(enz_currently_selected)
     } else {
      set enzlist $enzymes
     }
  }
  set text [do_text_map $w $enzlist $analyze_selection]
  if {$dialog == -1 && $text ne {}} {
    ##doing print
    print_text $text
  }

}

#############
## move frames up and down in text_map dialog- not used now
#############
proc text_map_dialog_raise_lower {frame direction} {
  global info
  set index [lsearch $info(enz_text_dialog_order) $frame]
  if {($index+ $direction > -1) && ($index + $direction < [llength $info(enz_text_dialog_order)])} {
    if {$direction == 1} {
      set info(enz_text_dialog_order) [lreplace $info(enz_text_dialog_order) $index [expr {$index +1}] [lindex $info(enz_text_dialog_order) [expr {$index +1}]] [lindex $info(enz_text_dialog_order) $index]]
    } else {
      set info(enz_text_dialog_order) [lreplace $info(enz_text_dialog_order) [expr {$index - 1}] $index [lindex $info(enz_text_dialog_order) $index] [lindex $info(enz_text_dialog_order) [expr {$index - 1}]]]
    }
    set i 0
    foreach frame $info(enz_text_dialog_order) {
      grid configure .dialog.$frame -row $i
      incr i
    }
  }
}

#############
## move frames up and down in text_map dialog by drag and drop
#############
proc text_map_frame_drag {drag_frame drop_x drop_y} {
  global info
  if {([regexp {\.dialog\.([^\.]*).*} [winfo containing $drop_x $drop_y] noop drop_frame]) && ([set drop_frame_index [lsearch -exact $info(enz_text_dialog_order) $drop_frame]] > -1)} {
    regexp {\.dialog\.(.*)} $drag_frame none drag_frame
    set drag_frame_index [lsearch -exact $info(enz_text_dialog_order) $drag_frame]
    set info(enz_text_dialog_order) [lreplace $info(enz_text_dialog_order) $drag_frame_index $drag_frame_index]
    set info(enz_text_dialog_order) [linsert $info(enz_text_dialog_order) $drop_frame_index $drag_frame]   
  }
  set i 0
  foreach frame $info(enz_text_dialog_order) {
    grid configure .dialog.$frame -row $i
    incr i
  }
}

#############
## move frames up and down in text_map with dialog--listbox
#############
proc text_map_dialog_frame_listbox {} {
  global info ok2

  set w ".dialog"
  toplevel .dialog2
  wm title .dialog2 [mc "Text Map Item Order..."]
  set ok2 0
  wm protocol .dialog2 WM_DELETE_WINDOW "set ok2 -1"
  set old_bind [bind . <<RaiseDialogs>>]
  bind . <<RaiseDialogs>> "wm deiconify .dialog2; raise .dialog2"
  bind .dialog2 <KeyPress-Escape>  "set ok2 -1"
  regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $w] wgeom winx winy
  wm geometry .dialog2 "+[expr (($winx<0)?0:$winx)+3]+[expr (($winy<0)?0:$winy)+50]"
  if {[tk windowingsystem] != "aqua"} {
    wm transient .dialog2 $w
  } else {
    ::tk::unsupported::MacWindowStyle style .dialog2 document {closeBox}
  }

  grid [listbox .dialog2.list  -height [llength $info(enz_text_dialog_order)]] -row 1 -column 1
  grid [frame .dialog2.raiseframe] -row 2 -column 1 -sticky nwe
  grid [button .dialog2.raiseframe.raise -text [mc "Raise"] -command "event generate .dialog2.list <<Raise>>"] -row 0 -column 1 -padx 10 -pady 3
  grid [button .dialog2.raiseframe.lower -text [mc "Lower"] -command "event generate .dialog2.list <<Lower>>"] -row 0 -column 2 -padx 10 -pady 3
  grid [button .dialog2.ok -command {set ok2 1} -text [mc "OK"]  -default active] -row 3 -column 1 -sticky n -padx 10 -pady 3
  bind .dialog2 <Key-Return> "set ok2 1"
  grid columnconfigure .dialog2 1 -weight 1
  wm resizable [winfo toplevel .dialog] 0 0

  foreach frame $info(enz_text_dialog_order) {
    .dialog2.list insert end [string map {enzymes Enzymes dna DNA features Features index "Index Line" translation Translation sec_strand "2nd Strand" genes Genes} $frame]
  }
  .dialog2.list selection set 0

  bind .dialog2.list <<Raise>> {
    if {[set i [.dialog2.list curselection]] > 0} {
      set t [.dialog2.list get $i]
      .dialog2.list delete $i
      .dialog2.list insert [expr {$i -1}] $t
      .dialog2.list selection set [expr {$i -1}]
    }
  }
  bind .dialog2.list <<Lower>> {
    if {[set i [.dialog2.list curselection]] < [expr {[.dialog2.list index end]-1}]} {
      set t [.dialog2.list get $i]
      .dialog2.list delete $i
      .dialog2.list insert [expr {$i +1}] $t
      .dialog2.list selection set [expr {$i +1}]
    }
  }
  regexp {([0-9]*)x([0-9]*)\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry .dialog2] wgeom winw winh winx winy
  if {[expr {$winx+$winw}] > [winfo screenwidth .]} {set winx [expr {[winfo screenwidth .]-$winw}]}
  if {$winx < 0} {set winx 0}
  if {[expr {$winy+$winh}] > [winfo screenheight .]} {set winy [expr {[winfo screenheight .]-$winh}]}
  if {$winy < 0} {set winy 0}
  wm geometry .dialog2 "+$winx+$winy"

  focus .dialog2
  set ok2 0
  vwait ok2
  ##needed to get around the bug in menus- \b is used as a non-printing leader to "-"
  set info(enz_text_index_char2) [string index $info(enz_text_index_char2) end]
  set info(enz_text_index_char1) [string index $info(enz_text_index_char1) end]


  set list_store [.dialog2.list get 0 end]
  destroy .dialog2
  bind . <<RaiseDialogs>> $old_bind
  if {$ok2 != 1} {unset ok2; return}
  unset ok2
  set info(enz_text_dialog_order) [list]
  foreach frame_name $list_store {
    lappend info(enz_text_dialog_order) [string map {Enzymes enzymes DNA dna Features features "Index Line" index Translation translation "2nd Strand" sec_strand Genes genes Space space} $frame_name]
  }
  set i 0
  foreach frame $info(enz_text_dialog_order) {
    grid configure .dialog.$frame -row $i
    incr i
  }
}

#############
## Make the Text map analysis window
#############
proc do_text_map {w enzlist analyze_selection} {
  global info modifier
  set region $analyze_selection

  if {[$w.textarea tag ranges sel] == ""} {set region "all"}

  set seq_length [string length [textarea_get $w.textarea  1.0 end]]
  if {$region == "all"} {
    set start 0
    set total_length [ix2bp $w.textarea end]
    set end $total_length
    set text [textarea_get $w.textarea [bp2ix $w.textarea $start] [bp2ix $w.textarea $end]]
  } else {
#selection used here 
    if {[llength [$w.textarea tag ranges sel]] == 2} {
      set start [ix2bp $w.textarea [$w.textarea index sel.first]]
      set end [ix2bp $w.textarea [$w.textarea index sel.last]]
      set total_length [expr {$end - $start}]
      set text [textarea_get $w.textarea [bp2ix $w.textarea $start] [bp2ix $w.textarea $end]]
    } else {
      set start [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 2]]
      set end [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 1]]
      set total_length [expr {$end + $seq_len- $start}]
      set text "[textarea_get $w.textarea [bp2ix $w.textarea $start] [bp2ix $w.textarea $total_length]][textarea_get $w.textarea 1.0 [bp2ix $w.textarea $end]]"
    }
  }
  if {$total_length < 1} return
  findenzymes $w



  set a [new_analysis_window $w "Text Map" text_map]

  set graphic_map_count 0

  create_textframe $a [expr {$info(enz_text_width)+21}]


  #initialize text lines that can be generated for the full sequence
  if {$info(enz_text_show_trans)} {
    #reminder:proc translate {dna {chars 1} {direction 1} {spacing 0}} {}
    switch $info(enz_text_trans) {
      off {set trans [list]}
      "1_1" {
        set trans [list [translate $text 1 1 2]]  
      }
      "3_1" {
        set trans [list "[translate $text 1 1 2]" " [translate [string range $text 1 end] 1 1 2]" "  [translate [string range $text 2 end] 1 1 2]"]
      }
      "6_1" {
        set trans [list "[translate $text 1 1 2]" " [translate [string range $text 1 end] 1 1 2]" "  [translate [string range $text 2 end] 1 1 2]" "[translate [string range $text 0 end] 1 -1 2]" " [translate [string range $text 1 end] 1 -1 2]" "  [translate [string range $text 2 end] 1 -1 2]" ]
      }
      "1_3" {
        set trans [list [translate $text 3 1 0]]
      }
      "3_3" {
        set trans [list "[translate $text 3 1 0]" " [translate [string range $text 1 end] 3 1 0]" "  [translate [string range $text 2 end] 3 1 0]"]
      }
        "6_3" {
       set trans [list [translate $text 3 1 0] [translate [string range $text 1 end] 3 1 0] [translate [string range $text 2 end] 3 1 0] [translate [string range $text 0 end-[expr {[string length $text] % 3}]] 3 -1 0] [translate [string range $text 0 end-[expr {1+([string length $text] % 3)}]] 3 -1 0] [translate [string range $text 0 end-[expr {2+([string length $text] % 3)}]] 3 -1 0]]
      }
    }
  }

  if {$info(enz_text_show_features)} {
   ## work here for selection through origin- selection used here
    set tag_list [get_tags_exact $w.textarea [list [bp2ix $w.textarea $start] [bp2ix $w.textarea $end]]]
    foreach {tag data} $tag_list {
      if {[regexp {f[0-9]+#} $tag]} {
	if {[$w.textarea tag cget $tag -background] =={} && !$info(enz_text_show_hidden_features) } {
          continue
	}
        set metadata_index [lsearch -exact [lindex $data 2] <<Metadata>>]
        set type [lindex [lindex [lindex $data 3] $metadata_index] 2]
        if {[string toupper $type] == "CDS"} {
          set dir [lindex [lindex [lindex $data 3] $metadata_index] 3]
          set cds_text [get_cds $w $tag]
          set cds_trans "[translate $cds_text 1 [expr {$dir?-1:1}] 2]  "
  ## use get_feature_exons_indexes
          set fn_tag [string replace $tag 0 0 fn]
          set tag_ranges [$w.textarea tag ranges $tag]
          set fn_tag_ranges [$w.textarea tag ranges $fn_tag]
          #rotate the tanslation string if feature goes through origin
          set f_store($tag,split) 0
          set f_store($tag,dir) $dir
          if {([llength $fn_tag_ranges] == 0) && ([llength $tag_ranges] == 4)} {
            #no fn_tag, passes through origin
            set split [expr {[ix2bp $w.textarea [lindex $tag_ranges 3]] - [ix2bp $w.textarea [lindex $tag_ranges 2]]}]
            set cds_trans "[string range $cds_trans $split end][string range $cds_trans 0 [expr {$split-1}]]"
            set f_store($tag,split) $split
          } elseif {[llength $fn_tag_ranges] == 4} {
            #fn tag, through origin
            set split 0
            foreach {f0 f1} [lrange $tag_ranges [lsearch -exact $tag_ranges [lindex $fn_tag_ranges 2]] end] {
              incr split [expr {[ix2bp $w.textarea $f1]- [ix2bp $w.textarea $f0]}]
            }
            set cds_trans "[string range $cds_trans $split end][string range $cds_trans 0 [expr {$split-1}]]"
            set f_store($tag,split) $split
          }
          set fstart 0
          foreach {f0 f1} $tag_ranges {
            set f0 [ix2bp $w.textarea $f0]
            if {$start < $f0} break
            set f1 [ix2bp $w.textarea $f1]
            if {$start < $f1} {
              incr fstart [expr {$start - $f0}]
            } else {
              incr fstart [expr {$f1 - $f0}]
            }
          }
          set f_store($tag) $cds_trans
          set f_store($tag,start) $fstart
        }
      }
    }
  }

  if {$info(enz_text_genes) == 1} {
    set geneslist [uppercase_cdna $text]
    set genesline [translate [lindex $geneslist 0] 1 1 2]
    foreach intron [lsort -decreasing -integer -index 0 [lindex $geneslist 1]] {
      set genesline "[string range $genesline 0 [expr {[lindex $intron 0]-1}]][string repeat " " [lindex $intron 1]][string range $genesline [lindex $intron 0] end]"
    }
  }

  set enz_line_above [expr {[lsearch $info(enz_text_dialog_order) "enzymes"] < [lsearch $info(enz_text_dialog_order) "dna"]}]
  set index_line_above [expr {[lsearch $info(enz_text_dialog_order) "index"] < [lsearch $info(enz_text_dialog_order) "dna"]}]


  ##start output
  catch {$a.textframe.text insert end "[clock format [clock seconds] -format $info(clock_format)]\n"}
  for {set u 0} {$u < [string length [wm title $w]]} {incr u [expr {$info(enz_text_width) +8}]} {
    $a.textframe.text insert end "[string range [wm title $w] $u [expr {$u+$info(enz_text_width) +7}]]\n"
  }
  #$a.textframe.text insert end "Text Map\n"

#put the output out 1 line at a time ($info(enz_text_width) bp per line)
  for {set x 0} {$x < [expr {[string length $text]}]} {incr x $info(enz_text_width)} {
    set linelength [expr {[string length $text]- $x}]
    if {$linelength > $info(enz_text_width)} {
      set linelength $info(enz_text_width)
    }
    foreach frame $info(enz_text_dialog_order) {
      switch $frame {
        enzymes {
          if {$info(enz_text_show_enz)} {
            set templist [linear_enz_sort $w $enzlist [expr {$start+$x+1}] [expr {$start+$x+$linelength}]]
            #set tickline [string repeat "         *" [expr {$linelength /10}]]
            set tickline [string repeat " " $linelength]
            foreach pair $templist {
              set i 0
              while {([info exists enzline($i)]) && ([string length $enzline($i)] >= [expr {[lindex $pair 0]-$start - $x -1}])} {
                incr i
              }
              if {![info exists enzline($i)]} {
                set enzline($i) ""
                set maxi $i
              }
              set tickline [string replace $tickline [expr {[lindex $pair 0] -$start - $x -1}] [expr {[lindex $pair 0] - $start - $x -1}] "|"]
              set enzline($i) "$enzline($i)[string repeat " " [expr {[lindex $pair 0] - $start - $x -1 -[string length $enzline($i)]}]][lindex $pair 0] [lindex $pair 1]"
            }
            if {[info exists enzline(0)]} {
              if {$enz_line_above} {
                for {set i $maxi} {$i >= 0} {incr i -1} {
                  $a.textframe.text insert end "[string repeat " " 7]$enzline($i)\n"
               }
                $a.textframe.text insert end "[string repeat " " 7]$tickline\n"
              } else {
                $a.textframe.text insert end "[string repeat " " 7]$tickline\n"
                for {set i 0} {$i <= $maxi} {incr i} {
                  $a.textframe.text insert end "[string repeat " " 7]$enzline($i)\n"
                }
              }
              unset i maxi enzline
            }
            unset templist tickline
          }
        }

        space {
          if {$info(enz_text_show_space)} {
            $a.textframe.text insert end "[string repeat \n $info(enz_text_space)]"
          }
        }

        graphic_map {
          ### experimental- not used
          if {$info(enz_text_graphic_map) == 1} {
            set c $a.textframe.text.c_$graphic_map_count
            incr graphic_map_count
            $a.textframe.text insert end [string repeat " " 7]
            $a.textframe.text window create end -window [canvas $c -background $info(graphic_bg_color)  -highlightthickness 0]
            seq_tooltip_update $w [bp2ix $w.textarea [expr {$x+$start}]] [bp2ix $w.textarea [expr {$x+$start+$linelength}]] $c
            $a.textframe.text insert end "\n"
          }
        }

        dna {
          set textline [string range $text $x [expr {$x+$linelength-1}]]
          set line_start_index [expr {seq_len_mod($x+$start+1, $seq_length)}]
          if {($info(enz_text_dna_numbers) == "Left") || ($info(enz_text_dna_numbers) == "Both")} {
            $a.textframe.text insert end "[string repeat " " [expr {6-[string length $line_start_index]}]]$line_start_index " 
          } else {
            $a.textframe.text insert end "[string repeat " " 7]" 
          }
          set lstag "ls$line_start_index\_1"
          $a.textframe.text insert end $textline [list dnatag $lstag]

          if {$info(enz_text_copy_highlight)} {
            ## work here for selection through origin- selection used here
            copy_tags $w.textarea [list [bp2ix $w.textarea [expr { ($x+$start) % $seq_length}]] [bp2ix $w.textarea [expr {($x+$start+$linelength-1) % $seq_length}]]] $a.textframe.text [$a.textframe.text index "end-1line linestart +7char"] "forward" ""
          }
          if {($info(enz_text_dna_numbers) == "Right") || ($info(enz_text_dna_numbers) == "Both")} {
            $a.textframe.text insert end " [expr {seq_len_mod($x+$start+$linelength, $seq_length)}]\n" {}
          } else {
            $a.textframe.text insert end " \n" {}
          }
        }

        sec_strand {
          if {$info(enz_text_2nd)} {
            $a.textframe.text insert end "[string repeat " " 7][string map {A T B V C G D H G C H D K M M K N N R Y S S T A V B W W Y R a t b v c g d h g c h d k m m k n n r y s s t a v b w w y r} $textline]\n"
          }
        }

        translation {
          if {$info(enz_text_show_trans)} {
            foreach transline $trans {
              $a.textframe.text insert end "[string repeat " " 7][string range $transline $x [expr {$x+$linelength-1}]]\n"
            }
          }
        }

        index {
          if {$info(enz_text_show_index)} {
            set start_index [expr {$x+$start+1}]
            set tickline "[string repeat " " [expr {$info(enz_text_index_spacing2)-1-(($start_index-1) % $info(enz_text_index_spacing2))}]]$info(enz_text_index_char2)"
            set tickline "$tickline[string repeat "[string repeat " " [expr {$info(enz_text_index_spacing2)-1}]]$info(enz_text_index_char2)" [expr {$linelength/$info(enz_text_index_spacing2)}]]"
            set tickline [string range $tickline 0 [expr {$linelength-1}]]
            set first_index [expr {$info(enz_text_index_spacing1)-1-(($start_index-1) % $info(enz_text_index_spacing1))}]

            set numline "[string repeat " " 7]"
            set first_num [expr {$start_index + $info(enz_text_index_spacing1) - ($start_index % $info(enz_text_index_spacing1))}]
            #set tickline [string replace $tickline $first_index $first_index $info(enz_text_index_char1)]
            #set numline "[string repeat " " [expr {7+$first_index-([string length $first_num] / 2)}]]$first_num"
            for {set i $first_index} {$i < $linelength} {incr i $info(enz_text_index_spacing1)} {
              set tickline [string replace $tickline $i $i $info(enz_text_index_char1)]
              set numline "$numline[string repeat " " $info(enz_text_index_spacing1)]"
              set numline "[string range $numline 0 [expr {7-1+$i-([string length $first_num] / 2)}]]$first_num"
              incr first_num $info(enz_text_index_spacing1)
            }
      
            if {$index_line_above} {
              if {$info(enz_text_index_nums)} {
                $a.textframe.text insert end "$numline\n"
              }
              $a.textframe.text insert end "[string repeat " " 7]$tickline\n"
            } else {
              $a.textframe.text insert end "[string repeat " " 7]$tickline\n"
              if {$info(enz_text_index_nums)} {
                $a.textframe.text insert end "$numline\n"
              }
            }
          }
        }
        genes {
          if {$info(enz_text_genes) == 1} {
            $a.textframe.text insert end "[string repeat " " 7][string range $genesline $x [expr {$x+$linelength-1}]]\n"
          }
        }
        features {
          if {$info(enz_text_show_features)} {
            set tag_space 0; ## set to 3 for unformatted tags
            set fea_char(0) ">"
            set fea_char(1) "<"
            set gap_char(0) "."
            set gap_char(1) "."
            set tag_list [get_tags_exact $w.textarea [list [bp2ix $w.textarea [expr {$x+$start}]] [bp2ix $w.textarea [expr {$x+$start+$linelength}]]]]
            set i 0
            set sorting_tag_list [list]
            foreach {tag data} $tag_list {
              lappend sorting_tag_list [list $tag $data]
            }
            set sorting_tag_list [lsort -integer -index {1 0 0} $sorting_tag_list]
  ##use get_feature_exons_indexes
            foreach element $sorting_tag_list {
              foreach {tag data} $element {}
              if {[regexp {f[0-9]+#} $tag]} {
		if {[$w.textarea tag cget $tag -background] =={} && !$info(enz_text_show_hidden_features) } {
                  continue
                }
                set fn_tag [string replace $tag 0 0 fn]
                set metadata_index [lsearch -exact [lindex $data 2] <<Metadata>>]
                set dir [lindex [lindex [lindex $data 3] $metadata_index] 3]
                set type [lindex [lindex [lindex $data 3] $metadata_index] 2]
                if {[set fn_list_loc [lsearch -exact $tag_list $fn_tag]] != -1} {
                  set start_index [lindex [lindex [lindex $tag_list [expr {$fn_list_loc+1}]] 0] 0]
                  set end_index [lindex [lindex [lindex $tag_list [expr {$fn_list_loc+1}]] 0] 1]
                } else {
                  set start_index [lindex [lindex $data 0] 0]
                  set end_index [lindex [lindex $data 0] 1]
                }
                set i 0
                while {([info exists fea_line($i)]) && (([expr {[string length $fea_line($i)]+$tag_space-1}] >= $start_index) || ([expr {[string length $name_line($i)]+$tag_space-1}] >= $start_index))} {
                  incr i
                }
                
                if {![info exists fea_line($i)]} {
                  set fea_line($i) ""
                  set name_line($i) ""
                  set tag_line($i) [list]
                  set trans_line($i) ""
                  set trans_index_line($i) ""
                }
                #move feature and name lines over to start_index
                set fea_line($i) "$fea_line($i)[string repeat " " [expr {$start_index-[string length $fea_line($i)]}]]"
                set name_line($i) "$name_line($i)[string repeat " " [expr {$start_index-[string length $name_line($i)]}]]"
                #fill in the feature line
                if {$fn_list_loc > -1} {
                  set fea_line($i) "$fea_line($i)[string repeat $gap_char($dir) [expr {$end_index-$start_index}]]"
                  foreach {f0 f1} [lindex $data 0] {
                    set fea_line($i) [string replace $fea_line($i) $f0 [expr {$f1-1}] [string repeat $fea_char($dir) [expr {$f1-$f0}]]]
                    lappend tag_line($i) [list $tag $f0 $f1]
                  }
                } else {
                  set fea_line($i) "$fea_line($i)[string repeat $fea_char($dir) [expr {$end_index-$start_index}]]"
                  lappend tag_line($i) [list $tag $start_index $end_index]
                }
                #fill in the trans line (if cds translation)
                if {[info exists f_store($tag)]} {
                  set trans_line($i) "$trans_line($i)[string repeat " " [expr {$start_index-[string length $trans_line($i)]}]]"
                  set trans_index_line($i) "$trans_index_line($i)[string repeat " " [expr {$start_index-[string length $trans_index_line($i)]}]]"

                  set trans_start_index [expr {([regexp -all {[^\s]} [string range $f_store($tag) 0 [expr {$f_store($tag,start)-1}]]] +($f_store($tag,split)+2)/3)% (max (3,[string length $f_store($tag)])/3) + 1}]
                  if {$f_store($tag,dir)} {
                    set trans_start_index [expr {[string length $f_store($tag)]/3- $trans_start_index+1}]
                  }
                  if {$fn_list_loc > -1} {
                    set trans_line($i) "$trans_line($i)[string repeat " " [expr {$end_index-$start_index}]]"
                    set trans_index_line($i) "$trans_index_line($i)[string repeat " " [expr {[lindex [lindex $data 0] 0]- 2-[string length $trans_index_line($i)]}]]"
                    foreach {f0 f1} [lindex $data 0] {
#numbering aa in trans line
#needs to know the rotation of through index features, and the direction
#sputs text_map_i possible start aa number $tag [expr {[regexp -all {[^\s]} [string range $f_store($tag) 0 [expr {$f_store($tag,start)-1}]]] + 1}]
#sputs text_map_ib $f_store($tag) $f_store($tag,start)
                      set trans_line($i) [string replace $trans_line($i) $f0 [expr {$f1-1}] [string range $f_store($tag) $f_store($tag,start) [expr {[incr f_store($tag,start) [expr {$f1-$f0}]]-1}]]]

                    }
                  } else {
#numbering aa in trans line
#needs to know the rotation of through index features, and the direction
#sputs text_map_i2 possible start aa number $tag [expr {[regexp -all {[^\s]} [string range $f_store($tag) 0 [expr {$f_store($tag,start)-1}]]] + 1}]
#sputs text_map_2b $f_store($tag) $f_store($tag,start)
                    set trans_line($i) "$trans_line($i)[string range $f_store($tag) $f_store($tag,start) [expr {[incr f_store($tag,start) [expr {$end_index-$start_index}]]-1}]]"
                  }
                  set trans_index_line($i) "$trans_index_line($i)$trans_start_index"
                }
                #fill in the name line
                set name_line($i) "$name_line($i)[lindex [lindex [lindex $data 3] $metadata_index] 0]"
              } elseif {([regexp {fn[0-9]+#} $tag]) && ([lsearch -exact $tag_list [set f_tag [string replace $tag 0 1 f]]] == -1)} {
               #fn tag without an f tag (all gap cahracters)
                set i 0
                while {[info exists fea_line($i)]} {
                  incr i
                }
                set metadata [$w.textarea tag bind $f_tag <<Metadata>>]
                set fea_line($i) [string repeat $gap_char([lindex $metadata 3]) $linelength]
                set name_line($i) [lindex $metadata 0]
                set tag_line($i) [list]
              }
            }; #foreach tag
            set j 0
            while {[info exists fea_line($j)]} {
              if {[info exists trans_line($j)] && ($trans_line($j) != "")} {
                $a.textframe.text insert end "[string repeat " " 7]$trans_line($j)\n" 
                $a.textframe.text insert end "[string repeat " " 7]$trans_index_line($j)\n" 
              }
              set tag_index [$a.textframe.text index "end-1char linestart"]
              $a.textframe.text insert end "[string repeat " " 7]$fea_line($j)\n" 
              foreach tag_data $tag_line($j) {
                foreach {tag start_tag end_tag} $tag_data {}
                if {[$a.textframe.text tag ranges $tag] == {}} {
                  $a.textframe.text tag configure $tag -background [lindex [$w.textarea tag bind $tag <<Revcolors>>] [lindex [$w.textarea tag bind $tag <<Metadata>>] 3]]
                }
### add new tags here- transparency is copied from the source tags, need to reset tag bg to [lindex [$w.textarea tag bind $tag <<Revcolors>>] [lindex [$w.textarea tag bind $tag <<Metadata>>] 3]]
                $a.textframe.text tag add $tag [$a.textframe.text index "$tag_index+[expr {$start_tag+7}]\chars"] [$a.textframe.text index "$tag_index+[expr {$end_tag+7}]\chars"]
              }
              if {$info(enz_text_crop_features)} {
                $a.textframe.text insert end "[string repeat " " 7][string range $name_line($j) 0 [expr {$info(enz_text_width)-1}]]\n" 
              } else {
                $a.textframe.text insert end "[string repeat " " 7]$name_line($j)\n" 
              }
              incr j
            }
            if {[info exists fea_line]} {
              unset fea_line
              unset tag_line
              unset name_line
            }
            if {[info exists trans_line]} {
              unset trans_line
            }
            unset i
          }; #if show features
        }
      }; #case
    }; #foreach frame
    if {$info(enz_text_show_enz) || $info(enz_text_2nd) || $info(enz_text_show_trans) || $info(enz_text_show_index) || $info(enz_text_graphic_map) || $info(enz_text_genes) || $info(enz_text_show_features)} {
      $a.textframe.text insert end "\n"
    }
  }

  foreach tag [$w.textarea tag names] {
     if {[lsearch -exact [$a.textframe.text tag names] $tag] > -1} {
       $a.textframe.text tag raise $tag
     }
  }

  $a.textframe.text tag bind dnatag <Double-Button-1> "alignlink2 $a.textframe.text $w \[$a.textframe.text index @%x,%y\] goto 1; break"
  $a.textframe.text tag bind dnatag <Button-1> "alignlink2 $a.textframe.text $w \[$a.textframe.text index @%x,%y\] goto 0; break"
  $a.textframe.text tag bind dnatag <Shift-Button-1> "alignlink2 $a.textframe.text $w \[$a.textframe.text index @%x,%y\] select 0; break"
  $a.textframe.text tag bind dnatag <Shift-Double-Button-1> "alignlink2 $a.textframe.text $w \[$a.textframe.text index @%x,%y\] select 1; break"
  lappend info($w,linked_events) [list $a.textframe.text dnatag <Double-Button-1>]
  lappend info($w,linked_events) [list $a.textframe.text dnatag <Button-1>]
  lappend info($w,linked_events) [list $a.textframe.text dnatag <Shift-Button-1>]
  lappend info($w,linked_events) [list $a.textframe.text dnatag <Shift-Double-Button-1>]
  $a.textframe.text tag bind dnatag <Any-Leave> {%W tag remove highlite 1.0 end}
  $a.textframe.text tag bind dnatag <Any-Motion> {%W tag remove highlite 1.0 end; %W tag add highlite current}
  $a.textframe.text tag bind dnatag <Any-Enter> {%W tag remove highlite 1.0 end; %W tag add highlite current}
  $a.textframe.text tag configure highlite -background red
#####
  set outputmenu [add_output_menu $a.textframe.text "Text" text $w]
  bind $a <Button-1> "focus $a.textframe.text" 
  bindtags $a.textframe.text [list $a.textframe.text AnalysisText $a . all]
  wm deiconify $a
  $a.textframe.text configure -state disabled
  if {[info exists info(last_analysis_xy)]} {
    wm geometry [winfo toplevel $a] [textbox_geometry $a.textframe.text {*}$info(last_analysis_xy)]
  } else {
    scan [wm geometry [winfo toplevel $a]] "%dx%d+%d+%d" w h x y
    wm geometry [winfo toplevel $a] [textbox_geometry $a.textframe.text $x $y]
  }
  window_on_screen $a
  focus $a.textframe.text
  return $a.textframe.text
}

##############
## returns cDNA extracted as uppercase exons, and location and size of introns
##############
proc uppercase_cdna {dna} {
  set templist [list]
  #find leading region
  set templist [concat $templist [regexp -inline -indices {([a-y]+)[A-Y]} $dna]]
  #find introns- lowercase gt..ag between uppercase exons
  set templist [concat $templist [regexp -all -inline -indices {[A-Y](g[tc][a-y]*?ag)[A-Y]} $dna]]
  #find trailing region- all lowercase after stop (stop not necessarily in frame with cDNA)
  set templist [concat $templist [regexp -all -inline -indices {(?:TGA|TAA|TAG)([a-y]+)} $dna]]

  set intronlist [list]
  foreach {i j} $templist {
    lappend intronlist $j
  }

  set intronlist [lsort -unique -integer -index 1 $intronlist]
  set sizelist [list]
  set sum 0
  foreach intron $intronlist { 
    set dna [string replace $dna [expr {[lindex $intron 0]-$sum}] [expr {[lindex $intron 1]-$sum}] ""]
    lappend sizelist [list [expr {[lindex $intron 0]-$sum}] [expr {[lindex $intron 1]-[lindex $intron 0]+1}]]
    incr sum [expr {[lindex $intron 1]-[lindex $intron 0]+1}]
  }

  return [list $dna $sizelist]
}


##############
## draws a graphic map of enzymes
##############
proc enz_graphic_map {w {numsites "none"}} {
  global enzymes
  global info
  global enzinfo
  global modifier modifier2
  global modstring

  set enz_list $info(enz_currently_selected) 
  set region $info(analyze_selection)
  if {[$w.textarea tag ranges sel] == ""} {set region "all"}

  set seq_length [string length [textarea_get $w.textarea  1.0 end]]
  if {$region == "all"} {
    set start 0
    set total_length [ix2bp $w.textarea end]
    set end $total_length
  } else {
#selection used here - ok
    if {[llength [$w.textarea tag ranges sel]] == 2} {
      set start [ix2bp $w.textarea [$w.textarea index sel.first]]
      set end [ix2bp $w.textarea [$w.textarea index sel.last]]
      set total_length [expr {$end - $start}]
    } else {
      set start [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 2]]
      set end [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 1]]
      set total_length [expr {$end + $seq_length- $start}]
    }
  }


  if {$total_length == 0} {return}
  findenzymes $w

  if {$numsites != "none"} {
    set extra_enz [enz_site_usage_filter $w $enzymes $numsites all]
  } else {
    set extra_enz [list]
  }

  if {($region == "all") && ($info($w,circular) == "circular")} {
    set a [new_analysis_window $w "Map" circular_graphic_map]
  } else {
    set a [new_analysis_window $w "Map" linear_graphic_map]
  }

#make the canvas
global c
  set c [canvas $a.canvas -width 500 -height 500 -background $info(graphic_bg_color) -xscrollincrement 1 -yscrollincrement 1]


   bind $c <<Window>> $w
####check for circular or linear map
  if {($region == "all") && ($info($w,circular) == "circular")} {
    ########draw circular map
    set radius $info(circ_map_radius)
    foreach {var default_val} $info(graphic_map_properties) {
      if {[dict exists $info($w,gformat_data) $var]} {
        set $var [dict get $info($w,gformat_data) $var]
      } else {
        set $var $default_val
      }
    }


    $c create oval [expr {-$radius}] [expr {-$radius}] $radius $radius -width [expr {$info(antialias_width) + $circular_baseline_fg_width + 2 * $circular_baseline_bg_width}] -outline [mix_color $circular_baseline_bg_color [$c cget -background] $info(antialias_percent)] -tags [list circle_background_aa aa]
    $c create oval [expr {-$radius}] [expr {-$radius}] $radius $radius -width [expr {$circular_baseline_fg_width + 2 * $circular_baseline_bg_width}] -outline $circular_baseline_bg_color -tags circle_background
    $c create oval [expr {-$radius}] [expr {-$radius}] $radius $radius -width [expr {min($circular_baseline_bg_width/2.0,$info(antialias_width)) + $circular_baseline_fg_width}] -outline [mix_color $circular_baseline_fg_color $circular_baseline_bg_color $info(antialias_percent)] -tags [list circle_aa aa]
    $c create oval [expr {-$radius}] [expr {-$radius}] $radius $radius -width $circular_baseline_fg_width -outline $circular_baseline_fg_color -tags circle 
    #$c raise circle circle_background

    set crosshair_length [expr {$circular_crosshair_length * $radius}]
    $c create line 0 [expr {-$crosshair_length}] 0 $crosshair_length  -width [expr {$circular_crosshair_fg_width + 2 * $circular_crosshair_bg_width}] -fill $circular_crosshair_bg_color -tags {crosshair_background vert}
    $c create line [expr {-$crosshair_length}] 0 $crosshair_length 0  -width [expr {$circular_crosshair_fg_width + 2 * $circular_crosshair_bg_width}] -fill $circular_crosshair_bg_color -tags {crosshair_background horiz}
    $c create line 0 [expr {-$crosshair_length}] 0 $crosshair_length -width $circular_crosshair_fg_width -fill $circular_crosshair_fg_color -tags {crosshair vert}
    $c create line [expr {-$crosshair_length}] 0 $crosshair_length 0 -width $circular_crosshair_fg_width -fill $circular_crosshair_fg_color -tags {crosshair horiz}

    set pi 3.141592654
    $c bind 1 <<Total_length>> $total_length
    set tick_dict [list]
    foreach var [list circular_map_index_offset circular_map_index_max_tick_spacing circular_map_index_max_at_zero index_label_format index_text_angle_format circular_index_max_tick_color index_circular_text_color circular_index_max_tick_font circular_index_max_tick_width  circular_index_max_tick_length circular_index_min_tick_per_max circular_index_min_tick_color  circular_index_min_tick_width  circular_index_min_tick_length] {
      if {[dict exists $info($w,gformat_data) $var]} {
        dict set tick_dict $var [dict get $info($w,gformat_data) $var]
      } else {
        dict set tick_dict $var [dict get $info(graphic_map_properties) $var]
      }
    }
    foreach var [list circular_index_max_tick_color index_circular_text_color circular_index_min_tick_color] {
      if {[dict get $tick_dict $var] == {}} {
        dict set tick_dict $var $info(graphic_fg_color)
      }
    }
    $c bind 1 <<Tick_dict>> $tick_dict

    #draw enzyme and feature labels
    #get a list of locations and tags
    set templist [circ_enz_sort $w [lsort -unique [concat $enz_list $extra_enz]] $total_length]
    set maxx 150; set maxy 150; set minx -150; set miny -150

    set charheight [expr [font metrics graphicfont -linespace]]
    set anchor "sw"; set bump [expr -$charheight]; set nexty 0; set comparison ">"
    set lastloc -1

    foreach var [list circ_enz_label_box_type circ_enz_label_box_fill_color circ_enz_label_box_outline_color circ_enz_label_box_outline_width] {
      if {[dict exists $info($w,gformat_data) $var]} {
        set $var [dict get $info($w,gformat_data) $var]
      } else {
        set $var [dict get $info(graphic_map_properties) $var]
      }
    }

    foreach {pair} $templist  {
      set loc [lindex $pair 0]
      set label_dict [lindex $pair 1]    
      set angle [expr {2*$pi*$loc/$total_length}]
      set tag [dict get $label_dict tag]
      set tag2 $tag
      if {[regexp {fn[0-9]+#} $tag]} {regsub fn $tag f tag}
      if {($anchor == "sw") && ($angle > [expr {$pi/2}])} {set anchor "nw"; set nexty 0; set comparison "<"; set bump $charheight}
      if {($anchor == "nw") && ($angle > $pi)} {set anchor "ne"; set nexty 0}
      if {($anchor == "ne") && ($angle > [expr {$pi*1.5}])} {set anchor "se"; set nexty 0; set comparison ">"; set bump [expr -$charheight]}
 


    
      if {[dict get $label_dict type] eq "enzyme"} {
        #enzyme label text
        set id [$c create text [expr {($radius+15)*sin($angle)}] [expr {-1*($radius+15)*cos($angle)}] -text "[dict get $label_dict location_start] [dict get $label_dict name] ([dict get $label_dict count])" -fill $info(graphic_fg_color) -anchor $anchor -font [list $info(graphicfontfamily) $info(graphicfontsize)]]

       #tick line
        set lineid_aa [$c create line [expr {0.5 + $radius*sin($angle)}] [expr {0.5 - $radius*cos($angle)}] [expr {0.5 + ($radius+10)*sin($angle)}] [expr {0.5 - ($radius+10)*cos($angle)}] -width [expr {$info(antialias_width) +1}]  -fill $info(graphic_fg_color) -tags [list $id.tick_aa $tag [dict get $label_dict type] tick_aa aa]]
        set lineid [$c create line [expr {0.5 + $radius*sin($angle)}] [expr {0.5 - $radius*cos($angle)}] [expr {0.5 + ($radius+10)*sin($angle)}] [expr {0.5 - ($radius+10)*cos($angle)}] -capstyle round -fill $info(graphic_fg_color)  -tags [list $id.tick $tag [dict get $label_dict type] tick]]
        set y [expr {-($radius+15)*cos($angle)}]
        if "$y $comparison $nexty" {set y $nexty}
        set nexty [expr {$y + $bump}]
        set nexty $y

        #connector line
        set connectorid_aa [$c create line [expr {0.5 + ($radius+10)*sin($angle)}] [expr {0.5 - ($radius+10)*cos($angle)}] [expr {($radius+15)*sin($angle)}] $y -fill $info(graphic_fg_color)  -state [expr {$info(draw_graphic_connectors)?"normal":"hidden"}] -width [expr {$info(antialias_width) +1}] -tags [list $id.connector_aa $tag enzyme connector_aa aa]]
        set connectorid [$c create line [expr {0.5 + ($radius+10)*sin($angle)}] [expr {0.5 - ($radius+10)*cos($angle)}] [expr {($radius+15)*sin($angle)}] $y -fill $info(graphic_fg_color)  -state [expr {$info(draw_graphic_connectors)?"normal":"hidden"}] -capstyle round  -tags [list $id.connector $tag enzyme connector]]



        #bindings for enzyme texts
        #$c bind $id <Any-Enter> "$c raise $tag; set tag_color \[lindex \[$c  bind $id <<Colors>>\] 1\];foreach egm_x \[$c find withtag (label||connector||tick)&&$tag\] {$c itemconfigure \$egm_x -fill \$tag_color}; destroy egm_x tag_color; $c itemconfigure label_box&&$tag -outline \{*\}\[ lindex \[$c  bind $id <<Colors>>\] 1\]"
        #$c bind $id <Any-Leave> "set tag_color \[lindex \[$c  bind $id <<Colors>>\] 0\];foreach egm_x \[$c find withtag (label||connector||tick)&&$tag\] {$c itemconfigure \$egm_x -fill \$tag_color}; $c itemconfigure label_box&&$tag -outline \{*\}\[ lindex \[$c  bind $id <<Colors>>\] 3\]; destroy egm_x tag_color"

        $c bind $id <Any-Enter> "graphic_map_recolor_enzymes $c $tag Enter"
        $c bind $id <Any-Leave> "graphic_map_recolor_enzymes $c $tag Leave"

        $c bind $id <Any-Enter> "+$c itemconfigure seqtext -text {$enzinfo(enz_pattern,$tag)}"
        $c bind $id <Any-Leave> "+$c itemconfigure seqtext -text {}"

        ## create background box
        set boxid [$c create polygon  0 0 -smooth raw -fill $circ_enz_label_box_fill_color -outline $circ_enz_label_box_outline_color -width $circ_enz_label_box_outline_width -tags [list enzyme $tag label_box $id.box]]
        $c bind $boxid <<Box>> [dict create type $circ_enz_label_box_type]
        graphic_map_redraw_label_box $c $id
        $c raise $id $boxid
#sputs enz $tag $boxid [$c itemconf $boxid] [$c coords $boxid]

        if {[lsearch -exact $enz_list $tag] > -1} {
          #selected enzymes
          $c bind $id <<Colors>> [list black red $info(graphic_fg_color) $circ_enz_label_box_outline_color]
          $c itemconfigure $id -tags [list enzyme $tag label moveablelabel selected_enz] -fill black
          $c itemconfigure $tag&&tick -fill $info(graphic_fg_color) 
          $c itemconfigure $tag&&tick_aa -fill [mix_color $info(graphic_fg_color)  [$c cget -background] $info(antialias_percent)]
          $c itemconfigure $tag&&connector -fill black
          $c itemconfigure $tag&&connector_aa -fill  [mix_color $info(graphic_fg_color)  [$c cget -background] $info(antialias_percent)]
        } else {
          #unique enzymes
          $c bind $id <<Colors>>  [list gray50 blue gray50 $circ_enz_label_box_outline_color]
          $c itemconfigure $id -tags [list enzyme $tag label moveablelabel unique_enz] -fill gray50
          $c itemconfigure $tag&&tick -fill gray50
          $c itemconfigure $tag&&tick_aa -fill [mix_color gray50 [$c cget -background] $info(antialias_percent)]
          $c itemconfigure $tag&&connector -fill gray50
          $c itemconfigure $tag&&connector_aa -fill  [mix_color gray50 [$c cget -background] $info(antialias_percent)]
          $c itemconfigure $tag&&label_box -outline $circ_enz_label_box_outline_color
        }
        set cut_site [expr {($loc + [lindex [enz_cut_offset [dict get $label_dict name] 0 [dict get $label_dict dir]] 0] -1) % $total_length}]
        set bottom_cut_site [expr {($loc + [lindex [enz_cut_offset [dict get $label_dict name] 0 [dict get $label_dict dir]] 1] -1) % $total_length}]

        dict set label_dict top_cut_site $cut_site
        dict set label_dict bottom_cut_site $bottom_cut_site
        dict set label_dict enz_tick_length 10
        dict set label_dict enz_label_subst "%l %n (%#)"
        dict set label_dict show_connector 1

        $c bind $id <<Label>> $label_dict

        # circular enzyme map bindings
        set config_treeview "[winfo toplevel $c].f_config.tabframe.enzymes.frame1.tv"
        $c bind $id <Button-1> "textsetcursor $w \[bp2ix $w.textarea $cut_site\]; $w.textarea tag remove tempsel 1.0 end; send_data <<EnzymeClick>> \[list [dict get $label_dict name] $c\]; if {\[winfo exists $config_treeview\]} {$config_treeview selection set $id; $config_treeview see $id}" 
        $c bind $id <Shift-Button-1> "select_region $w \[$w.textarea index insert\] \[bp2ix $w.textarea $cut_site\]; sputs sctv $config_treeview $id; if {\[winfo exists $config_treeview\]} {$config_treeview selection add $id; $config_treeview see $id}" 
        $c bind $id <Shift-Double-Button-1> "select_region $w \[$w.textarea index insert\] \[bp2ix $w.textarea $cut_site\]; event generate $c <<Return>>;break"
        $c bind $id <$modifier2-Button-1> " textsetcursor $w \[bp2ix $w.textarea $bottom_cut_site\]; $w.textarea tag remove tempsel 1.0 end" 
        $c bind $id <$modifier2-Shift-Button-1> "select_region $w \[$w.textarea index insert\] \[bp2ix $w.textarea $bottom_cut_site\]" 
        $c bind $id <$modifier2-Shift-Double-Button-1> "select_region $w \[$w.textarea index insert\] \[bp2ix $w.textarea $bottom_cut_site\]; event generate $c <<Return>>;break"
        lappend info($w,linked_events) [list $c $id <Button-1>] [list $c $id <Shift-Button-1>] [list $c $id <Shift-Double-Button-1>] [list $c $id <$modifier2-Button-1>] [list $c $id <$modifier2-Shift-Button-1>] [list $c $id <$modifier2-Shift-Double-Button-1>]
      } else {
        #feature label drawing        
        set direction [lindex [$w.textarea tag bind $tag <<Metadata>>] 3]
        set gformat_dict [lindex [$w.textarea tag bind $tag <<Metadata>>] 1]
        if { [dict exists $gformat_dict circular_label_font]} {
          set font [dict get $gformat_dict circular_label_font]
        } else {
          set font [list $info(graphicfontfamily) $info(graphicfontsize)]
          dict set gformat_dict circular_label_font $font
        }
        dict set label_dict direction $direction
        set tag_color  [format "\#%04X%04X%04X" {*}[winfo rgb . [lindex [$w.textarea tag bind $tag <<Revcolors>>] $direction]]]
        if {[dict exists $gformat_dict outline_color_$direction]} {
          set tag_bg_color [dict get $gformat_dict outline_color_$direction]
        } else {
          set tag_bg_color [gray_color $tag_color]
        }
        if { [dict exists $gformat_dict circular_label_color_$direction]} {
          set label_color [dict get $gformat_dict circular_label_color_$direction]
        } else {
          set label_color $tag_color
        }
        if { [dict exists $gformat_dict circular_tick_color_$direction]} {
          set tick_color [dict get $gformat_dict circular_tick_color_$direction]
        } else {
          set tick_color $tag_bg_color
        }
        if { [dict exists $gformat_dict circular_tick_length]} {
          set tick_length [dict get $gformat_dict circular_tick_length]
        } else {
          ## should set this from gformat defaults
          set tick_length 10
        }
        dict set label_dict fea_tick_length $tick_length

        # feature label text
        set id [$c create text [expr {($radius+$tick_length+5)*sin($angle)}] [expr {-($radius+15)*cos($angle)}] -text "[dict get $label_dict name]" -anchor $anchor -font $font  -fill $label_color -tags [list feature $tag label moveablelabel dir$direction]] 

       #tick line
        set lineid_aa [$c create line [expr {0.5 + $radius*sin($angle)}] [expr {0.5 - $radius*cos($angle)}] [expr {0.5 + ($radius+$tick_length)*sin($angle)}] [expr {0.5 - ($radius+$tick_length)*cos($angle)}] -width [expr {$info(antialias_width) +1}]  -tags [list $tag [dict get $label_dict type] tick_aa $id.tick_aa aa]]
        set lineid [$c create line [expr {0.5 + $radius*sin($angle)}] [expr {0.5 - $radius*cos($angle)}] [expr {0.5 + ($radius+$tick_length)*sin($angle)}] [expr {0.5 - ($radius+$tick_length)*cos($angle)}] -capstyle round -tags [list $tag [dict get $label_dict type] tick $id.tick]]

        #connector line
        set connectorid_aa [$c create line [expr {0.5 + ($radius+$tick_length)*sin($angle)}] [expr {0.5 - ($radius+$tick_length)*cos($angle)}] [expr {($radius+$tick_length+5)*sin($angle)}] [expr {-($radius+15)*cos($angle)}] -state [expr {$info(draw_graphic_connectors)?"normal":"hidden"}] -width [expr {$info(antialias_width) +1}]  -tags [list $tag [dict get $label_dict type] connector_aa $id.connector_aa aa]]
        set connectorid [$c create line [expr {0.5 + ($radius+$tick_length)*sin($angle)}] [expr {0.5 - ($radius+$tick_length)*cos($angle)}] [expr {($radius+$tick_length+5)*sin($angle)}] [expr {-($radius+15)*cos($angle)}] -state [expr {$info(draw_graphic_connectors)?"normal":"hidden"}] -capstyle round -tags [list $tag [dict get $label_dict type] connector $id.connector]]
        if { [dict exists $gformat_dict circular_tick_width]} {
          set tick_width [dict get $gformat_dict circular_tick_width]
        } else {
          ## should set this from gformat defaults
          set tick_width 1
        }
        if { [dict exists $gformat_dict circular_show_connector]} {
          set show_connector [dict get $gformat_dict circular_show_connector]
          if {$show_connector} {
           if {$info(antialias_show)} {
             $c itemconfigure $connectorid_aa -state ""
           }
           $c itemconfigure $connectorid -state ""
          } else {
           $c itemconfigure $connectorid_aa -state "hidden"
           $c itemconfigure $connectorid -state "hidden"
          }
        } else {
          set show_connector $info(draw_graphic_connectors)
        }
        dict set label_dict show_connector $show_connector


        if {[catch { set label_box_type  [dict get $gformat_dict label_box_type]}]} {
          set label_box_type r_rect
        }
        if {[catch { set label_box_fill_color  [dict get $gformat_dict label_box_fill_color]}]} {
          set label_box_fill_color {}
        }
        if {[catch { set label_box_outline_color  [dict get $gformat_dict label_box_outline_color]}]} {
          #set label_box_outline_color $label_color
          set label_box_outline_color white
        }
        if {[catch { set label_box_outline_width  [dict get $gformat_dict label_box_outline_width]}]} {
          set label_box_outline_width 2
        }
   
        set boxid [$c create polygon  0 0  -smooth raw  -fill $label_box_fill_color -outline $label_box_outline_color -width $label_box_outline_width -tags [list feature $tag label_box $id.box]]
        $c bind $boxid <<Box>> [dict create type $label_box_type]
        graphic_map_redraw_label_box $c $id
        $c raise $id $boxid

        if { [dict exists $gformat_dict use_arc]} {
          set use_arc [dict get $gformat_dict use_arc]
        } else {
          set use_arc 0
        }

        dict set label_dict use_arc $use_arc
        foreach char [split [dict get $label_dict name] ""] {
          $c create text 0 0 -text $char -font $font -fill $label_color -tags [list $tag circular_label feature]
        }
        $c bind $tag&&(circular_label) <$modifier-Button1-Motion> "canvas_circular_text $c $tag \[expr {sqrt(\[$c canvasx %x\]*\[$c canvasx %x\]+\[$c canvasy %y\]*\[$c canvasy %y\])}\]"
        if {$info(android)} {
          $c bind $tag&&(circular_label) <Button1-Motion> "canvas_circular_text $c $tag \[expr {sqrt(\[$c canvasx %x\]*\[$c canvasx %x\]+\[$c canvasy %y\]*\[$c canvasy %y\])}\]"
        }

        if {$use_arc} {
          $c itemconfigure $id -state "hidden"
          $c itemconfigure $boxid -state "hidden"
        } else {
          $c itemconfigure $tag&&circular_label -state "hidden"
        }

        dict set label_dict fea_label_subst "%n"

        $c itemconfigure $lineid -fill $tick_color -width $tick_width
        $c itemconfigure $lineid_aa -fill [mix_color $tick_color [$c cget -background] $info(antialias_percent)] -width [expr {$info(antialias_width) + $tick_width}]
        $c itemconfigure $connectorid -fill $tick_color -width $tick_width
        $c itemconfigure $connectorid_aa -fill [mix_color $tick_color [$c cget -background] $info(antialias_percent)] -width [expr {$info(antialias_width) + $tick_width}]
        $c bind $id <<Colors>> [list $label_color red $tick_color $label_box_outline_color]
        $c bind $id <<Label>> $label_dict
        $c bind $tag <<Label>> $label_dict
        $c bind $tag <<Gformat>> $gformat_dict
        $c bind 1 <<Feature_list>> [concat [$c bind 1 <<Feature_list>>] $tag]
      }
      
      #scan [$c bbox $id] "%u %u %u %u" x1 y1 x2 y2
      #if {$x1 < $minx} {set minx $x1}
      #if {$y1 < $miny} {set miny $y1}
      #if {$x2 > $maxx} {set maxx $x2}
      #if {$y2 > $maxy} {set maxy $y2}
    }


    #draw features
    set feature_ranges(0) [list]
    foreach {name tag} [feature_find $w] {
      set ftag [regsub fn [dict get $label_dict tag] f]
      set gformat_dict [$c bind $ftag <<Gformat>>]
      draw_circular_feature $w $c $tag
 
      
      ## move labels if they were explicitly moved in the gformat_dict
      if {[dict exists $gformat_dict circular_label_polar_pos] && [set item [$c find withtag $ftag&&moveablelabel]] !={}} {
        set coord_list [$c bind $ftag <<Coord_list>>]
#sputs get $gformat_dict [dict get $gformat_dict circular_label_polar_pos] 
        set feature_center_angle  [expr {([lindex $coord_list 0] + [lindex $coord_list end-1] + [lindex $coord_list end])*-1 / 2.0 + 90}]
#sputs fca $feature_center_angle
        lassign [$c coords $item] lx ly
        lassign [dict get $gformat_dict circular_label_polar_pos] new_r new_a
        set new_a [expr {$new_a + $feature_center_angle}]
        set new_r [expr {$info(circ_map_radius) * $new_r}]
        set new_x [expr {$new_r * sin($new_a * pi() / 180.0)}]
        set new_y [expr {$new_r * -1* cos($new_a * pi() / 180.0)}]
#sputs new $new_x $new_y
        drag_moveablelabel $c $item 0 [expr {$new_x}] 0  [expr {$new_y}]
      } elseif {[dict exists $gformat_dict circular_label_pos] && [set item [$c find withtag $ftag&&moveablelabel]] !={}} {
	lassign [$c bbox $item] lx ly lx2 ly2
	if {$lx ne {}} {
	  $c moveto $item $lx $ly
          foreach {lx ly} [dict get $gformat_dict circular_label_pos] {}
          drag_moveablelabel $c $item 0 [expr {$lx *  $info(circ_map_radius)}] 0  [expr {$ly *  $info(circ_map_radius)}]
	}
      }
    }
    $c lower tick
    $c lower connector
    $c lower tick_aa
    $c lower connector_aa
    $c raise circular_label

    if {!$info(antialias_show)} {
      $c itemconfigure aa -state hidden
    }
    ## bump all moveable labels
    foreach i [$c find withtag moveablelabel] {
      if {[$c bind $i <<Moved>>] ==""} {
        circular_map_reset_moveablelabel $c $i
      }
    }
    circular_map_bump_all_moveablelabel $c "" 1;     ## set last arg to 1 to avoid connectors in bump process

    circular_map_add_scale $c
    ## hide all circular texts
    #$c itemconfigure circular_label -state hidden

    #make the enzyme sequence text box
    $c create text 0 [expr {20+2*$info(graphicfontsize)}] -tags [list seqtext] -justify center -fill $info(graphic_fg_color) -anchor s -font [list $info(graphicfontfamily) $info(graphicfontsize)]

    #draw info text
    # values set from $info($w,gformat_data) or info(graphic_map_properties)
    $c create text $circular_title_x $circular_title_y -text "[file rootname [wm title $w]]" -justify center -width [expr {$radius * 1.25}] -font $circular_title_font -tags {title moveabletext} -anchor s -state $circular_title_state  -fill $info(graphic_fg_color)
    $c create text $circular_seq_length_x $circular_seq_length_y  -text "[expr $total_length] bp" -justify center -font $circular_seq_length_font -tags {seq_length moveabletext} -anchor n -state $circular_seq_length_state  -fill $info(graphic_fg_color)

    $c create text $circular_file_comment_x $circular_file_comment_y  -text  [$w.comframe.comtextframe.text get 1.0 end] -justify center -font $circular_file_comment_font -tags {file_comment moveabletext} -anchor s -state $circular_file_comment_state  -fill $info(graphic_fg_color)
    $c create text $circular_enz_list_x $circular_enz_list_y  -text [list_enzymes_text $w] -justify center -font $circular_enz_list_font -tags {enz_list moveabletext} -anchor s -state $circular_enz_list_state -fill $info(graphic_fg_color)
    $c create text $circular_feature_list_x $circular_feature_list_y  -text [list_features $w 1] -justify center -font $circular_feature_list_font -tags  {feature_list moveabletext} -anchor s -state $circular_feature_list_state -fill $info(graphic_fg_color)
  } else {

 #######draw linear map

    $c create line 0 350 390 350 -tags {baseline line}
    $c bind baseline <<Total_length>> [expr {$end-$start}]
    $c bind baseline <<Start_index>> $start
    $c bind baseline <<End_index>> $end
    set templist [linear_enz_sort $w [lsort -unique [concat $enz_list $extra_enz]] $start $end]

    #draw enzymes
    set maxx 400; set maxy 370; set minx 0; set miny 340

    foreach var [list linear_enz_label_box_type linear_enz_label_box_fill_color linear_enz_label_box_outline_color linear_enz_label_box_outline_width] {
      if {[dict exists $info($w,gformat_data) $var]} {
        set $var [dict get $info($w,gformat_data) $var]
      } else {
        set $var [dict get $info(graphic_map_properties) $var]
      }
    }

    set bump [expr -[font metrics graphicfont -linespace]]
    set xright 0
    set lastloc -1
    set nexty [expr 335+$bump]
    foreach pair $templist  {
      set x [expr {0 + 390 * ([lindex $pair 3] - $start) / $total_length}]
      #if {$lastloc != [lindex $pair 0]} {
      #  set lineid [$c create line $x 340 $x 350 -tags [list [lindex $pair 1] visible]]
      #} else {
      #  $c itemconfigure $lineid -tags [concat [$c itemcget $lineid -tags] [lindex $pair 1]]
      #}
      set lastloc [lindex $pair 0]
      
      if {$x > $xright} {
        set y 335
        set nexty [expr 335+$bump]
      } else {
        set y $nexty
        set nexty [expr $nexty+$bump]
      }
      while {[$c find overlapping $x [expr {$y-1}] [expr {$x+1}] [expr {$y-2}]] != ""} {
        set y $nexty
        set nexty [expr $nexty+$bump]      
      }
      set id [$c create text $x $y -text "[lindex $pair 0] [lindex $pair 1] \([llength $info($w,[lindex $pair 1])]\)" -anchor "sw" -font [list $info(graphicfontfamily) $info(graphicfontsize)] -fill black -tags [list [lindex $pair 1] moveableboxlabel enzyme label]]
      $c create line $x 340 $x 350 -tags [list [lindex $pair 1] $id.tick_aa aa visible] -width [expr {1+ $info(antialias_width)}] -fill [mix_color $info(graphic_fg_color) [$c cget -background] $info(antialias_percent)]
      $c create line $x 340 $x 350 -tags [list [lindex $pair 1] $id.tick visible] -fill $info(graphic_fg_color) -width [expr {1}] -capstyle round

      $c create line $x 340 $x $y -state [expr {$info(draw_graphic_connectors)?"normal":"hidden"}] -width [expr {1+ $info(antialias_width)}] -tags [list [lindex $pair 1] $id.connector_aa connector_aa aa] -fill [mix_color $info(graphic_fg_color) [$c cget -background] $info(antialias_percent)]
      $c create line $x 340 $x $y -state [expr {$info(draw_graphic_connectors)?"normal":"hidden"}] -width [expr {1}]  -capstyle round -fill $info(graphic_fg_color) -tags [list [lindex $pair 1] $id.connector connector] 
      #set boxid [$c create rectangle [lindex [$c bbox $id] 0] [lindex [$c bbox $id] 1] [lindex [$c bbox $id] 2] [lindex [$c bbox $id] 3] -fill [$c cget -background] -outline {}  -tags [list $id.box box]] 
      set boxid  [$c create polygon 0 0 -smooth raw -fill $linear_enz_label_box_fill_color -outline $linear_enz_label_box_outline_color  -tags [list [lindex $pair 1] $id.box box]] 
      $c bind $boxid <<Box>> [dict create type $linear_enz_label_box_type]
      graphic_map_redraw_label_box $c $id
      $c raise $id $boxid
      if {[lsearch -exact $enz_list [lindex $pair 1]] > -1} {
        $c bind $id <<Colors>> [list black red  $info(graphic_fg_color) $linear_enz_label_box_outline_color]
        #$c bind $id <Any-Enter> "$c raise [lindex $pair 1];$c raise box;$c raise moveableboxlabel; $c itemconfigure [lindex $pair 1]&&(label||connector) -fill \[lindex \[$c  bind $id <<Colors>>\] 1\]; $c itemconfigure [lindex $pair 1]&&(box) -outline \[lindex \[$c  bind $id <<Colors>>\] 1\]"
        #$c bind $id <Any-Leave> "$c itemconfigure [lindex $pair 1]&&(label) -fill \[lindex \[$c  bind $id <<Colors>>\] 0\];$c itemconfigure [lindex $pair 1]&&(connector) -fill \[lindex \[$c  bind $id <<Colors>>\] 2\];$c itemconfigure [lindex $pair 1]&&box -outline \{*\}\[lindex \[$c  bind $id <<Colors>>\] 3\]"
      } else {
        $c bind $id <<Colors>> [list gray50 blue gray50 $linear_enz_label_box_outline_color]
        $c itemconfigure $id -fill gray50
        $c itemconfigure $id.connector -fill gray50
        $c itemconfigure $id.tick -fill gray50
        $c itemconfigure $id.connector_aa -fill [mix_color gray50 [$c cget -background] $info(antialias_percent)]
        $c itemconfigure $id.tick_aa -fill [mix_color gray50 [$c cget -background] $info(antialias_percent)]
        $c itemconfigure $boxid -outline $linear_enz_label_box_outline_color
        #$c bind $id <Any-Enter> "$c raise [lindex $pair 1];$c raise box;$c raise moveableboxlabel; $c itemconfigure [lindex $pair 1]&&(label||connector) -fill \[lindex \[$c  bind $id <<Colors>>\] 1\]; $c itemconfigure [lindex $pair 1]&&(box) -outline \[lindex \[$c  bind $id <<Colors>>\] 1\]"
        #$c bind $id <Any-Leave> "$c itemconfigure [lindex $pair 1]&&(label) -fill \[lindex \[$c  bind $id <<Colors>>\] 0\];$c itemconfigure [lindex $pair 1]&&(connector) -fill \[lindex \[$c  bind $id <<Colors>>\] 2\];$c itemconfigure [lindex $pair 1]&&box -outline \{*\}\[lindex \[$c  bind $id <<Colors>>\] 3\]"
      }

        # linear enzyme map bindings
      set config_treeview "[winfo toplevel $c].f_config.tabframe.enzymes.frame1.tv"
      $c bind $id <Any-Enter> "graphic_map_recolor_enzymes $c [lindex $pair 1] Enter"
      $c bind $id <Any-Leave> "graphic_map_recolor_enzymes $c [lindex $pair 1] Leave"
      $c bind $id <Any-Enter> "+$c itemconfigure seqtext -text {$enzinfo(enz_pattern,[lindex $pair 1])}"
      $c bind $id <Any-Leave> "+$c itemconfigure seqtext -text {}"
      set cut_site [expr {([lindex [enz_cut_offset [lindex $pair 1] [lindex $pair 0] [lindex $pair 2]] 0]-1) % $seq_length}]
      set bottom_cut_site [expr {([lindex [enz_cut_offset [lindex $pair 1] [lindex $pair 0] [lindex $pair 2]] 1]-1) % $seq_length}]
      $c bind $id <<Label>> [list type enzyme location_start [lindex $pair 0] name [lindex $pair 1] tag [lindex $pair 1] count [llength $info($w,[lindex $pair 1])] dir [lindex $pair 2]]
      $c bind $id <Button-1> "textsetcursor $w \[bp2ix $w.textarea $cut_site\]; $w.textarea tag remove tempsel 1.0 end; send_data <<EnzymeClick>> \[list [lindex $pair 1] $c\]; if {\[winfo exists $config_treeview\]} {$config_treeview selection set $id; $config_treeview see $id}" 
      $c bind $id <Shift-Button-1> "select_region $w \[$w.textarea index insert\] \[bp2ix $w.textarea $cut_site\]; if {\[winfo exists $config_treeview\]} {$config_treeview selection add $id; $config_treeview see $id}" 
      $c bind $id <Shift-Double-Button-1> "select_region $w \[$w.textarea index insert\] \[bp2ix $w.textarea $cut_site\]; event generate $c <<Return>>; break" 
      $c bind $id <$modifier2-Button-1> "textsetcursor $w \[bp2ix $w.textarea $bottom_cut_site\]; $w.textarea tag remove tempsel 1.0 end; " 
      $c bind $id <$modifier2-Shift-Button-1> "select_region $w \[$w.textarea index insert\] \[bp2ix $w.textarea $bottom_cut_site\]" 
      $c bind $id <$modifier2-Shift-Double-Button-1> "select_region $w \[$w.textarea index insert\] \[bp2ix $w.textarea $bottom_cut_site\]; event generate $c <<Return>>; break" 
      lappend info($w,linked_events) [list $c $id <Button-1>] [list $c $id <Shift-Button-1>] [list $c $id <Shift-Double-Button-1>] [list $c $id <$modifier2-Button-1>] [list $c $id <$modifier2-Shift-Button-1>] [list $c $id <$modifier2-Shift-Double-Button-1>]

      scan [$c bbox $id] "%u %u %u %u" x1 y1 x2 y2
      if {$y1 < $miny} {set miny $y1}
      if {$x2 > $maxx} {set maxx $x2}
      if {$y == 335} {set xright [expr {23 + $x2}]}
    }
    $c raise box;$c raise moveableboxlabel

    #draw file identifiers
    set y [expr {350+5}]
    set ystep [font metrics [list $info(graphicfontfamily) $info(graphicfontsize)] -displayof . -linespace]
    incr y $ystep
    $c create text 0 $y -text "[wm title $w] from [expr {1+$start}] to $end" -anchor "sw" -font  [dict get $info(graphic_map_properties) linear_title_font]  -fill $info(graphic_fg_color) -tags {title visible moveabletext}
    incr y $ystep
    $c create text 0 $y  -justify left -anchor sw -font  [dict get $info(graphic_map_properties) linear_seqtext_font]  -fill $info(graphic_fg_color) -tags {seqtext visible}
    incr y 5

    #draw features
    set templist [feature_find $w $start $end]
    global icount
    set icount 0
    if {[llength $templist] > 100} {
      if {$info(use_tile)} {
        grid [label $w.pleasewait -width 50 -bg yellow -text [mc "Searching for Features, Please wait..."]] -row 2 -column 0  -columnspan 3  -sticky new
        grid [ttk::progressbar $w.pleasewait_prog -maximum [llength $templist] -variable icount -orient horizontal -mode determinate] -row 3 -column 1  -sticky new
      } else {
        grid [label $w.pleasewait -width 50 -bg yellow -text [mc "Searching for Features, Please wait..."]] -row 2 -column 0  -columnspan 3  -sticky new
      }
    }
    update idletasks
    #set depthdict [tagdepth_features $w.textarea [bp2ix $w.textarea $start] [bp2ix $w.textarea $end]]
    foreach {name tag} $templist {
      regsub "fn" $tag "f" tag
      #if {[dict exists $depthdict $tag]} {
      #  set yplus [dict get $depthdict $tag]
      #} else {
        set yplus 0
      #}
      if {$start < $end} {
        linear_feature_draw $c [expr {$y+ $yplus*30}] $w $start $end 0 $total_length $tag $tag
      } else {
        linear_feature_draw $c [expr {$y+ $yplus*30}] $w $start [expr {$seq_length + $end}] 0 $total_length $tag $tag
      }
      incr icount 2
      if {($icount % 100) ==0} {
        update idletasks
      }
    }
    $c raise label_box

    $c raise label
    destroy icount
    destroy $w.pleasewait
    if {[winfo exists $w.pleasewait_prog]} {destroy $w.pleasewait_prog}
    if {$info(linear_map_bump_label)} {
      linear_feature_label_bump $c
    }
    update idletasks
  }

  if {!$info(antialias_show)} {
    $c itemconfigure aa -state hidden
  }

  if {1} {
    $c configure -scrollregion [$c bbox all] -xscrollcommand "optionscrollbar $a.xscroll " -yscrollcommand "optionscrollbar $a.yscroll " -confine True
    set info($a,scale) 100
    set info($a,new_scale) 100
    grid rowconfigure $a 2 -weight 1
    grid columnconfigure  $a 0 -weight 1
    #need to set the minimum size here to save room for a scrollbar, to prevent infinite loops with autoscaling size (see <Configure> above)
    grid columnconfigure  $a 1 -minsize 17
    grid configure $c -row 2 -column 0 -sticky nsew
    grid configure [scrollbar $a.yscroll -command "$c yview " ] -row 2 -column 1 -sticky nes 
    grid configure  [scrollbar $a.xscroll -orient horizontal -command "$c xview"] -row 3 -column 0 -sticky wse

    wm deiconify $a
    #update

  }

  if {($region == "all") && ($info($w,circular) == "circular")} {
    foreach {x0 y0 x1 y1} [$a.canvas bbox all] {}
    wm geometry [winfo toplevel $a] [expr {min ($x1 - $x0 + 25, ([winfo vrootwidth $a]-100))}]x[expr {min ($y1 - $y0 + 25, ([winfo vrootheight $a]-150))}]
    #window resizing for circular maps- keeps the aspect ration constant and centered
    #the following keeps everything centered when the window is wider than the scrollregion, but requires scrollincrement= 1
    $c configure -xscrollincrement 1 -yscrollincrement 1

    #update
     #the following keeps everything scaled to fit and centered when the window is wider than the scrollregion, but requires scrollincrement= 1
    bind $c <Configure> {       set new_scale [expr {min(1.0*max(([winfo height %W]-20), 300)/([lindex [%W bbox all] 3]-[lindex [%W bbox all] 1]), 1.0*max(([winfo width %W]-40), 300)/([lindex [%W bbox all] 2]-[lindex [%W bbox all] 0]))}]
      if {$new_scale == 0} {continue}
      %W scale all 0 0 $new_scale $new_scale
      %W configure -scrollregion [%W bbox all]
      set templist [%W bbox all]
      %W xview scroll [expr {int((([lindex $templist 2]+[lindex $templist 0]-[winfo width %W])/2-[%W canvasx 0]))}] unit
      %W yview scroll [expr {int(([lindex $templist 3]+[lindex $templist 1]-[winfo height %W])/2-[%W canvasy 0])}] unit
      if {[%W type 1] == "oval"} {
        foreach tag [%W bind 1 <<Feature_list>>] {
          if {[set exon [lindex [%W find withtag $tag&&exon] 0]] != {}} {
            ## need to use gformat_dict feature_relative_radius if it exists, to set the radius to a fixed point difference, keeping things from getting overlapped
            #change_radius %W $tag {}
             set label_dict  [%W bind $tag <<Label>>]
              if { [dict exists $label_dict feature_relative_radius]} {
                set new_r [expr {[lindex [%W coords [%W find withtag circle]] 2] + [dict get $label_dict feature_relative_radius]}]

                set old_r [lindex [%W coords $tag&&exon] 2]
                change_radius %W $tag $new_r
                set label_dict2 [%W bind [%W find withtag $tag&&moveablelabel] <<Label>>]
                if {![dict exists $label_dict2  tick_anchor_raduis ] || [dict get $label_dict2  tick_anchor_raduis] eq {}} {
                  set r_diff [expr {$new_r-$old_r}]
                  foreach e1 [%W find withtag $tag&&(tick||connector||tick_aa||connector_aa||moveablelabel] {
                    set c_list [list]
                    foreach {x0 y0} [%W coords $e1] {
                       lappend c_list [expr {$r_diff * $x0 / sqrt($x0**2 + $y0**2) + $x0}] [expr {$r_diff * $y0 / sqrt($x0**2 + $y0**2) + $y0}]
                    }
                    %W coords $e1 {*}$c_list
                  } 
                } else {#sputs tagh $tag}
              } else {
                change_radius %W $tag [lindex [%W coords $exon] 2] 
              }


            #change_radius %W $tag [lindex [%W coords $exon] 2] 
          }
          if {[set circ_label [lindex [%W find withtag $tag&&circular_label] 0]] != {}} {
            #canvas_circular_text %W $tag [expr {sqrt([lindex [%W coords $circ_label] 0]*[lindex [%W coords $circ_label] 0] + [lindex [%W coords $circ_label] 1]*[lindex [%W coords $circ_label] 1])}]
            canvas_circular_text %W $tag {}
          }
	  %W itemconfigure title -width [expr {[lindex [%W coords $exon] 2] * 1.25}]
        }
        foreach label [%W find withtag label] {
          graphic_map_redraw_label_box %W $label
        }

         circular_map_reset_all_moveablelabel %W

        circular_map_change_scale_radius %W [circular_map_get_scale_radius %W]
        #if {[lindex [%W coord 1] 2] > 30} {
        #  set info(circ_map_radius) [expr {int([lindex [%W coord 1] 2])}]
        #}
      }
      unset -nocomplain templist new_scale exon tag label circ_label
    }

  } else {
    #window resizing for linear maps- resizes image to width, keeps height constant, resizes moveableboxlabel boxes
      # uses linear_feature_draw_arrow to redraw the arrows
    foreach {x0 y0 x1 y1} [$a.canvas bbox all] {}
    wm geometry [winfo toplevel $a] [expr {min ($x1 - $x0 + 40, ([winfo vrootwidth $a]-100))}]x[expr {min ($y1 - $y0 + 25, ([winfo vrootheight $a]-150))}]
    bind $c <Configure> {
      set new_scale [expr { 1.0*max(([winfo width %W]-17), 300)/([lindex [%W bbox line||label||moveableboxlabel] 2]-[lindex [%W bbox line||label||moveableboxlabel] 0])}]
      if {$new_scale == 0} {continue}

      %W scale all 0 350 $new_scale 1
      %W configure -scrollregion [%W bbox all]
      foreach boxlabel [%W find withtag moveabletext||moveableboxlabel] {
        graphic_map_redraw_label_box %W $boxlabel
      }
      unset -nocomplain boxlabel
      foreach fea [%W find withtag feature&&label] {
        linear_feature_draw_arrow %W [lsearch -regexp -inline [%W gettags $fea] {f[0-9]+#}]
      }
      unset -nocomplain fea 
      unset -nocomplain new_scale
      linear_map_reset_all_features %W
      linear_map_bump_all_features %W
      linear_map_reset_all_boxlabels %W
      linear_map_bump_all_boxlabels %W
    }

  }

  $c bind moveabletext <$modifier-Button-1> "set cmoveitem \[$c find withtag current&&moveabletext\]; if {\[$c type \$cmoveitem\] == \"text\"} {set cmdx \[expr {\[lindex \[$c coords \$cmoveitem\] 0\]-%x}\]; set cmdy \[expr {\[lindex \[$c coords \$cmoveitem\] 1\]-%y}\]} else {unset cmoveitem}"
  $c bind moveabletext <$modifier-B1-Motion> "if {!\[info exists cmoveitem\]} {[$c bind moveabletext <$modifier-Button-1>]} else {$c coords \$cmoveitem \[expr {\$cmdx+%x}\] \[expr {\$cmdy+%y}\]; graphic_map_recenter_label_box $c \$cmoveitem; $c bind \$cmoveitem <<Moved>> 1}"
  $c bind moveabletext <$modifier-ButtonRelease-1> "unset -nocomplain cmoveitem cmdx cmdy; $c configure -scrollregion \[$c bbox all\]"



## need to put a proc here - move the connector and tick, circular vs linear, need to bind to tick items to drag the knee point of the connector
  $c bind moveablelabel <$modifier-Button-1> "set cmoveitem \[$c find withtag current\]; if {(\[$c type \$cmoveitem\] == \"text\") && (\[$c type \[set cmoveitem2 \[$c find withtag \$cmoveitem.connector \]\]\] == \"line\")} {set cmdx \[expr {\[lindex \[$c bbox \$cmoveitem\] 0\]-%x}\]; set cmdy \[expr {\[lindex \[$c bbox \$cmoveitem\] 1\]-%y}\]} else {unset cmoveitem cmoveitem2}; break"
  $c bind moveablelabel <$modifier-B1-Motion> "if {!\[info exists cmoveitem\]} {[$c bind moveablelabel <$modifier-Button-1>]} else {drag_moveablelabel $c \$cmoveitem \$cmdx %x \$cmdy %y; graphic_map_recenter_label_box $c \$cmoveitem}"
  $c bind moveablelabel <$modifier-ButtonRelease-1> "unset -nocomplain cmoveitem cmdx cmdy cmoveitem2; $c configure -scrollregion \[$c bbox all\]"

  $c bind moveableboxlabel <$modifier-Button-1> "set cmoveitem \[$c find withtag current\]; if {(\[$c type \$cmoveitem\] == \"text\") && (\[set cmoveitem2 \[$c find withtag \$cmoveitem.connector \]\] != \"\") } {set cmdx %x; set cmdy %y; set cmx1 \[lindex \[$c coords \$cmoveitem\] 0\]; set cmy1 \[lindex \[$c coords \$cmoveitem\] 1\]} else {unset -nocomplain cmoveitem cmoveitem2}; break"
  $c bind moveableboxlabel <$modifier-B1-Motion> "if {!\[info exists cmoveitem\]} {[$c bind moveableboxlabel <$modifier-Button-1>]} else {$c coords \$cmoveitem \[expr {\$cmx1+%x-\$cmdx}\] \[expr {\$cmy1+%y-\$cmdy}\]; $c coords \$cmoveitem2 \[lindex \[$c coords \$cmoveitem2\] 0\] \[lindex \[$c coords \$cmoveitem2\] 1\] \[expr {\$cmx1+%x-\$cmdx}\] \[expr {\$cmy1+%y-\$cmdy}\]; $c coords \[$c find withtag \$cmoveitem.connector_aa\] \[$c coords \$cmoveitem2\];graphic_map_recenter_label_box $c \$cmoveitem}"
  $c bind moveableboxlabel <$modifier-ButtonRelease-1> "unset -nocomplain cmoveitem cmx1 cmy1 cmdx cmdy cmoveitem2 cmoveitem3; $c configure -scrollregion \[$c bbox all\]"


  set outputmenu [add_output_menu $c "Image" image $w]

  if {$info(android)} {
    bind $c <Configure> ""
    if {($region == "all") && ($info($w,circular) == "circular")} {
        bind $c <<PinchToZoom>> "android_pinch_circular_map_scale %x %s $c"
    } else {
        bind $c <<PinchToZoom>> "android_pinch_linear_map_scale %x %s $c"
    }
    bind $c <Button-1> "if {\[$c find withtag current\] == {}} {$c scan mark  %x %y}"
    bind $c <Button1-Motion> "if {\[$c find withtag current\] == {}} {$c scan dragto  %x %y 2}"
    $c bind moveabletext <Button-1> "[$c bind moveabletext <$modifier-Button-1> ]; break"
    $c bind moveabletext <B1-Motion> "[$c bind moveabletext <$modifier-B1-Motion> ]; break"
    $c bind moveabletext <ButtonRelease-1> "[$c bind moveabletext <$modifier-ButtonRelease-1>]; break"
    $c bind moveablelabel <Button-1> "[$c bind moveablelabel <$modifier-Button-1> ]; break"
    $c bind moveablelabel <B1-Motion>  "[$c bind moveablelabel <$modifier-B1-Motion>]; break"
    $c bind moveablelabel <ButtonRelease-1> "[$c bind moveablelabel <$modifier-ButtonRelease-1> ]; break"
    $c bind moveableboxlabel <Button-1> "[$c bind moveableboxlabel <$modifier-Button-1>]; break"
    $c bind moveableboxlabel <B1-Motion> "[$c bind moveableboxlabel <$modifier-B1-Motion> ]; break"
    $c bind moveableboxlabel <ButtonRelease-1> "[$c bind moveableboxlabel <$modifier-ButtonRelease-1>]; break"
  }

  if {($region == "all") && ($info($w,circular) == "circular")} {
    $outputmenu insert 0 command -label [mc "Configure"] -state normal -command "if {!\[info exists c_withtag_current\]} {set c_withtag_current \"\"};circular_map_configure_dialog $c \$c_withtag_current; unset c_withtag_current"
    #$outputmenu insert 1 cascade -label [mc "Change font size"] -state normal -menu $outputmenu.feature_size_menu
    menu $outputmenu.feature_size_menu
    $outputmenu.feature_size_menu add command -label [mc "Increase Feature and Enzyme"] -state normal -command "enz_graphic_map_resize_labels $c all +1"
    $outputmenu.feature_size_menu add command -label [mc "Decrease Feature and Enzyme"] -state normal -command "enz_graphic_map_resize_labels $c all -1"
    $outputmenu.feature_size_menu add command -label [mc "Increase Feature"] -state normal -command "enz_graphic_map_resize_labels $c feature +1"
    $outputmenu.feature_size_menu add command -label [mc "Decrease Feature"] -state normal -command "enz_graphic_map_resize_labels $c feature -1"
    $outputmenu.feature_size_menu add command -label [mc "Increase Enzyme"] -state normal -command "enz_graphic_map_resize_labels $c enzyme +1"
    $outputmenu.feature_size_menu add command -label [mc "Decrease Enzyme"] -state normal -command "enz_graphic_map_resize_labels $c enzyme -1"
    $outputmenu insert 1 separator
  } else {
    $outputmenu insert 0 command -label [mc "Configure"] -state normal -command "if {!\[info exists c_withtag_current\]} {set c_withtag_current \"\"};linear_map_configure_dialog $c \$c_withtag_current; unset c_withtag_current"
    #$outputmenu insert 1 cascade -label [mc "Change font size"] -state normal -menu $outputmenu.feature_size_menu
    menu $outputmenu.feature_size_menu
    $outputmenu.feature_size_menu add command -label [mc "Increase Feature and Enzyme"] -state normal -command "enz_graphic_map_resize_labels $c all +1"
    $outputmenu.feature_size_menu add command -label [mc "Decrease Feature and Enzyme"] -state normal -command "enz_graphic_map_resize_labels $c all -1"
    $outputmenu.feature_size_menu add command -label [mc "Increase Feature"] -state normal -command "enz_graphic_map_resize_labels $c feature +1"
    $outputmenu.feature_size_menu add command -label [mc "Decrease Feature"] -state normal -command "enz_graphic_map_resize_labels $c feature -1"
    $outputmenu.feature_size_menu add command -label [mc "Increase Enzyme"] -state normal -command "enz_graphic_map_resize_labels $c enzyme +1"
    $outputmenu.feature_size_menu add command -label [mc "Decrease Enzyme"] -state normal -command "enz_graphic_map_resize_labels $c enzyme -1"
    $outputmenu insert 2 separator
    bind $c <$modifier-Key-b> "linear_feature_rebump_labels $c"
  }

  if {!$info(android)} {
    bind $c <<RightClick>> "set c_withtag_current \[$c find withtag current\] ; tk_popup $outputmenu %X %Y"
  #bind $c <Button-2> "if \{\[$c find withtag current&&moveabletext\] != \"\"\} \{$outputmenu entryconfigure 0 -state normal\} else \{$outputmenu entryconfigure 0 -state disabled\}; tk_popup $a.menubar.outputmenu %X %Y"
  #$a.menubar.outputmenu entryconfigure 0 -command \"sputs \[$c find withtag current\]\"; tk_popup $a.menubar.outputmenu %X %Y"
  }

  #selection mechanism
  #bind $c <Shift-Button-1> "set info(mousex) %x; set info(mousey) %y"
  #bind $c <Shift-ButtonRelease-1> "sputs \[$c find enclosed \[$c canvasx \[expr {min(\$info(mousex), %x)}\]\] \[$c canvasy \[expr {min(\$info(mousey), %y)}\]\] \[$c canvasx \[expr {max(\$info(mousex), %x)}\]\] \[$c canvasy \[expr {max(\$info(mousey), %y)}\]\]\]; unset -nocomplain info(mousex); unset -nocomplain info(mousey)"

  #need to take out scale option if using the <Configure> above that keeps everything scaled
  #set scale_index [$outputmenu index [mc "Scale"]]
  #if {$scale_index != ""} {
  #  $outputmenu delete $scale_index
    #and the separator
   # $outputmenu delete $scale_index    
  #}


  bind $c <MouseWheel> {%W yview scroll [expr {int(10.0 * %D/-$info(mousewheelunits))}] units}
  bind $c <Shift-MouseWheel> {%W xview scroll [expr {int(10.0 * %D/-$info(mousewheelunits))}] units}
  bind $a <MouseWheel> {[winfo toplevel %W].canvas yview scroll [expr {int(10.0 * %D/-$info(mousewheelunits))}] units}
  bind $a <Shift-MouseWheel> {[winfo toplevel %W].canvas xview scroll [expr {int(10.0 *%D/-$info(mousewheelunits))}] units}
  #bind $a <Button-1> "focus $c" 

  if {[info exists info(last_analysis_xy)]} {
    wm geometry [winfo toplevel $a] +[lindex $info(last_analysis_xy) 0]+[lindex $info(last_analysis_xy) 1]
    window_on_screen $a
  }

  focus $a
  focus $c
  return $c
}

################
## Recolor enzyme items on mouseover
################
proc graphic_map_recolor_enzymes {c tag event} {
   # $c bind $id <<Colors>> text_color active_color tick_color box_outline_color
  # $c itemconfigure $id -tags [list enzyme $tag label moveablelabel selected_enz] -fill black
  global info

  set canvas_color [$c cget -background]
  switch $event {
   "Enter" {
      foreach id [$c find withtag $tag&&label] {
        set active_color [lindex [$c bind $id <<Colors>>] 1]
        $c itemconfigure $id -fill $active_color
        $c itemconfigure $id.tick -fill $active_color
        $c itemconfigure $id.connector -fill $active_color
        $c itemconfigure $id.tick_aa -fill [mix_color $active_color $canvas_color $info(antialias_percent)]
        $c itemconfigure $id.connector_aa -fill [mix_color $active_color $canvas_color $info(antialias_percent)]
        $c itemconfigure $id.box -outline $active_color
      }
    }
    "Leave" {
      foreach id [$c find withtag $tag&&label] {
        $c itemconfigure $id -fill [lindex [$c bind $id <<Colors>>] 0]
        $c itemconfigure $id.tick -fill [lindex [$c bind $id <<Colors>>] 2]
        $c itemconfigure $id.connector -fill [lindex [$c bind $id <<Colors>>] 2]
        $c itemconfigure $id.tick_aa -fill [mix_color [lindex [$c bind $id <<Colors>>] 2] $canvas_color $info(antialias_percent)]
        $c itemconfigure $id.connector_aa -fill [mix_color [lindex [$c bind $id <<Colors>>] 2] $canvas_color $info(antialias_percent)]
        $c itemconfigure $id.box -outline [lindex [$c bind $id <<Colors>>] 3]
      }
    }
  } 
}

################
## Enzyme label substitution
################
proc graphic_map_enz_label_subst {c e subst} {
  global enzinfo
  set label_dict [$c bind $e <<Label>>]
  return [string map [list %% % %l [dict get $label_dict location_start] %n [dict get $label_dict name] %t [expr {1+[dict get $label_dict top_cut_site]}] %C [expr {1+[dict get $label_dict top_cut_site]}] %c [expr {1+[dict get $label_dict bottom_cut_site]}] %# [dict get $label_dict count] %e [expr {[dict get $label_dict location_start]+ [string length $enzinfo(flatpat,[dict get $label_dict name])] - 1}] %S $enzinfo(enz_pattern,[dict get $label_dict name]) %A [string range [dict get $label_dict name] 0 0] %> [format {%c} [expr {$enzinfo(flatpat,[dict get $label_dict name]) eq [revcom $enzinfo(flatpat,[dict get $label_dict name])]?8660:([dict get $label_dict dir]?8678:8680)}]] %* [expr {[dict get $label_dict count]< 11?[format {%c} [expr {[dict get $label_dict count]+10101}]]:([dict get $label_dict count]< 21?[format {%c} [expr {[dict get $label_dict count]+9451}]]:"\u2295")}] %+ [expr {[dict get $label_dict count]< 11?[format {%c} [expr {[dict get $label_dict count]+9311}]]:([dict get $label_dict count]< 21?[format {%c} [expr {[dict get $label_dict count]+12880}]]:"\u2295")}] %@ [expr {[dict get $label_dict count]< 11?[format {%c} [expr {[dict get $label_dict count]+10111}]]:"\u2295"}] %! [expr {[dict get $label_dict count]< 11?[format {%c} [expr {[dict get $label_dict count]+10121}]]:"\u2295"}] %( [expr {[dict get $label_dict count]< 11?[format {%c} [expr {[dict get $label_dict count]+9331}]]:"\u2295"}] %. [expr {[dict get $label_dict count]< 11?[format {%c} [expr {[dict get $label_dict count]+9351}]]:"\u2295"}] %$ [expr {[dict get $label_dict count]< 11?[format {%c} [expr {[dict get $label_dict count]+9460}]]:"\u2295"}]] $subst]
}

################
## Feature label substitution
################
#features: $label_dict: type name location_start location_end tag direction
proc graphic_map_fea_label_subst {c e subst} {
  set label_dict [$c bind $e <<Label>>]
  return [string map [list %% % %s [dict get $label_dict location_start] %e [dict get $label_dict location_end] %d [expr {[dict get $label_dict direction]?"\u2190":"\u2192"}] %D [expr {[dict get $label_dict direction]?"\u21E6":"\u21E8"}]  %n [dict get $label_dict name] ] $subst]
}

################
## Drag moveablelabel items- move connector with them
################
proc drag_moveablelabel {c item dx x dy y} {
  ##experimental bump process- don't reset positon of moved objects
  $c bind $item <<Moved>> 1
  set connector [$c find withtag $item.connector]
  set tick [$c find withtag $item.tick]

  set connector_aa [$c find withtag $item.connector_aa]
  set tick_aa [$c find withtag $item.tick_aa]
  foreach {tx1 ty1 tx2 ty2} [$c coords $tick] {}
  foreach {cx1 cy1 cx2 cy2} [$c coords $connector] {}
  foreach {lx1 ly1 lx2 ly2} [$c bbox $item] {}
 
  #$c move $item [expr {-$lx1+$x+$dx}] [expr {-$ly1+$y+$dy}]
  $c moveto $item [expr {$x+$dx}] [expr {$y+$dy}]
  foreach {lx1 ly1 lx2 ly2} [$c bbox $item] {}
  # label center points
  set lcx1 [expr {($lx1+$lx2)/ 2.0}]
  set lcy1 [expr {($ly1+$ly2)/ 2.0}]

  ## set tick length if changed
  set label_dict [$c bind $item <<Label>>]
  if {[dict exists $label_dict fea_tick_length]} {
    set tick_length [dict get $label_dict fea_tick_length]
  } elseif {[dict exists $label_dict enz_tick_length]} {
    set tick_length [dict get $label_dict enz_tick_length]
  } else {
    set tick_length 10
  }
  set r1  [expr {sqrt ($tx1*$tx1+ $ty1*$ty1) }]
  set r2  [expr {sqrt ($tx2*$tx2+ $ty2*$ty2) }]
  if {[expr {abs(abs($r2-$r1)-$tick_length)}] > 0.9} {
    set tx2 [expr {$tx1 * ($r1+ $tick_length) /$r1}]
    set ty2 [expr {$ty1 * ($r1+ $tick_length) /$r1}]
  }
  # alternative tick junction point
  set tx2_2 [expr {2*$tx1- $tx2}]
  set ty2_2 [expr {2*$ty1- $ty2}]
  if {[expr {($lcx1-$tx2)*($lcx1-$tx2)+($lcy1-$ty2)*($lcy1-$ty2) }] >[expr {($lcx1-$tx2_2)*($lcx1-$tx2_2)+($lcy1-$ty2_2)*($lcy1-$ty2_2) }]} {
    set tx2 $tx2_2
    set ty2 $ty2_2
  }
  $c coords $tick $tx1 $ty1 $tx2 $ty2
  $c coords $tick_aa $tx1 $ty1 $tx2 $ty2

  if {$lcy1 < $ty2} {
    set new_cy2 $ly2
    set anchor "s"
  } else {
    set new_cy2 $ly1
    set anchor "n"
  }
  #if {[expr {abs($ty2-$lcy1)*4}]  < [expr {abs($tx2-$lcx1)}]} {
   # set anchor ""
  #  set new_cy2  [expr {($ly1+$ly2)/2.0}]
  #}
 # if {[expr {abs($ty2-$lcy1)}]  < [expr {4*abs($tx2-$lcx1)}]} {
    if {$lcx1 < $tx2} {
      set new_cx2 $lx2
      set anchor "$anchor\e"
    } else {
      set new_cx2 $lx1
      set anchor "$anchor\w"
    }
  #} else {
  #  set new_cx2  [expr {($lx1+$lx2)/2.0}]
  #}
  $c coords $connector $tx2 $ty2 $new_cx2 $new_cy2
  $c coords $connector_aa $tx2 $ty2 $new_cx2 $new_cy2

  $c itemconfigure $item -anchor $anchor
  #move the label back to where it was before the anchor change
  #$c coords $item $new_cx2 $new_cy2
  foreach {nlx1 nly1 nlx2 nly2} [$c bbox $item] {}
  $c move item [expr {$lx1 - $nlx1}]  [expr {$ly1 - $nly1}]

  ##experimental bump process
  foreach i [$c find withtag moveablelabel] {
    if {[$c bind $i <<Moved>>] ==""} {
      circular_map_reset_moveablelabel $c $i
    }
  }
  ## set last arg to 1 to avoid connectors in bump process
  circular_map_bump_all_moveablelabel $c $item 1
}

######
## 
proc circular_map_add_scale {c} {
  global info


  set deg2rad [expr {3.14159/180}]
  if {[$c type 1] == "oval"} {
    set radius [lindex [$c coords 1] 2]
    set total_length [$c bind 1 <<Total_length>>]
    set tick_dict [$c bind 1 <<Tick_dict>>]
    #circular_map_index_offset circular_map_index_max_tick_spacing circular_map_index_max_at_zero circular_index_max_tick_color index_circular_text_color circular_index_max_tick_font circular_index_max_tick_width circular_index_max_tick_length circular_index_min_tick_per_max circular_index_min_tick_color  circular_index_min_tick_width  circular_index_min_tick_length
    foreach {var default_val} $tick_dict {
      set $var $default_val
    }
    if {$circular_map_index_max_tick_spacing == 0} {return}
    set tick_direction [expr { ($circular_map_index_offset != 0 ? sign($circular_map_index_offset) : -1)}]

    for {set i 0} {$i < [expr {$total_length}] } {set i [expr {$i+1.0* $circular_map_index_max_tick_spacing /($circular_index_min_tick_per_max+1)}]} {
      set angle [expr {$i / $total_length * 2*pi()}]
      if {[expr {(int($i) % $circular_map_index_max_tick_spacing == 0)}]} { 
        set tx1 [expr {$radius * (1 + $circular_map_index_offset) * sin($angle)}]
        set tx2 [expr {$radius * (1 + $circular_map_index_offset + $tick_direction *  $circular_index_max_tick_length) * sin($angle)}]
        set ty1 [expr { $radius * (1 + $circular_map_index_offset) * -cos($angle)}]
        set ty2 [expr {$radius * (1 + $circular_map_index_offset + $tick_direction * $circular_index_max_tick_length) * -cos($angle)}]
        set lineid [$c create line $tx1 $ty1 $tx2 $ty2 -tags [list scale_tick major] -fill $circular_index_max_tick_color -width $circular_index_max_tick_width ]
        set lineid_aa [$c create line $tx1 $ty1 $tx2 $ty2 -tags [list scale_tick $lineid.aa major_aa aa] -fill [mix_color $circular_index_max_tick_color [$c cget -background] $info(antialias_percent)] -width [expr {$info(antialias_width) +$circular_index_max_tick_width }]]
        $c lower $lineid_aa $lineid
	set anchor ""
        #if {[expr {abs($tx2-$tx1)/abs($ty2-$ty1)}] > [expr {tan(pi() /8)}] } {}
	if {($angle > [expr {pi()* 0.125}] && $angle <= [expr {pi() * .875}])} {
            set anchor "e"
        } elseif {($angle > [expr {pi()* 1.125}] && $angle <= [expr {pi() * 1.875}])} {
            set anchor "w"
        }

       # if {[expr {abs($ty2-$ty1)/abs($tx2-$tx1)}] > [expr {tan(pi() /8)}] } {}
	if {($angle < [expr {pi()* 0.375}]) || ($angle > [expr {pi()* 1.625}])} {
            set anchor "n$anchor"

        } elseif { ($angle > [expr {pi()* .625}] && $angle <= [expr {pi() * 1.375}])} {
            set anchor "s$anchor"
	}

        switch $index_text_angle_format {
          "h" {
            set text_angle 0
          }
          "r90" {
            set text_angle [expr {( 90-($angle / $deg2rad)) }]
            set anchor e
            if {$text_angle < -90} {
              set text_angle [expr { 180+ $text_angle }]
              set anchor w
            }
          }
          "r45" {
            set text_angle [expr {( 45 -($angle / $deg2rad)) }]
            set anchor e
            if {$text_angle < -90 && $text_angle > -270} {
              set text_angle [expr { 180+ $text_angle }]
              set anchor w
            }
          }
          "r0ccw" {
            set text_angle [expr {( -($angle / $deg2rad)) }]
            set anchor e
            if {$text_angle < -90 && $text_angle > -270} {
              set text_angle [expr { 180+ $text_angle }]
              set tx2 [expr {$radius * (1 + $circular_map_index_offset + $tick_direction *  $circular_index_max_tick_length) * sin($angle+5)}]
              set ty2 [expr {$radius * (1 + $circular_map_index_offset + $tick_direction * $circular_index_max_tick_length) * -cos($angle+5)}]
              set anchor w
            }
          }
          "r0" {
            set text_angle [expr {( -($angle / $deg2rad)) }]
            set anchor n
            if {$text_angle < -90 && $text_angle > -270} {
              set text_angle [expr { 180+ $text_angle }]
              set anchor s
            }
          } 
        }

        if {$tick_direction > 0} {
          set anchor [string map {n s s n w e e w nw se se nw ne sw sw ne} $anchor]
        }
        if {$i ==0 && $circular_map_index_max_at_zero} {
          set i_num $total_length
        } else {
          set i_num $i
        }
        switch $index_label_format {
	  "none" {set tick_text ""}
	  "1000" {set tick_text [expr {int($i_num)}]}
	  "1,000" {set tick_text [commify [expr {int($i_num)}]]}
	  "1 000" {set tick_text [commify [expr {int($i_num)}] " "]}
	  "1.000" {set tick_text [commify [expr {int($i_num)}] .]}
	  "1.0 k" {set tick_text "[expr {$i_num/ 1000.0}] k"}
	  "1 k" {if {[expr {int($i_num)% 1000}] != 0 } {set tick_text "[expr {$i_num/ 1000.0}] k" } else {set tick_text "[expr {int($i_num)/ 1000}] k"} }
	  default {set tick_text [expr {int($i_num)}]}
	}
        if {$anchor eq "w" || $anchor eq "e"} {set tick_text " $tick_text "}
        set id [$c create text $tx2 $ty2 -text $tick_text -anchor $anchor -font $circular_index_max_tick_font -tags [list scale_text $lineid.text] -angle $text_angle  -fill $info(graphic_fg_color)] 
      } else {
	set tx1 [expr {$radius * (1 + $circular_map_index_offset) * sin($angle)}]
        set tx2 [expr {$radius * (1 + $circular_map_index_offset + $tick_direction *  $circular_index_min_tick_length) * sin($angle)}]
        set ty1 [expr {$radius * (1 + $circular_map_index_offset) * -cos($angle)}]
        set ty2 [expr {$radius * (1 + $circular_map_index_offset + $tick_direction * $circular_index_min_tick_length) * -cos($angle)}]
        set lineid [$c create line $tx1 $ty1 $tx2 $ty2 -tags [list scale_tick minor] -fill $circular_index_min_tick_color -width $circular_index_min_tick_width]
        set lineid_aa [$c create line $tx1 $ty1 $tx2 $ty2 -tags [list scale_tick $lineid.aa minor_aa aa] -fill [mix_color $circular_index_min_tick_color [$c cget -background] $info(antialias_percent)] -width [expr {$info(antialias_width) +$circular_index_min_tick_width }] ]
        $c lower $lineid_aa $lineid
      }

    }

    
    $c bind scale_text <Button-1> "set tick_move_offset \[expr { \[circular_map_get_scale_radius $c\] - sqrt(\[$c canvasx %x\]**2 +  \[$c canvasy %y\]**2)}\]"
    $c bind scale_text <B1-Motion> "if {\[info exists tick_move_offset\]} {circular_map_change_scale_radius $c \[expr { \$tick_move_offset+ sqrt(\[$c canvasx %x\]**2 +  \[$c canvasy %y\]**2)}\]}"
    $c bind scale_text <ButtonRelease-1> "unset -nocomplain tick_move_offset"

  }
}

##################
## add commas to a number
##################
proc commify { num {sep ,} {groupSize 3}} {
    while {[regsub "^(\[-+]?\\d+)(\\d{$groupSize})" $num "\\1$sep\\2" num]} {}
    return $num
}

##################
## Get current scale radius, for moves
##################
proc circular_map_get_scale_radius {c} {
  foreach {x1 y1 x2 y2} [$c coords scale_tick&&major] {}
  if {[info exists x1]} {
    return [expr {sqrt(($x1)**2 + ($y1)**2 )}]
  } else {
    return 0
  }
}

##################
##
##################
proc circular_map_change_scale_radius {c r} {
## find current radius (find point closest to circle of first scale_tick item, find distance to center (0,0)), find tick length, check whether switching sides of the circle, go through all scale_tick items and multply coords to get new radius, keep the length, swap coords if changing sides
  if {[$c type 1] == "oval"} {
    set map_radius [lindex [$c coords 1] 2]
    set tick_offset [expr {$r - $map_radius}]
    set x1 {}
    foreach {x1 y1 x2 y2} [$c coords scale_tick&&major] {}
    if {$x1 != {}} {
      set old_r1 [expr {sqrt(($x1)**2 + ($y1)**2 )}]
      set old_tick_offset [expr {$old_r1 - $map_radius}]
      set old_r2 [expr {sqrt(($x2)**2 + ($y2)**2 )}]
      set tick_len [expr {abs($old_r2 - $old_r1) * ($tick_offset != 0 ? sign($tick_offset) : -1)}]
      set scale_r1 [expr {1.0 * $r /$old_r1}]
      set switch_sides [expr {($tick_offset != 0 ? sign($tick_offset) : -1)  != ($old_tick_offset != 0 ? sign($old_tick_offset) : -1)}]
    } else {
      return
    }
    foreach {x1 y1 x2 y2} [$c coords scale_tick&&major] {}
    if {$x1 != {}} {
      set old_r2 [expr {sqrt(($x2)**2 + ($y2)**2 )}]
      set tick_len [expr {abs($old_r2 - $old_r1) * ($tick_offset != 0 ? sign($tick_offset) : -1)}]
      set scale_r1 [expr {1.0 * $r /$old_r1}]
      set scale_r2_major [expr {1.0 * ($r + $tick_len) /$old_r1}]
    }
    foreach {x1 y1 x2 y2} [$c coords scale_tick&&minor] {}
    if {$x1 != {}} {
      set old_r1 [expr {sqrt(($x1)**2 + ($y1)**2 )}]
      set old_r2 [expr {sqrt(($x2)**2 + ($y2)**2 )}]
      set minor_tick_len [expr {abs($old_r2 - $old_r1) * ($tick_offset != 0 ? sign($tick_offset) : -1)}]
      set scale_r2_minor [expr {1.0 * ($r + $minor_tick_len) /$old_r1}]
      foreach lineid [$c find withtag scale_tick&&minor] {
        foreach {x1 y1 x2 y2} [$c coords $lineid] {}
        set tx1 [expr {$x1 * $scale_r1}]
        set ty1 [expr {$y1 * $scale_r1}]
        set tx2 [expr {$x1 * $scale_r2_minor}]
        set ty2 [expr {$y1 * $scale_r2_minor}]
        $c coords $lineid $tx1 $ty1 $tx2 $ty2
        if {[set aa [$c find withtag $lineid.aa]] ne {}} {
          $c coords $aa $tx1 $ty1 $tx2 $ty2
        }
      }
    }
    $c itemconfigure scale_text -state normal
    set text_items [$c find withtag scale_text]
    foreach lineid [$c find withtag scale_tick&&major] {
      foreach {x1 y1 x2 y2} [$c coords $lineid] {}
      set tx1 [expr {$x1 * $scale_r1}]
      set ty1 [expr {$y1 * $scale_r1}]
      set tx2 [expr {$x1 * $scale_r2_major}]
      set ty2 [expr {$y1 * $scale_r2_major}]
      $c coords $lineid $tx1 $ty1 $tx2 $ty2
      if {[set aa [$c find withtag $lineid.aa]] ne {}} {
        $c coords $aa $tx1 $ty1 $tx2 $ty2
      }
      if {[set textid  [$c find withtag $lineid.text]] ne {}} {
        $c coords $textid $tx2 $ty2
        if {$switch_sides } {
          $c itemconfigure $textid -anchor [string map {n s s n w e e w nw se se nw ne sw sw ne} [$c itemcget $textid -anchor]]
        }
        if {[llength [set ov_list [$c find overlapping {*}[$c bbox $textid]]]] > 0} {
          foreach item $ov_list {
            if {$item ne $textid && $item in $text_items} {
              #sputs overlapping $textid $item $ov_list 
              $c itemconfigure $textid -state hidden
               break
            }
          }
        }
      }
    }
  } 
}

######
## move label tick position on a circular map, r in pixels relative to base circle (negaive for inside the circle)
######
proc circular_map_move_label_tick {c item {r 0}} {

  set tick [$c find withtag $item.tick]
  set tick_aa [$c find withtag $item.tick_aa]

  lassign [$c coords $tick] tx1 ty1 tx2 ty2
  set r0 [expr {sqrt($tx1*$tx1+$ty1*$ty1) }]
  lassign [$c coords 1] cx1 cy1 cx2 cy2
  set r1 [expr {$r + $cx2 }]
  set xmove [expr {1.0* $r1/$r0 * $tx1 - $tx1}]
  set ymove [expr {1.0* $r1/$r0 * $ty1 - $ty1}]
  $c move $tick $xmove $ymove
  $c move $tick_aa $xmove $ymove

  lassign [$c coords $tick] tx1 ty1 tx2 ty2
  lassign [$c coords $item.connector] cx1 cy1 cx2 cy2
   $c coords $item.connector $tx1 $ty1 $cx1 $cy1
   $c coords $item.connector_aa $tx1 $ty1 $cx1 $cy1
  #$c move [$c find withtag $item.connector] $xmove $ymove
  #$c move $item $xmove $ymove
  #$c move [$c find withtag $item.box] $xmove $ymove
}


######
## reset moveable label position on a circular map, r in pixels for connector length (negaive for inside the circle)
######
proc circular_map_reset_moveablelabel {c item {r 0}} {
  if {[$c itemcget $item -state] eq "hidden"} {return}
  set connector [$c find withtag $item.connector]
  set tick [$c find withtag $item.tick]
  set connector_aa [$c find withtag $item.connector_aa]
  set tick_aa [$c find withtag $item.tick_aa]
  lassign [$c coords $tick] tx1 ty1 tx2 ty2
  lassign [$c coords $connector] cx1 cy1 cx2 cy2
  set label_dict [$c bind $item <<Label>>]
  if {[dict exists $label_dict fea_tick_length]} {
    set tick_length [dict get $label_dict fea_tick_length]
  } elseif {[dict exists $label_dict enz_tick_length]} {
    set tick_length [dict get $label_dict enz_tick_length]
  } else {
    set tick_length 10
  }
    
  set r0 [expr {sqrt($tx1*$tx1+$ty1*$ty1) }]
  if {$r >= 0} {
    set r1 [expr {$r0 + $tick_length}]
  } else {
    set r1 [expr {$r0 - $tick_length}]
  }
  set tx2 [expr {$tx1 * $r1 / $r0}]
  set ty2 [expr {$ty1 * $r1 / $r0}]

  $c coords $tick $tx1 $ty1 $tx2 $ty2
  $c coords $tick_aa $tx1 $ty1 $tx2 $ty2


  # r was default 0.2, change to default 0
  $c coords $connector $tx2 $ty2 [set cx2 [expr {$tx2+1.0*abs($r)*($tx2-$tx1)/$tick_length}]] [set cy2 [expr {$ty2+1.0*abs($r)*($ty2-$ty1)/$tick_length}]]
  $c coords $connector_aa $tx2 $ty2 [set cx2 [expr {$tx2+1.0*abs($r)*($tx2-$tx1)/$tick_length}]] [set cy2 [expr {$ty2+1.0*abs($r)*($ty2-$ty1)/$tick_length}]]


  if {$ty1 >= $ty2} {
    set anchor "s"
  } else {
    set anchor "n"
  }

    if {$tx1 > $tx2} {
      set anchor "$anchor\e"
    } else {
      set anchor "$anchor\w"
    }

  $c itemconfigure $item -anchor $anchor
  $c coords $item $cx2 $cy2
  graphic_map_recenter_label_box $c $item
}

#####
proc circular_map_bump_moveablelabel_move {c item dy} {
  set connector [$c find withtag $item.connector]
  set connector_aa [$c find withtag $item.connector_aa]
  foreach {cx1 cy1 cx2 cy2} [$c coords $connector] {}
  $c coords $connector $cx1 $cy1 $cx2 [expr {$cy2+$dy}]
  $c coords $connector_aa $cx1 $cy1 $cx2 [expr {$cy2+$dy}]
  $c move $item 0 $dy
}

###########
proc circular_map_bump_moveablelabel_find_overlap_and_move {c item {exclude {}}} {
  ## don't bump previously moved items:[$c bind $item <<Moved>>] == 1
  if {[lsearch $exclude $item] > -1 || [$c bind $item <<Moved>>] == 1} {return}
  #don't bump hidden items
  if {[$c bbox $item] == {}} {return}
  ##spacing info global?
  set spacing 3
  foreach {lx1 ly1 lx2 ly2} [$c bbox $item] {}
  set tick [$c find withtag $item.tick]
  foreach {tx1 ty1 tx2 ty2} [$c coords $tick] {}

  foreach i [$c find overlapping $lx1 $ly1 $lx2 $ly2] {
    ## if overlapping an excluded (locked in) item, move out of the way of that item
    if {(($i == $item) || [lsearch $exclude $i] == -1)} {continue}

    foreach {bx1 by1 bx2 by2} [$c bbox $i] {}

    if {$ty1 >= $ty2} {
      #if {[expr {$by1-$ly2-$spacing}]>=0} {#break}
      circular_map_bump_moveablelabel_move $c $item [expr {$by1-$ly2-$spacing}]
    } else {
      #if {[expr {$by2-$ly1+$spacing}]<=0} {#break}
      circular_map_bump_moveablelabel_move $c $item [expr {$by2-$ly1+$spacing}]  
    }
    lset exclude [lsearch $exclude $i] {}
    circular_map_bump_moveablelabel_find_overlap_and_move $c $item $exclude
    break
  }
}

############
proc circular_map_bump_all_moveablelabel {c {item ""} {avoid_connectors 1}} {
  set exclude [list $item]
  ##avoid connectors info global?
  if {$avoid_connectors && ($item !="")} {
      #$i-1 is the connector for the item. lock this in to make labels avoid the connectors
    lappend exclude [$c find withtag $item.connector] 
    lappend exclude [$c find withtag $item.connector_aa] 
  }
  ## for labels inside the circle, sort by -decreasing, might have to sort all by decreasing, sort the insides, then do by increasing and sort the outsides

  foreach i [lsort -integer [$c find withtag moveablelabel]] {
    circular_map_bump_moveablelabel_find_overlap_and_move $c $i $exclude
    lappend exclude $i
    if {$avoid_connectors} {
      #$i-1 is the connector for the item. lock this in to make labels avoid the connectors
      lappend exclude [$c find withtag $i.connector] 
    lappend exclude [$c find withtag $i.connector_aa] 
    }
    graphic_map_recenter_label_box $c $i
  }

}

##### reset all labels
proc circular_map_reset_all_moveablelabel {c} { 
  foreach i [$c find withtag moveablelabel] {
    circular_map_reset_moveablelabel $c $i
    $c bind $i <<Moved>> ""
  } 
  circular_map_bump_all_moveablelabel $c
}

################
## Circular Configure dialog
################
proc circular_map_configure_dialog {c item} {
  global info temp_circ_config_info dialogblock ok  enz_list fea_list

  set w [winfo toplevel $c]
  if {!$info(android)} {
    if {[winfo exists $w.f_config]} {
      regexp {([0-9]+)x([0-9]+)} [wm geometry $w] - width height
      wm geometry $w "$width\x[expr {min([winfo screenheight $w], $height + [winfo height $w.f_config])}]"
      grid configure $w.f_config
      return
    } 
    grid [set dialog [frame $w.f_config]] -row 3 -column 0 -sticky nswe
    bind $w.f_config <Destroy> "array unset temp_circ_config_info $c,*"
    bind $dialog <<OK>> "grid remove $dialog; regexp {(\[0-9\]+)x(\[0-9\]+)} \[wm geometry $w\] - width height; wm geometry $w \"\$width\\x\[expr {\$height - \[winfo height $w.f_config\]}\]\"; unset -nocomplain width height"
  } else {
    if {$dialogblock == 1} {return}
    set dialog [new_dialog $w "Configure Map..." "CONFIGURE"]
    bind $dialog <<OK>> "set ok 1"
  }
  bind $dialog <<Cancel>> "set ok -1"


  
  #bind . <<RaiseDialogs>> "wm deiconify $dialog; raise $dialog"
  set ok 0

  grid [ttk::notebook $dialog.tabframe] -row 0 -column 0 -sticky nswe

  set active_tab texts
  set active_item 0

  ############## texts frame
  $dialog.tabframe add [ttk::frame $dialog.tabframe.texts -relief flat] -text [mc "Texts"] -sticky nswe
  grid columnconfigure $dialog.tabframe.texts 0 -weight 1
  grid rowconfigure $dialog.tabframe.texts 0 -weight 1

  grid [ttk::frame $dialog.tabframe.texts.frame1 -relief flat] -row 0 -column 0 -sticky nswe
  set f $dialog.tabframe.texts.frame1
  
  set t $f.tv
  set sc $f.sc
  ttk::treeview $t -yscrollcommand "optionscrollbar $sc" -height 5
  scrollbar $sc -orient vertical -command "$t yview" -width 15
  grid $f.tv -row 0 -column 0  -sticky nsew
  grid $f.sc -row 0 -column 1 -sticky nsw
  grid columnconfigure $f 0 -weight 1
  grid rowconfigure $f 0 -weight 1
  grid columnconfigure $f 1 -minsize 17


  $t heading #0 -text [mc "Text"] -command ""
  $t column #0 -width 200 -minwidth 50 -stretch 1 -anchor e

  $t configure -columns {blank} -displaycolumns {blank}
  $t heading blank -text ""
  $t column blank -width 260 -minwidth 50 -stretch 1 -anchor c

  bind $t <<TreeviewSelect>> "circular_config_text_treeview_manageselection $t $c $dialog; #$dialog.tabframe.texts.frame2.b1 configure -state disabled"
  bind $t <<OldSelection>> {}
  $t tag configure sel -background $info(text_select_bg_color)
  bind $t <Button-2> "sputs button2 \[$t identify column %x %y]  \[$t identify row %x %y];# can use identify item when 8.6 is available"
  bind $t <<RightClick>> "sputs enzyme gm table_rightclick $w %x %y"

  grid [ttk::frame $dialog.tabframe.texts.frame2 -relief ridge -borderwidth 2] -row 1 -column 0 -sticky swe
  #grid [button $dialog.tabframe.texts.frame2.b1 -text [mc "Apply"] -command "event generate $dialog <<raise>>; circular_config_text_treeview_apply  \[$t selection\]  $c $t"] -row 0 -column 0 -sticky we
  #button $dialog.tabframe.texts.frame2.b1 -text [mc "Apply"]
  bind $dialog <<changed_text>> "circular_config_text_treeview_apply \[$t selection\] $c $t"

  grid [ttk::frame $dialog.tabframe.texts.frame3 -relief ridge -borderwidth 2] -row 2 -column 0 -sticky swe
  grid [ttk::frame $dialog.tabframe.texts.frame3_dummy -relief ridge -borderwidth 2] -row 2 -column 0 -sticky nswe

  grid [checkbutton $dialog.tabframe.texts.frame3.visible -text [mc "Visible"] -variable temp_circ_config_info($c,text_visible) -command "if {\[info exists temp_circ_config_info($c,text_visible)\]} {event generate $dialog <<changed_text>>}" ] -row 0 -column 1 -columnspan 2 -sticky nw
  grid [label $dialog.tabframe.texts.frame3.fontfam_label -text [mc "Text:"]] -row 1 -column 1 -sticky nw
  
  set temp_circ_config_info($c,text_label_color) #000000
  grid [color_button $dialog.tabframe.texts.frame3.label_color temp_circ_config_info($c,text_label_color) 18] -row 1 -column 2 -sticky nw
  bind $dialog.tabframe.texts.frame3.label_color <<color_picked>> "event generate $dialog <<changed_text>>"
  grid [menubutton $dialog.tabframe.texts.frame3.fontfam -menu $dialog.tabframe.texts.frame3.fontfam.menu -textvariable temp_circ_config_info($c,text_fontfamily)] -row 1 -column 3 -sticky nw
   menu $dialog.tabframe.texts.frame3.fontfam.menu
    if {[llength $info(allfontlist)] <= 20} {
      foreach fontfam $info(allfontlist) {
        $dialog.tabframe.texts.frame3.fontfam.menu add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable temp_circ_config_info($c,text_fontfamily) -command "event generate $dialog <<changed_text>>";# -font [list $fontfam 10]
      }
    } else {
      for {set fi 0} {$fi < [llength $info(allfontlist)]} {incr fi 20} {
        if {[set fj [expr {$fi + 19}]] > [llength $info(allfontlist)]} {set fj [expr {[llength $info(allfontlist)]-1}]}
        $dialog.tabframe.texts.frame3.fontfam.menu add cascade -label "[lindex $info(allfontlist) $fi]-[lindex $info(allfontlist) $fj]" -menu $dialog.tabframe.texts.frame3.fontfam.menu.menu$fi 
        menu $dialog.tabframe.texts.frame3.fontfam.menu.menu$fi
        foreach fontfam [lrange $info(allfontlist) $fi $fj] {
          $dialog.tabframe.texts.frame3.fontfam.menu.menu$fi add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable temp_circ_config_info($c,text_fontfamily) -command "event generate $dialog <<changed_text>>";# -font [list $fontfam 10]
        }
      }
    }
  grid [menubutton $dialog.tabframe.texts.frame3.fontsiz -menu $dialog.tabframe.texts.frame3.fontsiz.menu -textvariable temp_circ_config_info($c,text_fontsize)] -row 1 -column 4 -sticky w
  menu $dialog.tabframe.texts.frame3.fontsiz.menu
  foreach fontsize [lsort -unique -integer [concat [list 6 8 9 10 11 12 13 14 16 18 20 24 28 30 32 34 36 40 44 48]]] {
      $dialog.tabframe.texts.frame3.fontsiz.menu add radiobutton -label $fontsize -indicatoron 1 -value $fontsize -variable temp_circ_config_info($c,text_fontsize)  -command "event generate $dialog <<changed_text>>"
  }
  set temp_circ_config_info($c,text_fontfamily) "---"
  set temp_circ_config_info($c,text_fontsize) "---"

  grid [ttk::checkbutton $dialog.tabframe.texts.frame3.fontb  -text "B"  -variable temp_circ_config_info($c,text_fontbold) -command "event generate $dialog <<changed_text>>"] -row 1 -column 5 -sticky w
  grid [ttk::checkbutton $dialog.tabframe.texts.frame3.fonti  -text "I" -variable temp_circ_config_info($c,text_fontitalic) -command "event generate $dialog <<changed_text>>"] -row 1 -column 6 -sticky w
  grid [ttk::checkbutton $dialog.tabframe.texts.frame3.fontu  -text "U" -variable temp_circ_config_info($c,text_fontunderline) -command "event generate $dialog <<changed_text>>"] -row 1 -column 7 -sticky w

  #grid [label $dialog.tabframe.texts.frame3.label_label -text [mc "Label"]] -row 2 -column 1 -sticky nw
  #grid [entry $dialog.tabframe.texts.frame3.label -text ""] -row 2 -column 2 -columnspan 2 -sticky nw

  #initialize texts settings
  set temp_circ_config_info($c,text_tag_dict) [dict create title [mc "Title"] seq_length [mc "Sequence Length"] file_comment [mc "File Comment"] enz_list [mc "Enzyme List"] feature_list [mc "Feature_List"]]
  # need to add custom texts here, (if available)
  circular_config_text_fill_treeview $t $c

  grid [ttk::frame $dialog.tabframe.texts.frame4 -relief ridge -borderwidth 2] -row 3 -column 0 -sticky swe
  grid [ttk::frame $dialog.tabframe.texts.frame4.baseline] -row 0 -column 0 -sticky nwe
  #grid [label $dialog.tabframe.texts.frame4.baseline.bl_label -text [mc "Baseline"]] -row 1 -column 1  -sticky nw
  ###set temp_circ_config_info($c,baseline_visible) 1
  ###grid [checkbutton $dialog.tabframe.texts.frame4.baseline.visible -text [mc "Visible"] -variable temp_circ_config_info($c,baseline_visible) -command "if {\[info exists temp_circ_config_info($c,baseline_visible)\]} {circular_config_baseline_apply $c}" ] -row 1 -column 2 -columnspan 1 -sticky nw
  grid [ttk::frame $dialog.tabframe.texts.frame4.baseline.bl_fg_frame] -row 3 -column 1 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.texts.frame4.baseline.bl_fg_frame.bl_fg_label -text [mc "Circle Pen:"]] -row 1 -column 1 -columnspan 1 -sticky w
  set temp_circ_config_info($c,baseline_fg_color) [$c itemcget circle -outline]
  grid [color_button $dialog.tabframe.texts.frame4.baseline.bl_fg_frame.bl_fg_color temp_circ_config_info($c,baseline_fg_color) 18] -row 1 -column 2 -sticky nw
  bind $dialog.tabframe.texts.frame4.baseline.bl_fg_frame.bl_fg_color <<color_picked>> "circular_config_baseline_apply $c"
  grid [ttk::label $dialog.tabframe.texts.frame4.baseline.bl_fg_frame.bl_fg_w_label -text [mc "Width:"]] -row 1 -column 3 -sticky w
  grid [ttk::scale $dialog.tabframe.texts.frame4.baseline.bl_fg_frame.bl_fg_width -orient horizontal -from 0 -to 20 -variable temp_circ_config_info($c,baseline_fg_width) -command "set temp_circ_config_info($c,baseline_fg_width) \[expr {max(0,round(\$temp_circ_config_info($c,baseline_fg_width)))}\]; circular_config_baseline_apply $c;#" ] -row 1 -column 4 -sticky w
  set temp_circ_config_info($c,baseline_fg_width) [expr {round([$c itemcget circle -width])}]
  grid [ttk::label $dialog.tabframe.texts.frame4.baseline.bl_fg_frame.bl_fg_w_v_label -textvariable temp_circ_config_info($c,baseline_fg_width)] -row 1 -column 5 -sticky w

  grid [ttk::frame $dialog.tabframe.texts.frame4.baseline.bl_bg_frame] -row 4 -column 1 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.texts.frame4.baseline.bl_bg_frame.bl_bg_label -text [mc "Outline:"]] -row 1 -column 1 -columnspan 1 -sticky w
  set temp_circ_config_info($c,baseline_bg_color) [$c itemcget circle_background -outline]
  grid [color_button $dialog.tabframe.texts.frame4.baseline.bl_bg_frame.bl_bg_color temp_circ_config_info($c,baseline_bg_color) 18] -row 1 -column 2 -sticky w
  bind $dialog.tabframe.texts.frame4.baseline.bl_bg_frame.bl_bg_color <<color_picked>> "circular_config_baseline_apply $c"
  grid [ttk::label $dialog.tabframe.texts.frame4.baseline.bl_bg_frame.bl_bg_w_label -text [mc "Width:"]] -row 1 -column 3 -sticky w
  grid [ttk::scale $dialog.tabframe.texts.frame4.baseline.bl_bg_frame.bl_bg_width -orient horizontal -from 0 -to 10 -variable temp_circ_config_info($c,baseline_bg_width) -command "set temp_circ_config_info($c,baseline_bg_width) \[expr {round(\$temp_circ_config_info($c,baseline_bg_width))}\];circular_config_baseline_apply $c;#" ] -row 1 -column 4 -sticky w
  set temp_circ_config_info($c,baseline_bg_width)  [expr {round(([$c itemcget circle_background -width] - [$c itemcget circle -width]) /2 )}]
  grid [ttk::label $dialog.tabframe.texts.frame4.baseline.bl_bg_frame.bl_bg_w_v_label -textvariable temp_circ_config_info($c,baseline_bg_width)] -row 1 -column 5 -sticky w

  grid [ttk::separator $dialog.tabframe.texts.frame4.sep] -row 1 -column 0 -sticky nwe -columnspan 7
  grid [ttk::frame $dialog.tabframe.texts.frame4.crosshair] -row 2 -column 0 -sticky nwe
  #grid [ttk::label $dialog.tabframe.texts.frame4.crosshair.ch_label -text [mc "Crosshair"]] -row 1 -column 1  -sticky nw
  ###set temp_circ_config_info($c,crosshair_visible) 1
  ###grid [checkbutton $dialog.tabframe.texts.frame4.crosshair.visible -text [mc "Visible"] -variable temp_circ_config_info($c,crosshair_visible) -command "if {\[info exists temp_circ_config_info($c,crosshair_visible)\]} {circular_config_baseline_apply $c}" ] -row 1 -column 2 -columnspan 1 -sticky nw

  grid [ttk::frame $dialog.tabframe.texts.frame4.crosshair.ch_fg_l_frame] -row 2 -column 1 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.texts.frame4.crosshair.ch_fg_l_frame.ch_fg_w_label -text [mc "Crosshair Length:"]] -row 1 -column 3 -sticky w
  grid [ttk::scale $dialog.tabframe.texts.frame4.crosshair.ch_fg_l_frame.ch_length -orient horizontal -from 0 -to 15 -variable temp_circ_config_info($c,crosshair_length) -command "set temp_circ_config_info($c,crosshair_length) \[expr {round(100 *\$temp_circ_config_info($c,crosshair_length)) / 100.0}\]; circular_config_baseline_apply $c;#" ] -row 1 -column 4 -sticky w
  set temp_circ_config_info($c,crosshair_length) [expr {round([lindex [$c coords crosshair&&vert] 3] / [lindex [$c coords circle] 2] * 100.0) /100.0}]
  grid [ttk::label $dialog.tabframe.texts.frame4.crosshair.ch_fg_l_frame.ch_fg_w_v_label -textvariable temp_circ_config_info($c,crosshair_length)] -row 1 -column 5 -sticky w

  grid [ttk::frame $dialog.tabframe.texts.frame4.crosshair.ch_fg_frame] -row 3 -column 1 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.texts.frame4.crosshair.ch_fg_frame.ch_fg_label -text [mc "Pen:"]] -row 1 -column 1 -columnspan 1 -sticky w
  set temp_circ_config_info($c,crosshair_fg_color) [$c itemcget crosshair -fill]
  grid [color_button $dialog.tabframe.texts.frame4.crosshair.ch_fg_frame.ch_fg_color temp_circ_config_info($c,crosshair_fg_color) 18] -row 1 -column 2 -sticky w
  bind $dialog.tabframe.texts.frame4.crosshair.ch_fg_frame.ch_fg_color <<color_picked>> "circular_config_baseline_apply $c"

  grid [ttk::label $dialog.tabframe.texts.frame4.crosshair.ch_fg_frame.ch_fg_w_label -text [mc "Width:"]] -row 1 -column 3 -sticky w
  grid [ttk::scale $dialog.tabframe.texts.frame4.crosshair.ch_fg_frame.ch_fg_width -orient horizontal -from 0 -to 20 -variable temp_circ_config_info($c,crosshair_fg_width) -command "set temp_circ_config_info($c,crosshair_fg_width) \[expr {round(\$temp_circ_config_info($c,crosshair_fg_width))}\];circular_config_baseline_apply $c;#" ] -row 1 -column 4 -sticky w
  set temp_circ_config_info($c,crosshair_fg_width)  [expr {round([$c itemcget crosshair -width])}]
  grid [ttk::label $dialog.tabframe.texts.frame4.crosshair.ch_fg_frame.ch_fg_w_v_label -textvariable temp_circ_config_info($c,crosshair_fg_width)] -row 1 -column 5 -sticky w

  grid [ttk::frame $dialog.tabframe.texts.frame4.crosshair.ch_bg_frame] -row 4 -column 1 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.texts.frame4.crosshair.ch_bg_frame.ch_bg_label -text [mc "Outline:"]] -row 1 -column 1 -columnspan 1 -sticky w
  set temp_circ_config_info($c,crosshair_bg_color) [$c itemcget crosshair_background -fill]
  grid [color_button $dialog.tabframe.texts.frame4.crosshair.ch_bg_frame.ch_bg_color temp_circ_config_info($c,crosshair_bg_color) 18] -row 1 -column 2 -sticky w
  bind $dialog.tabframe.texts.frame4.crosshair.ch_bg_frame.ch_bg_color <<color_picked>> "circular_config_baseline_apply $c"

  grid [ttk::label $dialog.tabframe.texts.frame4.crosshair.ch_bg_frame.ch_bg_w_label -text [mc "Width:"]] -row 1 -column 3 -sticky w
  grid [ttk::scale $dialog.tabframe.texts.frame4.crosshair.ch_bg_frame.ch_bg_width -orient horizontal -from 0 -to 10 -variable temp_circ_config_info($c,crosshair_bg_width) -command "set temp_circ_config_info($c,crosshair_bg_width) \[expr {round(\$temp_circ_config_info($c,crosshair_bg_width))}\];circular_config_baseline_apply $c;#" ] -row 1 -column 4 -sticky w
  set temp_circ_config_info($c,crosshair_bg_width)  [expr {round(([$c itemcget crosshair_background -width] - [$c itemcget crosshair -width]) /2 )}]
  grid [ttk::label $dialog.tabframe.texts.frame4.crosshair.ch_bg_frame.ch_bg_w_v_label -textvariable temp_circ_config_info($c,crosshair_bg_width)] -row 1 -column 5 -sticky w

#$c find withtag enzyme&&label
#$c find withtag feature&&label
#$c find withtag feature&&label&&dir0
#$c bind $id <<Colors>> 
#$c bind $id <<Label>> ($label_dict)
#enzymes: $label_dict:  type name location_start count tag
#features: $label_dict: type name location_start location_end (can be past end) tag direction




  ############ enzymes frame
  $dialog.tabframe add [ttk::frame $dialog.tabframe.enzymes -relief flat] -text [mc "Enzymes"] -sticky nswe
  grid columnconfigure $dialog.tabframe.enzymes 0 -weight 1
  grid rowconfigure $dialog.tabframe.enzymes 0 -weight 1

  grid [ttk::frame $dialog.tabframe.enzymes.frame1 -relief flat] -row 0 -column 0 -sticky nswe
  set f $dialog.tabframe.enzymes.frame1
  
  set t $f.tv
  set sc $f.sc
  ttk::treeview $t -yscrollcommand "optionscrollbar $sc" -height 5
  scrollbar $sc -orient vertical -command "$t yview" -width 15
  grid $f.tv -row 0 -column 0  -sticky nsew
  grid $f.sc -row 0 -column 1 -sticky nsw
  grid columnconfigure $f 0 -weight 1
  grid rowconfigure $f 0 -weight 1
  grid columnconfigure $f 1 -minsize 17

  set column_list {Location Count}
  for {set i 0} {$i < 20} {incr i} {
    lappend column_list [format "g_%03u" $i]
  }
  $t configure -columns $column_list -displaycolumns {Location Count}
  $t heading #0 -text [mc "Enzyme"] -command "treeview_sort $t {}"
  $t column #0 -width 200 -minwidth 50 -stretch 1 -anchor e
  $t heading Location -text [mc "Location  \u2193"] -command "treeview_sort $t Location"
  $t column Location -width 60 -minwidth 50 -stretch 0 -anchor c
  $t heading Count -text Count  -command "treeview_sort $t Count 0 -integer"
  $t column Count -width 150 -minwidth 50 -stretch 1 -anchor c

  bind $t <<TreeviewSelect>> "circular_config_enz_treeview_manageselection $t $c $dialog; $dialog.tabframe.enzymes.frame2.b1 configure -state disabled"
  bind $t <<OldSelection>> {}
  $t tag configure sel -background $info(text_select_bg_color)
  bind $t <<Sort_column>> Location
  bind $t <<Sort_direction>> 1
  bind $t <Button-2> "sputs button2 \[$t identify column %x %y]  \[$t identify row %x %y];# can use identify item when 8.6 is available"
  bind $t <<RightClick>> "sputs enzyme gm table_rightclick $w %x %y"

  grid [ttk::frame $dialog.tabframe.enzymes.frame2 -relief ridge -borderwidth 2] -row 1 -column 0 -sticky swe
  #grid [button $dialog.tabframe.enzymes.frame2.b1 -text [mc "Apply"] -command "event generate $dialog <<raise>>; circular_config_enz_treeview_apply \[$t selection\] $c $t" ] -row 0 -column 0 -sticky we
  button $dialog.tabframe.enzymes.frame2.b1
  bind $dialog <<changed_enzymes>> "circular_config_enz_treeview_apply \[$t selection\] $c $t"

  grid [ttk::frame $dialog.tabframe.enzymes.frame3 -relief ridge -borderwidth 2] -row 2 -column 0 -sticky swe
  grid [ttk::frame $dialog.tabframe.enzymes.frame3_dummy -relief ridge -borderwidth 2] -row 2 -column 0 -sticky nswe

  grid [ttk::frame $dialog.tabframe.enzymes.frame3.labelframe ] -row 1 -column 1 -sticky swe
  grid [checkbutton $dialog.tabframe.enzymes.frame3.labelframe.visible -text [mc "Visible"] -variable temp_circ_config_info($c,enz_visible) -command "if \{\[info exists temp_circ_config_info($c,enz_visible)\]\} \{event generate $dialog <<changed_enzymes>>\}" ] -row 0 -column 1 -columnspan 2 -sticky w
  grid [ttk::label $dialog.tabframe.enzymes.frame3.labelframe.fontfam_label -text [mc "Text:"]] -row 1 -column 1 -sticky w
    set temp_circ_config_info($c,enz_label_color) #000000
  grid [color_button $dialog.tabframe.enzymes.frame3.labelframe.label_color  temp_circ_config_info($c,enz_label_color) 18] -row 1 -column 2 -sticky w
  bind $dialog.tabframe.enzymes.frame3.labelframe.label_color <<color_picked>>  "event generate $dialog <<changed_enzymes>>"
  grid [menubutton $dialog.tabframe.enzymes.frame3.labelframe.fontfam -menu $dialog.tabframe.enzymes.frame3.labelframe.fontfam.menu -textvariable temp_circ_config_info($c,enz_fontfamily)] -row 1 -column 3 -sticky w
   menu $dialog.tabframe.enzymes.frame3.labelframe.fontfam.menu
    if {[llength $info(allfontlist)] <= 20} {
      foreach fontfam $info(allfontlist) {
        $dialog.tabframe.enzymes.frame3.labelframe.fontfam.menu add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable temp_circ_config_info($c,enz_fontfamily) -command "event generate $dialog <<changed_enzymes>>";# -font [list $fontfam 10]
      }
    } else {
      for {set fi 0} {$fi < [llength $info(allfontlist)]} {incr fi 20} {
        if {[set fj [expr {$fi + 19}]] > [llength $info(allfontlist)]} {set fj [expr {[llength $info(allfontlist)]-1}]}
        $dialog.tabframe.enzymes.frame3.labelframe.fontfam.menu add cascade -label "[lindex $info(allfontlist) $fi]-[lindex $info(allfontlist) $fj]" -menu $dialog.tabframe.enzymes.frame3.labelframe.fontfam.menu.menu$fi 
        menu $dialog.tabframe.enzymes.frame3.labelframe.fontfam.menu.menu$fi
        foreach fontfam [lrange $info(allfontlist) $fi $fj] {
          $dialog.tabframe.enzymes.frame3.labelframe.fontfam.menu.menu$fi add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable temp_circ_config_info($c,enz_fontfamily) -command "event generate $dialog <<changed_enzymes>>";# -font [list $fontfam 10]
        }
      }
    }
  grid [menubutton $dialog.tabframe.enzymes.frame3.labelframe.fontsiz -menu $dialog.tabframe.enzymes.frame3.labelframe.fontsiz.menu -textvariable temp_circ_config_info($c,enz_fontsize)] -row 1 -column 4 -sticky w
  menu $dialog.tabframe.enzymes.frame3.labelframe.fontsiz.menu
  foreach fontsize [lsort -unique -integer [concat [list 6 8 9 10 11 12 13 14 16 18 20 24 26 28 30 34 36 40]]] {
      $dialog.tabframe.enzymes.frame3.labelframe.fontsiz.menu add radiobutton -label $fontsize -indicatoron 1 -value $fontsize -variable temp_circ_config_info($c,enz_fontsize)  -command "event generate $dialog <<changed_enzymes>>"
  }
  set temp_circ_config_info($c,enz_fontfamily) "---"
  set temp_circ_config_info($c,enz_fontsize) "---"

  grid [ttk::checkbutton $dialog.tabframe.enzymes.frame3.labelframe.fontb  -text "B"  -variable temp_circ_config_info($c,enz_fontbold) -command "event generate $dialog <<changed_enzymes>>"] -row 1 -column 5 -sticky w
  grid [ttk::checkbutton $dialog.tabframe.enzymes.frame3.labelframe.fonti  -text "I" -variable temp_circ_config_info($c,enz_fontitalic) -command "event generate $dialog <<changed_enzymes>>"] -row 1 -column 6 -sticky w
  grid [ttk::checkbutton $dialog.tabframe.enzymes.frame3.labelframe.fontu  -text "U" -variable temp_circ_config_info($c,enz_fontunderline) -command "event generate $dialog <<changed_enzymes>>"] -row 1 -column 7 -sticky w

  grid [ttk::label $dialog.tabframe.enzymes.frame3.labelframe.entry_label -text [mc "Label:"]] -padx {4 0} -row 1 -column 8 -sticky w
  grid [ttk::entry $dialog.tabframe.enzymes.frame3.labelframe.label_subst -textvariable temp_circ_config_info($c,enz_label_subst) -validate key -validatecommand "after 100 {event generate $dialog <<changed_enzymes>>}; return 1"] -row 1 -column 9 -sticky w
  bind $dialog.tabframe.enzymes.frame3.labelframe.label_subst <FocusOut> "event generate $dialog <<changed_enzymes>>"
  grid [menubutton $dialog.tabframe.enzymes.frame3.labelframe.subst_vals -menu $dialog.tabframe.enzymes.frame3.labelframe.subst_vals.menu -text [mc "Substitutions"]] -row 1 -column 10 -sticky w
  menu $dialog.tabframe.enzymes.frame3.labelframe.subst_vals.menu
  foreach {mlabel subs} {"Name" %n "Location start" %l "Top strand cut" %C  "Bottom strand cut" %c "Number of cuts" %# "Location end" %e "Recognition site" %S "Abbreviation" %A "Direction" %> "Number of cuts (dark circle)" %* "Number of cuts (light circle)" %+ "Number of cuts (double light circle)" %$ "Number of cuts (light circle sans)" %@ "Number of cuts (dark circle sans)" %! "Number of cuts (parenthesis)" %( "Number of cuts (period)" %. } {
     $dialog.tabframe.enzymes.frame3.labelframe.subst_vals.menu add command -label [mc $mlabel] -command "$dialog.tabframe.enzymes.frame3.labelframe.label_subst insert insert \"$subs\";event generate $dialog <<changed_enzymes>>"
  }
  grid columnconfigure $dialog.tabframe.enzymes.frame3.labelframe 11 -weight 1

  # box frame
  grid [frame $dialog.tabframe.enzymes.frame3.boxframe] -row 2 -column 1 -columnspan 5 -sticky w
  grid [ttk::label $dialog.tabframe.enzymes.frame3.boxframe.label0 -text [mc "Box:"]] -row 1 -column 0 -sticky w
  global outline_box_types_dict
  grid [menubutton $dialog.tabframe.enzymes.frame3.boxframe.type -menu $dialog.tabframe.enzymes.frame3.boxframe.type.menu -textvariable temp_circ_config_info($c,enz_box_type_label)] -row 1 -column 1 -sticky w
  menu $dialog.tabframe.enzymes.frame3.boxframe.type.menu
  foreach box_type [dict keys $outline_box_types_dict] {
      set type_label [dict get $outline_box_types_dict $box_type]
      $dialog.tabframe.enzymes.frame3.boxframe.type.menu add radiobutton -label $type_label -indicatoron 1 -value $box_type -variable temp_circ_config_info($c,enz_box_type)  -command "set temp_circ_config_info($c,enz_box_type_label) \"$type_label\"; event generate $dialog <<changed_enzymes>>"
  }
  grid [ttk::label $dialog.tabframe.enzymes.frame3.boxframe.label1 -text [mc "Fill:"]] -row 1 -column 2 -sticky w
  set temp_circ_config_info($c,enz_box_fill_color) #000000
  grid [color_button $dialog.tabframe.enzymes.frame3.boxframe.box_fill_color  temp_circ_config_info($c,enz_box_fill_color) 18] -row 1 -column 3 -sticky w
  bind $dialog.tabframe.enzymes.frame3.boxframe.box_fill_color <<color_picked>> " event generate $dialog <<changed_enzymes>>"
  bind $dialog.tabframe.enzymes.frame3.boxframe.box_fill_color <Shift-ButtonRelease-1> "set temp_circ_config_info($c,enz_box_fill_color) {}; event generate $dialog <<changed_enzymes>>; break"

  grid [ttk::label $dialog.tabframe.enzymes.frame3.boxframe.label2 -text [mc "Outline:"]] -padx {4 0} -row 1 -column 4 -sticky w
  set temp_circ_config_info($c,enz_box_outline_color) #000000
  grid [color_button $dialog.tabframe.enzymes.frame3.boxframe.box_outline_color  temp_circ_config_info($c,enz_box_outline_color) 18] -row 1 -column 5 -sticky w
  bind $dialog.tabframe.enzymes.frame3.boxframe.box_outline_color <<color_picked>> "event generate $dialog <<changed_enzymes>>"
  bind $dialog.tabframe.enzymes.frame3.boxframe.box_outline_color <Shift-ButtonRelease-1> "set temp_circ_config_info($c,enz_box_outline_color) {}; event generate $dialog <<changed_enzymes>>; break"
    grid [ttk::scale $dialog.tabframe.enzymes.frame3.boxframe.box_outlinewidth -orient horizontal -from 0 -to 8 -variable temp_circ_config_info($c,enz_box_outline_width) -command " set temp_circ_config_info($c,enz_box_outline_width) \[expr {round(\$temp_circ_config_info($c,enz_box_outline_width))}\];event generate $dialog <<changed_enzymes>>;#" ] -row 1 -column 6 -sticky w
    set temp_circ_config_info($c,enz_box_outline_width) "---"
    grid [ttk::label $dialog.tabframe.enzymes.frame3.boxframe.box_outlinewidth_label -textvariable temp_circ_config_info($c,enz_box_outline_width)] -row 1 -column 7 -sticky w

 ## tick frame
  grid [ttk::frame $dialog.tabframe.enzymes.frame3.tick_frame] -row 5 -column 1 -columnspan 7 -sticky we
  grid [ttk::label $dialog.tabframe.enzymes.frame3.tick_frame.tlabel -text [mc "Tick:"] -state normal] -row 2 -column 1 -sticky w

    set temp_circ_config_info($c,enz_tick_color) #000000
    grid [color_button $dialog.tabframe.enzymes.frame3.tick_frame.tcolor  temp_circ_config_info($c,enz_tick_color) 18] -row 2 -column 2 -sticky w
    bind $dialog.tabframe.enzymes.frame3.tick_frame.tcolor <<color_picked>> "event generate $dialog <<changed_enzymes>>"

    set temp_circ_config_info($c,enz_tick_width) 1
    grid [ttk::label $dialog.tabframe.enzymes.frame3.tick_frame.twlabel -text [mc "Width:"] -state normal] -padx {4 0} -row 2 -column 5 -sticky w
    grid [ttk::scale $dialog.tabframe.enzymes.frame3.tick_frame.tick_width -orient horizontal -from 1 -to 8 -variable temp_circ_config_info($c,enz_tick_width) -command "event generate $dialog <<changed_enzymes>>; set temp_circ_config_info($c,enz_tick_width) \[expr {round(\$temp_circ_config_info($c,enz_tick_width))}\];#" ] -row 2 -column 6 -sticky w
    set temp_circ_config_info($c,enz_tick_width) "---"
    grid [ttk::label $dialog.tabframe.enzymes.frame3.tick_frame.tick_width_label -textvariable temp_circ_config_info($c,enz_tick_width)] -row 2 -column 7 -sticky w
    set temp_circ_config_info($c,enz_tick_length) 1
    grid [ttk::label $dialog.tabframe.enzymes.frame3.tick_frame.tlenlabel -text [mc "Length:"] -state normal] -padx {4 0} -row 2 -column 8 -sticky w
    grid [ttk::scale $dialog.tabframe.enzymes.frame3.tick_frame.tick_length -orient horizontal -from 1 -to 20 -variable temp_circ_config_info($c,enz_tick_length) -command "event generate $dialog <<changed_enzymes>>; set temp_circ_config_info($c,enz_tick_length) \[expr {round(\$temp_circ_config_info($c,enz_tick_length))}\];#" ] -row 2 -column 9 -sticky w
    set temp_circ_config_info($c,enz_tick_length) "---"
    grid [ttk::label $dialog.tabframe.enzymes.frame3.tick_frame.tick_length_label -textvariable temp_circ_config_info($c,enz_tick_length)] -row 2 -column 10 -sticky w

    grid [checkbutton $dialog.tabframe.enzymes.frame3.tick_frame.show_con -text [mc "Show Connector"] -variable temp_circ_config_info($c,enz_label_show_connector) -command "if {\[info exists temp_circ_config_info($c,enz_label_show_connector)\]} {event generate $dialog <<changed_enzymes>>}" ] -row 2 -column 11 -sticky w

  # label text (name %n, pos%1, count %# variables)
  #grid [ttk::label $dialog.tabframe.enzymes.frame3.label_label -text [mc "Label"]] -row 2 -column 1 -sticky w
  #grid [entry $dialog.tabframe.enzymes.frame3.label -text ""] -row 2 -column 2 -columnspan 2 -sticky w


  circular_config_enz_fill_treeview $t $c

  ####features frame
  $dialog.tabframe add [ttk::frame $dialog.tabframe.features -relief flat] -text [mc "Features"] -sticky nswe
  grid columnconfigure $dialog.tabframe.features 0 -weight 1
  grid rowconfigure $dialog.tabframe.features 0 -weight 1

  grid [ttk::frame $dialog.tabframe.features.frame1 -relief flat] -row 0 -column 0 -sticky nswe
  set f $dialog.tabframe.features.frame1
  
  set t $f.tv
  set sc $f.sc
  ttk::treeview $t -yscrollcommand "optionscrollbar $sc" -height 5
  scrollbar $sc -orient vertical -command "$t yview" -width 15
  grid $f.tv -row 0 -column 0  -sticky nsew
  grid $f.sc -row 0 -column 1 -sticky nsw
  grid columnconfigure $f 0 -weight 1
  grid rowconfigure $f 0 -weight 1
  grid columnconfigure $f 1 -minsize 17

  set column_list {Direction Type Location Length}
  for {set i 0} {$i < 20} {incr i} {
    lappend column_list [format "g_%03u" $i]
  }
  $t configure -columns $column_list -displaycolumns {Direction Type Location Length}
  $t heading #0 -text [mc "Feature"] -command "treeview_sort $t {}"
  $t column #0 -width 200 -minwidth 50 -stretch 1 -anchor e
  $t heading Direction -text [mc "Direction"] -command "treeview_sort $t Direction"
  $t column Direction -width 60 -minwidth 50 -stretch 0 -anchor c
  $t heading Type -text [mc "Type"] -command "treeview_sort $t Type"
  $t column Type -width 80 -minwidth 50 -stretch 0 -anchor c
  $t heading Location -text [mc "Location  \u2193"] -command "treeview_sort $t Location"
  $t column Location -width 200 -minwidth 50 -stretch 0 -anchor c
  $t heading Length -text Length  -command "treeview_sort $t Length"
  $t column Length -width 60 -minwidth 50 -stretch 1 -anchor c

  bind $t <<TreeviewSelect>> "circular_config_fea_treeview_manageselection $t $c $dialog; $dialog.tabframe.features.frame2.b1 configure -state disabled"
  bind $t <<OldSelection>> {}
  $t tag configure sel -foreground $info(text_select_fg_color) -font boldlabelfont
  bind $t <<Sort_column>> Location
  bind $t <<Sort_direction>> 1
  bind $t <Button-2> "sputs button2 \[$t identify column %x %y]  \[$t identify row %x %y];# can use identify item when 8.6 is available"
  bind $t <<RightClick>> "sputs enzyme gm table_rightclick $w %x %y"

  grid [ttk::frame $dialog.tabframe.features.frame2 -relief ridge -borderwidth 2] -row 1 -column 0 -sticky swe
  #grid [button $dialog.tabframe.features.frame2.b1 -text [mc "Apply"] -command "event generate $dialog <<raise>>; circular_config_fea_treeview_apply \[$t selection\] $c $t"] -row 0 -column 0 -sticky we
  button $dialog.tabframe.features.frame2.b1
  bind $dialog <<changed_features>> "circular_config_fea_treeview_apply \[$t selection\] $c $t"

  grid [ttk::frame $dialog.tabframe.features.frame3 -relief ridge -borderwidth 2] -row 2 -column 0 -sticky swe
  grid [ttk::frame $dialog.tabframe.features.frame3_dummy -relief ridge -borderwidth 2] -row 2 -column 0 -sticky nswe
  grid [checkbutton $dialog.tabframe.features.frame3.visible -text [mc "Visible"] -variable temp_circ_config_info($c,fea_visible) -command "if {\[info exists temp_circ_config_info($c,fea_visible)\]} {event generate $dialog <<changed_features>>}" ] -row 0 -column 1 -columnspan 2 -sticky w


  ## feature fill and outline frame
  grid [ttk::frame $dialog.tabframe.features.frame3.ffg_frame] -row 1 -column 1 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.features.frame3.ffg_frame.ffg_label -text [mc "Fill:"] -state normal] -row 2 -column 1 -columnspan 2 -sticky w
  set temp_circ_config_info($c,fea_fg_color) {}
  grid [color_button $dialog.tabframe.features.frame3.ffg_frame.ffg_color  temp_circ_config_info($c,fea_fg_color) 18] -row 2 -column 3 -sticky w
  bind $dialog.tabframe.features.frame3.ffg_frame.ffg_color <<color_picked>> "event generate $dialog <<changed_features>>; $dialog.tabframe.features.frame3.ffg_frame.ffg_label configure -state normal"

  grid [ttk::frame $dialog.tabframe.features.frame3.ffg_frame.fwid_frame] -row 2 -column 4 -columnspan 1 -sticky we
  #grid [ttk::label $dialog.tabframe.features.frame3.ffg_frame.fwid_frame.fwidth_label -text [mc "Feature Width"]] -row 3 -column 1 -sticky w
  set temp_circ_config_info($c,fea_width) 5
  grid [ttk::scale $dialog.tabframe.features.frame3.ffg_frame.fwid_frame.fea_width -orient horizontal -from 2 -to 25 -variable temp_circ_config_info($c,fea_width) -command "event generate $dialog <<changed_features>>; set temp_circ_config_info($c,fea_width) \[expr {round(\$temp_circ_config_info($c,fea_width))}\];#" ] -row 3 -column 2 -sticky w
  set temp_circ_config_info($c,fea_width) "---"
  grid [ttk::label $dialog.tabframe.features.frame3.ffg_frame.fwid_frame.fea_width_label -textvariable temp_circ_config_info($c,fea_width)] -row 3 -column 3 -sticky w


  grid [ttk::frame $dialog.tabframe.features.frame3.ffg_frame.fbg_frame] -row 2 -column 5 -columnspan 1 -sticky we
  grid [ttk::label $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_label -text [mc "Outline:"] -state normal] -padx {4 0} -row 3 -column 1 -columnspan 2 -sticky w
  set temp_circ_config_info($c,fea_bg_color) {}
  grid [color_button $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color  temp_circ_config_info($c,fea_bg_color) 18] -row 3 -column 3 -sticky w
  bind $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color <<color_picked>> "event generate $dialog <<changed_features>>;$dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_label configure -state normal; #grid configure $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color_percent;# grid configure $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color_percent_label"

  grid [menubutton $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color_percent -menu $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color.menu -text "%"] -row 3 -column 4 -sticky w
  menu $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color.menu
  foreach perc [list 20 40 50 60 80] {
    $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color.menu add command -label [mc "Mix with %s%% Fill Color" $perc] -command "circular_config_fea_treeview_apply_tag_color_to_outline $t $c $perc $dialog"
  }
  $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color.menu add command -label [mc "Set to Fill Color"] -command "circular_config_fea_treeview_apply_tag_color_to_outline $t $c 100 $dialog"


  grid [ttk::frame $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.out_frame] -row 3 -column 6
  #grid [ttk::label $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.out_frame.foutl_label -text [mc "Feature Outline"]] -row 4 -column 1 -sticky w
  set temp_circ_config_info($c,fea_outline) 1
  grid [ttk::scale $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.out_frame.fea_outline -orient horizontal -from 1 -to 12 -variable temp_circ_config_info($c,fea_outline) -command "event generate $dialog <<changed_features>>; set temp_circ_config_info($c,fea_outline) \[expr {round(\$temp_circ_config_info($c,fea_outline))}\];#" ] -row 4 -column 2 -sticky w
  set temp_circ_config_info($c,fea_outline) "---"
  grid [ttk::label $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.out_frame.fea_outline_label -textvariable temp_circ_config_info($c,fea_outline)] -row 4 -column 3 -sticky w
  ## move feature radius aligned/ in/ out

  grid [ttk::frame $dialog.tabframe.features.frame3.ffg_frame.move_frame] -row 2 -column 6 -sticky we
  grid [tk_button $dialog.tabframe.features.frame3.ffg_frame.move_frame.move_in -text "<" -command "circular_config_fea_treeview_apply_move \[$t selection\] $c -1 f p"] -row 1 -column 2 -sticky w
  grid [tk_button $dialog.tabframe.features.frame3.ffg_frame.move_frame.move_in1 -text "-1" -command "circular_config_fea_treeview_apply_move \[$t selection\] $c -1 f w"] -row 1 -column 3 -sticky w
  grid [tk_button $dialog.tabframe.features.frame3.ffg_frame.move_frame.move_c -text "0" -command "circular_config_fea_treeview_apply_move \[$t selection\] $c 0 f w"] -row 1 -column 4 -sticky w
  grid [tk_button $dialog.tabframe.features.frame3.ffg_frame.move_frame.move_out1 -text "+1" -command "circular_config_fea_treeview_apply_move \[$t selection\] $c 1 f w"] -row 1 -column 5 -sticky w
  grid [tk_button $dialog.tabframe.features.frame3.ffg_frame.move_frame.move_out -text ">" -command "circular_config_fea_treeview_apply_move \[$t selection\] $c 1 f p"] -row 1 -column 6 -sticky w

  ## Intron formatting frame
  grid [ttk::frame $dialog.tabframe.features.frame3.intron_frame] -row 2 -column 1 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.features.frame3.intron_frame.ffg_label -text [mc "Intron Fill:"] -state normal] -row 2 -column 1 -columnspan 2 -sticky w
  set temp_circ_config_info($c,fea_intron_fg_color) {}
  grid [color_button $dialog.tabframe.features.frame3.intron_frame.ffg_color  temp_circ_config_info($c,fea_intron_fg_color) 18] -row 2 -column 3 -sticky w
  bind $dialog.tabframe.features.frame3.intron_frame.ffg_color <<color_picked>> "event generate $dialog <<changed_features>>; $dialog.tabframe.features.frame3.intron_frame.ffg_label configure -state normal"

  grid [ttk::frame $dialog.tabframe.features.frame3.intron_frame.fwid_frame] -row 2 -column 4 -columnspan 1 -sticky we
  set temp_circ_config_info($c,fea_intron_width) 5
  grid [ttk::scale $dialog.tabframe.features.frame3.intron_frame.fwid_frame.fea_intron_width -orient horizontal -from 1 -to 25 -variable temp_circ_config_info($c,fea_intron_width) -command "event generate $dialog <<changed_features>>; set temp_circ_config_info($c,fea_intron_width) \[expr {round(\$temp_circ_config_info($c,fea_intron_width))}\];#" ] -row 3 -column 2 -sticky w
  set temp_circ_config_info($c,fea_intron_width) "---"
  grid [ttk::label $dialog.tabframe.features.frame3.intron_frame.fwid_frame.fea_intron_width_label -textvariable temp_circ_config_info($c,fea_intron_width)] -row 3 -column 3 -sticky w

  set temp_circ_config_info($c,fea_intron_height) 0
  grid [ttk::scale $dialog.tabframe.features.frame3.intron_frame.fwid_frame.fea_intron_height -orient horizontal -from -0.5 -to +0.5 -variable temp_circ_config_info($c,fea_intron_height) -command "event generate $dialog <<changed_features>>; set temp_circ_config_info($c,fea_intron_height) \[expr {round(\$temp_circ_config_info($c,fea_intron_height)*10)/10.0}\];#" ] -row 3 -column 4 -sticky w
  set temp_circ_config_info($c,fea_intron_height) "---"
  grid [ttk::label $dialog.tabframe.features.frame3.intron_frame.fwid_frame.fea_intron_height_label -textvariable temp_circ_config_info($c,fea_intron_height)] -row 3 -column 5 -sticky w

  grid [ttk::frame $dialog.tabframe.features.frame3.intron_frame.fbg_frame] -row 2 -column 6 -columnspan 1 -sticky we
  grid [ttk::label $dialog.tabframe.features.frame3.intron_frame.fbg_frame.fbg_label -text [mc "Outline:"] -state normal] -padx {4 0} -row 3 -column 1  -sticky w
  set temp_circ_config_info($c,fea_intron_bg_color) {}
  grid [color_button $dialog.tabframe.features.frame3.intron_frame.fbg_frame.fbg_color  temp_circ_config_info($c,fea_intron_bg_color) 18] -row 3 -column 2 -sticky w
  bind $dialog.tabframe.features.frame3.intron_frame.fbg_frame.fbg_color <<color_picked>> "event generate $dialog <<changed_features>>;$dialog.tabframe.features.frame3.intron_frame.fbg_frame.fbg_label configure -state normal; #grid configure $dialog.tabframe.features.frame3.intron_frame.fbg_frame.fbg_color_percent;# grid configure $dialog.tabframe.features.frame3.intron_frame.fbg_frame.fbg_color_percent_label"

  grid [ttk::frame $dialog.tabframe.features.frame3.intron_frame.fbg_frame.out_frame] -row 3 -column 3
  set temp_circ_config_info($c,fea_intron_outline) 1
  grid [ttk::scale $dialog.tabframe.features.frame3.intron_frame.fbg_frame.out_frame.fea_intron_outline -orient horizontal -from 0 -to 12 -variable temp_circ_config_info($c,fea_intron_outline) -command "event generate $dialog <<changed_features>>; set temp_circ_config_info($c,fea_intron_outline) \[expr {round(\$temp_circ_config_info($c,fea_intron_outline))}\];#" ] -row 4 -column 2 -sticky w
  set temp_circ_config_info($c,fea_intron_outline) "---"
  grid [ttk::label $dialog.tabframe.features.frame3.intron_frame.fbg_frame.out_frame.fea_intron_outline_label -textvariable temp_circ_config_info($c,fea_intron_outline)] -row 4 -column 4 -sticky w

  grid [button $dialog.tabframe.features.frame3.intron_frame.fbg_frame.fbg_use_main -text [mc "Use Main"] -command "circular_config_fea_treeview_apply_tag_properties_to_intron $t $c $dialog"] -row 3 -column 5 -sticky w

  ## Arrow formatting frame
  grid [ttk::frame $dialog.tabframe.features.frame3.arrow_frame] -row 3 -column 1 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.features.frame3.arrow_frame.l2 -text [mc "5' arrow:"]] -row 1 -column 1 -sticky w
  #grid [entry $dialog.tabframe.features.frame3.arrow_frame.e2 -textvariable temp_circ_config_info($c,fea_r_arrow)] -row 1 -column 2 -sticky w
  grid [menubutton $dialog.tabframe.features.frame3.arrow_frame.reva -textvariable temp_circ_config_info($c,r_arrow_text)] -row 1 -column 2 -sticky w
  $dialog.tabframe.features.frame3.arrow_frame.reva configure -menu [menu $dialog.tabframe.features.frame3.arrow_frame.reva.m]
  set temp_circ_config_info($c,fea_r_arrow) {}
  fill_arrow_menu $dialog.tabframe.features.frame3.arrow_frame.reva.m $info(arrowlist) temp_circ_config_info($c,fea_r_arrow) temp_circ_config_info($c,r_arrow_text) "event generate $dialog <<changed_features>>"

  grid [ttk::label $dialog.tabframe.features.frame3.arrow_frame.l1 -text [mc "3' arrow:"]] -padx {4 0} -row 1 -column 3 -sticky w
  grid [menubutton $dialog.tabframe.features.frame3.arrow_frame.fwda -textvariable temp_circ_config_info($c,f_arrow_text)] -row 1 -column 4 -sticky w
  $dialog.tabframe.features.frame3.arrow_frame.fwda configure -menu [menu $dialog.tabframe.features.frame3.arrow_frame.fwda.m]
  set temp_circ_config_info($c,fea_f_arrow) {}
  fill_arrow_menu $dialog.tabframe.features.frame3.arrow_frame.fwda.m $info(arrowlist) temp_circ_config_info($c,fea_f_arrow) temp_circ_config_info($c,f_arrow_text) "event generate $dialog <<changed_features>>"

    ## Text formatting frame
    grid [ttk::frame $dialog.tabframe.features.frame3.label_frame] -row 4 -column 1 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.features.frame3.label_frame.fontfam_label -text [mc "Text:"]] -row 1 -column 1 -sticky w
    set temp_circ_config_info($c,fea_label_color) #000000
  grid [color_button $dialog.tabframe.features.frame3.label_frame.label_color  temp_circ_config_info($c,fea_label_color) 18] -row 1 -column 2 -sticky w
  bind $dialog.tabframe.features.frame3.label_frame.label_color <<color_picked>> " event generate $dialog <<changed_features>>"

    grid [menubutton $dialog.tabframe.features.frame3.label_frame.label_color_percent -menu $dialog.tabframe.features.frame3.label_frame.label_color_percent.menu -text "%"] -row 1 -column 3 -sticky w
  menu $dialog.tabframe.features.frame3.label_frame.label_color_percent.menu
  foreach perc [list 20 40 50 60 80] {
    $dialog.tabframe.features.frame3.label_frame.label_color_percent.menu add command -label [mc "Mix with %s%% Fill Color" $perc] -command "circular_config_fea_treeview_apply_tag_color_to_label $t $c $perc $dialog"
  }
  $dialog.tabframe.features.frame3.label_frame.label_color_percent.menu add command -label [mc "Set to Fill Color"] -command "circular_config_fea_treeview_apply_tag_color_to_label $t $c 100 $dialog"
  
  grid [menubutton $dialog.tabframe.features.frame3.label_frame.fontfam -menu $dialog.tabframe.features.frame3.label_frame.fontfam.menu -textvariable temp_circ_config_info($c,fea_fontfamily)] -row 1 -column 4 -sticky w
   menu $dialog.tabframe.features.frame3.label_frame.fontfam.menu
    if {[llength $info(allfontlist)] <= 20} {
      foreach fontfam $info(allfontlist) {
        $dialog.tabframe.features.frame3.label_frame.fontfam.menu add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable temp_circ_config_info($c,fea_fontfamily) -command "event generate $dialog <<changed_features>>";# -font [list $fontfam 10]
      }
    } else {
      for {set fi 0} {$fi < [llength $info(allfontlist)]} {incr fi 20} {
        if {[set fj [expr {$fi + 19}]] > [llength $info(allfontlist)]} {set fj [expr {[llength $info(allfontlist)]-1}]}
        $dialog.tabframe.features.frame3.label_frame.fontfam.menu add cascade -label "[lindex $info(allfontlist) $fi]-[lindex $info(allfontlist) $fj]" -menu $dialog.tabframe.features.frame3.label_frame.fontfam.menu.menu$fi 
        menu $dialog.tabframe.features.frame3.label_frame.fontfam.menu.menu$fi
        foreach fontfam [lrange $info(allfontlist) $fi $fj] {
          $dialog.tabframe.features.frame3.label_frame.fontfam.menu.menu$fi add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable temp_circ_config_info($c,fea_fontfamily) -command "event generate $dialog <<changed_features>>";# -font [list $fontfam 10]
        }
      }
    }
  grid [menubutton $dialog.tabframe.features.frame3.label_frame.fontsiz -menu $dialog.tabframe.features.frame3.label_frame.fontsiz.menu -textvariable temp_circ_config_info($c,fea_fontsize)] -row 1 -column 5 -sticky w
  menu $dialog.tabframe.features.frame3.label_frame.fontsiz.menu
  foreach fontsize [lsort -unique -integer [concat [list 6 8 9 10 11 12 13 14 16 18 20 24 26 28 30 34 36 40]]] {
      $dialog.tabframe.features.frame3.label_frame.fontsiz.menu add radiobutton -label $fontsize -indicatoron 1 -value $fontsize -variable temp_circ_config_info($c,fea_fontsize)  -command "event generate $dialog <<changed_features>>"
  }
  set temp_circ_config_info($c,fea_fontfamily) "---"
  set temp_circ_config_info($c,fea_fontsize) "---"

  grid [ttk::checkbutton $dialog.tabframe.features.frame3.label_frame.fontb  -text "B"  -variable temp_circ_config_info($c,fea_fontbold) -command "event generate $dialog <<changed_features>>"] -row 1 -column 6 -sticky w
  grid [ttk::checkbutton $dialog.tabframe.features.frame3.label_frame.fonti  -text "I" -variable temp_circ_config_info($c,fea_fontitalic) -command "event generate $dialog <<changed_features>>"] -row 1 -column 7 -sticky w
  grid [ttk::checkbutton $dialog.tabframe.features.frame3.label_frame.fontu  -text "U" -variable temp_circ_config_info($c,fea_fontunderline) -command "event generate $dialog <<changed_features>>"] -row 1 -column 8 -sticky w


#    align 
    grid [menubutton $dialog.tabframe.features.frame3.label_frame.align -menu $dialog.tabframe.features.frame3.label_frame.align.menu -textvariable temp_circ_config_info($c,fea_label_align)] -padx {4 0} -row 1 -column 9 -sticky w
    menu $dialog.tabframe.features.frame3.label_frame.align.menu
    foreach al [list "Center" "CCW" "CW" "5'" "3'" "-CCW" "-CW" "-5'" "-3'"] {
      $dialog.tabframe.features.frame3.label_frame.align.menu add  radiobutton -label $al -indicatoron 1 -value $al -variable temp_circ_config_info($c,fea_label_align)  -command "event generate $dialog <<changed_features>>"
    }
    set temp_circ_config_info($c,fea_label_align) "Center"

  ### label text (name %n, pos%1, count %# variables)
  ###grid [ttk::label $dialog.tabframe.features.frame3.label_frame.label_label -text [mc "Label"]] -row 2 -column 1 -sticky w
  ###grid [entry $dialog.tabframe.features.frame3.label_frame.label -text ""] -row 2 -column 2 -columnspan 2 -sticky w


  #grid [button $dialog.tabframe.features.frame3.label_frame.label_use_ffg_color -text [mc "Use Feature Color"] -command "circular_config_fea_treeview_apply_tag_color_to_label $t $c 100 $dialog" ] -row 1 -column 6 -sticky w

  grid [checkbutton $dialog.tabframe.features.frame3.label_frame.label_use_arc -text [mc "Use Arc Text"] -variable temp_circ_config_info($c,fea_label_arc) -command "if {\[info exists temp_circ_config_info($c,fea_label_arc)\]} {event generate $dialog <<changed_features>>; ; if {\$temp_circ_config_info($c,fea_label_arc)} {grid configure $dialog.tabframe.features.frame3.label_frame.subst_frame.move_in;grid configure $dialog.tabframe.features.frame3.label_frame.subst_frame.move_out1; grid configure $dialog.tabframe.features.frame3.label_frame.subst_frame.move_out; grid remove $dialog.tabframe.features.frame3.label_frame.subst_frame.entry_label; grid remove $dialog.tabframe.features.frame3.label_frame.subst_frame.label_subst; grid remove $dialog.tabframe.features.frame3.label_frame.subst_frame.subst_vals; grid remove $dialog.tabframe.features.frame3.boxframe} else {grid remove $dialog.tabframe.features.frame3.label_frame.subst_frame.move_in;grid remove $dialog.tabframe.features.frame3.label_frame.subst_frame.move_out1; grid remove $dialog.tabframe.features.frame3.label_frame.subst_frame.move_out; grid configure $dialog.tabframe.features.frame3.label_frame.subst_frame.entry_label; grid configure $dialog.tabframe.features.frame3.label_frame.subst_frame.label_subst; grid configure $dialog.tabframe.features.frame3.label_frame.subst_frame.subst_vals; grid configure $dialog.tabframe.features.frame3.boxframe }}" ] -row 1 -column 10 -sticky w



  grid [ttk::frame $dialog.tabframe.features.frame3.label_frame.subst_frame] -row 2 -column 1 -columnspan 10 -sticky nwe
  grid [ttk::label $dialog.tabframe.features.frame3.label_frame.subst_frame.entry_label -text [mc "Label:"]] -row 1 -column 5 -sticky nw
  grid [ttk::entry $dialog.tabframe.features.frame3.label_frame.subst_frame.label_subst -textvariable temp_circ_config_info($c,fea_label_subst) -validate key -validatecommand "after 100 {event generate $dialog <<changed_features>>}; return 1"] -row 1 -column 6 -sticky nw
  bind $dialog.tabframe.features.frame3.label_frame.subst_frame.label_subst <FocusOut> "event generate $dialog <<changed_features>>"
  grid [menubutton $dialog.tabframe.features.frame3.label_frame.subst_frame.subst_vals -menu $dialog.tabframe.features.frame3.label_frame.subst_frame.subst_vals.menu -text [mc "Substitutions"]] -row 1 -column 7 -sticky nw
  menu $dialog.tabframe.features.frame3.label_frame.subst_frame.subst_vals.menu
  foreach {mlabel subs} {"Name" %n "Location start" %s "Location end" %e  "Direction thin arrow" %d "Direction thick arrow" %D} {
     $dialog.tabframe.features.frame3.label_frame.subst_frame.subst_vals.menu add command -label [mc $mlabel] -command "$dialog.tabframe.features.frame3.label_frame.subst_frame.label_subst insert insert \"$subs\";event generate $dialog <<changed_features>>"
  }

  ## delta radius (for arc feature labels)
  ## in/out pointing for non-arc feature labels
  grid [tk_button $dialog.tabframe.features.frame3.label_frame.subst_frame.move_in -text "<" -command "circular_config_fea_treeview_apply_move \[$t selection\] $c -1 l p"] -row 1 -column 8 -sticky w
  grid [tk_button $dialog.tabframe.features.frame3.label_frame.subst_frame.move_in1 -text "-1" -command "circular_config_fea_treeview_apply_move \[$t selection\] $c -1 l w"] -row 1 -column 9 -sticky w
  grid [tk_button $dialog.tabframe.features.frame3.label_frame.subst_frame.move_c -text "0" -command "circular_config_fea_treeview_apply_move \[$t selection\] $c 0 l w"] -row 1 -column 10 -sticky w
  grid [tk_button $dialog.tabframe.features.frame3.label_frame.subst_frame.move_out1 -text "+1" -command "circular_config_fea_treeview_apply_move \[$t selection\] $c 1 l w"] -row 1 -column 11 -sticky w
  grid [tk_button $dialog.tabframe.features.frame3.label_frame.subst_frame.move_out -text ">" -command "circular_config_fea_treeview_apply_move \[$t selection\] $c 1 l p"] -row 1 -column 12 -sticky w


  ## Box outline frame
  grid [ttk::frame $dialog.tabframe.features.frame3.boxframe] -row 5 -column 1 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.features.frame3.boxframe.label0 -text [mc "Box:"]] -row 1 -column 0 -sticky e
  global outline_box_types_dict
  grid [menubutton $dialog.tabframe.features.frame3.boxframe.type -menu $dialog.tabframe.features.frame3.boxframe.type.menu -textvariable temp_circ_config_info($c,fea_box_type_label)] -row 1 -column 1 -sticky w
  menu $dialog.tabframe.features.frame3.boxframe.type.menu
  foreach box_type [dict keys $outline_box_types_dict] {
      set type_label [dict get $outline_box_types_dict $box_type]
      $dialog.tabframe.features.frame3.boxframe.type.menu add radiobutton -label $type_label -indicatoron 1 -value $box_type -variable temp_circ_config_info($c,fea_box_type)  -command "set temp_circ_config_info($c,fea_box_type_label) \"$type_label\"; event generate $dialog <<changed_features>>"
  }
  grid [ttk::label $dialog.tabframe.features.frame3.boxframe.label1 -text [mc "Fill:"]] -row 1 -column 2 -sticky w
  set temp_circ_config_info($c,fea_box_fill_color) #000000
  grid [color_button $dialog.tabframe.features.frame3.boxframe.box_fill_color  temp_circ_config_info($c,fea_box_fill_color) 18] -row 1 -column 3 -sticky w
  bind $dialog.tabframe.features.frame3.boxframe.box_fill_color <<color_picked>> "event generate $dialog <<changed_features>>"
  bind $dialog.tabframe.features.frame3.boxframe.box_fill_color <Shift-ButtonRelease-1> "set temp_circ_config_info($c,fea_box_fill_color) {}; event generate $dialog <<changed_features>>; break"

  grid [ttk::label $dialog.tabframe.features.frame3.boxframe.label2 -text [mc "Outline:"]] -padx {4 0} -row 1 -column 4 -sticky w
  set temp_circ_config_info($c,fea_box_outline_color) #000000
  grid [color_button $dialog.tabframe.features.frame3.boxframe.box_outline_color  temp_circ_config_info($c,fea_box_outline_color) 18] -row 1 -column 5 -sticky w
  bind $dialog.tabframe.features.frame3.boxframe.box_outline_color <<color_picked>> "event generate $dialog <<changed_features>>"
  bind $dialog.tabframe.features.frame3.boxframe.box_outline_color <Shift-ButtonRelease-1> "set temp_circ_config_info($c,fea_box_outline_color) {}; event generate $dialog <<changed_features>>; break"
    grid [ttk::scale $dialog.tabframe.features.frame3.boxframe.box_outlinewidth -orient horizontal -from 0 -to 8 -variable temp_circ_config_info($c,fea_box_outline_width) -command " set temp_circ_config_info($c,fea_box_outline_width) \[expr {round(\$temp_circ_config_info($c,fea_box_outline_width))}\];event generate $dialog <<changed_features>>;#" ] -row 1 -column 6 -sticky w
    set temp_circ_config_info($c,fea_box_outline_width) "---"
    grid [ttk::label $dialog.tabframe.features.frame3.boxframe.box_outlinewidth_label -textvariable temp_circ_config_info($c,fea_box_outline_width)] -row 1 -column 7 -sticky w


  ## tick frame
  grid [ttk::frame $dialog.tabframe.features.frame3.tick_frame] -row 6 -column 1 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.features.frame3.tick_frame.tlabel -text [mc "Tick:"] -state normal] -row 2 -column 1 -sticky w

    set temp_circ_config_info($c,fea_tick_color) #000000
    grid [color_button $dialog.tabframe.features.frame3.tick_frame.tcolor  temp_circ_config_info($c,fea_tick_color) 18] -row 2 -column 2 -sticky w
    bind $dialog.tabframe.features.frame3.tick_frame.tcolor <<color_picked>> "event generate $dialog <<changed_features>>"

    grid [menubutton $dialog.tabframe.features.frame3.tick_frame.tcolor_percent -menu $dialog.tabframe.features.frame3.tick_frame.tcolor_percent.menu -text "%"] -row 2 -column 3 -sticky w
    menu $dialog.tabframe.features.frame3.tick_frame.tcolor_percent.menu
    foreach perc [list 20 40 50 60 80] {
      $dialog.tabframe.features.frame3.tick_frame.tcolor_percent.menu add command -label [mc "Mix with %s%% Fill Color" $perc] -command "circular_config_fea_treeview_apply_tag_color_to_tick $t $c $perc $dialog"
    }
    $dialog.tabframe.features.frame3.tick_frame.tcolor_percent.menu add command -label [mc "Set to Fill Color"] -command "circular_config_fea_treeview_apply_tag_color_to_tick $t $c 100 $dialog"

    set temp_circ_config_info($c,fea_tick_width) 1
    grid [ttk::label $dialog.tabframe.features.frame3.tick_frame.twlabel -text [mc "Width:"] -state normal] -padx {4 0} -row 2 -column 5 -sticky w
    grid [ttk::scale $dialog.tabframe.features.frame3.tick_frame.tick_width -orient horizontal -from 1 -to 8 -variable temp_circ_config_info($c,fea_tick_width) -command "event generate $dialog <<changed_features>>; set temp_circ_config_info($c,fea_tick_width) \[expr {round(\$temp_circ_config_info($c,fea_tick_width))}\];#" ] -row 2 -column 6 -sticky w
    set temp_circ_config_info($c,fea_tick_width) "---"
    grid [ttk::label $dialog.tabframe.features.frame3.tick_frame.tick_width_label -textvariable temp_circ_config_info($c,fea_tick_width)] -row 2 -column 7 -sticky w
    set temp_circ_config_info($c,fea_tick_length) 1
    grid [ttk::label $dialog.tabframe.features.frame3.tick_frame.tlenlabel -text [mc "Length:"] -state normal] -padx {4 0} -row 2 -column 8 -sticky w
    grid [ttk::scale $dialog.tabframe.features.frame3.tick_frame.tick_length -orient horizontal -from 1 -to 20 -variable temp_circ_config_info($c,fea_tick_length) -command "event generate $dialog <<changed_features>>; set temp_circ_config_info($c,fea_tick_length) \[expr {round(\$temp_circ_config_info($c,fea_tick_length))}\];#" ] -row 2 -column 9 -sticky w
    set temp_circ_config_info($c,fea_tick_length) "---"
    grid [ttk::label $dialog.tabframe.features.frame3.tick_frame.tick_length_label -textvariable temp_circ_config_info($c,fea_tick_length)] -row 2 -column 10 -sticky w

    grid [checkbutton $dialog.tabframe.features.frame3.tick_frame.show_con -text [mc "Show Connector"] -variable temp_circ_config_info($c,fea_label_show_connector) -command "if {\[info exists temp_circ_config_info($c,fea_label_show_connector)\]} {event generate $dialog <<changed_features>>}" ] -row 2 -column 11 -sticky w


  #grid [checkbutton $dialog.tabframe.features.frame3.arrow_frame.c1 -text [mc "Flip on reverse"] -variable temp_circ_config_info($c,arrow_flip)]  -row 1 -column 5 -sticky w

  #grid [ttk::label $dialog.tabframe.features.frame3.arrow_frame.l4 -text [mc "Offset:"]] -row 2 -column 1 -sticky w

  #if {$info(bg_color) eq "systemWindowBackgroundColor"} {
  #  recolor_tabframe_bg $dialog.tabframe 1
  #}

  circular_config_fea_fill_treeview $t $c

  ####Index frame
  $dialog.tabframe add [ttk::frame $dialog.tabframe.index -relief flat] -text [mc "Index"] -sticky nswe
  grid columnconfigure $dialog.tabframe.index 1 -weight 1
  grid rowconfigure $dialog.tabframe.index 0 -weight 1
  set tick_dict [$c bind 1 <<Tick_dict>>]

  grid [ttk::frame $dialog.tabframe.index.frame2 -relief flat] -row 0 -column 1 -sticky nswe

  grid [ttk::frame  $dialog.tabframe.index.frame2.major] -row 1 -column 0 -sticky nwe
  grid [ttk::label $dialog.tabframe.index.frame2.major.maj_label -text [mc "Major Tick"]] -row 1 -column 0  -sticky nw
  
  grid [ttk::frame $dialog.tabframe.index.frame2.major.bp_frame] -row 2 -column 0 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.index.frame2.major.bp_frame.m_label -text [mc "Base Pair per Tick:"]] -row 1 -column 0 -sticky w
  grid [ttk::menubutton $dialog.tabframe.index.frame2.major.bp_frame.mmb -textvariable temp_circ_config_info($c,index_bp_per_max) -menu  $dialog.tabframe.index.frame2.major.bp_frame.mmb.menu] -row 1 -column 1 -sticky w
  menu  $dialog.tabframe.index.frame2.major.bp_frame.mmb.menu
  foreach m [list 0 100 200 500 1000 2000 5000 10000] {
    $dialog.tabframe.index.frame2.major.bp_frame.mmb.menu add radiobutton -label $m -variable temp_circ_config_info($c,index_bp_per_max) -value $m -command "circular_config_index_apply $c"
  }
  set temp_circ_config_info($c,index_bp_per_max) [dict get $tick_dict circular_map_index_max_tick_spacing]


  grid [ttk::checkbutton $dialog.tabframe.index.frame2.major.bp_frame.12oc -variable temp_circ_config_info($c,max_at_zero) -text [mc "Max at zero"] -command "circular_config_index_apply $c"] -row 1 -column 2 -sticky w
  set temp_circ_config_info($c,max_at_zero) [dict get $tick_dict circular_map_index_max_at_zero]


  grid [ttk::frame $dialog.tabframe.index.frame2.major.format_frame] -row 3 -column 0 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.index.frame2.major.format_frame.m_label -text [mc "Label Format:"]] -row 1 -column 0 -sticky w
  grid [ttk::menubutton $dialog.tabframe.index.frame2.major.format_frame.fb -textvariable temp_circ_config_info($c,index_label_format) -menu  $dialog.tabframe.index.frame2.major.format_frame.fb.menu] -row 1 -column 1 -sticky w
  menu  $dialog.tabframe.index.frame2.major.format_frame.fb.menu
  foreach m [list "none" "1000" "1,000" "1 000" "1.000" "1.0 k"  "1 k"] {
    $dialog.tabframe.index.frame2.major.format_frame.fb.menu add radiobutton -label $m -variable temp_circ_config_info($c,index_label_format) -value $m -command "circular_config_index_apply $c"
  }
  set temp_circ_config_info($c,index_label_format) [dict get $tick_dict index_label_format]

  grid [ttk::menubutton $dialog.tabframe.index.frame2.major.format_frame.fb2 -textvariable temp_circ_config_info($c,index_text_angle_format_text) -menu  $dialog.tabframe.index.frame2.major.format_frame.fb2.menu] -row 1 -column 2 -sticky w
  menu  $dialog.tabframe.index.frame2.major.format_frame.fb2.menu
  set temp_circ_config_info($c,index_text_angle_format) [dict get $tick_dict index_text_angle_format]
  foreach m [list h r90 r45 r0ccw r0] mt [list "Horizontal text" "Radial text 90\u00B0" "Radial text 45\u00B0" "Radial text 0\u00B0 CCW" "Radial text 0\u00B0"] {
    $dialog.tabframe.index.frame2.major.format_frame.fb2.menu add radiobutton -label $mt -variable temp_circ_config_info($c,index_text_angle_format) -value $m -command "circular_config_index_apply $c"
    if {$temp_circ_config_info($c,index_text_angle_format) eq $m} {
      set temp_circ_config_info($c,index_text_angle_format_text) $mt
    }
  }

  

  grid [ttk::frame $dialog.tabframe.index.frame2.major.max_font_frame] -row 4 -column 0 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.index.frame2.major.max_font_frame.m_label -text [mc "Text:"]] -row 1 -column 0 -sticky nw

  set temp_circ_config_info($c,index_circular_text_color)  [dict get $tick_dict index_circular_text_color]
  grid [color_button $dialog.tabframe.index.frame2.major.max_font_frame.lael_color temp_circ_config_info($c,index_circular_text_color) 18] -row 1 -column 1 -sticky nw
    bind $dialog.tabframe.index.frame2.major.max_font_frame.lael_color <<color_picked>> "circular_config_index_apply $c"
  grid [menubutton $dialog.tabframe.index.frame2.major.max_font_frame.fontfam -menu $dialog.tabframe.index.frame2.major.max_font_frame.fontfam.menu -textvariable temp_circ_config_info($c,index_tick_fontfamily)] -row 1 -column 2 -sticky nw
   menu $dialog.tabframe.index.frame2.major.max_font_frame.fontfam.menu
    if {[llength $info(allfontlist)] <= 20} {
      foreach fontfam $info(allfontlist) {
        $dialog.tabframe.index.frame2.major.max_font_frame.fontfam.menu add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable temp_circ_config_info($c,index_tick_fontfamily) -command "circular_config_index_apply $c";# -font [list $fontfam 10]
      }
    } else {
      for {set fi 0} {$fi < [llength $info(allfontlist)]} {incr fi 20} {
        if {[set fj [expr {$fi + 19}]] > [llength $info(allfontlist)]} {set fj [expr {[llength $info(allfontlist)]-1}]}
        $dialog.tabframe.index.frame2.major.max_font_frame.fontfam.menu add cascade -label "[lindex $info(allfontlist) $fi]-[lindex $info(allfontlist) $fj]" -menu $dialog.tabframe.index.frame2.major.max_font_frame.fontfam.menu.menu$fi 
        menu $dialog.tabframe.index.frame2.major.max_font_frame.fontfam.menu.menu$fi
        foreach fontfam [lrange $info(allfontlist) $fi $fj] {
          $dialog.tabframe.index.frame2.major.max_font_frame.fontfam.menu.menu$fi add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable temp_circ_config_info($c,index_tick_fontfamily) -command "circular_config_index_apply $c";# -font [list $fontfam 10]
        }
      }
    }
  grid [menubutton $dialog.tabframe.index.frame2.major.max_font_frame.fontsiz -menu $dialog.tabframe.index.frame2.major.max_font_frame.fontsiz.menu -textvariable temp_circ_config_info($c,index_tick_fontsize)] -row 1 -column 3 -sticky nw
  menu $dialog.tabframe.index.frame2.major.max_font_frame.fontsiz.menu
  foreach fontsize [lsort -unique -integer [concat [list 6 8 9 10 11 12 13 14 16 18 20 24 26 28 30 34 36 40]]] {
      $dialog.tabframe.index.frame2.major.max_font_frame.fontsiz.menu add radiobutton -label $fontsize -indicatoron 1 -value $fontsize -variable temp_circ_config_info($c,index_tick_fontsize)  -command "circular_config_index_apply $c"
  }

  set temp_circ_config_info($c,index_tick_fontfamily) [font actual [dict get $tick_dict circular_index_max_tick_font] -family]
  set temp_circ_config_info($c,index_tick_fontsize) [font actual [dict get $tick_dict circular_index_max_tick_font] -size]

  grid [ttk::frame $dialog.tabframe.index.frame2.major.maj_len_frame] -row 5 -column 0 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.index.frame2.major.maj_len_frame.bl_fg_label -text [mc "Line:"]] -row 1 -column 1 -columnspan 1 -sticky nw
  set temp_circ_config_info($c,index_maj_tick_fg_color)  [dict get $tick_dict circular_index_max_tick_color]
  grid [color_button $dialog.tabframe.index.frame2.major.maj_len_frame.bl_fg_color temp_circ_config_info($c,index_maj_tick_fg_color) 18] -row 1 -column 2 -sticky nw
  bind $dialog.tabframe.index.frame2.major.maj_len_frame.bl_fg_color <<color_picked>> "circular_config_index_apply $c"
  grid [ttk::label $dialog.tabframe.index.frame2.major.maj_len_frame.bl_fg_w_label -text [mc "Length:"]] -row 1 -column 3 -sticky nw
grid [ttk::scale $dialog.tabframe.index.frame2.major.maj_len_frame.bl_fg_width -orient horizontal -from 0 -to 20 -variable temp_circ_config_info($c,index_maj_tick_length) -command "set temp_circ_config_info($c,index_maj_tick_length) \[expr {round(\$temp_circ_config_info($c,index_maj_tick_length) *100) / 100.0}\];circular_config_index_apply $c;#" ] -row 1 -column 4 -sticky nw
  set temp_circ_config_info($c,index_maj_tick_length) [expr {100* [dict get $tick_dict circular_index_max_tick_length]}]
  grid [ttk::label $dialog.tabframe.index.frame2.major.maj_len_frame.bl_fg_w_v_label -textvariable temp_circ_config_info($c,index_maj_tick_length)] -row 1 -column 5 -sticky nw

  grid [ttk::frame $dialog.tabframe.index.frame2.major.maj_width_frame] -row 6 -column 0 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.index.frame2.major.maj_width_frame.bl_bg_w_label -text [mc "Width:"]] -row 1 -column 3 -sticky nw
grid [ttk::scale $dialog.tabframe.index.frame2.major.maj_width_frame.bl_bg_width -orient horizontal -from 1 -to 5 -variable temp_circ_config_info($c,index_maj_tick_width) -command "set temp_circ_config_info($c,index_maj_tick_width) \[expr {round(\$temp_circ_config_info($c,index_maj_tick_width))}\];circular_config_index_apply $c;#" ] -row 1 -column 4 -sticky nw
  set temp_circ_config_info($c,index_maj_tick_width) [dict get $tick_dict circular_index_max_tick_width]
  grid [ttk::label $dialog.tabframe.index.frame2.major.maj_width_frame.bl_bg_w_v_label -textvariable temp_circ_config_info($c,index_maj_tick_width)] -row 1 -column 5 -sticky nw

  grid [ttk::separator  $dialog.tabframe.index.frame2.sep] -row 2 -column 0 -sticky nwe -columnspan 7

  grid [ttk::frame  $dialog.tabframe.index.frame2.minor] -row 3 -column 0 -sticky nwe
  grid [ttk::label $dialog.tabframe.index.frame2.minor.ch_label -text [mc "Minor Tick"]] -row 1 -column 1  -sticky nw

  grid [ttk::frame $dialog.tabframe.index.frame2.minor.min_per_max_frame] -row 2 -column 1 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.index.frame2.minor.min_per_max_frame.m_label -text [mc "Minor per Major:"]] -row 1 -column 0 -sticky nw
  grid [ttk::menubutton $dialog.tabframe.index.frame2.minor.min_per_max_frame.mmb -textvariable temp_circ_config_info($c,index_min_per_max) -menu  $dialog.tabframe.index.frame2.minor.min_per_max_frame.mmb.menu] -row 1 -column 1 -sticky nw
  menu  $dialog.tabframe.index.frame2.minor.min_per_max_frame.mmb.menu
  foreach m [list 0 1 3 4 9 19] {
    $dialog.tabframe.index.frame2.minor.min_per_max_frame.mmb.menu add radiobutton -label $m -variable temp_circ_config_info($c,index_min_per_max) -value $m -command "circular_config_index_apply $c"
  }
  set temp_circ_config_info($c,index_min_per_max) [dict get $tick_dict circular_index_min_tick_per_max]
  grid [ttk::frame $dialog.tabframe.index.frame2.minor.len_frame] -row 3 -column 1 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.index.frame2.minor.len_frame.ch_fg_label -text [mc "Line:"]] -row 1 -column 1 -columnspan 1 -sticky nw
  set temp_circ_config_info($c,index_min_tick_fg_color)  [dict get $tick_dict circular_index_min_tick_color]
  grid [color_button $dialog.tabframe.index.frame2.minor.len_frame.ch_fg_color temp_circ_config_info($c,index_min_tick_fg_color) 18] -row 1 -column 2 -sticky nw
  bind $dialog.tabframe.index.frame2.minor.len_frame.ch_fg_color <<color_picked>> "circular_config_index_apply $c"
  grid [ttk::label $dialog.tabframe.index.frame2.minor.len_frame.ch_fg_w_label -text [mc "Length:"]] -row 1 -column 3 -sticky nw
grid [ttk::scale $dialog.tabframe.index.frame2.minor.len_frame.ch_length -orient horizontal -from 0 -to 15 -variable temp_circ_config_info($c,index_min_tick_length) -command "set temp_circ_config_info($c,index_min_tick_length) \[expr {round(100 *\$temp_circ_config_info($c,index_min_tick_length)) / 100.0}\];circular_config_index_apply $c;#" ] -row 1 -column 4 -sticky nw
set temp_circ_config_info($c,index_min_tick_length) [expr {100* [dict get $tick_dict circular_index_min_tick_length]}]
  grid [ttk::label $dialog.tabframe.index.frame2.minor.len_frame.ch_fg_w_v_label -textvariable temp_circ_config_info($c,index_min_tick_length)] -row 1 -column 5 -sticky nw

  grid [ttk::frame $dialog.tabframe.index.frame2.minor.width_frame] -row 4 -column 1 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.index.frame2.minor.width_frame.ch_fg_w_label -text [mc "Width:"]] -row 1 -column 3 -sticky nw
grid [ttk::scale $dialog.tabframe.index.frame2.minor.width_frame.ch_fg_width -orient horizontal -from 1 -to 5 -variable temp_circ_config_info($c,index_min_tick_width) -command "set temp_circ_config_info($c,index_min_tick_width) \[expr {round(\$temp_circ_config_info($c,index_min_tick_width))}\];circular_config_index_apply $c;#" ] -row 1 -column 4 -sticky nw
  set temp_circ_config_info($c,index_min_tick_width)   [dict get $tick_dict circular_index_min_tick_width]
  grid [ttk::label $dialog.tabframe.index.frame2.minor.width_frame.ch_fg_w_v_label -textvariable temp_circ_config_info($c,index_min_tick_width)] -row 1 -column 5 -sticky nw



# hide
# label text (name %n pos1 %1, pos2 %2 variables)
#      format {%1$s} r t y
#      set a [regsub %% asdf%% \x0]
#      set b [regsub \x0 $a %]
# label color (use feature color)
# font size and family

  ####circle frame
# show GC circle: radius, accumulation window, low-color, mid-color, high color, >%, <%
# show ORFs circle: radius, min length, fwd color, rev color, delta radius (for fwd/ rev offset)
# all length measures are as % of enzymes circle

  ## parameters frame
# parameter: label bump overlap 
# parameter: bump connectors
# parameter: bump moved ojects (don't ignore in bump proc)
# button: reset moved objects


  #### ok frame
  if {!$info(android)} {
    grid [frame $dialog.frame2 -relief raised] -row 1 -column 0 -sticky swe
    #grid [checkbutton $dialog.frame2.apply -text [mc "Apply to Sequence"] -style Switch.MD.TCheckbutton -variable temp_circ_config_info($c,apply)] -row 0 -column 0 -padx 5 -pady 3 -sticky nw
    set temp_circ_config_info($c,apply) 0
    grid [menubutton $dialog.frame2.apply_button -text [mc "Apply Formatting..."] -menu $dialog.frame2.apply_button.menu] -row 0 -column 0 -padx 5 -pady 3 -sticky nw
    menu $dialog.frame2.apply_button.menu
    $dialog.frame2.apply_button.menu add command -label [mc "Apply Formatting to Sequence"] -command "circular_config_formatting_to_seq $c"
    $dialog.frame2.apply_button.menu add command -label [mc "Apply Feature Colors to Sequence"] -command "" -state disabled
    $dialog.frame2.apply_button.menu add command -label [mc "Apply Feature Show/ Hide to Sequence"] -command "" -state disabled
    $dialog.frame2.apply_button.menu  add command -label [mc "Apply Formatting to Defaults"] -state disabled
    
    grid [button $dialog.frame2.theme -text [mc "Apply Theme"] -command "parse_theme_file $c" ] -row 0 -column 1 -padx 5 -pady 3 -sticky nw
   grid [button $dialog.frame2.save_theme -text [mc "Save Theme"] -command "theme_generate_theme_data $c" ] -row 0 -column 2 -padx 5 -pady 3 -sticky nw
    grid [button $dialog.frame2.ok -text [mc "OK"] -command "event generate $dialog <<OK>>" -default active] -row 0 -column 3 -padx 5 -pady 3 -sticky nw
    grid columnconfigure $dialog.frame2 1 -weight 1
    grid columnconfigure $dialog.frame2 2 -weight 1
    grid columnconfigure $dialog.frame2 3 -weight 1
    #bind $dialog <Key-Return> "set ok 1"
  }

  
  #grid rowconfigure $dialog 0 -weight 1
  grid rowconfigure $dialog 1 -weight 0
  grid columnconfigure $dialog 0 -weight 1

  update idletasks

  regexp {([0-9]+)x([0-9]+)} [wm geometry $w] - width height
  wm geometry $w "$width\x[expr {min([winfo screenheight $w], $height + [winfo height $w.f_config])}]"
      

  if {$info(android)} {
    vwait ok
    set dialogblock 0
    unset -nocomplain ok
    destroy $dialog
    bind . <<RaiseDialogs>> ""
  }


#hidden items:
#$t itemconfigure 0 -selectforeground gray60 -selectbackground gray80
}

################
## arc text on circular maps
################
if {0} {
### test canvas_circular_text
set c $w\_analysis0.canvas
foreach tag [$c bind 1 <<Feature_list>>] {
  set l [$c find withtag $tag&&label]
  set text [dict get [$c bind $tag <<Label>>] name]
  set font [$c itemcget $l -font]
  foreach a [split $text ""] {
    $c create text 0 0 -text $a -font $font -tags [list $tag circular_label feature]
  }
  $c bind $tag&&(circular_label) <$modifier-Button1-Motion> "canvas_circular_text $c $tag \[expr {sqrt(\[$c canvasx %x\]*\[$c canvasx %x\]+\[$c canvasy %y\]*\[$c canvasy %y\])}\]"
  canvas_circular_text $c $tag 190
}

}

################
## move arc texts to a new radius move the connector to the text if the text is visible
################
proc canvas_circular_text {c tag r {dir 0}} {
  set degtorad 0.017453292522222223
  set items [$c find withtag $tag&&circular_label]
  set label_item  [$c find withtag label&&$tag]
  set label_dict [$c bind $label_item <<Label>>]


  set text [dict get $label_dict name]
  set font [$c itemcget [lindex $items 0] -font]
  if {$font ne {}} {
    set length [font measure $font $text]
    set char_length  [font measure $font "M"]
    set height [expr {[font metrics $font -linespace]/2.0}]
  } else {
    set length 0
    set char_length 0
    set height 0
  }
  set coord_list [$c bind $tag <<Coord_list>>]

  if {[catch {set feature_radius [lindex [$c coords [lindex [$c find withtag $tag&&exon] 0]] 2]}]} {
    set feature_radius [lindex [$c coords 1] 2]
  }

  if {$r == {}} {
    set arc_text_offset 0
    if {[dict exists $label_dict arc_text_offset]} {
      set arc_text_offset [dict get $label_dict arc_text_offset]
    } 
    set r [expr {$arc_text_offset + $feature_radius}]
  } else {
    set arc_text_offset [expr {$r- $feature_radius}]
    dict set label_dict arc_text_offset $arc_text_offset
    $c bind $label_item <<Label>> $label_dict
  }

# add property: arc_text_vertical_alignment to adjust the baseline to 

  if {[dict exists $label_dict fea_label_align]} {
    set align [dict get $label_dict fea_label_align]
  } else {
    set align "Center"
  }
  if {$align eq "Center"} {
    set tick_angle [expr {$degtorad*([lindex $coord_list 0] + [lindex $coord_list end-1] + [lindex $coord_list end])/ 2.0}]
    set center_angle $tick_angle
  } else {
    if {[$c bind $tag <<Direction>>]} {
      set align [string map {"5'" "CW" "3'" "CCW" "-5'" "-CW" "-3'" "-CCW"} $align]
    } else {
      set align [string map {"5'" "CCW" "3'" "CW" "-3'" "-CW" "-5'" "-CCW"} $align]
    }
    if {$align eq "-CW" || $align eq "CW"} {
        set tick_angle  [expr {$degtorad*([lindex $coord_list end-1] + [lindex $coord_list end]) }]
    } else {
        set tick_angle [expr {$degtorad*[lindex $coord_list 0]}]
    }
    if {$align eq "-CCW" || $align eq "CW"} {
        set center_angle [expr {$tick_angle+(1.0*($length+$char_length)/2/($r-$height)) }]
    } else {
        set center_angle [expr {$tick_angle -(1.0*($length+$char_length)/2/($r-$height)) }]
    }
  }
  if {![expr {abs($dir)}]} {
    set text_dir [expr {(int($center_angle/$degtorad) % 360 > 180)? -1: 1}]
  } else {
    set text_dir [expr {[dict get [$c bind $tag <<Label>>] direction]? -1 : 1}]
  }
  set angle_start [expr {$center_angle+$text_dir*(1.0*$length/2/($r-$height)) }]

  set item_angle $angle_start
  for {set i 0} {$i < [llength $items]} {incr i} {
    set item [lindex $items $i]
    $c coords $item [expr {$r*cos($item_angle)}] [expr {-1*$r*sin($item_angle)}]
    $c itemconfigure $item -anchor center -angle [expr {180/pi()*($item_angle-$text_dir*pi()/2.0)}] 
    set angle_incr [expr {-1*([font measure $font [string range $text $i [expr {$i+1}]]])/2.0/($r-$height)}]
    set item_angle [expr {$item_angle + $text_dir*$angle_incr}]
  }


  if {[$c itemcget [lindex $items 0] -state] eq "hidden"} {return}
  ## need to adjust the tick and connector line lengths to match the text here
  set tick_item  [$c find withtag $tag&&tick] 
  set tick_item_aa  [$c find withtag $tag&&tick_aa] 
  lassign [$c coords $tick_item] tx0 ty0 tx1 ty1
  set fea_r [expr { sqrt($tx0 * $tx0 + $ty0 * $ty0)}]
  set connector_item  [$c find withtag $tag&&connector] 
  set connector_item_aa  [$c find withtag $tag&&connector_aa] 

  if {[expr {abs($r - $fea_r)}]<= $height} {
    $c coords $tick_item $tx0 $ty0  $tx0 $ty0
    $c coords $connector_item $tx0 $ty0  $tx0 $ty0
    $c coords $tick_item_aa $tx0 $ty0  $tx0 $ty0
    $c coords $connector_item_aa $tx0 $ty0  $tx0 $ty0
  } else {
    set tick_dir [expr { sign($r - $fea_r)}]
    if {[dict exists $label_dict fea_tick_length]} {
      set max_tick_length [dict get $label_dict fea_tick_length]
    } elseif {[dict exists $label_dict enz_tick_length]} {
      set max_tick_length [dict get $label_dict enz_tick_length]
    } else {
      set max_tick_length 10
    }
    set r0 [expr {$r-$height * $tick_dir}]
    set new_tick_length [expr {min($max_tick_length, abs($r0 - $fea_r)) }]
    set tx1 [expr {$tx0* ($fea_r + $new_tick_length* $tick_dir)  / $fea_r }]
    set ty1 [expr {$ty0* ($fea_r + $new_tick_length* $tick_dir)  / $fea_r }]
    $c coords $tick_item $tx0 $ty0 $tx1 $ty1
    $c coords $tick_item_aa $tx0 $ty0 $tx1 $ty1
    set tx2 [expr {$tx0* $r0 / $fea_r }]
    set ty2 [expr {$ty0* $r0 / $fea_r }]
    $c coords $connector_item $tx1 $ty1  $tx2 $ty2
    $c coords $connector_item_aa $tx1 $ty1  $tx2 $ty2
  }
  return [list $angle_start $item_angle [expr {$r+$height}]  [expr {$r-$height}]]
}

 

###############
##
###############
proc circular_config_set_feature_radius {c tags action value} {
  set circle_radius [lindex [$c coords [$c find withtag circle]] 2]
  foreach tag $tags {
    switch $action {
      width {
        set feature_width [expr {[$c itemcget exon&&outline&&$tag -width] }]
        set r [expr {$circle_radius + $feature_width/2.0*$value}]
      }
      pixel_r {
        set current_r [lindex [$c coords [lindex [$c find withtag $tag&&exon] 0]] 2]
        set r [expr {$current_r + $value}]
      }
      pixel_a -
      default {
        set r [expr {$circle_radius + $value}]
      }
    }

    set old_r [lindex [$c coords $tag&&exon] 2]
    change_radius $c $tag $r

    ## change linear label radius
    set label_dict [$c bind [$c find withtag $tag&&moveablelabel] <<Label>>]
    if {![dict exists $label_dict  tick_anchor_raduis ] || [dict get $label_dict  tick_anchor_raduis] eq {}} {
      set r_diff [expr {$r-$old_r}]
      foreach e1 [$c find withtag $tag&&(tick||connector||tick_aa||connector_aa||moveablelabel] {
        set c_list [list]
        foreach {x0 y0} [$c coords $e1] {
           lappend c_list [expr {$r_diff * $x0 / sqrt($x0**2 + $y0**2) + $x0}] [expr {$r_diff * $y0 / sqrt($x0**2 + $y0**2) + $y0}]
        }
        $c coords $e1 {*}$c_list
      }
    }

    ## change arc label radius
    canvas_circular_text $c $tag {}
  }

  ## set last arg to 1 to avoid connectors in bump process
  circular_map_bump_all_moveablelabel $c

}

###############
## Move a feature label offest to: label, baseline, or feature radius. feature radius mode multiplies by 1/2 font linespace plus 1/2 feature width (including outline)
###############
proc circular_config_set_label_radius {c tag value offset} {

  set circle_radius [lindex [$c coords [$c find withtag circle]] 2]
  switch $offset {
    bseline {
      set r [expr {$circle_radius + $value}]
    }
    feature {
      set font [$c itemcget [lindex [$c find withtag $tag&&circular_label] 0] -font]
      if {$font ne {}} {
        set font_height [expr {[font metrics $font -linespace]}]
      } else {
         set font_height 0
      }
      set feature_width [expr {[$c itemcget exon&&outline&&$tag -width] }]
      set mult [expr {($feature_width + $font_height) /2 }]
      if {[catch {set feature_radius [lindex [$c coords [lindex [$c find withtag $tag&&exon] 0]] 2]}]} {
        set feature_radius $circle_radius
      }
      set r [expr {$feature_radius + $mult * $value}]
    }
    label -
    default {
       if {[catch {set label_coords [$c coords [lindex [$c find withtag $tag&&circular_label] 0]] }]} {
          set label_radius $circle_radius
        } else {
          foreach {lx ly} $label_coords {}
          set label_radius [expr {sqrt($lx*$lx + $ly*$ly)}]
        }
        set r [expr {$label_radius + $value}]
    }
  }
  canvas_circular_text $c $tag $r
}

################
## set tick and connector coords when alignment changes
################
proc circular_map_set_alignment {c item} {
  set degtorad 0.017453292522222223
  set label_dict [$c bind $item <<Label>>]
  set tag [regsub fn [dict get $label_dict tag] f]
  #set label_dict [$c bind $tag <<Label>>]
  set coord_list [$c bind $tag <<Coord_list>>]

  if {[dict exists $label_dict fea_label_align]} {
    set align [dict get $label_dict fea_label_align]
  } else {
    set align "Center"
  }
  if {$align eq "Center"} {
    set tick_angle [expr {$degtorad*([lindex $coord_list 0] + [lindex $coord_list end-1] + [lindex $coord_list end])/ 2.0}]
    if {[expr {[lindex $coord_list end-1] + [lindex $coord_list end]}] > [lindex $coord_list 0]} {
      set tick_angle [expr {$tick_angle - $degtorad*180}]
    }
  } else {
    if {[$c bind $tag <<Direction>>]} {
      set align [string map {"5'" "CW" "3'" "CCW" "-5'" "-CW" "-3'" "-CCW"} $align]
    } else {
      set align [string map {"5'" "CCW" "3'" "CW" "-3'" "-CW" "-5'" "-CCW"} $align]
    }
    if {$align eq "-CW" || $align eq "CW"} {
        set tick_angle  [expr {$degtorad*([lindex $coord_list end-1] + [lindex $coord_list end]) }]
    } else {
        set tick_angle [expr {$degtorad*[lindex $coord_list 0]}]
    }
  }
  ## uses 3 o'clock CCW coords
  set tick_item  [$c find withtag $tag&&tick] 
  set tick_item_aa  [$c find withtag $tag&&tick_aa] 
  lassign [$c coords $tick_item] tx0 ty0 tx1 ty1
  set fea_r [expr { sqrt($tx0 * $tx0 + $ty0 * $ty0)}]
  set tx0 [expr {$fea_r*cos($tick_angle)}]
  set ty0 [expr {-1.0*$fea_r*sin($tick_angle)}]
  set tx1 [expr {(10+$fea_r)/$fea_r * $tx0}]
  set ty1 [expr {(10+$fea_r)/$fea_r * $ty0}]
  $c coords $tick_item $tx0 $ty0 $tx1 $ty1
  $c coords $tick_item_aa $tx0 $ty0 $tx1 $ty1
  set connector_item  [$c find withtag $tag&&connector] 
  set connector_item_aa  [$c find withtag $tag&&connector_aa] 
  $c coords $connector_item $tx1 $ty1 $tx1 $ty1
  $c coords $connector_item_aa $tx1 $ty1 $tx1 $ty1
}

################
## resize labes of features and enzymes
################
proc enz_graphic_map_resize_labels {c mode direction} {
  set font_size_list [list 8 9 10 11 12 13 14 18 20 22 24 28 32 36 40 42 48]
  switch $mode {
    feature {set textlist [$c find withtag (label||circular_label)&&feature]}
    enzyme {set textlist [$c find withtag (label||circular_label)&&enzyme]}
    all {set textlist [$c find withtag (label||circular_label)&&(feature||enzyme)]}
    default {set textlist [$c find withtag (label||circular_label)&&(feature||enzyme)]}
  }
  foreach text $textlist {
    set fontsize [font actual [$c itemcget $text -font] -size]
    set fontfam [font actual [$c itemcget $text -font] -family]
    set fontweight [font actual [$c itemcget $text -font] -weight]
    set i [lsearch -integer $font_size_list $fontsize]
    if  {($i != -1)} {
      incr i $direction
      set i [expr {max (0,min($i,[llength $font_size_list]-1))}]
    } else {
      if {$direction == 1} {
        set i 0
        while {([lindex $font_size_list $i] < $fontsize) && ($i < [expr {[llength $font_size_list]-1}])} {incr i}
      } else {
        set i [expr {[llength $font_size_list]-1}]
        while {([lindex $font_size_list $i] > $fontsize) && ($i > 1)} {incr i -1}
      }
    }  
    $c itemconfigure $text -font [list $fontfam [lindex $font_size_list $i] $fontweight]
  }
  #reset circular label spacings
  if {$mode =="all" || $mode == "feature"} {
    foreach tag [$c bind 1 <<Feature_list>>] {
      if {[set circ_label [lindex [$c find withtag $tag&&circular_label] 0]] != {}} {
        $c bind $tag <<Gformat>> [dict replace [$c bind $tag <<Gformat>>] circular_label_font [list $fontfam [lindex $font_size_list $i] $fontweight]]
        canvas_circular_text $c $tag [expr {sqrt([lindex [$c coords $circ_label] 0]*[lindex [$c coords $circ_label] 0] + [lindex [$c coords $circ_label] 1]*[lindex [$c coords $circ_label] 1])}]
      }
    }
  }
  #rebump moveablelabels
  foreach i [$c find withtag moveablelabel] {
    if {[$c bind $i <<Moved>>] ==""} {
      circular_map_reset_moveablelabel $c $i
    }
  }
  ## set last arg to 1 to avoid connectors in bump process
  circular_map_bump_all_moveablelabel $c "" 0
}
################
## utility to fill text treeview
################
proc circular_config_text_fill_treeview {tv c} {
  global temp_circ_config_info info
  if {![winfo exists $tv]} {
    sputs no text frame
    return
  }

  if {![$tv exists hidden]} {
    $tv insert {} end -id hidden -text [mc "Hidden"] -tag hidden
  }

  foreach tag [dict keys $temp_circ_config_info($c,text_tag_dict)] {
    $tv insert {} end -id $tag -text [dict get $temp_circ_config_info($c,text_tag_dict) $tag] -tag $tag
    #$tv tag configure $tag -background $info(graphic_bg_color) -foreground [$c itemcget $tag -fill];# -font "[list [font actual [$c itemcget $tag -font] -family]] 12"
    if {[$c itemcget $tag -state] == "hidden"} {
      $tv move $tag hidden end
    }
  }
  if {[llength [$tv children hidden]] ==0} {
    $tv detach hidden
  }
}

#############
##
#############
proc circular_config_text_treeview_manageselection {t c dialog} {
  global temp_circ_config_info
  set text_visible ""
  set text_font_bold ""
  set text_font_italic ""
  set text_font_underline ""
  set text_fontfamily "---"
  set text_fontsize "---"
  set text_label_color ""
  #set dialog .dialog

  if {[$t selection] == {} || [$t selection] == [list hidden]} {
    grid configure $dialog.tabframe.texts.frame3_dummy
    return
  } else {
    grid remove $dialog.tabframe.texts.frame3_dummy
  }
  foreach e [$t selection] {
    if {$e eq "hidden"} {continue}
    if {$text_visible == ""} {
      set text_visible [expr {[$c itemcget $e -state] eq "normal"}]
    } elseif {$text_visible != [expr {[$c itemcget $e -state] eq "normal"}]} {
      set text_visible -1
    }

    if {$text_font_bold == ""} {
      set text_font_bold [expr {[font actual [$c itemcget $e -font] -weight] eq "bold"}]
    } elseif {$text_font_bold != [expr {[font actual [$c itemcget $e -font] -weight] eq "bold"}]} {
      set text_font_bold -1
    }
    if {$text_font_italic == ""} {
      set text_font_italic [expr {[font actual [$c itemcget $e -font] -slant] eq "italic"}]
    } elseif {$text_font_italic != [expr {[font actual [$c itemcget $e -font] -slant] eq "italic"}]} {
      set text_font_italic -1
    }
    if {$text_font_underline == ""} {
      set text_font_underline [font actual [$c itemcget $e -font] -underline]
    } elseif {$text_font_underline != [font actual [$c itemcget $e -font] -underline] } {
      set text_font_underline -1
    }

    if {$text_fontfamily == "---"} {
      set text_fontfamily [font actual [$c itemcget $e -font] -family]
    } elseif {$text_fontfamily != [font actual [$c itemcget $e -font] -family]} {
      set text_fontfamily -1
    }
    if {$text_fontsize == "---"} {
      set text_fontsize [font actual [$c itemcget $e -font] -size]
    } elseif {$text_fontsize != [font actual [$c itemcget $e -font] -size]} {
      set text_fontsize -1
    }
    if {$text_label_color == ""} {
      set text_label_color [$c itemcget $e -fill]
    } elseif {$text_label_color != [$c itemcget $e -fill]} {
      set text_label_color -1
    }
  }

  if {$text_visible == -1} {
    unset -nocomplain temp_circ_config_info($c,text_visible)
  } else {
    set temp_circ_config_info($c,text_visible) $text_visible
  }
  if {$text_font_bold == -1} {
    unset -nocomplain temp_circ_config_info($c,text_fontbold)
  } else {
    set temp_circ_config_info($c,text_fontbold) $text_font_bold
  }
  if {$text_font_italic == -1} {
    unset -nocomplain temp_circ_config_info($c,text_fontitalic)
  } else {
    set temp_circ_config_info($c,text_fontitalic) $text_font_italic
  }
  if {$text_font_underline == -1} {
    unset -nocomplain temp_circ_config_info($c,text_fontunderline)
  } else {
    set temp_circ_config_info($c,text_fontunderline) $text_font_underline
  }


  if {$text_fontfamily == -1} {
    set temp_circ_config_info($c,text_fontfamily) "---"
  } else {
    set temp_circ_config_info($c,text_fontfamily) $text_fontfamily
  }
  if {$text_fontsize == -1} {
    set temp_circ_config_info($c,text_fontsize) "---"
  } else {
    set temp_circ_config_info($c,text_fontsize) $text_fontsize
  }
  if {$text_label_color == -1 || $text_label_color ==""} {
    set temp_circ_config_info($c,text_label_color) $text_label_color
  } else {
    set temp_circ_config_info($c,text_label_color) $text_label_color
  }
}



#############
##
#############
proc circular_config_text_treeview_apply {tag_selection c {t {}}} {
  global temp_circ_config_info
  foreach e $tag_selection {
    if {$e eq "hidden"} {continue}
    if {[info exists temp_circ_config_info($c,text_visible)]} {
      if {$temp_circ_config_info($c,text_visible) == 1} {
        $c itemconfigure $e -state "normal"
        if {[winfo exists $t]} {
          $t move $e {} end
        }
      } elseif {$temp_circ_config_info($c,text_visible) == 0} {
        $c itemconfigure $e -state "hidden"
        if {[winfo exists $t]} {
          $t move $e hidden end
        }
      }
    }
    set family [font actual [$c itemcget $e -font] -family]
    set size  [font actual [$c itemcget $e -font] -size]
    set new_font ""
    if {[info exists temp_circ_config_info($c,text_fontfamily)] && $temp_circ_config_info($c,text_fontfamily) != "---"} {
      set family $temp_circ_config_info($c,text_fontfamily)
      set new_font "[list $family] $size"
    }
    if {[info exists temp_circ_config_info($c,text_fontsize)] && $temp_circ_config_info($c,text_fontsize) != "---"} {
      set size  $temp_circ_config_info($c,text_fontsize)
      set new_font "[list $family] $size"
    }
    if {[info exists temp_circ_config_info($c,text_fontitalic)] && $temp_circ_config_info($c,text_fontitalic)} {
      if {$new_font eq {}} {
        set new_font "[list $family] $size"
      }
      set new_font  "$new_font italic"
    }
    if {[info exists temp_circ_config_info($c,text_fontunderline)] && $temp_circ_config_info($c,text_fontunderline)} {
      if {$new_font eq {}} {
        set new_font "[list $family] $size"
      }
      set new_font  "$new_font underline"
    }
    if {[info exists temp_circ_config_info($c,text_fontbold)] && $temp_circ_config_info($c,text_fontbold)} {
      if {$new_font eq {}} {
        set new_font "[list $family] $size"
      }
      set new_font  "$new_font bold"
    }
    if {$new_font ne ""} {
      $c itemconfigure $e -font $new_font
    }


    if {[info exists temp_circ_config_info($c,text_label_color)] && $temp_circ_config_info($c,text_label_color) != -1 && $temp_circ_config_info($c,text_label_color) != 0} {
      $c itemconfigure $e -fill $temp_circ_config_info($c,text_label_color)
      $c bind $e <<Colors>> [lreplace [$c bind $e <<Colors>>] 0 0 $temp_circ_config_info($c,text_label_color)]
      #$t tag configure $e -foreground $temp_circ_config_info($c,text_label_color)
    }
  }
  if {[winfo exists $t]} {
    foreach tag [dict keys $temp_circ_config_info($c,text_tag_dict)] {
      $t move $tag [$t parent $tag] end
    }
    if {[$t children hidden] == {}} {
      $t detach hidden
    } else {
      $t move hidden {} 0
    }
  }
}

#############
##
#############
proc circular_config_baseline_apply {c} {
  global temp_circ_config_info info


  if {[info exists temp_circ_config_info($c,baseline_bg_color)] &&  $temp_circ_config_info($c,baseline_bg_color) != -1} {
    $c itemconfigure circle_background  -outline $temp_circ_config_info($c,baseline_bg_color)
    $c itemconfigure circle_background_aa  -outline [mix_color $temp_circ_config_info($c,baseline_bg_color) [$c cget -background] $info(antialias_percent)]
    set this_baseline_bg_color $temp_circ_config_info($c,baseline_bg_color)
  } else {
    set this_baseline_bg_color [$c itemcget circle_background  -outline]
  }
  if {[info exists temp_circ_config_info($c,baseline_bg_width)] &&  $temp_circ_config_info($c,baseline_bg_width) != -1} {
    if {$temp_circ_config_info($c,baseline_bg_width) == 0} {
      $c itemconfigure circle_background -width 0 
      $c itemconfigure circle_background_aa -width 0 
      set this_baseline_bg_width 0
    } else {
      $c itemconfigure circle_background -width [expr {$temp_circ_config_info($c,baseline_fg_width) + 2* $temp_circ_config_info($c,baseline_bg_width)}]
      $c itemconfigure circle_background_aa -width  [expr { $info(antialias_width) +$temp_circ_config_info($c,baseline_fg_width) + 2* $temp_circ_config_info($c,baseline_bg_width)}]
      set this_baseline_bg_width $temp_circ_config_info($c,baseline_bg_width)
    }
  }

  if {[info exists temp_circ_config_info($c,baseline_fg_color)] &&  $temp_circ_config_info($c,baseline_fg_color) != -1} {
    $c itemconfigure circle -outline $temp_circ_config_info($c,baseline_fg_color)
    if {$this_baseline_bg_width >0} {
      $c itemconfigure circle_aa -outline [mix_color $temp_circ_config_info($c,baseline_fg_color) $this_baseline_bg_color $info(antialias_percent)]
    } else {
      $c itemconfigure circle_aa -outline [mix_color $temp_circ_config_info($c,baseline_fg_color)  [$c cget -background] $info(antialias_percent)]
    }
  }
  if {[info exists temp_circ_config_info($c,baseline_fg_width)] &&  $temp_circ_config_info($c,baseline_fg_width) != -1} {
    $c itemconfigure circle -width $temp_circ_config_info($c,baseline_fg_width) 
    if {$temp_circ_config_info($c,baseline_fg_width) > 0} {
      $c itemconfigure circle_aa -width [expr {min($this_baseline_bg_width/2.0,$info(antialias_width)) + $temp_circ_config_info($c,baseline_fg_width)}]
    } else {
      $c itemconfigure circle_aa -width 0
    }
  }



  if {[info exists temp_circ_config_info($c,crosshair_fg_width)] &&  $temp_circ_config_info($c,crosshair_fg_width) != -1} {
    $c itemconfigure crosshair -width $temp_circ_config_info($c,crosshair_fg_width)
  }
  if {[info exists temp_circ_config_info($c,crosshair_fg_color)] &&  $temp_circ_config_info($c,crosshair_fg_color) != -1} {
    $c itemconfigure crosshair -fill $temp_circ_config_info($c,crosshair_fg_color)
  }

  if {[info exists temp_circ_config_info($c,crosshair_bg_color)] &&  $temp_circ_config_info($c,crosshair_bg_color) != -1} {
    $c itemconfigure crosshair_background -fill $temp_circ_config_info($c,crosshair_bg_color)
  }
  if {[info exists temp_circ_config_info($c,crosshair_bg_width)] &&  $temp_circ_config_info($c,crosshair_bg_width) != -1} {
    if {$temp_circ_config_info($c,crosshair_bg_width) == 0} {
      $c itemconfigure crosshair_background -width 0 
    } else {
      $c itemconfigure crosshair_background -width  [expr {$temp_circ_config_info($c,crosshair_fg_width) + 2* $temp_circ_config_info($c,crosshair_bg_width)}] 
    }
  }
  if {[info exists temp_circ_config_info($c,crosshair_length)] &&  $temp_circ_config_info($c,crosshair_length) != -1} {
    set crosshair_length [expr {$temp_circ_config_info($c,crosshair_length) /100.0 * [lindex [$c coords circle] 2]}]
    $c coords crosshair&&vert  0 [expr {-$crosshair_length}] 0 $crosshair_length 
    $c coords crosshair&&horiz [expr {-$crosshair_length}] 0 $crosshair_length 0  
    $c coords crosshair_background&&vert 0 [expr {-$crosshair_length}] 0 $crosshair_length 
    $c coords crosshair_background&&horiz [expr {-$crosshair_length}] 0 $crosshair_length 0 
  }
}

#############
##
#############
proc circular_config_index_apply {c} {
  global temp_circ_config_info info
  set old_tick_dict [$c bind 1 <<Tick_dict>>]

  if {[$c find withtag scale_tick&&major] != {} } {
    set tx1 [lindex [$c coords scale_tick&&major] 0]
    set ty1 [lindex [$c coords scale_tick&&major] 1]
    set radius [lindex [$c coords circle] 2]
    set major_tick_radus  [expr {(sqrt($ty1**2 + $tx1**2))}]
    set new_offset  [expr {(sqrt($ty1**2 + $tx1**2)/ $radius) -1}]
  } else {
    set new_offset [dict get $old_tick_dict circular_map_index_offset]
  }
  set new_tick_dict [dict create circular_map_index_offset $new_offset circular_map_index_max_tick_spacing $temp_circ_config_info($c,index_bp_per_max) circular_map_index_max_at_zero $temp_circ_config_info($c,max_at_zero) index_label_format $temp_circ_config_info($c,index_label_format)  index_text_angle_format $temp_circ_config_info($c,index_text_angle_format)   circular_index_max_tick_color  $temp_circ_config_info($c,index_maj_tick_fg_color) index_circular_text_color $temp_circ_config_info($c,index_circular_text_color) circular_index_max_tick_font "[list $temp_circ_config_info($c,index_tick_fontfamily)] $temp_circ_config_info($c,index_tick_fontsize)" circular_index_max_tick_width $temp_circ_config_info($c,index_maj_tick_width) circular_index_max_tick_length [expr {$temp_circ_config_info($c,index_maj_tick_length)/100.0}] circular_index_min_tick_per_max $temp_circ_config_info($c,index_min_per_max) circular_index_min_tick_color $temp_circ_config_info($c,index_min_tick_fg_color) circular_index_min_tick_width $temp_circ_config_info($c,index_min_tick_width) circular_index_min_tick_length [expr {$temp_circ_config_info($c,index_min_tick_length)/100.0}]]
  $c bind 1 <<Tick_dict>> $new_tick_dict
  ## set the menu text to match the changed format
  if { [dict get $old_tick_dict index_text_angle_format] != [dict get $new_tick_dict index_text_angle_format]} {
    set temp_circ_config_info($c,index_text_angle_format_text) [dict get {h {Horizontal text} r90 "Radial text 90\u00B0" r45 "Radial text 45\u00B0" r0ccw "Radial text 0\u00B0 CCW" r0 "Radial text 0\u00B0" } [dict get $new_tick_dict index_text_angle_format]]
  }
  if {[dict get $old_tick_dict circular_map_index_max_tick_spacing] != [dict get $new_tick_dict circular_map_index_max_tick_spacing] || [dict get $old_tick_dict index_label_format] != [dict get $new_tick_dict index_label_format] || [dict get $old_tick_dict index_text_angle_format] != [dict get $new_tick_dict index_text_angle_format] || [dict get $old_tick_dict circular_index_max_tick_length] != [dict get $new_tick_dict circular_index_max_tick_length] || [dict get $old_tick_dict circular_index_min_tick_length] != [dict get $new_tick_dict circular_index_min_tick_length] || [dict get $old_tick_dict circular_index_min_tick_per_max] != [dict get $new_tick_dict circular_index_min_tick_per_max] || [dict get $old_tick_dict circular_map_index_max_at_zero] != [dict get $new_tick_dict circular_map_index_max_at_zero] } {
    $c delete scale_tick
    $c delete scale_text
    circular_map_add_scale $c
    if {[info exists major_tick_radus]} {
      circular_map_change_scale_radius $c $major_tick_radus
    }
  } else {
    $c itemconfigure scale_tick&&major -width $temp_circ_config_info($c,index_maj_tick_width) -fill $temp_circ_config_info($c,index_maj_tick_fg_color)
    $c itemconfigure scale_tick&&major_aa -width [expr {$info(antialias_width) + $temp_circ_config_info($c,index_maj_tick_width)}] -fill [mix_color $temp_circ_config_info($c,index_maj_tick_fg_color) [$c cget -background] 30]

    $c itemconfigure scale_text -font "[list $temp_circ_config_info($c,index_tick_fontfamily)] $temp_circ_config_info($c,index_tick_fontsize)" -fill $temp_circ_config_info($c,index_circular_text_color)
    $c itemconfigure scale_tick&&minor -width $temp_circ_config_info($c,index_min_tick_width) -fill $temp_circ_config_info($c,index_min_tick_fg_color)
    $c itemconfigure scale_tick&&minor_aa -width [expr {$info(antialias_width) + $temp_circ_config_info($c,index_min_tick_width)}] -fill [mix_color $temp_circ_config_info($c,index_min_tick_fg_color) [$c cget -background] 30]
    if {[info exists major_tick_radus]} {
      circular_map_change_scale_radius $c $major_tick_radus
    }
  }
}

################
## utility to fill enzymes treeview
################
proc circular_config_enz_fill_treeview {tv c} {
  global temp_circ_config_info
  if {![winfo exists $tv]} {
    sputs no enz
    return
  }
  if {![$tv exists hidden]} {
    $tv insert {} end -id hidden -text [mc "Hidden"] -tag hidden
  }
  $tv children {} [list hidden]
  set enz_list [list]
  foreach tag [$c find withtag enzyme&&label] {
    set label_dict  [$c bind $tag <<Label>>]
    $tv insert {} end -id $tag -text [dict get $label_dict name] -tag $tag
    $tv set $tag Location [dict get $label_dict location_start]
    $tv set $tag Count [dict get $label_dict count]
    $tv tag configure $tag -background white -foreground [$c itemcget $tag -fill] 
    if {[$c itemcget $tag -state] == "hidden"} {
      $tv move $tag hidden end
    }
  }
  treeview_sort $tv [bind $tv <<Sort_column>>] 1
}

#############
##
#############
proc circular_config_enz_treeview_manageselection {t c dialog} {
  global temp_circ_config_info outline_box_types_dict
  set enz_visible ""
  set enz_font_bold ""
  set enz_font_italic ""
  set enz_font_underline ""
  set enz_fontfamily "---"
  set enz_fontsize "---"
  set enz_label_color ""
  set enz_label_subst "\u01"
  set enz_box_type "---"
  set enz_box_fill_color ""
  set enz_box_outline_color ""
  set enz_box_width "---"
  set enz_tick_color 0
  set enz_tick_width ""
  set enz_tick_length ""
  set enz_show_connector ""
  #set dialog .dialog

  if {[$t selection] == {} || [$t selection] == [list hidden]} {
    grid configure $dialog.tabframe.enzymes.frame3_dummy
    return
  } else {
    grid remove $dialog.tabframe.enzymes.frame3_dummy
  }
  foreach e [$t selection] {
    if {$e eq "hidden"} {continue}
    set label_dict  [$c bind $e <<Label>>]
    if {$enz_visible == ""} {
      set enz_visible [expr {[$c itemcget $e -state] eq ""}]
    } elseif {$enz_visible != [expr {[$c itemcget $e -state] eq ""}]} {
      set enz_visible -1
    }

    if {$enz_label_subst == "\u01" && [dict exists $label_dict enz_label_subst]} {
      set enz_label_subst [dict get $label_dict enz_label_subst]
    } elseif {[dict exists $label_dict enz_label_subst] && $enz_label_subst != [dict get $label_dict enz_label_subst]} {
      set enz_label_subst "\u00"
    }
    if {$enz_font_bold == ""} {
      set enz_font_bold [expr {[font actual [$c itemcget $e -font] -weight] eq "bold"}]
    } elseif {$enz_font_bold != [expr {[font actual [$c itemcget $e -font] -weight] eq "bold"}]} {
      set enz_font_bold -1
    }
    if {$enz_font_italic == ""} {
      set enz_font_italic [expr {[font actual [$c itemcget $e -font] -slant] eq "italic"}]
    } elseif {$enz_font_italic != [expr {[font actual [$c itemcget $e -font] -slant] eq "italic"}]} {
      set enz_font_italic -1
    }
    if {$enz_font_underline == ""} {
      set enz_font_underline [font actual [$c itemcget $e -font] -underline]
    } elseif {$enz_font_underline != [font actual [$c itemcget $e -font] -underline] } {
      set enz_font_underline -1
    }
    if {$enz_fontfamily == "---"} {
      set enz_fontfamily [font actual [$c itemcget $e -font] -family]
    } elseif {$enz_fontfamily != [font actual [$c itemcget $e -font] -family]} {
      set enz_fontfamily -1
    }
    if {$enz_fontsize == "---"} {
      set enz_fontsize [font actual [$c itemcget $e -font] -size]
    } elseif {$enz_fontsize != [font actual [$c itemcget $e -font] -size]} {
      set enz_fontsize -1
    }
    if {$enz_label_color == ""} {
      set enz_label_color [$c itemcget $e -fill]
    } elseif {$enz_label_color != [$c itemcget $e -fill]} {
      set enz_label_color -1
    }
    set box_item [$c find withtag $e.box]
    if {$box_item != {}} {
      if {[set box_dict [$c bind $box_item <<Box>>]] ne {} && [dict exists $box_dict type]} {
        set box_type [dict get $box_dict type]
      } else {
        set box_type ""
      }
      if {$enz_box_type == "---"} {
        set enz_box_type $box_type
      } elseif {$enz_box_type != $box_type} {
        set enz_box_type -1
      }
      if {$enz_box_fill_color == ""} {
        set enz_box_fill_color [$c itemcget $box_item -fill]
      } elseif {$enz_box_fill_color != [$c itemcget $box_item -fill]} {
        set enz_box_fill_color -1
      }
      if {$enz_box_outline_color == ""} {
        set enz_box_outline_color [$c itemcget $box_item -outline]
      } elseif {$enz_box_outline_color != [$c itemcget $box_item -outline]} {
        set enz_box_outline_color -1
      }
      if {$enz_box_width == "---"} {
        set enz_box_width [$c itemcget $box_item -width]
      } elseif {$enz_box_width != [$c itemcget $box_item -width]} {
        set enz_box_width -1
      }
    } 
    set this_enz_tick_color [$c itemcget [$c find withtag $e.tick] -fill]
    if {$enz_tick_color == 0} {
      set enz_tick_color $this_enz_tick_color
    } elseif {$enz_tick_color !=  $this_enz_tick_color} {
      set enz_tick_color -1
    }

    set this_enz_tick_width [expr {round([$c itemcget [$c find withtag $e.tick] -width])}]
    if {$enz_tick_width == ""} {
      set enz_tick_width $this_enz_tick_width
    } elseif {$enz_tick_width != $this_enz_tick_width} {
      set enz_tick_width -1
    }

    if {[dict exists $label_dict enz_tick_length]} {
      set this_tick_length [dict get $label_dict enz_tick_length]
    } else {
      set this_tick_length 10
    }
    if {$enz_tick_length == ""} {
      set enz_tick_length $this_tick_length
    } elseif {$enz_tick_length != $this_tick_length} {
      set enz_tick_length -1
    }

    if {[dict exists $label_dict show_connector]} {
      set show_connector [dict get $label_dict show_connector]
    } else {
      set show_connector 0
    }
    if {$enz_show_connector == ""} {
      set enz_show_connector $show_connector
    } elseif {$enz_show_connector != $show_connector} {
      set enz_show_connector -1
    }
  }

  if {$enz_visible == -1} {
    unset -nocomplain temp_circ_config_info($c,enz_visible)
  } else {
    set temp_circ_config_info($c,enz_visible) $enz_visible
  }
  if {$enz_font_bold == -1} {
    unset -nocomplain temp_circ_config_info($c,enz_fontbold)
  } else {
    set temp_circ_config_info($c,enz_fontbold) $enz_font_bold
  }
  if {$enz_font_italic == -1} {
    unset -nocomplain temp_circ_config_info($c,enz_fontitalic)
  } else {
    set temp_circ_config_info($c,enz_fontitalic) $enz_font_italic
  }
  if {$enz_font_underline == -1} {
    unset -nocomplain temp_circ_config_info($c,enz_fontunderline)
  } else {
    set temp_circ_config_info($c,enz_fontunderline) $enz_font_underline
  }
  if {$enz_fontfamily == -1} {
    set temp_circ_config_info($c,enz_fontfamily) "---"
  } else {
    set temp_circ_config_info($c,enz_fontfamily) $enz_fontfamily
  }
  if {$enz_fontsize == -1} {
    set temp_circ_config_info($c,enz_fontsize) "---"
  } else {
    set temp_circ_config_info($c,enz_fontsize) $enz_fontsize
  }
  if {$enz_label_color == -1 || $enz_label_color ==""} {
    set temp_circ_config_info($c,enz_label_color) $enz_label_color
  } else {
    set temp_circ_config_info($c,enz_label_color) $enz_label_color
  }


  if {$enz_box_type == -1 || $enz_box_type =="" || ![dict exists $outline_box_types_dict $enz_box_type]} {
    set temp_circ_config_info($c,enz_box_type) "---"
    set  temp_circ_config_info($c,enz_box_type_label) "---"
  } else {
    set temp_circ_config_info($c,enz_box_type) $enz_box_type
    set  temp_circ_config_info($c,enz_box_type_label) [dict get $outline_box_types_dict $enz_box_type]
  }


  if {$enz_box_fill_color == -1 || $enz_box_fill_color ==""} {
    set temp_circ_config_info($c,enz_box_fill_color) $enz_box_fill_color
  } else {
    set temp_circ_config_info($c,enz_box_fill_color) $enz_box_fill_color
  }
  if {$enz_box_outline_color == -1 || $enz_box_outline_color ==""} {
    set temp_circ_config_info($c,enz_box_outline_color)  $enz_box_outline_color
  } else {
    set temp_circ_config_info($c,enz_box_outline_color) $enz_box_outline_color
  }
  if {$enz_box_width == -1 || $enz_box_width ==""} {
    set temp_circ_config_info($c,enz_box_outline_width) "---"
  } else {
    set temp_circ_config_info($c,enz_box_outline_width) [expr {round($enz_box_width)}]
  }

  if {$enz_tick_color == 0} {
    set temp_circ_config_info($c,enz_tick_color) -1
  } else {
    set temp_circ_config_info($c,enz_tick_color) $enz_tick_color
  }

  if {$enz_tick_width == -1} {
    set temp_circ_config_info($c,enz_tick_width) "---"
  } else {
    set temp_circ_config_info($c,enz_tick_width) $enz_tick_width
  }
  if {$enz_tick_length == -1} {
    set temp_circ_config_info($c,enz_tick_length) "---"
  } else {
    set temp_circ_config_info($c,enz_tick_length) $enz_tick_length
  }
  if {$enz_label_subst eq "\u00"} {
    set temp_circ_config_info($c,enz_label_subst) "multiple"
  } else {
    set temp_circ_config_info($c,enz_label_subst) $enz_label_subst
  }

  if {$enz_show_connector == -1} {
    unset -nocomplain temp_circ_config_info($c,enz_label_show_connector)
  } else {
    set temp_circ_config_info($c,enz_label_show_connector) $enz_show_connector
  }
}



#############
##
#############
proc circular_config_enz_treeview_apply {tag_selection c {t {}}} {
  global temp_circ_config_info info
  foreach e $tag_selection {
    if {$e eq "hidden"} {continue}
    if {[info exists temp_circ_config_info($c,enz_visible)]} {
      if {$temp_circ_config_info($c,enz_visible) == 1} {
        $c itemconfigure $e -state ""
        $c itemconfigure [$c find withtag $e.connector]  -state ""
        $c itemconfigure [$c find withtag $e.tick]  -state ""
        if {$info(antialias_show)} {
          $c itemconfigure [$c find withtag $e.connector_aa]  -state ""
          $c itemconfigure [$c find withtag $e.tick_aa]  -state ""
        }
        $c itemconfigure $e.box -state ""    
        if {[winfo exists $t]} {
          $t move $e {} end
        }
      } elseif {$temp_circ_config_info($c,enz_visible) == 0} {
        $c itemconfigure $e -state "hidden"
        $c itemconfigure [$c find withtag $e.connector]  -state "hidden"
        $c itemconfigure [$c find withtag $e.tick]  -state "hidden"
        $c itemconfigure [$c find withtag $e.connector_aa]  -state "hidden"
        $c itemconfigure [$c find withtag $e.tick_aa]  -state "hidden"
          $c itemconfigure $e.box -state "hidden"    
        if {[winfo exists $t]} {
          $t move $e hidden end
        }
      }
    }
    set family [font actual [$c itemcget $e -font] -family]
    set size  [font actual [$c itemcget $e -font] -size]
    set new_font ""
    if {[info exists temp_circ_config_info($c,enz_fontfamily)] && $temp_circ_config_info($c,enz_fontfamily) != "---"} {
      set family $temp_circ_config_info($c,enz_fontfamily)
      set new_font "[list $family] $size"
    }
    if {[info exists temp_circ_config_info($c,enz_fontsize)] && $temp_circ_config_info($c,enz_fontsize) != "---"} {
      set new_font "[list $family] $temp_circ_config_info($c,enz_fontsize)"
    }
    if {[info exists temp_circ_config_info($c,enz_fontitalic)] && $temp_circ_config_info($c,enz_fontitalic)} {
      if {$new_font eq {}} {
        set new_font "[list $family] $size"
      }
      set new_font  "$new_font italic"
    }
    if {[info exists temp_circ_config_info($c,enz_fontunderline)] && $temp_circ_config_info($c,enz_fontunderline)} {
      if {$new_font eq {}} {
        set new_font "[list $family] $size"
      }
      set new_font  "$new_font underline"
    }
    if {[info exists temp_circ_config_info($c,enz_fontbold)] && $temp_circ_config_info($c,enz_fontbold)} {
      if {$new_font eq {}} {
        set new_font "[list $family] $size"
      }
      set new_font  "$new_font bold"
    }
    if {$new_font ne {}} {
      $c itemconfigure $e -font $new_font
      graphic_map_redraw_label_box $c $e
    }


    if {[info exists temp_circ_config_info($c,enz_label_color)] && $temp_circ_config_info($c,enz_label_color) != 0 && $temp_circ_config_info($c,enz_label_color) != -1} {
      $c itemconfigure $e -fill $temp_circ_config_info($c,enz_label_color)
      $c bind $e <<Colors>> [lreplace [$c bind $e <<Colors>>] 0 0 $temp_circ_config_info($c,enz_label_color)]
     # $t tag configure $e -foreground $temp_circ_config_info($c,enz_label_color)
    }

    if {[info exists temp_circ_config_info($c,enz_box_type)] && $temp_circ_config_info($c,enz_box_type) ne "---" } {
      set this_label_box_type $temp_circ_config_info($c,enz_box_type)
      set box_item [$c find withtag $e.box]
      set box_dict [$c bind $box_item <<Box>>]
      if {[dict exists $box_dict type]} {
        dict set box_dict type $this_label_box_type 
        $c bind $box_item <<Box>> $box_dict
        graphic_map_redraw_label_box $c $e
      }
    } 
    if {[info exists temp_circ_config_info($c,enz_box_fill_color)] && $temp_circ_config_info($c,enz_box_fill_color) != 0 && $temp_circ_config_info($c,enz_box_fill_color) !=  -1} {
      set new_box_fill_color $temp_circ_config_info($c,enz_box_fill_color)
      $c itemconfigure $e.box -fill $new_box_fill_color
      ##dict set gformat_dict circ_enz_label_box_fill_color $new_box_fill_color
    }
    if {[info exists temp_circ_config_info($c,enz_box_outline_color)] && $temp_circ_config_info($c,enz_box_outline_color) != 0  && $temp_circ_config_info($c,enz_box_outline_color) != -1} {
      set new_box_outline_color $temp_circ_config_info($c,enz_box_outline_color)
      $c itemconfigure $e.box -outline $new_box_outline_color
      $c bind $e <<Colors>> [lreplace [$c bind $e <<Colors>>] 3 3 $new_box_outline_color]
      #dict set gformat_dict circ_enz_label_box_ouline_color $new_box_fill_color
    }
    if {[info exists temp_circ_config_info($c,enz_box_outline_width)] && ![catch {expr {1*$temp_circ_config_info($c,enz_box_outline_width)}}]} {
      set this_box_outline_width [expr {round($temp_circ_config_info($c,enz_box_outline_width))}]
      $c itemconfigure $e.box -width $this_box_outline_width
      if { $this_box_outline_width == 0} {
        $c itemconfigure $e.box -outline {}
        $c bind $e <<Colors>> [lreplace [$c bind $e <<Colors>>] 3 3 {}]
      }
      #dict set gformat_dict circ_enz_label_box_outline_width $this_box_outline_width
    } 

    set new_tick_color ""
    if {[info exists temp_circ_config_info($c,enz_tick_color)] && $temp_circ_config_info($c,enz_tick_color) != 0 && $temp_circ_config_info($c,enz_tick_color) != -1} {
      set new_tick_color $temp_circ_config_info($c,enz_tick_color)
    } 
    if {$new_tick_color != ""} {
      $c itemconfigure [$c find withtag $e.connector] -fill $new_tick_color
      $c itemconfigure [$c find withtag $e.tick] -fill $new_tick_color
      $c itemconfigure [$c find withtag $e.connector_aa] -fill [mix_color $new_tick_color [$c cget -background] $info(antialias_percent)]
      $c itemconfigure [$c find withtag $e.tick_aa] -fill [mix_color $new_tick_color [$c cget -background] $info(antialias_percent)]
      $c bind $e <<Colors>> [lreplace [$c bind $e <<Colors>>] 2 2 $new_tick_color]
    }

    if {[info exists temp_circ_config_info($c,enz_tick_width)] && ![catch {expr {1*$temp_circ_config_info($c,enz_tick_width)}}]} {
      set this_tick_width $temp_circ_config_info($c,enz_tick_width)
      $c itemconfigure [$c find withtag $e.tick] -width $this_tick_width
      $c itemconfigure [$c find withtag $e.connector] -width $this_tick_width
      $c itemconfigure [$c find withtag $e.tick_aa] -width [expr {$info(antialias_width) + $this_tick_width}]
      $c itemconfigure [$c find withtag $e.connector_aa] -width [expr {$info(antialias_width) + $this_tick_width}]
    } 

    if {[info exists temp_circ_config_info($c,enz_tick_length)] && ![catch {expr {1*$temp_circ_config_info($c,enz_tick_length)}}]} {
      set this_tick_length $temp_circ_config_info($c,enz_tick_length)
      set label_dict [$c bind $e <<Label>>]
      dict set label_dict enz_tick_length $this_tick_length
      $c bind $e <<Label>> $label_dict
    } 


    if {[info exists temp_circ_config_info($c,enz_label_subst)] && $temp_circ_config_info($c,enz_label_subst) ne "multiple" } {
      set label_dict [$c bind $e <<Label>>]
      dict set label_dict enz_label_subst $temp_circ_config_info($c,enz_label_subst)
      $c bind $e <<Label>> $label_dict
      $c itemconfigure $e -text [graphic_map_enz_label_subst $c $e $temp_circ_config_info($c,enz_label_subst)]
      graphic_map_redraw_label_box $c $e
    } 
    if {[info exists temp_circ_config_info($c,enz_label_show_connector)]} {
      set show_connector $temp_circ_config_info($c,enz_label_show_connector)
      if {$show_connector && [$c itemcget [$c find withtag $e.tick]  -state] eq ""} {
        $c itemconfigure [$c find withtag $e.connector] -state ""
        if {$info(antialias_show)} {
          $c itemconfigure [$c find withtag $e.connector_aa] -state ""
        }
      } else {
        $c itemconfigure [$c find withtag $e.connector] -state "hidden"
        $c itemconfigure [$c find withtag $e.connector_aa] -state "hidden"
      }
      set label_dict [$c bind $e <<Label>>]
      dict set label_dict show_connector $show_connector
      $c bind $e <<Label>> $label_dict
    }

  }
  if {[winfo exists $t]} {
    treeview_sort $t [bind $t <<Sort_column>>] 1
  }
  #rebump moveablelabels
  foreach i [$c find withtag moveablelabel] {
    if {[$c bind $i <<Moved>>] ==""} {
      circular_map_reset_moveablelabel $c $i
    }
  }
  ## set last arg to 1 to avoid connectors in bump process
  circular_map_bump_all_moveablelabel $c "" 1
}

################
## utility to fill features treeview
################
proc circular_config_fea_fill_treeview {tv c} {
  global enz_list

  if {![winfo exists $tv]} {
    sputs no fea
    return
  }
  if {![$tv exists hidden]} {
    $tv insert {} end -id hidden -text [mc "Hidden"] -tag hidden
  }
  $tv children {} [list hidden]
  set total_length [$c bind 1 <<Total_length>>]
  foreach tag [$c find withtag feature&&label] {
    set label_dict  [$c bind $tag <<Label>>]
    set ftag [regsub fn [dict get $label_dict tag] f]
    $tv insert {} end -id $tag -text [dict get $label_dict name] -tag $tag
    $tv set $tag Location [dict get $label_dict location_start]
    $tv set $tag Direction [expr {[dict get $label_dict direction]?"<<<":">>>"}]
    $tv set $tag Type [dict get $label_dict feature_type]
    $tv set $tag Length [expr {( ([dict get $label_dict direction] * 2 -1) *([dict get $label_dict location_start]-[dict get $label_dict location_end])) % $total_length}]
    set label_dict  [$c bind $tag <<Label>>]
    set f_tag [regsub fn [dict get $label_dict tag] f]
    set fg_color  [$c itemcget exon&&foreground&&$f_tag -outline] 
    #$tv tag configure $tag -background $bg_color -foreground [$c itemcget $tag -fill]
    $tv tag configure $tag -background $fg_color -foreground [process_feature_color $c $tag vis+fill_color+black+white]
    if {[$c itemcget $ftag&&exon -state] == "hidden"} {
      $tv move $tag hidden end
    }
  }
  treeview_sort $tv [bind $tv <<Sort_column>>] 1
}

#############
##
#############
## work here
proc circular_config_fea_treeview_manageselection {t c dialog} {
  global temp_circ_config_info info outline_box_types_dict
  set fea_visible ""
  set fea_fontfamily "---"
  set fea_fontsize "---"
 set fea_font_bold ""
  set fea_font_italic ""
  set fea_font_underline ""
  set fea_label_subst "\u01"
  set fea_label_color 0

  set fea_width ""
  set fea_outline ""
  set fea_radius ""

  set fea_intron_width ""
  set fea_intron_outline ""
  set fea_intron_height ""
  set fea_intron_bg_color 0
  set fea_intron_fg_color 0

  set fea_box_type "---"
  set fea_box_fill_color 0
  set fea_box_outline_color 0
  set fea_box_width "---"

  set fea_tick_color 0
  set fea_label_align "---"
  set fea_tick_width ""
  set fea_tick_length ""
  set fea_show_connector ""

  set fea_label_arc ""
  set fea_fg_color 0
  set fea_bg_color 0
  set fea_bg_color_percent ""
  set fea_fwd_arrow "Empty"
  set fea_rev_arrow "Empty"


  $t tag remove sel
  $t tag add sel [$t selection]

  #set dialog .dialog
  if {[$t selection] == {} || [$t selection] == [list hidden]} {
    grid configure $dialog.tabframe.features.frame3_dummy
    return
  } else {
    grid remove $dialog.tabframe.features.frame3_dummy
  }


  set has_intron 0
  foreach e [$t selection] {
    if {$e eq "hidden"} {continue}

    set label_dict  [$c bind $e <<Label>>]
    set label_color_list   [$c bind $e <<Colors>>]
    set tag [regsub fn [dict get $label_dict tag] f]
    set tag_color_list   [$c bind $tag <<Colors>>]

    if {$fea_visible == ""} {
      set fea_visible [expr {[$c itemcget $tag&&exon -state] ne "hidden"}]
    } elseif {$fea_visible != [expr {[$c itemcget $tag&&exon -state] ne "hidden"}]} {
      set fea_visible -1
    }
    if {$fea_fontfamily == "---"} {
      set fea_fontfamily [font actual [$c itemcget $e -font] -family]
    } elseif {$fea_fontfamily != [font actual [$c itemcget $e -font] -family]} {
      set fea_fontfamily -1
    }
    if {$fea_fontsize == "---"} {
      set fea_fontsize [font actual [$c itemcget $e -font] -size]
    } elseif {$fea_fontsize != [font actual [$c itemcget $e -font] -size]} {
      set fea_fontsize -1
    }
    if {$fea_font_bold == ""} {
      set fea_font_bold [expr {[font actual [$c itemcget $e -font] -weight] eq "bold"}]
    } elseif {$fea_font_bold != [expr {[font actual [$c itemcget $e -font] -weight] eq "bold"}]} {
      set fea_font_bold -1
    }
    if {$fea_font_italic == ""} {
      set fea_font_italic [expr {[font actual [$c itemcget $e -font] -slant] eq "italic"}]
    } elseif {$fea_font_italic != [expr {[font actual [$c itemcget $e -font] -slant] eq "italic"}]} {
      set fea_font_italic -1
    }
    if {$fea_font_underline == ""} {
      set fea_font_underline [font actual [$c itemcget $e -font] -underline]
    } elseif {$fea_font_underline != [font actual [$c itemcget $e -font] -underline] } {
      set fea_font_underline -1
    }
    #set this_fea_label_color [$c itemcget $e -fill]
    set this_fea_label_color [lindex $label_color_list 0]
    if {$fea_label_color == 0} {
      set fea_label_color $this_fea_label_color
    } elseif {$fea_label_color != $this_fea_label_color} {
      set fea_label_color -1
    }
    #set this_fea_tick_color [$c itemcget [$c find withtag $e.tick]  -fill]
    set this_fea_tick_color [lindex $label_color_list 2]
    if {$fea_tick_color == 0} {
      set fea_tick_color $this_fea_tick_color
    } elseif {$fea_tick_color !=  $this_fea_tick_color} {
      set fea_tick_color -1
    }

    if {$fea_label_subst == "\u01" && [dict exists $label_dict fea_label_subst]} {
      set fea_label_subst [dict get $label_dict fea_label_subst]
    } elseif {[dict exists $label_dict fea_label_subst] && $fea_label_subst != [dict get $label_dict fea_label_subst]} {
      set fea_label_subst "\u00"
    }

    if {[dict exists $label_dict fea_label_align]} {
      set label_align [dict get $label_dict fea_label_align]
    } else {
      set label_align "Center"
    }
    if {$fea_label_align == "---"} {
      set fea_label_align $label_align
    } elseif {$fea_label_align != $label_align} {
      set fea_label_align -1
    }

    set box_item [$c find withtag $e.box]
    if {$box_item != {}} {
      if {[set box_dict [$c bind $box_item <<Box>>]] ne {} && [dict exists $box_dict type]} {
        set box_type [dict get $box_dict type]
      } else {
        set box_type ""
      }
      if {$fea_box_type == "---"} {
        set fea_box_type $box_type
      } elseif {$fea_box_type != $box_type} {
        set fea_box_type -1
      }
      if {$fea_box_fill_color == 0} {
        set fea_box_fill_color [$c itemcget $box_item -fill]
      } elseif {$fea_box_fill_color != [$c itemcget $box_item -fill]} {
        set fea_box_fill_color -1
      }
      if {$fea_box_outline_color == 0} {
        #set fea_box_outline_color [$c itemcget $box_item -outline]
        set fea_box_outline_color [lindex $label_color_list 3]   
      } elseif {$fea_box_outline_color != [$c itemcget $box_item -outline]} {
        set fea_box_outline_color -1
      }
      if {$fea_box_width == "---"} {
        set fea_box_width [$c itemcget $box_item -width]
      } elseif {$fea_box_width != [$c itemcget $box_item -width]} {
        set fea_box_width -1
      }
    } 


    set this_fea_tick_width [$c itemcget [$c find withtag $e.tick]  -width]
    if {$fea_tick_width == ""} {
      set fea_tick_width $this_fea_tick_width
    } elseif {$fea_tick_width != $this_fea_tick_width} {
      set fea_tick_width -1
    }

    if {[dict exists $label_dict fea_tick_length]} {
      set tick_length [dict get $label_dict fea_tick_length]
    } else {
      set tick_length 10
    }
    if {$fea_tick_length == ""} {
      set fea_tick_length $tick_length
    } elseif {$fea_tick_length != $tick_length} {
      set fea_tick_length -1
    }

    if {[dict exists $label_dict show_connector]} {
      set show_connector [dict get $label_dict show_connector]
    } else {
      set show_connector 0
    }
    if {$fea_show_connector == ""} {
      set fea_show_connector $show_connector
    } elseif {$fea_show_connector != $show_connector} {
      set fea_show_connector -1
    }

    #set this_fea_fg_color [$c itemcget $tag&&foreground&&exon -outline]
    #set this_fea_bg_color [$c itemcget $tag&&outline&&exon -outline]
    set this_fea_fg_color [lindex $tag_color_list 0]
    set this_fea_bg_color [lindex $tag_color_list 2]

    if {$fea_fg_color == 0} {
      set fea_fg_color $this_fea_fg_color
    } elseif {$fea_fg_color != $this_fea_fg_color} {
      set fea_fg_color -1
    }
    if {[dict exists $label_dict use_arc]} {
      set use_arc [dict get $label_dict use_arc]
    } else {
      set use_arc 0
    }
    if {$fea_label_arc == ""} {
      set fea_label_arc $use_arc
    } elseif {$fea_label_arc != $use_arc} {
      set fea_label_arc -1
    }


    if {$fea_bg_color == 0} {
      set fea_bg_color [$c itemcget $tag&&outline&&exon -outline]
    } elseif {$fea_bg_color != [$c itemcget $tag&&outline&&exon -outline]} {
      set fea_bg_color -1
    }

    if {$fea_width == ""} {
      set fea_width [$c itemcget $tag&&foreground&&exon -width]
    } elseif {$fea_width != [$c itemcget $tag&&foreground&&exon -width]} {
      set fea_width -1
    }
    if {$fea_outline == ""} {
      set fea_outline [expr {([$c itemcget $tag&&outline&&exon -width] - [$c itemcget $tag&&foreground&&exon -width]) /2}]
    } elseif {$fea_outline != [expr {([$c itemcget $tag&&outline&&exon -width] - [$c itemcget $tag&&foreground&&exon -width]) /2}]} {
      set fea_outline -1
    }
#sputs tag $tag [$c bind $tag <<Direction>>] [$c bind $tag <<Arrow_list>>] [$c bind $tag <<Gformat>>] 
    
    if {[$c find withtag $tag&&intron] != [list]} {
      set has_intron 1
      if {$fea_intron_fg_color == 0} {
        set fea_intron_fg_color [$c itemcget $tag&&foreground&&intron -outline]
      } elseif {$fea_intron_fg_color != [$c itemcget $tag&&foreground&&intron -outline]} {
        set fea_intron_fg_color -1
      }
     if {$fea_intron_bg_color == 0} {
       set fea_intron_bg_color [$c itemcget $tag&&outline&&intron -outline]
      } elseif {$fea_intron_bg_color != [$c itemcget $tag&&outline&&intron -outline]} {
        set fea_intron_bg_color -1
      }

      if {$fea_intron_width == ""} {
        set fea_intron_width [$c itemcget $tag&&foreground&&intron -width]
      } elseif {$fea_intron_width != [$c itemcget $tag&&foreground&&intron -width]} {
        set fea_intron_width -1
      }
      set r_i [lindex [$c coords [lindex [$c find withtag $tag&&intron] 0]] 2]
      set r_f [lindex [$c coords [lindex [$c find withtag $tag&&exon] 0]] 2]
      if {[$c itemcget $tag&&foreground&&exon -width] >= [$c itemcget $tag&&foreground&&intron -width]} {
        set this_fea_intron_height [expr {round(10*((1-2 * [$c bind $tag <<Direction>>] ) * ($r_i - $r_f)/ ([$c itemcget $tag&&foreground&&exon -width]- [$c itemcget $tag&&foreground&&intron -width]))) /10.0  }]
      } else {
        set this_fea_intron_height 0
      }
      if {$fea_intron_height == ""} {
        set fea_intron_height $this_fea_intron_height
      } elseif {$fea_intron_height != $this_fea_intron_height} {
        set fea_intron_height -1
      }
      if {$fea_intron_outline == ""} {
        set fea_intron_outline [expr {([$c itemcget $tag&&outline&&intron -width] - [$c itemcget $tag&&foreground&&intron -width]) /2}]
      } elseif {$fea_intron_outline != [expr {([$c itemcget $tag&&outline&&intron -width] - [$c itemcget $tag&&foreground&&intron -width]) /2}]} {
        set fea_intron_outline -1
      }
    }

    set this_fea_fwd_arrow [lindex [$c bind $tag <<Arrow_list>>] 0]
    set this_fea_rev_arrow [lindex [$c bind $tag <<Arrow_list>>] 1]
    
    if {$fea_fwd_arrow ==  "Empty"} {
      set fea_fwd_arrow $this_fea_fwd_arrow
    } elseif {$this_fea_fwd_arrow != $fea_fwd_arrow} {
      set fea_fwd_arrow "NoArrow"
    }
    if {$fea_rev_arrow == "Empty"} {
      set fea_rev_arrow $this_fea_rev_arrow
    } elseif {$this_fea_rev_arrow != $fea_rev_arrow} {
      set fea_rev_arrow "NoArrow"
    }
    
  }

  ## process loop result
  if {$fea_visible == -1} {
    ## sets the checkbox into the alt/ tri state
    unset -nocomplain temp_circ_config_info($c,fea_visible)
  } else {
    set temp_circ_config_info($c,fea_visible) $fea_visible
  }
  if {$fea_fontfamily == -1} {
    set temp_circ_config_info($c,fea_fontfamily) "---"
  } else {
    set temp_circ_config_info($c,fea_fontfamily) $fea_fontfamily
  }
  if {$fea_fontsize == -1} {
    set temp_circ_config_info($c,fea_fontsize) "---"
  } else {
    set temp_circ_config_info($c,fea_fontsize) $fea_fontsize
  }
  if {$fea_font_bold == -1} {
    unset -nocomplain temp_circ_config_info($c,fea_fontbold)
  } else {
    set temp_circ_config_info($c,fea_fontbold) $fea_font_bold
  }
  if {$fea_font_italic == -1} {
    unset -nocomplain temp_circ_config_info($c,fea_fontitalic)
  } else {
    set temp_circ_config_info($c,fea_fontitalic) $fea_font_italic
  }
  if {$fea_font_underline == -1} {
    unset -nocomplain temp_circ_config_info($c,fea_fontunderline)
  } else {
    set temp_circ_config_info($c,fea_fontunderline) $fea_font_underline
  }
  if {$fea_label_color == 0} {
    set temp_circ_config_info($c,fea_label_color) -1
  } else {
    set temp_circ_config_info($c,fea_label_color) $fea_label_color
  }
  if {$fea_tick_color == 0} {
    set temp_circ_config_info($c,fea_tick_color) -1
  } else {
    set temp_circ_config_info($c,fea_tick_color) $fea_tick_color
  }
  if {$fea_label_align == -1} {
    set temp_circ_config_info($c,fea_label_align) "---"
  } else {
    set temp_circ_config_info($c,fea_label_align) $fea_label_align
  }

  if {$fea_label_subst eq "\u00"} {
    set temp_circ_config_info($c,fea_label_subst) "multiple"
  } else {
    set temp_circ_config_info($c,fea_label_subst) $fea_label_subst
  }

  if {$fea_box_type == -1 || $fea_box_type =="" || $fea_box_type == "---"} {
    set temp_circ_config_info($c,fea_box_type) "---"
    set  temp_circ_config_info($c,fea_box_type_label) "---"
  } else {
    set temp_circ_config_info($c,fea_box_type) $fea_box_type
    set  temp_circ_config_info($c,fea_box_type_label) [dict get $outline_box_types_dict $fea_box_type]
  }
  if {$fea_box_fill_color == 0} {
    set temp_circ_config_info($c,fea_box_fill_color) -1
  } else {
    set temp_circ_config_info($c,fea_box_fill_color) $fea_box_fill_color
  }
  if {$fea_box_outline_color == 0} {
    set temp_circ_config_info($c,fea_box_outline_color) -1
  } else {
    set temp_circ_config_info($c,fea_box_outline_color) $fea_box_outline_color
  }
  if {$fea_box_width == -1 || $fea_box_width ==""} {
    set temp_circ_config_info($c,fea_box_outline_width) "---"
  } else {
    set temp_circ_config_info($c,fea_box_outline_width) $fea_box_width
  }

  if {$fea_tick_width == -1} {
    set temp_circ_config_info($c,fea_tick_width) "---"
  } else {
    set temp_circ_config_info($c,fea_tick_width) $fea_tick_width
  }
  if {$fea_tick_length == -1} {
    set temp_circ_config_info($c,fea_tick_length) "---"
  } else {
    set temp_circ_config_info($c,fea_tick_length) $fea_tick_length
  }

  if {$fea_show_connector == -1} {
    unset -nocomplain temp_circ_config_info($c,fea_label_show_connector)
  } else {
    set temp_circ_config_info($c,fea_label_show_connector) $fea_show_connector
  }

  if {$has_intron} {
    grid configure $dialog.tabframe.features.frame3.intron_frame
    if {$fea_intron_width == -1} {
      set temp_circ_config_info($c,fea_intron_width) "---"
    } else {
      set temp_circ_config_info($c,fea_intron_width) [expr {round($fea_intron_width)}]
    }
    if {$fea_intron_height == -1} {
      set temp_circ_config_info($c,fea_intron_height) "---"
    } else {
      set temp_circ_config_info($c,fea_intron_height) $fea_intron_height
    }
    if {$fea_intron_outline == -1} {
      set temp_circ_config_info($c,fea_intron_outline) "---"
    } else {
      set temp_circ_config_info($c,fea_intron_outline) [expr {round($fea_intron_outline)}]
    }
    if {$fea_intron_fg_color == 0} {
      set temp_circ_config_info($c,fea_intron_fg_color) -1
    } else {
      set temp_circ_config_info($c,fea_intron_fg_color) $fea_intron_fg_color
    }
    if {$fea_intron_bg_color == 0} {
      set temp_circ_config_info($c,fea_intron_bg_color) -1
    } else {
      set temp_circ_config_info($c,fea_intron_bg_color) $fea_intron_bg_color
    }
  } else {
    grid remove $dialog.tabframe.features.frame3.intron_frame
  }

  if {$fea_label_arc == -1} {
      unset -nocomplain temp_circ_config_info($c,fea_label_arc)
      grid configure $dialog.tabframe.features.frame3.label_frame.subst_frame.move_in  
      grid configure $dialog.tabframe.features.frame3.label_frame.subst_frame.move_out1 
      grid configure $dialog.tabframe.features.frame3.label_frame.subst_frame.move_out 
      grid configure $dialog.tabframe.features.frame3.label_frame.subst_frame.entry_label
      grid configure $dialog.tabframe.features.frame3.label_frame.subst_frame.label_subst
      grid configure $dialog.tabframe.features.frame3.label_frame.subst_frame.subst_vals
      grid configure $dialog.tabframe.features.frame3.boxframe
  } else {
    set temp_circ_config_info($c,fea_label_arc) $fea_label_arc
    if {$fea_label_arc} {
      grid configure $dialog.tabframe.features.frame3.label_frame.subst_frame.move_in  
      grid configure $dialog.tabframe.features.frame3.label_frame.subst_frame.move_out1 
      grid configure $dialog.tabframe.features.frame3.label_frame.subst_frame.move_out 
      grid remove $dialog.tabframe.features.frame3.label_frame.subst_frame.entry_label
      grid remove $dialog.tabframe.features.frame3.label_frame.subst_frame.label_subst
      grid remove $dialog.tabframe.features.frame3.label_frame.subst_frame.subst_vals
      grid remove $dialog.tabframe.features.frame3.boxframe
    } else {
      grid remove $dialog.tabframe.features.frame3.label_frame.subst_frame.move_in  
      grid remove $dialog.tabframe.features.frame3.label_frame.subst_frame.move_out1 
      grid remove $dialog.tabframe.features.frame3.label_frame.subst_frame.move_out 
      grid configure $dialog.tabframe.features.frame3.label_frame.subst_frame.entry_label
      grid configure $dialog.tabframe.features.frame3.label_frame.subst_frame.label_subst
      grid configure $dialog.tabframe.features.frame3.label_frame.subst_frame.subst_vals
      grid configure $dialog.tabframe.features.frame3.boxframe
    }
  }
  if {$fea_width == -1 || $fea_width == ""} {
    set temp_circ_config_info($c,fea_width) "---"
  } else {
    set temp_circ_config_info($c,fea_width) [expr {int($fea_width)}]
  }
  if {$fea_outline <= -1} {
    set temp_circ_config_info($c,fea_outline) "---"
  } else {
    set temp_circ_config_info($c,fea_outline) [expr {int($fea_outline)}]
  }
  if { $fea_fg_color == 0 ||  $fea_fg_color == -1} {
    set temp_circ_config_info($c,fea_fg_color) -1
    #$dialog.tabframe.features.frame3.ffg_frame.ffg_label configure -state disabled
  } else {
    set temp_circ_config_info($c,fea_fg_color) $this_fea_fg_color
   $dialog.tabframe.features.frame3.ffg_frame.ffg_label configure -state normal
  }
  if {$fea_bg_color == 0 || $fea_bg_color == -1} {
    set temp_circ_config_info($c,fea_bg_color) -1
    #$dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_label configure -state disabled
   # grid remove $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color_percent; grid remove $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color_percent_label
  } else {
    set temp_circ_config_info($c,fea_bg_color) $this_fea_bg_color
    $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_label configure -state normal
    #grid remove $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color_percent; grid remove $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color_percent_label
  }

  if {[dict exists $info(arrow_dict) $fea_fwd_arrow]} {
    set temp_circ_config_info($c,f_arrow_text) [dict get $info(arrow_dict) $fea_fwd_arrow]
    set temp_circ_config_info($c,fea_f_arrow) $fea_fwd_arrow
  } else {
    set temp_circ_config_info($c,f_arrow_text) "----"
    set temp_circ_config_info($c,fea_f_arrow) -1
  }
  if {[dict exists $info(arrow_dict) $fea_rev_arrow]} {
    set temp_circ_config_info($c,r_arrow_text) [dict get $info(arrow_dict) $fea_rev_arrow]
    set temp_circ_config_info($c,fea_r_arrow) $fea_rev_arrow
  } else {
    set temp_circ_config_info($c,r_arrow_text) "----"
    set temp_circ_config_info($c,fea_r_arrow) -1
  }
}

################
## 
################
proc circular_config_fea_treeview_apply {tag_selection c {t {}}} {
  global temp_circ_config_info info
  ## treeview items are indexed as canvas item numbers of the feature label item
  set w [bind $c <<Window>>]
  foreach e $tag_selection {
    if {$e eq "hidden"} {continue}
    set redraw 0
    set label_dict  [$c bind $e <<Label>>]
    set tag [regsub fn [dict get $label_dict tag] f]
    set gformat_dict [$c bind $tag <<Gformat>>]
    set direction [$c bind $tag <<Direction>>]

    if {[info exists temp_circ_config_info($c,fea_visible)]} {
      ## visible is set or unset, not the mixed tri state 
      if {[dict exists $label_dict use_arc]} {
        set use_arc [dict get $label_dict use_arc]
      } else {
        set use_arc 0
      }
      dict set gformat_dict use_arc $use_arc
      if {$temp_circ_config_info($c,fea_visible) == 1} {
        dict set gformat_dict circular_state normal
        $c itemconfigure $tag -state ""
        if {$use_arc} {
          $c itemconfigure $e -state "hidden"
          $c itemconfigure $e.box -state "hidden"        
         # $c itemconfigure [$c find withtag $e.connector]  -state "hidden"
         # $c itemconfigure [$c find withtag $e.tick]  -state "hidden"
        } else {
          $c itemconfigure $tag&&circular_label -state "hidden"
        }
        if {[winfo exists $t]} {
          $t move $e {} end
        }
      } elseif {$temp_circ_config_info($c,fea_visible) == 0} {
        $c itemconfigure $tag -state "hidden"
        if {[winfo exists $t]} {
          $t move $e hidden end
        }
        dict set gformat_dict circular_state hidden
      }
    }

    if {[info exists temp_circ_config_info($c,fea_label_arc)]} {
      set use_arc $temp_circ_config_info($c,fea_label_arc)
      if {[$c itemcget $tag&&exon -state] != "hidden"} {
        if {$use_arc} {
          $c itemconfigure $e -state "hidden"
          $c itemconfigure $e.box -state "hidden"    
          #$c itemconfigure [$c find withtag $e.connector]  -state "hidden"
          #$c itemconfigure [$c find withtag $e.tick]  -state "hidden"
          ## show tick and conncector, actually- change move arc text proc to align connctor
          $c itemconfigure [$c find withtag $e.connector] -state ""
          $c itemconfigure [$c find withtag $e.tick] -state ""
          if {$info(antialias_show)} {
           $c itemconfigure [$c find withtag $e.connector_aa] -state ""
            $c itemconfigure [$c find withtag $e.tick_aa] -state ""
          }
          $c itemconfigure $tag&&circular_label -state ""
        } else {
          $c itemconfigure $e -state "normal"
          $c itemconfigure $e.box -state "normal"    
          $c itemconfigure [$c find withtag $e.connector] -state ""
          $c itemconfigure [$c find withtag $e.tick] -state ""
          if {$info(antialias_show)} {
            $c itemconfigure [$c find withtag $e.connector_aa] -state ""
            $c itemconfigure [$c find withtag $e.tick_aa] -state ""
          }
          $c itemconfigure $tag&&circular_label -state "hidden"
        }
      }
      dict set label_dict use_arc $use_arc
      dict set gformat_dict use_arc $use_arc
      $c bind $e <<Label>> $label_dict
    }

    set family [font actual [$c itemcget $e -font] -family]
    set size  [font actual [$c itemcget $e -font] -size]
    set new_font {}
    if {[info exists temp_circ_config_info($c,fea_fontfamily)] && $temp_circ_config_info($c,fea_fontfamily) != "---"} {
      set family $temp_circ_config_info($c,fea_fontfamily)
      set new_font "[list $family] $size"
    }
    if {[info exists temp_circ_config_info($c,fea_fontsize)] && $temp_circ_config_info($c,fea_fontsize) != "---"} {
      set new_font  "[list $family] $temp_circ_config_info($c,fea_fontsize)"
    }
    if {[info exists temp_circ_config_info($c,fea_fontitalic)] && $temp_circ_config_info($c,fea_fontitalic)} {
      if {$new_font eq {}} {
        set new_font "[list $family] $size"
      }
      set new_font  "$new_font italic"
      dict set gformat_dict circular_label_font $new_font
    }
    if {[info exists temp_circ_config_info($c,fea_fontunderline)] && $temp_circ_config_info($c,fea_fontunderline)} {
      if {$new_font eq {}} {
        set new_font "[list $family] $size"
      }
      set new_font  "$new_font underline"
      dict set gformat_dict circular_label_font $new_font
    }
    if {[info exists temp_circ_config_info($c,fea_fontbold)] && $temp_circ_config_info($c,fea_fontbold)} {
      if {$new_font eq {}} {
        set new_font "[list $family] $size"
      }
      set new_font  "$new_font bold"
      dict set gformat_dict circular_label_font $new_font
    }
    if {$new_font ne {}} {
      $c itemconfigure $e -font $new_font
      dict set gformat_dict circular_label_font $new_font
      graphic_map_redraw_label_box $c $e
      set old_font [$c itemcget [lindex [$c find withtag $tag&&circular_label] 0] -font]
      if {[dict exists $label_dict arc_text_offset] && $old_font ne {}} {
        set arc_text_offset [dict get $label_dict arc_text_offset]
        set old_height [font metrics $old_font -linespace]
        if {[expr {abs($arc_text_offset)}] > $old_height} {
          set new_height [font metrics $new_font -linespace]
          set arc_text_offset [expr {$arc_text_offset + sign($arc_text_offset) * 0.5* ($new_height-$old_height)}]
          dict set label_dict arc_text_offset $arc_text_offset
          $c bind $e <<Label>> $label_dict
        }
      } 
      $c itemconfigure $tag&&circular_label -font $new_font
    }

    if {[info exists temp_circ_config_info($c,fea_box_type)] && $temp_circ_config_info($c,fea_box_type) ne "---" } {
      set this_label_box_type $temp_circ_config_info($c,fea_box_type)
      set box_item [$c find withtag $e.box]
      set box_dict [$c bind $box_item <<Box>>]
      if {[dict exists $box_dict type]} {
        dict set box_dict type $this_label_box_type
        $c bind $box_item <<Box>> $box_dict
        graphic_map_redraw_label_box $c $e
      }
    } 
    if {[info exists temp_circ_config_info($c,fea_box_fill_color)] && $temp_circ_config_info($c,fea_box_fill_color) != -1} {
      set new_box_fill_color [process_feature_color $c $e $temp_circ_config_info($c,fea_box_fill_color)]
      $c itemconfigure $e.box -fill $new_box_fill_color
      ##dict set gformat_dict circ_fea_label_box_fill_color $new_box_fill_color
    }
    if {[info exists temp_circ_config_info($c,fea_box_outline_color)] && $temp_circ_config_info($c,fea_box_outline_color) !=-1} {
      set new_box_outline_color [process_feature_color  $c $e $temp_circ_config_info($c,fea_box_outline_color)]
      $c itemconfigure $e.box -outline $new_box_outline_color
      $c bind $e <<Colors>> [lreplace [$c bind $e <<Colors>>] 3 3 $new_box_outline_color]
      #dict set gformat_dict circ_fea_label_box_ouline_color $new_box_fill_color
    }
    if {[info exists temp_circ_config_info($c,fea_box_outline_width)] && ![catch {expr {1*$temp_circ_config_info($c,fea_box_outline_width)}}]} {
      set this_box_outline_width $temp_circ_config_info($c,fea_box_outline_width)
      $c itemconfigure $e.box -width $this_box_outline_width
      if { $this_box_outline_width == 0} {
        $c itemconfigure $e.box -outline {}
        $c bind $e <<Colors>> [lreplace [$c bind $e <<Colors>>] 3 3 {}]
      }
      #dict set gformat_dict circ_fea_label_box_outline_width $this_box_outline_width
    } 

    if {[info exists temp_circ_config_info($c,fea_label_subst)] && $temp_circ_config_info($c,fea_label_subst) ne "multiple" } {
      set label_dict [$c bind $e <<Label>>]
      dict set label_dict fea_label_subst $temp_circ_config_info($c,fea_label_subst)
      $c bind $e <<Label>> $label_dict
      $c itemconfigure $e -text [graphic_map_fea_label_subst $c $e $temp_circ_config_info($c,fea_label_subst)]
      graphic_map_redraw_label_box $c $e
    } 

    if {[info exists temp_circ_config_info($c,fea_fg_color)] && $temp_circ_config_info($c,fea_fg_color) !=-1} {
      set color_list [split $temp_circ_config_info($c,fea_fg_color) ","]
      set this_fea_fg_color [lindex $color_list 0]
      set temp_circ_config_info($c,fea_fg_color) [join [list {*}[lrange $color_list 1 end] $this_fea_fg_color] ","]
      set this_fea_fg_color [process_feature_color  $c $e $this_fea_fg_color]
      $c itemconfigure $tag&&exon&&foreground -outline $this_fea_fg_color -fill $this_fea_fg_color
      $c itemconfigure $tag&&intron&&foreground -outline $this_fea_fg_color -fill $this_fea_fg_color
      $c itemconfigure $tag&&foreground&&fwd_arrow -fill $this_fea_fg_color
      $c itemconfigure $tag&&foreground&&rev_arrow -fill $this_fea_fg_color 
      $c bind $tag <<Colors>> [lreplace [$c bind $tag <<Colors>>] 0 0 $this_fea_fg_color]

      dict set gformat_dict graphic_fg_color_[$c bind $tag <<Direction>>] $this_fea_fg_color
      if {[winfo exists $t]} {
        #$t tag configure $e -foreground $this_fea_fg_color
        $t tag configure $e -background $this_fea_fg_color -foreground [process_feature_color $c $e vis+fill_color+black+white]
      }
    } else {
      set this_fea_fg_color [$c itemcget $tag&&foreground&&exon -outline]
    }


    if {[info exists temp_circ_config_info($c,fea_bg_color)] &&  $temp_circ_config_info($c,fea_bg_color) !=-1} {
      set this_fea_bg_color  [process_feature_color  $c $e $temp_circ_config_info($c,fea_bg_color)]
      $c itemconfigure $tag&&exon&&outline -outline $this_fea_bg_color -fill  $this_fea_bg_color
      $c itemconfigure $tag&&intron&&outline -outline $this_fea_bg_color -fill  $this_fea_bg_color
      $c itemconfigure $tag&&outline&&fwd_arrow -outline $this_fea_bg_color 
      $c itemconfigure $tag&&outline&&rev_arrow -outline $this_fea_bg_color 
      $c bind $tag <<Colors>> [lreplace [$c bind $tag <<Colors>>] 2 2 $this_fea_bg_color]
      dict set gformat_dict outline_color_$direction $this_fea_bg_color
    }

    if {[info exists temp_circ_config_info($c,fea_width)] && ![catch {expr {1*$temp_circ_config_info($c,fea_width)}}]} {
      set fea_outline [expr {([$c itemcget $tag&&outline&&exon -width] - [$c itemcget $tag&&foreground&&exon -width]) /2}]
      $c itemconfigure $tag&&foreground&&exon -width [expr {$temp_circ_config_info($c,fea_width)}]
      set this_fea_width $temp_circ_config_info($c,fea_width)
      $c itemconfigure $tag&&outline&&exon -width [expr {$this_fea_width + 2 * $fea_outline}]
      $c itemconfigure $tag&&outline&&fwd_arrow -width [expr {2 * $fea_outline}]
      $c itemconfigure $tag&&outline&&rev_arrow -width [expr {2 * $fea_outline}]
    } else {
      set this_fea_width [$c itemcget $tag&&foreground&&exon -width]
    }
    dict set gformat_dict width $this_fea_width
    if {[info exists temp_circ_config_info($c,fea_outline)] &&![catch {expr {1*$temp_circ_config_info($c,fea_outline)}}]} {
      $c itemconfigure $tag&&outline&&exon -width [expr {$this_fea_width + 2 * $temp_circ_config_info($c,fea_outline)}]
      $c itemconfigure $tag&&outline&&fwd_arrow -width [expr {2 * $temp_circ_config_info($c,fea_outline)}]
      $c itemconfigure $tag&&outline&&rev_arrow -width [expr {2 * $temp_circ_config_info($c,fea_outline)}]
      dict set gformat_dict outline_width $temp_circ_config_info($c,fea_outline)
    }
    if {[info exists temp_circ_config_info($c,fea_outline)] && ![catch {expr {1*$temp_circ_config_info($c,fea_outline)}}] || [info exists temp_circ_config_info($c,fea_width)] && ![catch {expr {1* $temp_circ_config_info($c,fea_width)}}] } {
      set redraw 1
    }

    # circular intron configure here
    # fg and bg color are set to the main fg and bg color above, so will only be different if explicitly set to be different
    if {[$c find withtag $tag&&intron] != [list]} {
      if {[info exists temp_circ_config_info($c,fea_intron_fg_color)] && $temp_circ_config_info($c,fea_intron_fg_color) !=-1} {
        set color_list [split $temp_circ_config_info($c,fea_intron_fg_color) ","]
        set this_fea_intron_fg_color [lindex $color_list 0]
        set temp_circ_config_info($c,fea_intron_fg_color) [join [list {*}[lrange $color_list 1 end] $this_fea_intron_fg_color] ","]
        set this_fea_intron_fg_color [process_feature_color  $c $e $this_fea_intron_fg_color]
        $c itemconfigure $tag&&intron&&foreground -outline $this_fea_intron_fg_color
        #$c bind $tag <<Colors>> [lreplace [$c bind $tag <<Colors>>] xxx xxx $this_fea_intron_fg_color]
        dict set gformat_dict intron_fg_color_$direction $this_fea_intron_fg_color
      } else {
        set this_fea_intron_fg_color [$c itemcget $tag&&foreground&&intron -outline]
      }

      if {[info exists temp_circ_config_info($c,fea_intron_bg_color)] &&  $temp_circ_config_info($c,fea_intron_bg_color) !=-1} {
        set this_fea_intron_bg_color  [process_feature_color  $c $e $temp_circ_config_info($c,fea_intron_bg_color)]
        $c itemconfigure $tag&&intron&&outline -outline $this_fea_intron_bg_color -fill  $this_fea_intron_bg_color
        #$c bind $tag <<Colors>> [lreplace [$c bind $tag <<Colors>>] xxx xxx $this_fea_intron_bg_color]
        dict set gformat_dict intron_outline_color_$direction $this_fea_intron_bg_color
      }

      if {[info exists temp_circ_config_info($c,fea_intron_width)] && ![catch {expr {1*$temp_circ_config_info($c,fea_intron_width)}}]} {
        $c itemconfigure $tag&&foreground&&intron -width [expr {$temp_circ_config_info($c,fea_intron_width)}]
        set this_fea_intron_width $temp_circ_config_info($c,fea_intron_width)
      } else {
        set this_fea_intron_width [$c itemcget $tag&&foreground&&intron -width]
      }
      dict set gformat_dict intron_width $this_fea_intron_width

      if {[info exists temp_circ_config_info($c,fea_intron_height)] && ![catch {expr {1*$temp_circ_config_info($c,fea_intron_height)}}]} {
        set r_0 [lindex [$c coords [lindex [$c find withtag $tag&&exon&&foreground] 0]] 2]
        set ri [expr {(1-2 * $direction ) * (max(0,($this_fea_width- $this_fea_intron_width)) *  $temp_circ_config_info($c,fea_intron_height) ) + $r_0}]
        foreach intron_item [$c find withtag $tag&&intron] {
          $c coords $intron_item -$ri -$ri $ri $ri
        }
        dict set gformat_dict intron_height $temp_circ_config_info($c,fea_intron_height)
      } 

      if {[info exists temp_circ_config_info($c,fea_intron_outline)] &&![catch {expr {1*$temp_circ_config_info($c,fea_intron_outline)}}]} {
        $c itemconfigure $tag&&outline&&intron -width [expr {$this_fea_intron_width + 2 * $temp_circ_config_info($c,fea_intron_outline)}]
        dict set gformat_dict intron_outline_width $temp_circ_config_info($c,fea_intron_outline)
      }
    }


    if {[info exists temp_circ_config_info($c,fea_label_align)] && $temp_circ_config_info($c,fea_label_align) ne "---"} {
      set this_label_align $temp_circ_config_info($c,fea_label_align)
      dict set gformat_dict circular_label_align $this_label_align
      dict set label_dict fea_label_align $this_label_align
      $c bind $e <<Label>> $label_dict
      ## move the tick and connctor coords here
      circular_map_set_alignment $c $e
    } 

    set new_label_color ""
    if {[info exists temp_circ_config_info($c,fea_label_color)] && $temp_circ_config_info($c,fea_label_color) != -1&& $temp_circ_config_info($c,fea_label_color) != 0} {
      set new_label_color [process_feature_color  $c $e $temp_circ_config_info($c,fea_label_color)]
    } 
    if {$new_label_color != ""} {
      $c itemconfigure $e -fill $new_label_color
      #$c itemconfigure [$c find withtag $e.connector] -fill $new_label_color
      #$c itemconfigure [$c find withtag $e.tick] -fill $new_label_color
      $c itemconfigure $tag&&circular_label -fill $new_label_color
      $c bind $e <<Colors>> [lreplace [$c bind $e <<Colors>>] 0 0 $new_label_color]
      dict set gformat_dict circular_label_color_$direction $new_label_color
      #if {[winfo exists $t]} {
       # $t tag configure $e -foreground $new_label_color
      #}
    }

    set new_tick_color ""
    if {[info exists temp_circ_config_info($c,fea_tick_color)] && $temp_circ_config_info($c,fea_tick_color) != 0 && $temp_circ_config_info($c,fea_tick_color) != -1} {
      set new_tick_color [process_feature_color  $c $e $temp_circ_config_info($c,fea_tick_color)]
    } 
    if {$new_tick_color != ""} {
      $c itemconfigure $tag&&connector -fill $new_tick_color
      $c itemconfigure $tag&&tick -fill $new_tick_color
      $c itemconfigure $tag&&connector_aa -fill [mix_color $new_tick_color [$c cget -background] $info(antialias_percent)]
      $c itemconfigure $tag&&tick_aa -fill  [mix_color $new_tick_color [$c cget -background] $info(antialias_percent)]
      $c bind $e <<Colors>> [lreplace [$c bind $e <<Colors>>] 2 2 $new_tick_color]
      dict set gformat_dict circular_tick_color_$direction $new_tick_color
    }


    if {[info exists temp_circ_config_info($c,fea_tick_width)] && ![catch {expr {1*$temp_circ_config_info($c,fea_tick_width)}}]} {
      set this_tick_width $temp_circ_config_info($c,fea_tick_width)
      $c itemconfigure $tag&&connector -width $this_tick_width
      $c itemconfigure $tag&&tick -width $this_tick_width
      $c itemconfigure $tag&&connector_aa -width [expr {$info(antialias_width) + $this_tick_width}]
      $c itemconfigure $tag&&tick_aa -width [expr {$info(antialias_width) + $this_tick_width}]
      dict set gformat_dict circular_tick_width $this_tick_width
    } 

    if {[info exists temp_circ_config_info($c,fea_tick_length)] && ![catch {expr {1*$temp_circ_config_info($c,fea_tick_length)}}]} {
      set this_tick_length $temp_circ_config_info($c,fea_tick_length)
      dict set gformat_dict circular_tick_length $this_tick_length
      dict set label_dict fea_tick_length $this_tick_length
      $c bind $e <<Label>> $label_dict
    } 

    if {[info exists temp_circ_config_info($c,fea_label_show_connector)]} {
      set show_connector $temp_circ_config_info($c,fea_label_show_connector)
      if {$show_connector} {
        $c itemconfigure $tag&&connector -state ""
        if {$info(antialias_show)} {
          $c itemconfigure $tag&&connector_aa -state ""
        }
      } else {
        $c itemconfigure $tag&&connector -state "hidden"
        $c itemconfigure $tag&&connector_aa -state "hidden"
      }
      dict set label_dict show_connector $show_connector
      dict set gformat_dict circular_show_connector $show_connector
      $c bind $e <<Label>> $label_dict
    }

    ## this has to be after label align, since it's the redraw of the circular features
    if {$new_font ne {} || [info exists temp_circ_config_info($c,fea_label_align)] && $temp_circ_config_info($c,fea_label_align) ne "---"} {
      canvas_circular_text $c $tag {}
    }

    if {[dict exists $gformat_dict arrow_data]} {
      set arrow_list [dict get $gformat_dict arrow_data]
      if {[info exists temp_circ_config_info($c,fea_f_arrow)] && $temp_circ_config_info($c,fea_f_arrow) != -1} {
        lset arrow_list 0 $temp_circ_config_info($c,fea_f_arrow)
        set redraw 1
      }
      if {[info exists temp_circ_config_info($c,fea_r_arrow)] && $temp_circ_config_info($c,fea_r_arrow) != -1} {
        lset arrow_list 1 $temp_circ_config_info($c,fea_r_arrow)
        set redraw 1
      }
      $c bind $tag <<Arrow_list>> $arrow_list
      dict set gformat_dict arrow_data $arrow_list
    }
 
    $c bind $tag <<Gformat>> $gformat_dict
    graphic_map_redraw_label_box $c $e
    if {[info exists temp_circ_config_info($c,apply)] && $temp_circ_config_info($c,apply)} {
      set metadata [$w.textarea tag bind $tag <<Metadata>>]
      lset metadata 1 $gformat_dict
      $w.textarea tag bind $tag <<Metadata>> $metadata
      ## apply fill color to feature
      set revcolors [$w.textarea tag bind $tag <<Revcolors>>]
      lset revcolors $direction $temp_circ_config_info($c,fea_fg_color)
      $w.textarea tag bind $tag <<Revcolors>> $revcolors
      if {[$w.textarea tag cget $tag -background] != {}} {
        textarea_tag_configure $w.textarea $tag -background $temp_circ_config_info($c,fea_fg_color)
      }
      register_undo_separator $w "Edit Feature"
      features_to_tree_view $w
    }
    if {$redraw} {
      #change_radius $c $tag [lindex [$c coords $tag&&foreground&&exon] 2]
      change_radius $c $tag {}
    }
  }
 if {[winfo exists $t]} {
    treeview_sort $t [bind $t <<Sort_column>>] 1
  }
  #rebump moveablelabels
  foreach i [$c find withtag moveablelabel] {
    if {[$c bind $i <<Moved>>] ==""} {
      circular_map_reset_moveablelabel $c $i
    } elseif {[$c itemcget $i -state] ne "hidden"} {
      lassign [$c bbox $i] lx0 ly0 lx1 ly1
      drag_moveablelabel $c $i 0 $lx0 0 $ly0
    }
  }
  ## set last arg to 1 to avoid connectors in bump process
  circular_map_bump_all_moveablelabel $c "" 1
}

################
## 
################
#     $c bind $id <<Colors>> [list $label_color red $tick_color $label_box_outline_color]
proc circular_config_fea_treeview_apply_tag_color_to_label {t c percent dialog {color ""}} {
  global temp_circ_config_info
  foreach e [$t selection] {
    if {$e eq "hidden"} {continue}
    set label_dict [$c bind $e <<Label>>]
    set tag [regsub fn [dict get $label_dict tag] f]
    if {$color eq ""} {
      set color [$c itemcget $tag&&foreground&&exon -outline]
    } 
    set new_label_color [mix_color $color $temp_circ_config_info($c,fea_label_color) $percent]
    $c itemconfigure $e -fill $new_label_color
    $c itemconfigure $tag&&circular_label -fill $new_label_color
    $c bind $e <<Colors>> [lreplace [$c bind $e <<Colors>>] 0 0 $new_label_color]
    #$t tag configure $e -foreground $new_label_color
    set gformat_dict [$c bind $tag <<Gformat>>]
    set direction [$c bind $tag <<Direction>>]
    dict set gformat_dict circular_label_color_$direction $new_label_color
    $c bind $tag <<Gformat>> $gformat_dict
  }
  circular_config_fea_treeview_manageselection $t $c $dialog
}

################
## 
################
proc circular_config_fea_treeview_apply_tag_color_to_tick {t c percent dialog {color ""}} {
  global temp_circ_config_info info
  foreach e [$t selection] {
    if {$e eq "hidden"} {continue}
    set label_dict [$c bind $e <<Label>>]
    set tag [regsub fn [dict get $label_dict tag] f]
    if {$color eq ""} {
      set color [$c itemcget $tag&&foreground&&exon -outline]
    } 
    set new_label_color [mix_color $color $temp_circ_config_info($c,fea_label_color) $percent]
    $c itemconfigure [$c find withtag $e.connector] -fill $new_label_color
    $c itemconfigure [$c find withtag $e.tick]  -fill $new_label_color
    $c itemconfigure [$c find withtag $e.connector_aa] -fill [mix_color $new_label_color [$c cget -background] $info(antialias_percent)]
    $c itemconfigure [$c find withtag $e.tick_aa]  -fill [mix_color $new_label_color [$c cget -background] $info(antialias_percent)]
    $c bind $e <<Colors>> [lreplace [$c bind $e <<Colors>>] 2 2 $new_label_color]
    set gformat_dict [$c bind $tag <<Gformat>>]
    set direction [$c bind $tag <<Direction>>]
    dict set gformat_dict circular_tick_color_$direction $new_label_color
    $c bind $tag <<Gformat>> $gformat_dict
  }
  circular_config_fea_treeview_manageselection $t $c $dialog
}


################
## 
################
proc circular_config_fea_treeview_apply_tag_color_to_outline {t c percent dialog} {
  global temp_circ_config_info
  foreach e [$t selection] {
    if {$e eq "hidden"} {continue}
    set label_dict [$c bind $e <<Label>>]
    set tag [regsub fn [dict get $label_dict tag] f]
    set gformat_dict [$c bind $tag <<Gformat>>]
    set this_fea_fg_color [$c itemcget $tag&&foreground&&exon -outline]
    set this_fea_bg_color [mix_color $this_fea_fg_color $temp_circ_config_info($c,fea_bg_color) $percent]
    $c itemconfigure $tag&&outline -outline $this_fea_bg_color -fill  $this_fea_bg_color
    $c bind $tag <<Colors>> [lreplace [$c bind $tag <<Colors>>] 2 2 $this_fea_bg_color]
    set direction [$c bind $tag <<Direction>>]
    dict set gformat_dict outline_color_$direction $this_fea_bg_color
    $c bind $tag <<Gformat>> $gformat_dict
  }
  circular_config_fea_treeview_manageselection $t $c $dialog
}

################
## 
################
proc circular_config_fea_treeview_apply_tag_properties_to_intron {t c  dialog} {
  global temp_circ_config_info
  foreach e [$t selection] {
    set label_dict [$c bind $e <<Label>>]
    set tag [regsub fn [dict get $label_dict tag] f]
    if {[$c find withtag $tag&&intron] != [list]} {
      set gformat_dict [$c bind $tag <<Gformat>>]

      set this_fea_outline [expr {([$c itemcget $tag&&outline&&exon -width] - [$c itemcget $tag&&foreground&&exon -width]) /2}]
      set this_fea_intron_width [$c itemcget [lindex [$c find withtag $tag&&foreground&&intron] 0] -width]
      $c itemconfigure $tag&&outline&&intron -width [expr {$this_fea_intron_width + 2 * $this_fea_outline}]
      dict set gformat_dict intron_outline_width  $this_fea_outline

      set direction [$c bind $tag <<Direction>>]
      set this_fea_fg_color [$c itemcget $tag&&foreground&&exon -outline]
      $c itemconfigure $tag&&intron&&foreground -outline $this_fea_fg_color
      dict set gformat_dict intron_fg_color_$direction $this_fea_fg_color

      set this_fea_bg_color [$c itemcget $tag&&outline&&exon -outline]
      $c itemconfigure $tag&&intron&&outline -outline $this_fea_bg_color -fill  $this_fea_bg_color
      dict set gformat_dict intron_outline_color_$direction $this_fea_bg_color

      $c bind $tag <<Gformat>> $gformat_dict
    }
  }
  circular_config_fea_treeview_manageselection $t $c $dialog
}

################
## 
################
#color_pattern: mix+fg_color+black+20
#color pattern vis+reference_color+option_color+option_color vis+box_color+black+white
proc process_feature_color  {c e color_pattern} {

  if {$e eq "hidden"} {return {}}
  if {![catch {winfo rgb . $color_pattern}] || $color_pattern =={} } {
    return $color_pattern
  }
  set label_dict [$c bind $e <<Label>>]
  set box_item [$c find withtag $e.box]
  set tag [regsub fn [dict get $label_dict tag] f]
  set gformat_dict [$c bind $tag <<Gformat>>]
  if {[$c type 1] eq "oval"} {
    set this_fea_fg_color [$c itemcget $tag&&foreground&&exon -outline]
  } else {
    set this_fea_fg_color [$c itemcget $tag&&foreground&&exon -fill]
  }
  set this_fea_bg_color [$c itemcget $tag&&outline&&exon -outline]
  set this_fea_label_color [$c itemcget $e -fill]
  set fea_box_fill_color [$c itemcget $box_item -fill]
  regsub -all {fg_color|fill_color} $color_pattern $this_fea_fg_color color_pattern
  regsub -all {bg_color|outline_color} $color_pattern $this_fea_bg_color color_pattern
  regsub -all {text_color|label_color} $color_pattern $this_fea_label_color color_pattern
  regsub -all {box_color} $color_pattern $fea_box_fill_color color_pattern

  switch -regexp  -nocase -matchvar match_list $color_pattern {
    {mix\+([^+]+)\+([^+]+)\+([0-9]+)} {
      lassign $match_list -- color1 color2 percent
      set return [mix_color $color1 $color2 $percent]
      if {![catch {winfo rgb . $return} err]} {
        return $return
      } else {
        sputs bad process color $err
        return  #888
      }
        
    }
    {vis\+([^+]+)\+([^+]+)\+([^+]+)} {
      lassign $match_list -- color1 color2 color3
      if {[catch {luminance $color1} lum1] || [catch {luminance $color2} lum2] || [catch {luminance $color3} lum3]} {
        return #888
      } else {
        if {[expr {abs($lum1-$lum2) > abs($lum1 - $lum3)}]} {
          return $color2
        } else {
          return $color3
        }
      } 
    }
    default {
      if {![catch {winfo rgb . $color_pattern} err]} {
        return $color_pattern
      } else {
        sputs bad process color $err
        return  #888
      }
    }
  }
}


################
## set circular map feature and feature label moves
################
##  move modes are pixels relative to current position (pixel_r). pixel_a are absolute moves, not implemented here)
proc circular_config_fea_treeview_apply_move {e_list c value obj mode} {
  foreach e $e_list {
    if {$e eq "hidden"} {continue}
    set label_dict [$c bind $e <<Label>>]
    set tag [regsub fn [dict get $label_dict tag] f]
    if {$obj eq "f"} {
      #move feature
      if {$mode eq "p"} {
        #pixel move
        circular_config_set_feature_radius $c $tag pixel_r $value
      } else {
        #width move
        circular_config_set_feature_radius $c $tag width $value
      }
    } elseif {$obj eq "l"} { 
      #move label
      if {$mode eq "p"} {
        #pixel move
        circular_config_set_label_radius $c $tag $value baseline
      } else {
        #width move
        circular_config_set_label_radius $c $tag  $value feature
        if { [$c itemcget $e -state] ne "hidden"} {
          ## reset linear labels to base position relative to the tick if the label is linear
          if {$value ==0} {
            circular_map_reset_moveablelabel $c $e 0
          } elseif {$value ==-1} {
            circular_map_reset_moveablelabel $c $e -.01
          }
          $c bind $e <<Moved>> 1
        }
      }
    } elseif {$obj eq "t"} {
      if {1} {
        if {$mode eq "p"} {
          #pixel relative to baseline
          circular_map_move_label_tick $c $e $value
          dict set label_dict tick_anchor_raduis $value
        } elseif {$mode eq "r"} {
          #pixel move relative to current tick position
          set r0 [lindex [$c coords 1] 2] 
          lassign [$c coords $e.tick] tx1 ty1 tx2 ty2
          set tick_r [expr {sqrt($tx1*$tx1+$ty1*$ty1)}]
          circular_map_move_label_tick $c $e [expr {$tick_r-$r0+$value}]
        } elseif {$mode eq "w"} {
          #width move relative to baseline
          if {[set feature_width [expr {[$c itemcget exon&&outline&&$tag -width] }]] ne {}} {
            circular_map_move_label_tick $c $e [expr {$value*$feature_width}]
            dict set label_dict tick_anchor_raduis [expr {$value*$feature_width}]
          }
        } elseif {$mode eq "f"} {
          #move/reset tick to feature center
          set r0 [lindex [$c coords 1] 2] 
          set r1 [lindex [$c coords [lindex [$c find withtag $tag&&exon] 0]] 2]
          circular_map_move_label_tick $c $e [expr {$r1-$r0}]
          dict set label_dict tick_anchor_raduis {}
        }
        $c bind $e <<Label>> $label_dict
      }
    }
  }
}

################
## set circular map enzyme label locations
################
proc circular_config_enz_treeview_apply_move {e_list c value obj} {
  foreach e $e_list {
    if {$e eq "hidden"} {continue}
    if {$obj eq "l"} { 
      #move label
      circular_map_reset_moveablelabel $c $e $value
       $c bind $e <<Moved>> 1
    } elseif {$obj eq "t"} {
      if { [$c itemcget $e -state] ne "hidden"} {
        circular_map_move_label_tick $c $e $value
      }
    } elseif {$obj eq "tr"} {
      #pixel move relative to current tick position
      set r0 [lindex [$c coords 1] 2] 
      lassign [$c coords $e.tick] tx1 ty1 tx2 ty2
      set tick_r [expr {sqrt($tx1*$tx1+$ty1*$ty1)}]
      circular_map_move_label_tick $c $e [expr {$tick_r-$r0+$value}]
    }
  }
}

################
## 
################
proc circular_config_formatting_to_seq {c} {
  global info undo
  
  #set w [bind $c <<Window>>]
  set w $info([winfo toplevel $c],linked_windows)
  if { $w == {}} {tk_messageBox -message [mc "The window this map refers to has been modified. The formatting can't be applied."];return}
  set edited 0
  set radius [lindex [$c coords [$c find withtag circle]] 2]
  
  foreach tag [lsearch -inline -all -regexp [$w.textarea tag names] {f[0-9]+#}] {
    set gformat_dict  [$c bind $tag <<Gformat>>]
    if {$gformat_dict  == {}} {continue}
    
    ## add feature realtive radius (in points from map circle) to gformat_dict here
    set feature_radius [lindex [$c coords [lindex [$c find withtag exon&&$tag] 0]] 2] 
    dict set gformat_dict feature_relative_radius [expr {$feature_radius - $radius}]

    ## add feature arc text radius to gformat_dict here
    if {[$c find withtag $tag&&circular_label] != {}} {
      lassign  [$c coords $tag&&circular_label] lx ly
      dict set gformat_dict arc_text_offset [expr {sqrt($lx*$lx+$ly*$ly)  -$feature_radius}]
    } else {
      dict set gformat_dict use_arc 0
      dict set gformat_dict arc_text_offset 0
    }

    ## add feature label pos x,y to gformat_dict here
    #if {[set item [$c find withtag $tag&&moveablelabel]] !={} && [$c bind $item <<Moved>>] == 1} {
    #  foreach {lx1 ly1 lx2 ly2} [$c bbox $item] {}
    #  if {[info exists lx1]} {
    #    dict set gformat_dict circular_label_pos [expr {$lx1 / $radius}] [expr {$ly1 / $radius}]
    #  }
    #}

    ## add feature label pos angle and r relative to tick to gformat_dict here
    if {[set item [$c find withtag $tag&&moveablelabel]] !={} && [$c bind $item <<Moved>>] == 1 && [$c bind $tag <<Coord_list>>] ne [list]} {
        lassign [$c coords $item] x0 y0 x1 y1
        set text_r [expr {sqrt($x0 *$x0 + $y0 * $y0) / $radius}]
        set text_a [expr {acos(-$y0 /sqrt($x0 *$x0 + $y0 * $y0)) /pi()*180.0}]
        if {$x0 < 0} {
          set text_a [expr {360.0 -$text_a}]
        }
        set coord_list [$c bind $tag <<Coord_list>>]
        set feature_center_angle  [expr {([lindex $coord_list 0] + [lindex $coord_list end-1] + [lindex $coord_list end])*-1 / 2.0 +90}]
        set text_a [expr {$text_a- $feature_center_angle}]
        dict set gformat_dict circular_label_polar_pos [list $text_r $text_a]
    }

    ## Replace the gformat data in the sequence
    set metadata [$w.textarea tag bind $tag <<Metadata>>]
    set old_gformat_dict [lindex $metadata 1]
    set new_gformat_dict [dict merge $old_gformat_dict $gformat_dict]
    if {$old_gformat_dict  != $new_gformat_dict} {
      lset metadata 1 $new_gformat_dict
      textarea_tag_bind $w.textarea $tag <<Metadata>> $metadata
      set edited 1
    }

    ## NOT USED apply fill color to feature - move this to a separate function, also apply show/hide from map to sequence as a separate function
    if {0 && [set old_bg_color [$w.textarea tag cget $tag -background]] != {}} {
      set fea_fg_color [$c itemcget [$c find withtag exon&&foreground&&$tag] -outline]
      if {$old_bg_color != $fea_fg_color} {
        set revcolors [$w.textarea tag bind $tag <<Revcolors>>]
        lset revcolors $direction $fea_fg_color
        $w.textarea tag bind $tag <<Revcolors>> $revcolors
	textarea_tag_configure $w.textarea $tag -background $fea_fg_color
        set edited 1
      }
    }
  }
  if {$edited} {
    features_to_tree_view $w
    register_undo_separator $w "Save Formatting to Features"
  }
  ## add baseline, crosshair and index data here
  set seq_gformat_dict $info($w,gformat_data)
  set seq_gformat_dict [dict merge $seq_gformat_dict [$c bind 1 <<Tick_dict>>]]
  dict set seq_gformat_dict circular_baseline_fg_width [$c itemcget circle -width]
  dict set seq_gformat_dict circular_baseline_bg_width [expr {([$c itemcget circle_background -width] - [$c itemcget circle -width])/2 }]
  dict set seq_gformat_dict circular_baseline_bg_color [$c itemcget circle_background -outline]
  dict set seq_gformat_dict circular_baseline_fg_color [$c itemcget circle -outline]
  dict set seq_gformat_dict circular_crosshair_length [expr {[lindex [$c coords crosshair&&vert] 3]/ $radius}]
  dict set seq_gformat_dict circular_crosshair_fg_width [$c itemcget crosshair -width]
  dict set seq_gformat_dict circular_crosshair_bg_width [expr {([$c itemcget crosshair_background -width] - [$c itemcget crosshair -width])/2 }]
  dict set seq_gformat_dict circular_crosshair_bg_color [$c itemcget crosshair_background -fill]
  dict set seq_gformat_dict circular_crosshair_fg_color [$c itemcget crosshair -fill]
  lappend undo(undo,$w) [list set info($w,gformat_data) $info($w,gformat_data)]
  set info($w,gformat_data) $seq_gformat_dict
  register_undo_separator $w "Save Map Format to Sequence"
}

################
## 
################
proc linear_config_fea_treeview_apply_tag_color_to_label {t c percent dialog} {
  global temp_linear_config_info
  if {$temp_linear_config_info($c,fea_label_color) == -1} {return}
  foreach e [$t selection] {
    if {$e eq "hidden"} {continue}
    set label_dict [$c bind $e <<Label>>]
    set tag [regsub fn [dict get $label_dict tag] f]
    set this_fea_fg_color [$c itemcget $tag&&foreground&&exon -fill]
    set new_label_color [mix_color $this_fea_fg_color $temp_linear_config_info($c,fea_label_color) $percent]
    $c itemconfigure $e -fill $new_label_color
    $c bind $e <<Colors>> [lreplace [$c bind $e <<Colors>>] 0 0 $new_label_color]
    #$t tag configure $e -foreground $new_label_color
    set gformat_dict [$c bind $tag <<Gformat>>]
    set direction [$c bind $tag <<Direction>>]
    dict set gformat_dict linear_label_color_$direction $new_label_color
    $c bind $tag <<Gformat>> $gformat_dict
  }
  linear_config_fea_treeview_manageselection $t $c $dialog
}

################
## 
################
proc linear_config_fea_treeview_apply_tag_color_to_outline {t c percent dialog} {
  global temp_linear_config_info
  if {$temp_linear_config_info($c,fea_bg_color) == -1} {return}
  foreach e [$t selection] {
    if {$e eq "hidden"} {continue}
    set label_dict [$c bind $e <<Label>>]
    set tag [regsub fn [dict get $label_dict tag] f]
    set gformat_dict [$c bind $tag <<Gformat>>]
    set this_fea_fg_color [$c itemcget $tag&&foreground&&exon -fill]
    set this_fea_bg_color [mix_color $this_fea_fg_color $temp_linear_config_info($c,fea_bg_color) $percent]
    $c itemconfigure $tag&&exon&&outline -outline $this_fea_bg_color -fill  $this_fea_bg_color
    $c itemconfigure $tag&&fwd_arrow&&outline -outline $this_fea_bg_color -fill  $this_fea_bg_color
    $c itemconfigure $tag&&rev_arrow&&outline -outline $this_fea_bg_color -fill  $this_fea_bg_color
    $c bind $tag <<Colors>> [lreplace [$c bind $tag <<Colors>>] 2 2 $this_fea_bg_color]
    set direction [$c bind $tag <<Direction>>]
    dict set gformat_dict outline_color_$direction $this_fea_bg_color
    $c bind $tag <<Gformat>> $gformat_dict
  }
  linear_config_fea_treeview_manageselection $t $c $dialog
}

################
## Linear Configure dialog
################
proc linear_map_configure_dialog {c item} {
  global info temp_linear_config_info  dialogblock ok  enz_list fea_list

  set w [winfo toplevel $c]
  if {!$info(android)} {
    if {[winfo exists $w.f_config]} {
      regexp {([0-9]+)x([0-9]+)} [wm geometry $w] - width height
      wm geometry $w "$width\x[expr {min([winfo screenheight $w], $height + [winfo height $w.f_config])}]"
      grid configure $w.f_config
      return
    }
    grid [set dialog [frame $w.f_config]] -row 3 -column 0 -sticky nswe
    bind $w.f_config <Destroy> "array unset temp_linear_config_info $c,*"
    bind $dialog <<OK>> "grid remove $dialog; regexp {(\[0-9\]+)x(\[0-9\]+)} \[wm geometry $w\] - width height; wm geometry $w \"\$width\\x\[expr {\$height - \[winfo height $w.f_config\]}\]\"; unset -nocomplain width height"
  } else {
    if {$dialogblock == 1} {return}
    set dialog [new_dialog $w "Configure Map..." "CONFIGURE"]
    bind $dialog <<OK>> "set ok 1"
  }
  bind $dialog <<Cancel>> "set ok -1"



  grid [ttk::notebook $dialog.tabframe] -row 0 -column 0 -sticky nswe

  set active_tab texts
  set active_item 0

  ############## texts frame
  $dialog.tabframe add [ttk::frame $dialog.tabframe.texts -relief flat] -text [mc "Texts"] -sticky nswe
  grid columnconfigure $dialog.tabframe.texts 0 -weight 1
  grid rowconfigure $dialog.tabframe.texts 0 -weight 1

  grid [ttk::frame $dialog.tabframe.texts.frame1 -relief flat] -row 0 -column 0 -sticky nswe
  set f $dialog.tabframe.texts.frame1
  
  set t $f.tv
  set sc $f.sc
  ttk::treeview $t -yscrollcommand "optionscrollbar $sc" -height 5
  scrollbar $sc -orient vertical -command "$t yview" -width 15
  grid $f.tv -row 0 -column 0  -sticky nsew
  grid $f.sc -row 0 -column 1 -sticky nsw
  grid columnconfigure $f 0 -weight 1
  grid rowconfigure $f 0 -weight 1
  grid columnconfigure $f 1 -minsize 17


  $t heading #0 -text [mc "Text"] -command ""
  $t column #0 -width 200 -minwidth 50 -stretch 1 -anchor e

  $t configure -columns {blank} -displaycolumns {blank}
  $t heading blank -text ""
  $t column blank -width 260 -minwidth 50 -stretch 1 -anchor c

  bind $t <<TreeviewSelect>> "linear_config_text_treeview_manageselection $t $c $dialog; #$dialog.tabframe.texts.frame2.b1 configure -state disabled"
  bind $t <<OldSelection>> {}
  $t tag configure sel -background $info(text_select_bg_color)
  bind $t <Button-2> "sputs button2 \[$t identify column %x %y]  \[$t identify row %x %y];# can use identify item when 8.6 is available"
  bind $t <<RightClick>> "sputs enzyme gm table_rightclick $w %x %y"

  grid [ttk::frame $dialog.tabframe.texts.frame2 -relief ridge -borderwidth 2] -row 1 -column 0 -sticky swe
  #grid [button $dialog.tabframe.texts.frame2.b1 -text [mc "Apply"] -command "event generate $dialog <<raise>>; linear_config_text_treeview_apply $t $c"] -row 0 -column 0 -sticky we
  #button $dialog.tabframe.texts.frame2.b1
  bind $dialog <<changed_text>> "linear_config_text_treeview_apply $t $c"

  grid [ttk::frame $dialog.tabframe.texts.frame3 -relief ridge -borderwidth 2] -row 2 -column 0 -sticky swe
  grid [ttk::frame $dialog.tabframe.texts.frame3_dummy -relief ridge -borderwidth 2] -row 2 -column 0 -sticky nswe

  grid [checkbutton $dialog.tabframe.texts.frame3.visible -text [mc "Visible"] -variable temp_linear_config_info($c,text_visible) -command "if {\[info exists temp_linear_config_info($c,text_visible)\]} {event generate $dialog <<changed_text>>}" ] -row 0 -column 1 -columnspan 2 -sticky nw
  grid [ttk::label $dialog.tabframe.texts.frame3.fontfam_label -text [mc "Text:"]] -row 1 -column 1 -sticky nw
    set temp_linear_config_info($c,text_label_color) #000000
  grid [color_button $dialog.tabframe.texts.frame3.label_color temp_linear_config_info($c,text_label_color) 18] -row 1 -column 2 -sticky nw
  bind $dialog.tabframe.texts.frame3.label_color <<color_picked>> "event generate $dialog <<changed_text>>"
  grid [menubutton $dialog.tabframe.texts.frame3.fontfam -menu $dialog.tabframe.texts.frame3.fontfam.menu -textvariable temp_linear_config_info($c,text_fontfamily)] -row 1 -column 3 -sticky nw
   menu $dialog.tabframe.texts.frame3.fontfam.menu
    if {[llength $info(allfontlist)] <= 20} {
      foreach fontfam $info(allfontlist) {
        $dialog.tabframe.texts.frame3.fontfam.menu add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable temp_linear_config_info($c,text_fontfamily) -command "event generate $dialog <<changed_text>>";# -font [list $fontfam 10]
      }
    } else {
      for {set fi 0} {$fi < [llength $info(allfontlist)]} {incr fi 20} {
        if {[set fj [expr {$fi + 19}]] > [llength $info(allfontlist)]} {set fj [expr {[llength $info(allfontlist)]-1}]}
        $dialog.tabframe.texts.frame3.fontfam.menu add cascade -label "[lindex $info(allfontlist) $fi]-[lindex $info(allfontlist) $fj]" -menu $dialog.tabframe.texts.frame3.fontfam.menu.menu$fi 
        menu $dialog.tabframe.texts.frame3.fontfam.menu.menu$fi
        foreach fontfam [lrange $info(allfontlist) $fi $fj] {
          $dialog.tabframe.texts.frame3.fontfam.menu.menu$fi add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable temp_linear_config_info($c,text_fontfamily) -command "event generate $dialog <<changed_text>>";# -font [list $fontfam 10]
        }
      }
    }
  grid [menubutton $dialog.tabframe.texts.frame3.fontsiz -menu $dialog.tabframe.texts.frame3.fontsiz.menu -textvariable temp_linear_config_info($c,text_fontsize)] -row 1 -column 4 -sticky nw
  menu $dialog.tabframe.texts.frame3.fontsiz.menu
  foreach fontsize [lsort -unique -integer [concat [list 6 8 9 10 11 12 13 14 16 18 20 24 28 30 32 34 36 40 44 48]]] {
      $dialog.tabframe.texts.frame3.fontsiz.menu add radiobutton -label $fontsize -indicatoron 1 -value $fontsize -variable temp_linear_config_info($c,text_fontsize)  -command "event generate $dialog <<changed_text>>"
  }
  set temp_linear_config_info($c,text_fontfamily) "---"
  set temp_linear_config_info($c,text_fontsize) "---"

  #grid [ttk::label $dialog.tabframe.texts.frame3.label_label -text [mc "Label"]] -row 2 -column 1 -sticky nw
  #grid [entry $dialog.tabframe.texts.frame3.label -text ""] -row 2 -column 2 -columnspan 2 -sticky nw


  #initialize texts settings
  set temp_linear_config_info($c,text_tag_dict) [dict create title [mc "Title"] seqtext [mc "Mouseover Text"]]
  # need to add custom texts here, (if available)
  linear_config_text_fill_treeview $t $c

#$c find withtag enzyme&&label
#$c find withtag feature&&label
#$c find withtag feature&&label&&dir0
#$c bind $id <<Colors>> 
#$c bind $id <<Label>> ($label_dict)
#enzymes: $label_dict:  type name location_start count tag
#features: $label_dict: type name location_start location_end tag direction




  ############ enzymes frame
  $dialog.tabframe add [ttk::frame $dialog.tabframe.enzymes -relief flat] -text [mc "Enzymes"] -sticky nswe
  grid columnconfigure $dialog.tabframe.enzymes 0 -weight 1
  grid rowconfigure $dialog.tabframe.enzymes 0 -weight 1

  grid [ttk::frame $dialog.tabframe.enzymes.frame1 -relief flat] -row 0 -column 0 -sticky nswe
  set f $dialog.tabframe.enzymes.frame1
  
  set t $f.tv
  set sc $f.sc
  ttk::treeview $t -yscrollcommand "optionscrollbar $sc" -height 5
  scrollbar $sc -orient vertical -command "$t yview" -width 15
  grid $f.tv -row 0 -column 0  -sticky nsew
  grid $f.sc -row 0 -column 1 -sticky nsw
  grid columnconfigure $f 0 -weight 1
  grid rowconfigure $f 0 -weight 1
  grid columnconfigure $f 1 -minsize 17

  set column_list {Location Count}
  for {set i 0} {$i < 20} {incr i} {
    lappend column_list [format "g_%03u" $i]
  }
  $t configure -columns $column_list -displaycolumns {Location Count}
  $t heading #0 -text [mc "Enzyme"] -command "treeview_sort $t {}"
  $t column #0 -width 200 -minwidth 50 -stretch 1 -anchor e
  $t heading Location -text [mc "Location  \u2193"] -command "treeview_sort $t Location"
  $t column Location -width 60 -minwidth 50 -stretch 0 -anchor c
  $t heading Count -text Count  -command "treeview_sort $t Count"
  $t column Count -width 150 -minwidth 50 -stretch 1 -anchor c

  bind $t <<TreeviewSelect>> "linear_config_enz_treeview_manageselection $t $c $dialog; $dialog.tabframe.enzymes.frame2.b1 configure -state disabled"
  bind $t <<OldSelection>> {}
  $t tag configure sel -background $info(text_select_bg_color)
  bind $t <<Sort_column>> Location
  bind $t <<Sort_direction>> 1
  bind $t <Button-2> "sputs button2 \[$t identify column %x %y]  \[$t identify row %x %y];# can use identify item when 8.6 is available"
  bind $t <<RightClick>> "sputs enzyme gm table_rightclick $w %x %y"

  grid [ttk::frame $dialog.tabframe.enzymes.frame2 -relief ridge -borderwidth 2] -row 1 -column 0 -sticky swe
  #grid [button $dialog.tabframe.enzymes.frame2.b1 -text [mc "Apply"] -command "event generate $dialog <<changed_enzymes>>; linear_config_enz_treeview_apply $t $c"] -row 0 -column 0 -sticky we
  button $dialog.tabframe.enzymes.frame2.b1
  bind $dialog <<changed_enzymes>> "linear_config_enz_treeview_apply $t $c"

  grid [ttk::frame $dialog.tabframe.enzymes.frame3 -relief ridge -borderwidth 2] -row 2 -column 0 -sticky swe
  grid [ttk::frame $dialog.tabframe.enzymes.frame3_dummy -relief ridge -borderwidth 2] -row 2 -column 0 -sticky nswe

  grid [checkbutton $dialog.tabframe.enzymes.frame3.visible -text [mc "Visible"] -variable temp_linear_config_info($c,enz_visible) -command "if \{\[info exists temp_linear_config_info($c,enz_visible)\]\} \{event generate $dialog <<changed_enzymes>>\}" ] -row 0 -column 1 -columnspan 2 -sticky nw
  grid [ttk::label $dialog.tabframe.enzymes.frame3.fontfam_label -text [mc "Text:"]] -row 1 -column 1 -sticky nw
    set temp_linear_config_info($c,enz_label_color) #000000
  grid [color_button $dialog.tabframe.enzymes.frame3.label_color  temp_linear_config_info($c,enz_label_color) 18] -row 1 -column 2 -sticky nw
  bind $dialog.tabframe.enzymes.frame3.label_color <<color_picked>> "event generate $dialog <<changed_enzymes>>"
  grid [menubutton $dialog.tabframe.enzymes.frame3.fontfam -menu $dialog.tabframe.enzymes.frame3.fontfam.menu -textvariable temp_linear_config_info($c,enz_fontfamily)] -row 1 -column 3 -sticky nw
   menu $dialog.tabframe.enzymes.frame3.fontfam.menu
    if {[llength $info(allfontlist)] <= 20} {
      foreach fontfam $info(allfontlist) {
        $dialog.tabframe.enzymes.frame3.fontfam.menu add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable temp_linear_config_info($c,enz_fontfamily) -command "event generate $dialog <<changed_enzymes>>";# -font [list $fontfam 10]
      }
    } else {
      for {set fi 0} {$fi < [llength $info(allfontlist)]} {incr fi 20} {
        if {[set fj [expr {$fi + 19}]] > [llength $info(allfontlist)]} {set fj [expr {[llength $info(allfontlist)]-1}]}
        $dialog.tabframe.enzymes.frame3.fontfam.menu add cascade -label "[lindex $info(allfontlist) $fi]-[lindex $info(allfontlist) $fj]" -menu $dialog.tabframe.enzymes.frame3.fontfam.menu.menu$fi 
        menu $dialog.tabframe.enzymes.frame3.fontfam.menu.menu$fi
        foreach fontfam [lrange $info(allfontlist) $fi $fj] {
          $dialog.tabframe.enzymes.frame3.fontfam.menu.menu$fi add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable temp_linear_config_info($c,enz_fontfamily) -command "event generate $dialog <<changed_enzymes>>";# -font [list $fontfam 10]
        }
      }
    }
  grid [menubutton $dialog.tabframe.enzymes.frame3.fontsiz -menu $dialog.tabframe.enzymes.frame3.fontsiz.menu -textvariable temp_linear_config_info($c,enz_fontsize)] -row 1 -column 4 -sticky nw
  menu $dialog.tabframe.enzymes.frame3.fontsiz.menu
  foreach fontsize [lsort -unique -integer [concat [list 6 8 9 10 11 12 13 14 16 18 20 24 26 28 30 34 36 40]]] {
      $dialog.tabframe.enzymes.frame3.fontsiz.menu add radiobutton -label $fontsize -indicatoron 1 -value $fontsize -variable temp_linear_config_info($c,enz_fontsize)  -command "event generate $dialog <<changed_enzymes>>"
  }
  set temp_linear_config_info($c,enz_fontfamily) "---"
  set temp_linear_config_info($c,enz_fontsize) "---"



  # label text (name %n, pos%1, count %# variables)
  #grid [ttk::label $dialog.tabframe.enzymes.frame3.label_label -text [mc "Label"]] -row 2 -column 1 -sticky nw
  #grid [entry $dialog.tabframe.enzymes.frame3.label -text ""] -row 2 -column 2 -columnspan 2 -sticky nw


  grid [ttk::label $dialog.tabframe.enzymes.frame3.angle_label -text [mc "Angle"]] -row 1 -column 5 -sticky nw
  grid [menubutton $dialog.tabframe.enzymes.frame3.text_angle -menu $dialog.tabframe.enzymes.frame3.text_angle.menu -textvariable temp_linear_config_info($c,enz_label_angle)] -row 1 -column 6 -sticky nw
  menu $dialog.tabframe.enzymes.frame3.text_angle.menu
  foreach label_angle [lsort -unique -integer [concat [list 0 45 90 270 315]]] {
    $dialog.tabframe.enzymes.frame3.text_angle.menu add radiobutton -label $label_angle -indicatoron 1 -value $label_angle -variable temp_linear_config_info($c,enz_label_angle)  -command "event generate $dialog <<changed_enzymes>>"
  }
  set temp_linear_config_info($c,enz_label_angle) "---"

##
 ## Box outline frame
  grid [ttk::frame $dialog.tabframe.enzymes.frame3.boxframe] -row 2 -column 1 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.enzymes.frame3.boxframe.label0 -text [mc "Box:"]] -row 1 -column 0 -sticky nw
  global outline_box_types_dict
  grid [menubutton $dialog.tabframe.enzymes.frame3.boxframe.type -menu $dialog.tabframe.enzymes.frame3.boxframe.type.menu -textvariable temp_linear_config_info($c,enz_box_type_label)] -row 1 -column 1 -sticky nw
  menu $dialog.tabframe.enzymes.frame3.boxframe.type.menu
  foreach box_type [dict keys $outline_box_types_dict] {
      set type_label [dict get $outline_box_types_dict $box_type]
      $dialog.tabframe.enzymes.frame3.boxframe.type.menu add radiobutton -label $type_label -indicatoron 1 -value $box_type -variable temp_linear_config_info($c,enz_box_type)  -command "set temp_linear_config_info($c,enz_box_type_label) \"$type_label\"; event generate $dialog <<changed_enzymes>>"
  }
  grid [ttk::label $dialog.tabframe.enzymes.frame3.boxframe.label1 -text [mc "Fill:"]] -row 1 -column 2 -sticky nw
  set temp_linear_config_info($c,enz_box_fill_color) #000000
  grid [color_button $dialog.tabframe.enzymes.frame3.boxframe.box_fill_color  temp_linear_config_info($c,enz_box_fill_color) 18] -row 1 -column 3 -sticky nw
  bind $dialog.tabframe.enzymes.frame3.boxframe.box_fill_color <<color_picked>> "event generate $dialog <<changed_enzymes>>"
  bind $dialog.tabframe.enzymes.frame3.boxframe.box_fill_color <Shift-ButtonRelease-1> "set temp_linear_config_info($c,enz_box_fill_color) {}; event generate $dialog <<changed_enzymes>>; break"

  grid [ttk::label $dialog.tabframe.enzymes.frame3.boxframe.label2 -text [mc "Outline:"]] -row 1 -column 4 -sticky nw
  set temp_linear_config_info($c,enz_box_outline_color) #000000
  grid [color_button $dialog.tabframe.enzymes.frame3.boxframe.box_outline_color  temp_linear_config_info($c,enz_box_outline_color) 18] -row 1 -column 5 -sticky nw
  bind $dialog.tabframe.enzymes.frame3.boxframe.box_outline_color <<color_picked>> "event generate $dialog <<changed_enzymes>>"
  bind $dialog.tabframe.enzymes.frame3.boxframe.box_outline_color <Shift-ButtonRelease-1> "set temp_linear_config_info($c,enz_box_outline_color) {}; event generate $dialog <<changed_enzymes>>; break"
    grid [ttk::scale $dialog.tabframe.enzymes.frame3.boxframe.box_outlinewidth -orient horizontal -from 0 -to 8 -variable temp_linear_config_info($c,enz_box_outline_width) -command " set temp_linear_config_info($c,enz_box_outline_width) \[expr {round(\$temp_linear_config_info($c,enz_box_outline_width))}\];event generate $dialog <<changed_enzymes>>;#" ] -row 1 -column 6 -sticky w
    set temp_linear_config_info($c,enz_box_outline_width) "---"
    grid [ttk::label $dialog.tabframe.enzymes.frame3.boxframe.box_outlinewidth_label -textvariable temp_linear_config_info($c,enz_box_outline_width)] -row 1 -column 7 -sticky w
##
  
  linear_config_enz_fill_treeview $t $c

  ####features frame
  $dialog.tabframe add [ttk::frame $dialog.tabframe.features -relief flat] -text [mc "Features"] -sticky nswe
  grid columnconfigure $dialog.tabframe.features 0 -weight 1
  grid rowconfigure $dialog.tabframe.features 0 -weight 1

  grid [ttk::frame $dialog.tabframe.features.frame1 -relief flat] -row 0 -column 0 -sticky nswe
  set f $dialog.tabframe.features.frame1
  
  set t $f.tv
  set sc $f.sc
  ttk::treeview $t -yscrollcommand "optionscrollbar $sc" -height 5
  scrollbar $sc -orient vertical -command "$t yview" -width 15
  grid $f.tv -row 0 -column 0  -sticky nsew
  grid $f.sc -row 0 -column 1 -sticky nsw
  grid columnconfigure $f 0 -weight 1
  grid rowconfigure $f 0 -weight 1
  grid columnconfigure $f 1 -minsize 17

  set column_list {Direction Type Location Length}
  for {set i 0} {$i < 20} {incr i} {
    lappend column_list [format "g_%03u" $i]
  }
  $t configure -columns $column_list -displaycolumns {Direction Type Location Length}
  $t heading #0 -text [mc "Feature"] -command "treeview_sort $t {}"
  $t column #0 -width 200 -minwidth 50 -stretch 1 -anchor e
  $t heading Direction -text [mc "Direction"] -command "treeview_sort $t Direction"
  $t column Direction -width 60 -minwidth 50 -stretch 0 -anchor c
  $t heading Type -text [mc "Type"] -command "treeview_sort $t Type"
  $t column Type -width 80 -minwidth 50 -stretch 0 -anchor c
  $t heading Location -text [mc "Location  \u2193"] -command "treeview_sort $t Location"
  $t column Location -width 200 -minwidth 50 -stretch 0 -anchor c
  $t heading Length -text Length  -command "treeview_sort $t Length"
  $t column Length -width 60 -minwidth 50 -stretch 1 -anchor c

  bind $t <<TreeviewSelect>> "linear_config_fea_treeview_manageselection $t $c $dialog; $dialog.tabframe.features.frame2.b1 configure -state disabled"
  bind $t <<OldSelection>> {}
  $t tag configure sel  -foreground  $info(text_select_fg_color) -font boldlabelfont
  bind $t <<Sort_column>> Location
  bind $t <<Sort_direction>> 1
  bind $t <Button-2> "sputs button2 \[$t identify column %x %y]  \[$t identify row %x %y];# can use identify item when 8.6 is available"
  bind $t <<RightClick>> "sputs enzyme gm table_rightclick $w %x %y"

  grid [ttk::frame $dialog.tabframe.features.frame2 -relief ridge -borderwidth 2] -row 1 -column 0 -sticky swe
  #grid [button $dialog.tabframe.features.frame2.b1 -text [mc "Apply"] -command "event generate $dialog <<raise>>; linear_config_fea_treeview_apply $t $c"] -row 0 -column 0 -sticky we
  button $dialog.tabframe.features.frame2.b1
  bind $dialog <<changed_features>> "linear_config_fea_treeview_apply $t $c"

  grid [ttk::frame $dialog.tabframe.features.frame3 -relief ridge -borderwidth 2] -row 2 -column 0 -sticky swe
  grid [ttk::frame $dialog.tabframe.features.frame3_dummy -relief ridge -borderwidth 2] -row 2 -column 0 -sticky nswe

  grid [checkbutton $dialog.tabframe.features.frame3.visible -text [mc "Visible"] -variable temp_linear_config_info($c,fea_visible) -command "if {\[info exists temp_linear_config_info($c,fea_visible)\]} {event generate $dialog <<changed_features>>}" ] -row 0 -column 1 -columnspan 2 -sticky nw
  
  ## feature configuration frame
  grid [ttk::frame $dialog.tabframe.features.frame3.ffg_frame] -row 1 -column 1 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.features.frame3.ffg_frame.ffg_label -text [mc "Fill:"] -state normal] -row 2 -column 1 -columnspan 1 -sticky nw
  set temp_linear_config_info($c,fea_fg_color) gray80
  grid [color_button $dialog.tabframe.features.frame3.ffg_frame.ffg_color  temp_linear_config_info($c,fea_fg_color) 18] -row 2 -column 2 -sticky nw

  bind $dialog.tabframe.features.frame3.ffg_frame.ffg_color <<color_picked>> "event generate $dialog <<changed_features>>; $dialog.tabframe.features.frame3.ffg_frame.ffg_label configure -state normal"
  grid [ttk::frame $dialog.tabframe.features.frame3.ffg_frame.fwid_frame]  -row 2 -column 3 -sticky nw
  grid [ttk::scale $dialog.tabframe.features.frame3.ffg_frame.fwid_frame.fea_width -orient horizontal -from 2 -to 25 -variable temp_linear_config_info($c,fea_width) -command "event generate $dialog <<changed_features>>; set temp_linear_config_info($c,fea_width) \[expr {round(\$temp_linear_config_info($c,fea_width))}\];#" ] -row 3 -column 2 -sticky nw
  set temp_linear_config_info($c,fea_width) "---"
  grid [ttk::label $dialog.tabframe.features.frame3.ffg_frame.fwid_frame.fea_width_label -textvariable temp_linear_config_info($c,fea_width)] -row 3 -column 3 -sticky nw

  grid [ttk::frame $dialog.tabframe.features.frame3.ffg_frame.fbg_frame] -row 2 -column 4 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_label -text [mc "Outline:"] -state normal] -row 3 -column 1 -columnspan 2 -sticky nw
  set temp_linear_config_info($c,fea_bg_color) gray80
  grid [color_button $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color  temp_linear_config_info($c,fea_bg_color) 18] -row 3 -column 3 -sticky nw

  bind $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color <<color_picked>> "event generate $dialog <<changed_features>>;$dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_label configure -state normal; #grid configure $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color_percent; #grid configure $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color_percent_label"

    grid [menubutton $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color_percent -menu $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color.menu -text "%"] -row 3 -column 4 -sticky nw
  menu $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color.menu
  foreach perc [list 20 40 50 60 80] {
    $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color.menu add command -label [mc "Mix with %s%% Fill Color" $perc] -command "linear_config_fea_treeview_apply_tag_color_to_outline $t $c $perc $dialog"
  }
  $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color.menu add command -label [mc "Set to Fill Color"] -command "linear_config_fea_treeview_apply_tag_color_to_outline $t $c 100 $dialog"
  
  #set temp_linear_config_info($c,fea_bg_color_percent) 0
  #grid [ttk::scale $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color_percent -orient horizontal -from 0 -to 100 -variable temp_linear_config_info($c,fea_bg_color_percent) -command "event generate $dialog <<changed_features>>; set temp_linear_config_info($c,fea_bg_color_percent) \[expr {round(\$temp_linear_config_info($c,fea_bg_color_percent))}\]; #"] -row 3 -column 4 -sticky nw
  #grid [ttk::label $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color_percent_label -textvariable temp_linear_config_info($c,fea_bg_color_percent)] -row 3 -column 5 -sticky nw
  #grid remove $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color_percent; grid remove $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color_percent_label

  grid [ttk::frame $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fout_frame]  -row 3 -column 6 -sticky nw
  #grid [ttk::label $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fout_frame.foutl_label -text [mc "Width"]] -row 4 -column 1 -sticky nw
  set temp_linear_config_info($c,fea_outline) 1
  grid [ttk::scale $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fout_frame.fea_outline -orient horizontal -from 1 -to 12 -variable temp_linear_config_info($c,fea_outline) -command "event generate $dialog <<changed_features>>; set temp_linear_config_info($c,fea_outline) \[expr {round(\$temp_linear_config_info($c,fea_outline))}\];#" ] -row 4 -column 2 -sticky nw
  set temp_linear_config_info($c,fea_outline) "---"
  grid [ttk::label $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fout_frame.fea_outline_label -textvariable temp_linear_config_info($c,fea_outline)] -row 4 -column 3 -sticky nw

  ## Intron formatting frame
  grid [ttk::frame $dialog.tabframe.features.frame3.intron_frame] -row 2 -column 1 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.features.frame3.intron_frame.ffg_label -text [mc "Intron Fill:"] -state normal] -row 2 -column 1 -sticky w
  set temp_linear_config_info($c,fea_intron_fg_color) {}
  grid [color_button $dialog.tabframe.features.frame3.intron_frame.ffg_color  temp_linear_config_info($c,fea_intron_fg_color) 18] -row 2 -column 2 -sticky w
  bind $dialog.tabframe.features.frame3.intron_frame.ffg_color <<color_picked>> "event generate $dialog <<changed_features>>; $dialog.tabframe.features.frame3.intron_frame.ffg_label configure -state normal"

  grid [ttk::frame $dialog.tabframe.features.frame3.intron_frame.fwid_frame] -row 2 -column 3 -columnspan 1 -sticky we
  set temp_linear_config_info($c,fea_intron_width) 5
  grid [ttk::scale $dialog.tabframe.features.frame3.intron_frame.fwid_frame.fea_intron_width -orient horizontal -from 1 -to 25 -variable temp_linear_config_info($c,fea_intron_width) -command "event generate $dialog <<changed_features>>; set temp_linear_config_info($c,fea_intron_width) \[expr {round(\$temp_linear_config_info($c,fea_intron_width))}\];#" ] -row 3 -column 2 -rowspan 2 -sticky w
  set temp_linear_config_info($c,fea_intron_width) "---"
  grid [ttk::label $dialog.tabframe.features.frame3.intron_frame.fwid_frame.fea_intron_width_label -textvariable temp_linear_config_info($c,fea_intron_width)] -row 3 -column 3 -rowspan 2 -sticky w
  set temp_linear_config_info($c,fea_intron_height) 0
  grid [ttk::scale $dialog.tabframe.features.frame3.intron_frame.fwid_frame.fea_intron_height -orient horizontal -from -0.5 -to +0.5 -variable temp_linear_config_info($c,fea_intron_height) -command "event generate $dialog <<changed_features>>; set temp_linear_config_info($c,fea_intron_height) \[expr {round(\$temp_linear_config_info($c,fea_intron_height)*10)/10.0}\];#" ] -row 3 -column 4 -sticky w
  set temp_linear_config_info($c,fea_intron_height) "---"
  grid [ttk::label $dialog.tabframe.features.frame3.intron_frame.fwid_frame.fea_intron_height_label -textvariable temp_linear_config_info($c,fea_intron_height)] -row 3 -column 5 -sticky w
  set temp_linear_config_info($c,fea_intron_dip) 0
  grid [ttk::scale $dialog.tabframe.features.frame3.intron_frame.fwid_frame.fea_intron_dip -orient horizontal -from -2.5 -to +2.5 -variable temp_linear_config_info($c,fea_intron_dip) -command "event generate $dialog <<changed_features>>; set temp_linear_config_info($c,fea_intron_dip) \[expr {round(\$temp_linear_config_info($c,fea_intron_dip)*10)/10.0}\];#" ] -row 4 -column 4 -sticky w
  set temp_linear_config_info($c,fea_intron_dip) "---"
  grid [ttk::label $dialog.tabframe.features.frame3.intron_frame.fwid_frame.fea_intron_dip_label -textvariable temp_linear_config_info($c,fea_intron_dip)] -row 4 -column 5 -sticky w

  grid [ttk::frame $dialog.tabframe.features.frame3.intron_frame.fbg_frame] -row 2 -column 4  -sticky we
  grid [ttk::label $dialog.tabframe.features.frame3.intron_frame.fbg_frame.fbg_label -text [mc "Outline:"] -state normal] -row 3 -column 1  -sticky w
  set temp_linear_config_info($c,fea_intron_bg_color) {}
  grid [color_button $dialog.tabframe.features.frame3.intron_frame.fbg_frame.fbg_color  temp_linear_config_info($c,fea_intron_bg_color) 18] -row 3 -column 2 -sticky w
  bind $dialog.tabframe.features.frame3.intron_frame.fbg_frame.fbg_color <<color_picked>> "event generate $dialog <<changed_features>>;$dialog.tabframe.features.frame3.intron_frame.fbg_frame.fbg_label configure -state normal; #grid configure $dialog.tabframe.features.frame3.intron_frame.fbg_frame.fbg_color_percent;# grid configure $dialog.tabframe.features.frame3.intron_frame.fbg_frame.fbg_color_percent_label"

  grid [ttk::frame $dialog.tabframe.features.frame3.intron_frame.fbg_frame.out_frame] -row 3 -column 3
  set temp_linear_config_info($c,fea_intron_outline) 1
  grid [ttk::scale $dialog.tabframe.features.frame3.intron_frame.fbg_frame.out_frame.fea_intron_outline -orient horizontal -from 0 -to 12 -variable temp_linear_config_info($c,fea_intron_outline) -command "event generate $dialog <<changed_features>>; set temp_linear_config_info($c,fea_intron_outline) \[expr {round(\$temp_linear_config_info($c,fea_intron_outline))}\];#" ] -row 4 -column 2 -sticky w
  set temp_linear_config_info($c,fea_intron_outline) "---"
  grid [ttk::label $dialog.tabframe.features.frame3.intron_frame.fbg_frame.out_frame.fea_intron_outline_label -textvariable temp_linear_config_info($c,fea_intron_outline)] -row 4 -column 4 -sticky w

  grid [button $dialog.tabframe.features.frame3.intron_frame.fbg_frame.fbg_use_main -text [mc "Use Main"] -command "linear_config_fea_treeview_apply_tag_properties_to_intron $t $c $dialog"] -row 3 -column 5 -sticky w

  ## arrow configuration frame
  grid [ttk::frame $dialog.tabframe.features.frame3.arrow_frame] -row 3 -column 1 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.features.frame3.arrow_frame.l2 -text [mc "5' arrow:"]] -row 1 -column 1 -sticky w
  grid [menubutton $dialog.tabframe.features.frame3.arrow_frame.reva -textvariable temp_linear_config_info($c,r_arrow_text)] -row 1 -column 2 -sticky w
  $dialog.tabframe.features.frame3.arrow_frame.reva configure -menu [menu $dialog.tabframe.features.frame3.arrow_frame.reva.m]
  set temp_linear_config_info($c,r_arrow) {}
  fill_arrow_menu $dialog.tabframe.features.frame3.arrow_frame.reva.m $info(arrowlist) temp_linear_config_info($c,r_arrow) temp_linear_config_info($c,r_arrow_text) "event generate $dialog <<changed_features>>"

  grid [ttk::label $dialog.tabframe.features.frame3.arrow_frame.l1 -text [mc "3' arrow:"]] -row 1 -column 3 -sticky w
  grid [menubutton $dialog.tabframe.features.frame3.arrow_frame.fwda -textvariable temp_linear_config_info($c,f_arrow_text)] -row 1 -column 4 -sticky w
  $dialog.tabframe.features.frame3.arrow_frame.fwda configure -menu [menu $dialog.tabframe.features.frame3.arrow_frame.fwda.m]
  set temp_linear_config_info($c,f_arrow) {}
  fill_arrow_menu $dialog.tabframe.features.frame3.arrow_frame.fwda.m $info(arrowlist) temp_linear_config_info($c,f_arrow) temp_linear_config_info($c,f_arrow_text) "event generate $dialog <<changed_features>>"

  ## Text frame
  grid [ttk::frame $dialog.tabframe.features.frame3.text_frame] -row 4 -column 1 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.features.frame3.text_frame.fontfam_label -text [mc "Text:"]] -row 1 -column 1 -sticky nw
    set temp_linear_config_info($c,fea_label_color) #000000
  grid [color_button $dialog.tabframe.features.frame3.text_frame.label_color  temp_linear_config_info($c,fea_label_color) 18] -row 1 -column 2 -sticky nw

  bind $dialog.tabframe.features.frame3.text_frame.label_color <<color_picked>> "event generate $dialog <<changed_features>>"
  
      grid [menubutton $dialog.tabframe.features.frame3.text_frame.label_color_percent -menu $dialog.tabframe.features.frame3.text_frame.label_color_percent.menu -text "%"] -row 1 -column 3 -sticky nw
  menu $dialog.tabframe.features.frame3.text_frame.label_color_percent.menu
  foreach perc [list 20 40 50 60 80] {
    $dialog.tabframe.features.frame3.text_frame.label_color_percent.menu add command -label [mc "Mix with %s%% Fill Color" $perc] -command "linear_config_fea_treeview_apply_tag_color_to_label $t $c $perc $dialog"
  }
  $dialog.tabframe.features.frame3.text_frame.label_color_percent.menu add command -label [mc "Set to Fill Color"] -command "linear_config_fea_treeview_apply_tag_color_to_label $t $c 100 $dialog"
  
  grid [menubutton $dialog.tabframe.features.frame3.text_frame.fontfam -menu $dialog.tabframe.features.frame3.text_frame.fontfam.menu -textvariable temp_linear_config_info($c,fea_fontfamily)] -row 1 -column 4 -sticky nw
   menu $dialog.tabframe.features.frame3.text_frame.fontfam.menu
    if {[llength $info(allfontlist)] <= 20} {
      foreach fontfam $info(allfontlist) {
        $dialog.tabframe.features.frame3.text_frame.fontfam.menu add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable temp_linear_config_info($c,fea_fontfamily) -command "event generate $dialog <<changed_features>>";# -font [list $fontfam 10]
      }
    } else {
      for {set fi 0} {$fi < [llength $info(allfontlist)]} {incr fi 20} {
        if {[set fj [expr {$fi + 19}]] > [llength $info(allfontlist)]} {set fj [expr {[llength $info(allfontlist)]-1}]}
        $dialog.tabframe.features.frame3.text_frame.fontfam.menu add cascade -label "[lindex $info(allfontlist) $fi]-[lindex $info(allfontlist) $fj]" -menu $dialog.tabframe.features.frame3.text_frame.fontfam.menu.menu$fi 
        menu $dialog.tabframe.features.frame3.text_frame.fontfam.menu.menu$fi
        foreach fontfam [lrange $info(allfontlist) $fi $fj] {
          $dialog.tabframe.features.frame3.text_frame.fontfam.menu.menu$fi add radiobutton -label $fontfam -indicatoron 1 -value $fontfam -variable temp_linear_config_info($c,fea_fontfamily) -command "event generate $dialog <<changed_features>>";# -font [list $fontfam 10]
        }
      }
    }
  grid [menubutton $dialog.tabframe.features.frame3.text_frame.fontsiz -menu $dialog.tabframe.features.frame3.text_frame.fontsiz.menu -textvariable temp_linear_config_info($c,fea_fontsize)] -row 1 -column 5 -sticky nw
  menu $dialog.tabframe.features.frame3.text_frame.fontsiz.menu
  foreach fontsize [lsort -unique -integer [concat [list 6 8 9 10 11 12 13 14 16 18 20 24 26 28 30 34 36 40]]] {
      $dialog.tabframe.features.frame3.text_frame.fontsiz.menu add radiobutton -label $fontsize -indicatoron 1 -value $fontsize -variable temp_linear_config_info($c,fea_fontsize)  -command "event generate $dialog <<changed_features>>"
  }
  set temp_linear_config_info($c,fea_fontfamily) "---"
  set temp_linear_config_info($c,fea_fontsize) "---"



  ##grid [button $dialog.tabframe.features.frame3.text_frame.label_use_ffg_color -text [mc "Use Feature Color"] -command "linear_config_fea_treeview_apply_tag_color_to_label $t $c $dialog" ] -row 1 -column 6 -sticky nw
  grid [ttk::label $dialog.tabframe.features.frame3.text_frame.angle_label -text [mc "Angle:"]] -row 1 -column 7 -sticky nw
  grid [menubutton $dialog.tabframe.features.frame3.text_frame.text_angle -menu $dialog.tabframe.features.frame3.text_frame.text_angle.menu -textvariable temp_linear_config_info($c,fea_label_angle)] -row 1 -column 8 -sticky nw
  menu $dialog.tabframe.features.frame3.text_frame.text_angle.menu
  foreach label_angle [lsort -unique -integer [concat [list 0 45 90 270 315]]] {
    $dialog.tabframe.features.frame3.text_frame.text_angle.menu add radiobutton -label $label_angle -indicatoron 1 -value $label_angle -variable temp_linear_config_info($c,fea_label_angle)  -command "event generate $dialog <<changed_features>>"
  }
  set temp_linear_config_info($c,fea_label_angle) "---"
  ##
 ## Box outline frame
  grid [ttk::frame $dialog.tabframe.features.frame3.boxframe] -row 5 -column 1 -columnspan 7 -sticky nwe
  grid [ttk::label $dialog.tabframe.features.frame3.boxframe.label0 -text [mc "Box:"]] -row 1 -column 0 -sticky e
  global outline_box_types_dict
  grid [menubutton $dialog.tabframe.features.frame3.boxframe.type -menu $dialog.tabframe.features.frame3.boxframe.type.menu -textvariable temp_linear_config_info($c,fea_box_type_label)] -row 1 -column 1 -sticky nw
  menu $dialog.tabframe.features.frame3.boxframe.type.menu
  foreach box_type [dict keys $outline_box_types_dict] {
      set type_label [dict get $outline_box_types_dict $box_type]
      $dialog.tabframe.features.frame3.boxframe.type.menu add radiobutton -label $type_label -indicatoron 1 -value $box_type -variable temp_linear_config_info($c,fea_box_type)  -command "set temp_linear_config_info($c,fea_box_type_label) \"$type_label\"; event generate $dialog <<changed_features>>"
  }
  grid [ttk::label $dialog.tabframe.features.frame3.boxframe.label1 -text [mc "Fill:"]] -row 1 -column 2 -sticky nw
  set temp_linear_config_info($c,fea_box_fill_color) #000000
  grid [color_button $dialog.tabframe.features.frame3.boxframe.box_fill_color  temp_linear_config_info($c,fea_box_fill_color) 18] -row 1 -column 3 -sticky nw
  bind $dialog.tabframe.features.frame3.boxframe.box_fill_color <<color_picked>> " event generate $dialog <<changed_features>>"
  bind $dialog.tabframe.features.frame3.boxframe.box_fill_color <Shift-ButtonRelease-1> "set temp_linear_config_info($c,fea_box_fill_color) {}; event generate $dialog <<changed_features>>; break"

  grid [ttk::label $dialog.tabframe.features.frame3.boxframe.label2 -text [mc "Outline:"]] -row 1 -column 4 -sticky nw
  set temp_linear_config_info($c,fea_box_outline_color) #000000
  grid [color_button $dialog.tabframe.features.frame3.boxframe.box_outline_color  temp_linear_config_info($c,fea_box_outline_color) 18] -row 1 -column 5 -sticky nw
  bind $dialog.tabframe.features.frame3.boxframe.box_outline_color <<color_picked>> " event generate $dialog <<changed_features>>"
  bind $dialog.tabframe.features.frame3.boxframe.box_outline_color <Shift-ButtonRelease-1> "set temp_linear_config_info($c,fea_box_outline_color) {};  event generate $dialog <<changed_features>>; break"
    grid [ttk::scale $dialog.tabframe.features.frame3.boxframe.box_outlinewidth -orient horizontal -from 0 -to 8 -variable temp_linear_config_info($c,fea_box_outline_width) -command " set temp_linear_config_info($c,fea_box_outline_width) \[expr {round(\$temp_linear_config_info($c,fea_box_outline_width))}\];event generate $dialog <<changed_features>>;#" ] -row 1 -column 6 -sticky w
    set temp_linear_config_info($c,fea_box_outline_width) "---"
    grid [ttk::label $dialog.tabframe.features.frame3.boxframe.box_outlinewidth_label -textvariable temp_linear_config_info($c,fea_box_outline_width)] -row 1 -column 7 -sticky w
##
  #grid [ttk::label $dialog.tabframe.features.frame3.arrow_frame.l4 -text [mc "Offset:"]] -row 2 -column 1 -sticky w

  linear_config_fea_fill_treeview $t $c

# hide
# label text (name %n pos1 %1, pos2 %2 variables)
#      format {%1$s} r t y
#      set a [regsub %% asdf%% \x0]
#      set b [regsub \x0 $a %]
# label color (use feature color)
# font size and family

  ####circle frame
# show enzymes circle: width, color
# show features circle (features height is relative to features circle): radius, width, color, 
# show crosshairs: width, color
# show index marks: radius, spacing, font, size, color, with 0's, angle, in/out
# show GC circle: radius, accumulation window, low-color, mid-color, high color, >%, <%
# show ORFs circle: radius, min length, fwd color, rev color, delta radius (for fwd/ rev offset)
# all radius measures are as % of enzymes circle

  ## parameters frame
# parameter: label bump overlap 
# parameter: bump connectors
# parameter: bump moved ojects (don't ignore in bump proc)
# button: reset moved objects

 # $dialog.tabframe add [frame $dialog.tabframe.circle -relief flat] -text [mc "Circle"] -sticky nswe
 # grid [frame $dialog.tabframe.circle.frame1 -relief flat] -row 0 -column 0 -sticky nswe
 # grid rowconfigure $dialog.tabframe.circle 0 -weight 1
 # grid columnconfigure $dialog.tabframe.circle 0 -weight 1
 # grid [button $dialog.tabframe.circle.frame1.some -text [mc "For future use"] -command ""] -row 0 -column 0 -sticky we

  #### ok frame
  if {!$info(android)} {
    grid [frame $dialog.frame2 -relief raised] -row 1 -column 0 -sticky swe
    #grid [checkbutton $dialog.frame2.apply -text [mc "Apply to Sequence"] -style Switch.MD.TCheckbutton -variable temp_linear_config_info($c,apply)] -row 0 -column 0 -padx 5 -pady 3 -sticky nw
    set temp_linear_config_info($c,apply) 0
    grid [menubutton $dialog.frame2.apply_button -text [mc "Apply Formatting..."] -menu $dialog.frame2.apply_button.menu] -row 0 -column 0 -padx 5 -pady 3 -sticky nw
    menu $dialog.frame2.apply_button.menu
    $dialog.frame2.apply_button.menu add command -label [mc "Apply Formatting to Sequence"] -command "linear_config_formatting_to_seq $c"
    $dialog.frame2.apply_button.menu add command -label [mc "Apply Feature Colors to Sequence"] -command "" -state disabled
    $dialog.frame2.apply_button.menu add command -label [mc "Apply Feature Show/ Hide to Sequence"] -command "" -state disabled
    $dialog.frame2.apply_button.menu  add command -label [mc "Apply Formatting to Defaults"] -state disabled

    
    grid [button $dialog.frame2.ok -text [mc "OK"] -command "event generate $dialog <<OK>>" -default active] -row 0 -column 1 -padx 5 -pady 3 -sticky nw
    grid columnconfigure $dialog.frame2 0 -weight 1
    grid columnconfigure $dialog.frame2 1 -weight 1
    bind $dialog <Key-Return> "set ok 1"
  }

  grid rowconfigure $dialog 0 -weight 1
  grid rowconfigure $dialog 1 -weight 0
  grid columnconfigure $dialog 0 -weight 1
  update idletasks
  regexp {([0-9]+)x([0-9]+)} [wm geometry $w] - width height
  wm geometry $w "$width\x[expr {min([winfo screenheight $w], $height + [winfo height $w.f_config])}]"

  if {$info(android)} {
    vwait ok
    set dialogblock 0
    unset -nocomplain ok
    destroy $dialog
    bind . <<RaiseDialogs>> ""
  }
#hidden items:
#$t itemconfigure 0 -selectforeground gray60 -selectbackground gray80
}

#############
##
#############
proc linear_config_text_fill_treeview {tv c} {
  global temp_linear_config_info
  if {![winfo exists $tv]} {
    sputs no text frame
    return
  }

  if {![$tv exists hidden]} {
    $tv insert {} end -id hidden -text [mc "Hidden"] -tag hidden
  }

  foreach tag [dict keys $temp_linear_config_info($c,text_tag_dict)] {
    if {[$c itemcget $tag -font] == ""} {
      sputs error $tag
      continue
    }
    $tv insert {} end -id $tag -text [dict get $temp_linear_config_info($c,text_tag_dict) $tag] -tag $tag
    #$tv tag configure $tag -background white -foreground [$c itemcget $tag -fill];# -font "[list [font actual [$c itemcget $tag -font] -family]] 12"
    if {[$c itemcget $tag -state] == "hidden"} {
      $tv move $tag hidden end
    }
  }
  if {[llength [$tv children hidden]] ==0} {
    $tv detach hidden
  }
}

#############
##
#############
proc linear_config_text_treeview_manageselection {t c dialog} {
  global temp_linear_config_info
  set text_visible ""
  set text_fontfamily "---"
  set text_fontsize "---"
  set text_label_color ""

  if {[$t selection] == {} || [$t selection] == [list hidden]} {
    grid configure $dialog.tabframe.texts.frame3_dummy
    return
  } else {
    grid remove $dialog.tabframe.texts.frame3_dummy
  }
  foreach e [$t selection] {
    if {$e eq "hidden"} {continue}
    set itemfont [$c itemcget $e -font] 
    if {$itemfont == ""} {
      sputs error $e
      continue
    }
    if {$text_visible == ""} {
      set text_visible [expr {[$c itemcget $e -state] ne "hidden"}]
    } elseif {$text_visible != [expr {[$c itemcget $e -state] ne "hidden"}]} {
      set text_visible -1
    }
    if {$text_fontfamily == "---"} {
      set text_fontfamily [font actual [$c itemcget $e -font]  -family]
    } elseif {$text_fontfamily != [font actual [$c itemcget $e -font] -family]} {
      set text_fontfamily -1
    }
    if {$text_fontsize == "---"} {
      set text_fontsize [font actual [$c itemcget $e -font] -size]
    } elseif {$text_fontsize != [font actual [$c itemcget $e -font] -size]} {
      set text_fontsize -1
    }
    if {$text_label_color == ""} {
      set text_label_color [$c itemcget $e -fill]
    } elseif {$text_label_color != [$c itemcget $e -fill]} {
      set text_label_color -1
    }
  }

  if {$text_visible == -1} {
    unset -nocomplain temp_linear_config_info($c,text_visible)
  } else {
    set temp_linear_config_info($c,text_visible) $text_visible
  }
  if {$text_fontfamily == -1} {
    set temp_linear_config_info($c,text_fontfamily) "---"
  } else {
    set temp_linear_config_info($c,text_fontfamily) $text_fontfamily
  }
  if {$text_fontsize == -1} {
    set temp_linear_config_info($c,text_fontsize) "---"
  } else {
    set temp_linear_config_info($c,text_fontsize) $text_fontsize
  }
  if {$text_label_color == -1 || $text_label_color ==""} {
    set temp_linear_config_info($c,text_label_color) $text_label_color
  } else {
    set temp_linear_config_info($c,text_label_color) $text_label_color
  }

}



#############
##
#############
proc linear_config_text_treeview_apply {t c} {
  global temp_linear_config_info
  foreach e [$t selection] {
    if {$e eq "hidden"} {continue}
    if {[info exists temp_linear_config_info($c,text_visible)]} {
      if {$temp_linear_config_info($c,text_visible) == 1} {
        $c itemconfigure $e -state "normal"
        $t move $e {} end
      } elseif {$temp_linear_config_info($c,text_visible) == 0} {
        $c itemconfigure $e -state "hidden"
        $t move $e hidden end
      }
    }
    set family [font actual [$c itemcget $e -font] -family]
    set size  [font actual [$c itemcget $e -font] -size]
    set new_font ""
    if {$temp_linear_config_info($c,text_fontfamily) != "---"} {
      set family $temp_linear_config_info($c,text_fontfamily)
      set new_font "[list $family] $size"
    }
    if {$temp_linear_config_info($c,text_fontsize) != "---"} {
      set size  $temp_linear_config_info($c,text_fontsize)
      set new_font "[list $family] $size"
    }
    if {[info exists temp_linear_config_info($c,text_fontitalic)] && $temp_linear_config_info($c,text_fontitalic)} {
      if {$new_font eq {}} {
        set new_font "[list $family] $size"
      }
      set new_font  "$new_font italic"
    }
    if {[info exists temp_linear_config_info($c,text_fontunderline)] && $temp_linear_config_info($c,text_fontunderline)} {
      if {$new_font eq {}} {
        set new_font "[list $family] $size"
      }
      set new_font  "$new_font underline"
    }
    if {[info exists temp_linear_config_info($c,text_fontbold)] && $temp_linear_config_info($c,text_fontbold)} {
      if {$new_font eq {}} {
        set new_font "[list $family] $size"
      }
      set new_font  "$new_font bold"
    }
    if {$new_font ne ""} {
      $c itemconfigure $e -font $new_font
    }
    if {$temp_linear_config_info($c,text_label_color) != 0 && $temp_linear_config_info($c,text_label_color) != -1} {
      $c itemconfigure $e -fill $temp_linear_config_info($c,text_label_color)
      $c bind $e <<Colors>> [lreplace [$c bind $e <<Colors>>] 0 0 $temp_linear_config_info($c,text_label_color)]
      $t tag configure $e -foreground $temp_linear_config_info($c,text_label_color)
    }
  }
  foreach tag [dict keys $temp_linear_config_info($c,text_tag_dict)] {
    $t move $tag [$t parent $tag] end
  }
  if {[$t children hidden] == {}} {
    $t detach hidden
  } else {
    $t move hidden {} 0
  }
}

################
## utility to fill enzymes treeview
################
proc linear_config_enz_fill_treeview {tv c} {
  global enz_list
  if {![winfo exists $tv]} {
    sputs no enz
    return
  }
  if {![$tv exists hidden]} {
    $tv insert {} end -id hidden -text [mc "Hidden"] -tag hidden
  }
  $tv children {} [list hidden]
  set enz_list [list]
  foreach tag [$c find withtag enzyme&&label] {
    set label_dict  [$c bind $tag <<Label>>]
    $tv insert {} end -id $tag -text [dict get $label_dict name] -tag $tag
    $tv set $tag Location [dict get $label_dict location_start]
    $tv set $tag Count [dict get $label_dict count]
    $tv tag configure $tag -background white -foreground [$c itemcget $tag -fill] 
    if {[$c itemcget $tag -state] == "hidden"} {
      $tv move $tag hidden end
    }
  }
  treeview_sort $tv [bind $tv <<Sort_column>>] 1
}

#############
##
#############
proc linear_config_enz_treeview_manageselection {t c dialog} {
  global temp_linear_config_info outline_box_types_dict
  set enz_visible ""
  set enz_fontfamily "---"
  set enz_fontsize "---"
  set enz_label_color 0
  set enz_label_angle "---"

  set enz_box_type "---"
  set enz_box_fill_color 0
  set enz_box_outline_color 0
  set enz_box_width "---"
  if {[$t selection] == {} || [$t selection] == [list hidden]} {
    grid configure $dialog.tabframe.enzymes.frame3_dummy
    return
  } else {
    grid remove $dialog.tabframe.enzymes.frame3_dummy
  }
  foreach e [$t selection] {
    if {$e eq "hidden"} {continue}
    if {$enz_visible == ""} {
      set enz_visible [expr {[$c itemcget $e -state] eq ""}]
    } elseif {$enz_visible != [expr {[$c itemcget $e -state] eq ""}]} {
      set enz_visible -1
    }
    if {$enz_fontfamily == "---"} {
      set enz_fontfamily [font actual [$c itemcget $e -font] -family]
    } elseif {$enz_fontfamily != [font actual [$c itemcget $e -font] -family]} {
      set enz_fontfamily -1
    }
    if {$enz_fontsize == "---"} {
      set enz_fontsize [font actual [$c itemcget $e -font] -size]
    } elseif {$enz_fontsize != [font actual [$c itemcget $e -font] -size]} {
      set enz_fontsize -1
    }
    if {$enz_label_color == 0} {
      set enz_label_color [$c itemcget $e -fill]
    } elseif {$enz_label_color != [$c itemcget $e -fill]} {
      set enz_label_color -1
    }

    if {$enz_label_angle == "---"} {
      set enz_label_angle [expr {int([$c itemcget $e -angle])}]
    } elseif {$enz_label_angle != [expr {int([$c itemcget $e -angle])}]} {
      set enz_label_angle -720
    }
    set box_item [$c find withtag $e.box]
    if {$box_item != {}} {
      if {[set box_dict [$c bind $box_item <<Box>>]] ne {} && [dict exists $box_dict type]} {
        set box_type [dict get $box_dict type]
      } else {
        set box_type ""
      }
      if {$enz_box_type == "---"} {
        set enz_box_type $box_type
      } elseif {$enz_box_type != $box_type} {
        set enz_box_type -1
      }
      if {$enz_box_fill_color == 0} {
        set enz_box_fill_color [$c itemcget $box_item -fill]
      } elseif {$enz_box_fill_color != [$c itemcget $box_item -fill]} {
        set enz_box_fill_color -1
      }
      if {$enz_box_outline_color == 0} {
        set enz_box_outline_color [$c itemcget $box_item -outline]
      } elseif {$enz_box_outline_color != [$c itemcget $box_item -outline]} {
        set enz_box_outline_color -1
      }
      if {$enz_box_width == "---"} {
        set enz_box_width [$c itemcget $box_item -width]
      } elseif {$enz_box_width != [$c itemcget $box_item -width]} {
        set enz_box_width -1
      }
    } 
  
  }

  if {$enz_visible == -1} {
    unset -nocomplain temp_linear_config_info($c,enz_visible)
  } else {
    set temp_linear_config_info($c,enz_visible) $enz_visible
  }
  if {$enz_fontfamily == -1} {
    set temp_linear_config_info($c,enz_fontfamily) "---"
  } else {
    set temp_linear_config_info($c,enz_fontfamily) $enz_fontfamily
  }
  if {$enz_fontsize == -1} {
    set temp_linear_config_info($c,enz_fontsize) "---"
  } else {
    set temp_linear_config_info($c,enz_fontsize) $enz_fontsize
  }
  if {$enz_label_color == -1 || $enz_label_color ==""} {
    set temp_linear_config_info($c,enz_label_color) $enz_label_color
  } else {
    set temp_linear_config_info($c,enz_label_color) $enz_label_color
  }
  if {$enz_label_angle == -720} {
    set temp_linear_config_info($c,enz_label_angle) "---"
  } else {
    set temp_linear_config_info($c,enz_label_angle) $enz_label_angle
  }


  if {$enz_box_type == -1 || $enz_box_type =="" || ![dict exists $outline_box_types_dict $enz_box_type]} {
    set temp_linear_config_info($c,enz_box_type) "---"
    set  temp_linear_config_info($c,enz_box_type_label) "---"
  } else {
    set temp_linear_config_info($c,enz_box_type) $enz_box_type
    set  temp_linear_config_info($c,enz_box_type_label) [dict get $outline_box_types_dict $enz_box_type]
  }
  if {$enz_box_fill_color == -1 || $enz_box_fill_color ==""} {
    set temp_linear_config_info($c,enz_box_fill_color) $enz_box_fill_color 
  } else {
    set temp_linear_config_info($c,enz_box_fill_color) $enz_box_fill_color
  }
  if {$enz_box_outline_color == -1 || $enz_box_outline_color ==""} {
    set temp_linear_config_info($c,enz_box_outline_color) $enz_box_outline_color
  } else {
    set temp_linear_config_info($c,enz_box_outline_color) $enz_box_outline_color
  }
  if {$enz_box_width == -1 || $enz_box_width ==""} {
    set temp_linear_config_info($c,enz_box_outline_width) "---"
  } else {
    set temp_linear_config_info($c,enz_box_outline_width) [expr {round($enz_box_width)}]
  }

}



#############
##
#############
proc linear_config_enz_treeview_apply {t c} {
  global temp_linear_config_info info
  foreach e [$t selection] {
    if {$e eq "hidden"} {continue}
    if {[info exists temp_linear_config_info($c,enz_visible)]} {
      if {$temp_linear_config_info($c,enz_visible) == 1} {
        $c itemconfigure $e -state ""
        $c itemconfigure $e.tick -state ""
        $c itemconfigure $e.connector -state ""
        if {$info(antialias_show)} {
          $c itemconfigure $e.tick_aa -state ""
          $c itemconfigure $e.connector_aa -state ""
        }
        $c itemconfigure $e.box -state ""
        $t move $e {} end
      } elseif {$temp_linear_config_info($c,enz_visible) == 0} {
        $c itemconfigure $e -state "hidden"
        $c itemconfigure $e.tick -state "hidden"
        $c itemconfigure $e.connector -state "hidden"
        $c itemconfigure $e.tick_aa -state "hidden"
        $c itemconfigure $e.connector_aa -state "hidden"
        $c itemconfigure $e.box -state "hidden"
        $t move $e hidden end
      }
    }
    set family [font actual [$c itemcget $e -font] -family]
    set size  [font actual [$c itemcget $e -font] -size]
    set new_font ""
    if {[info exists temp_linear_config_info($c,enz_fontfamily)] && $temp_linear_config_info($c,enz_fontfamily) != "---"} {
      set family $temp_linear_config_info($c,enz_fontfamily)
      set new_font "[list $family] $size"
    }
    if {[info exists temp_linear_config_info($c,enz_fontsize)] && $temp_linear_config_info($c,enz_fontsize) != "---"} {
      set size  $temp_linear_config_info($c,enz_fontsize)
      set new_font "[list $family] $size"

    }
    if {[info exists temp_linear_config_info($c,enz_fontitalic)] && $temp_linear_config_info($c,enz_fontitalic)} {
      if {$new_font eq {}} {
        set new_font "[list $family] $size"
      }
      set new_font  "$new_font italic"
      dict set gformat_dict circular_label_font $new_font
    }
    if {[info exists temp_linear_config_info($c,enz_fontunderline)] && $temp_linear_config_info($c,enz_fontunderline)} {
      if {$new_font eq {}} {
        set new_font "[list $family] $size"
      }
      set new_font  "$new_font underline"
      dict set gformat_dict circular_label_font $new_font
    }
    if {[info exists temp_linear_config_info($c,enz_fontbold)] && $temp_linear_config_info($c,enz_fontbold)} {
      if {$new_font eq {}} {
        set new_font "[list $family] $size"
      }
      set new_font  "$new_font bold"
      dict set gformat_dict circular_label_font $new_font
    }
    if {$new_font ne ""} {
      $c itemconfigure $e -font $new_font
      graphic_map_redraw_label_box $c $e
    }

    if {$temp_linear_config_info($c,enz_label_color) != -1 && $temp_linear_config_info($c,enz_label_color)!= 0} {
      $c itemconfigure $e -fill $temp_linear_config_info($c,enz_label_color)
      $c itemconfigure $e.connector -fill $temp_linear_config_info($c,enz_label_color)
      $c itemconfigure $e.tick -fill $temp_linear_config_info($c,enz_label_color)
      $c itemconfigure $e.connector_aa -fill [mix_color $temp_linear_config_info($c,enz_label_color) [$c cget -background] $info(antialias_percent)]
      $c itemconfigure $e.tick_aa -fill [mix_color $temp_linear_config_info($c,enz_label_color) [$c cget -background] $info(antialias_percent)]
      $c bind $e <<Colors>> [lreplace [$c bind $e <<Colors>>] 0 0 $temp_linear_config_info($c,enz_label_color)]
     # $t tag configure $e -foreground $temp_linear_config_info($c,enz_label_color)
    }

    if {$temp_linear_config_info($c,enz_label_angle) != "---"} {
      set anchor n
      switch $temp_linear_config_info($c,enz_label_angle) {
	270 {set anchor e}
	315 {set anchor se}
	0 {set anchor sw}
	45 {set anchor sw}
	90 {set anchor w}
      }
      $c itemconfigure $e -angle $temp_linear_config_info($c,enz_label_angle) -anchor $anchor
      $c coords $e.box {*}[$c bbox $e]
    }

    if {[info exists temp_linear_config_info($c,enz_box_type)] && $temp_linear_config_info($c,enz_box_type) ne "---" } {
      set this_label_box_type $temp_linear_config_info($c,enz_box_type)
      set box_item [$c find withtag $e.box]
      set box_dict [$c bind $box_item <<Box>>]
      if {[dict exists $box_dict type]} {
        dict set box_dict type $this_label_box_type
        $c bind $box_item <<Box>> $box_dict
        graphic_map_redraw_label_box $c $e
      }
    } 
    if {[info exists temp_linear_config_info($c,enz_box_fill_color)] && $temp_linear_config_info($c,enz_box_fill_color) !=0 && $temp_linear_config_info($c,enz_box_fill_color) != -1} {
      set new_box_fill_color $temp_linear_config_info($c,enz_box_fill_color)
      $c itemconfigure $e.box -fill $new_box_fill_color
      ##dict set gformat_dict linear_enz_label_box_fill_color $new_box_fill_color
    }
    if {[info exists temp_linear_config_info($c,enz_box_outline_color)] && $temp_linear_config_info($c,enz_box_outline_color)!=0  && $temp_linear_config_info($c,enz_box_outline_color)!= -1} {
      set new_box_outline_color $temp_linear_config_info($c,enz_box_outline_color)
      $c itemconfigure $e.box -outline $new_box_outline_color
      $c bind $e <<Colors>> [lreplace [$c bind $e <<Colors>>] 3 3 $new_box_outline_color]
      #dict set gformat_dict linear_enz_label_box_ouline_color $new_box_fill_color
    }

    if {[info exists temp_linear_config_info($c,enz_box_outline_width)] && ![catch {expr {1*$temp_linear_config_info($c,enz_box_outline_width)}}]} {
      set this_box_outline_width $temp_linear_config_info($c,enz_box_outline_width)
      $c itemconfigure $e.box -width $this_box_outline_width
      if { $this_box_outline_width == 0} {
        $c itemconfigure $e.box -outline {}
        $c bind $e <<Colors>> [lreplace [$c bind $e <<Colors>>] 3 3 {}]
      }
      #dict set gformat_dict linear_enz_label_box_outline_width $this_box_outline_width
    } 

  }

  treeview_sort $t [bind $t <<Sort_column>>] 1
  linear_map_reset_all_boxlabels $c
  linear_map_bump_all_boxlabels $c
}

################
## utility to fill features treeview
################
proc linear_config_fea_fill_treeview {tv c} {
  global enz_list

  if {![winfo exists $tv]} {
    sputs no fea
    return
  }
  if {![$tv exists hidden]} {
    $tv insert {} end -id hidden -text [mc "Hidden"] -tag hidden
  }
  $tv children {} [list hidden]
  foreach tag [$c find withtag feature&&label] {
    set label_dict  [$c bind $tag <<Label>>]
    set ftag [regsub fn [dict get $label_dict tag] f]
    set gformat_dict [$c bind $ftag <<Gformat>>]
    $tv insert {} end -id $tag -text [dict get $label_dict name] -tag $tag
    $tv set $tag Location [dict get $label_dict location_start]
    $tv set $tag Direction [expr {[dict get $label_dict direction]?"<<<":">>>"}]
    $tv set $tag Type [dict get $label_dict feature_type]
    $tv set $tag Length [expr {abs([dict get $label_dict location_start]-[dict get $label_dict location_end])+1}]

    #$tv tag configure $tag -background white -foreground [$c itemcget $ftag -fill]
    set label_dict  [$c bind $tag <<Label>>]
    set f_tag [regsub fn [dict get $label_dict tag] f]
    set bg_color  [$c itemcget exon&&foreground&&$f_tag -fill] 
    $tv tag configure $tag -background  [$c itemcget $ftag&&foreground&&exon -fill]  -foreground [process_feature_color $c $tag vis+fill_color+black+white]
    if {[dict get $gformat_dict linear_state] == "hidden"} {
      $tv move $tag hidden end
    }
  }
  treeview_sort $tv [bind $tv <<Sort_column>>] 1
}

#############
##
#############
proc linear_config_fea_treeview_manageselection {t c dialog} {
  global temp_linear_config_info info outline_box_types_dict
  set fea_visible ""
  set fea_fontfamily "---"
  set fea_fontsize "---"
  set fea_label_angle "---"
  set fea_label_color 0

  set fea_fg_color 0
  set fea_bg_color 0
  set fea_fwd_arrow "Empty"
  set fea_rev_arrow "Empty"
  set fea_width ""
  set fea_outline ""

  set fea_intron_width ""
  set fea_intron_outline ""
  set fea_intron_height ""
  set fea_intron_dip ""
  set fea_intron_bg_color 0
  set fea_intron_fg_color 0

  set fea_box_type "---"
  set fea_box_fill_color 0
  set fea_box_outline_color 0
  set fea_box_width "---"

  $t tag remove sel
  $t tag add sel [$t selection]

  if {[$t selection] == {} || [$t selection] == [list hidden]} {
    grid configure $dialog.tabframe.features.frame3_dummy
    return
  } else {
    grid remove $dialog.tabframe.features.frame3_dummy
  }

  set has_intron 0
  foreach e [$t selection] {
    if {$e eq "hidden"} {continue}

    set label_dict  [$c bind $e <<Label>>]
    set tag [regsub fn [dict get $label_dict tag] f]
    set gformat_dict [$c bind $tag <<Gformat>>]

    if {$fea_visible == ""} {
      set fea_visible [expr {[dict get $gformat_dict linear_state] ne "hidden"}]
    } elseif {$fea_visible != [expr {[dict get $gformat_dict linear_state] ne "hidden"}]} {
      set fea_visible -1
    }
    if {$fea_fontfamily == "---"} {
      set fea_fontfamily [font actual [$c itemcget $e -font] -family]
    } elseif {$fea_fontfamily != [font actual [$c itemcget $e -font] -family]} {
      set fea_fontfamily -1
    }
    if {$fea_fontsize == "---"} {
      set fea_fontsize [font actual [$c itemcget $e -font] -size]
    } elseif {$fea_fontsize != [font actual [$c itemcget $e -font] -size]} {
      set fea_fontsize -1
    }

    if {$fea_label_angle == "---"} {
      set fea_label_angle [expr {int([$c itemcget $e -angle])}]
    } elseif {$fea_label_angle != [expr {int([$c itemcget $e -angle])}]} {
      set fea_label_angle -720
    }
    
    set this_fea_label_color [$c itemcget $e -fill]
    if {$fea_label_color == 0} {
      set fea_label_color $this_fea_label_color
    } elseif {$fea_label_color != $this_fea_label_color} {
      set fea_label_color -1
    }

    set this_fea_fg_color [$c itemcget $tag&&foreground&&exon -fill]
    set this_fea_bg_color [$c itemcget $tag&&outline&&exon -outline]

    set box_item [$c find withtag $e.box]
    if {$box_item != {}} {
      if {[set box_dict [$c bind $box_item <<Box>>]] ne {} && [dict exists $box_dict type]} {
        set box_type [dict get $box_dict type]
      } else {
        set box_type ""
      }
      if {$fea_box_type == "---"} {
        set fea_box_type $box_type
      } elseif {$fea_box_type != $box_type} {
        set fea_box_type -1
      }
      if {$fea_box_fill_color == 0} {
        set fea_box_fill_color [$c itemcget $box_item -fill]
      } elseif {$fea_box_fill_color != [$c itemcget $box_item -fill]} {
        set fea_box_fill_color -1
      }
      if {$fea_box_outline_color == 0} {
        set fea_box_outline_color [$c itemcget $box_item -outline]
      } elseif {$fea_box_outline_color != [$c itemcget $box_item -outline]} {
        set fea_box_outline_color -1
      }
      if {$fea_box_width == "---"} {
        set fea_box_width [$c itemcget $box_item -width]
      } elseif {$fea_box_width != [$c itemcget $box_item -width]} {
        set fea_box_width -1
      }
    } 

    if {$fea_fg_color == 0} {
      set fea_fg_color $this_fea_fg_color
    } elseif {$fea_fg_color != $this_fea_fg_color} {
      set fea_fg_color -1
    }

    if {$fea_bg_color == 0} {
      set fea_bg_color $this_fea_bg_color
    } elseif {$fea_bg_color != $this_fea_bg_color} {
      set fea_bg_color -1
    }

    set exons [$c find withtag $tag&&exon]
    if {[llength $exons] > 0 } {
      lassign [$c coords [lindex $exons 0]] x0 y0 x1 y1
      set this_fea_width [expr {($y1 - $y0)}]
      if {$fea_width == ""} {
        set fea_width $this_fea_width
      } elseif {$fea_width != $this_fea_width} {
        set fea_width -1
      }
    }

    if {$fea_outline == ""} {
      set fea_outline [expr {([$c itemcget $tag&&outline&&exon -width] )/2}]
    } elseif {$fea_outline != [expr {([$c itemcget $tag&&outline&&exon -width]) /2}]} {
      set fea_outline -1
    }
      
    if {[$c find withtag $tag&&intron] != [list]} {
      set has_intron 1
      if {$fea_intron_fg_color == 0} {
        set fea_intron_fg_color [$c itemcget $tag&&foreground&&intron -fill]
      } elseif {$fea_intron_fg_color != [$c itemcget $tag&&foreground&&intron -fill]} {
        set fea_intron_fg_color -1
      }
     if {$fea_intron_bg_color == 0} {
       set fea_intron_bg_color [$c itemcget $tag&&outline&&intron -fill]
      } elseif {$fea_intron_bg_color != [$c itemcget $tag&&outline&&intron -fill]} {
        set fea_intron_bg_color -1
      }

      if {$fea_intron_width == ""} {
        set this_fea_intron_width [$c itemcget $tag&&foreground&&intron -width]
        set fea_intron_width $this_fea_intron_width
      } elseif {$fea_intron_width != $this_fea_intron_width} {
        set fea_intron_width -1
      }

      lassign [$c coords [lindex [$c find withtag $tag&&exon] 0]] x0 y0 x1 y1
      lassign [$c coords [lindex [$c find withtag $tag&&intron] 0]] ix0 iy0 ix1 iy1
      if {$this_fea_width >= [$c itemcget $tag&&foreground&&intron -width]} {
        ## intron work
        set this_fea_intron_height [expr {round(10.0*(($y1+$y0)/2.0-$iy0)/($this_fea_width -$this_fea_intron_width))/10.0}]
      } else {
        set this_fea_intron_height 0
      }
      if {$fea_intron_height == ""} {
        set fea_intron_height $this_fea_intron_height
      } elseif {$fea_intron_height != $this_fea_intron_height} {
        set fea_intron_height -1
      }

      set this_intron_dip [expr { round(10.0*($iy0-$iy1)/$this_fea_width)/10.0}]
      if {$fea_intron_dip == ""} {
        set fea_intron_dip $this_intron_dip
      } elseif {$fea_intron_dip != $this_intron_dip} {
        set fea_intron_dip -1
      }

      if {$fea_intron_outline == ""} {
        set fea_intron_outline [expr {([$c itemcget $tag&&outline&&intron -width] - [$c itemcget $tag&&foreground&&intron -width]) /2}]
      } elseif {$fea_intron_outline != [expr {([$c itemcget $tag&&outline&&intron -width] - [$c itemcget $tag&&foreground&&intron -width]) /2}]} {
        set fea_intron_outline -1
      }
    }

    set this_fea_fwd_arrow [lindex [dict get $gformat_dict arrow_data] 0]
    set this_fea_rev_arrow [lindex [dict get $gformat_dict arrow_data] 1]
      
    if {$fea_fwd_arrow ==  "Empty"} {
      set fea_fwd_arrow $this_fea_fwd_arrow
    } elseif {$this_fea_fwd_arrow != $fea_fwd_arrow} {
      set fea_fwd_arrow "NoArrow"
    }
    if {$fea_rev_arrow == "Empty"} {
      set fea_rev_arrow $this_fea_rev_arrow
    } elseif {$this_fea_rev_arrow != $fea_rev_arrow} {
      set fea_rev_arrow "NoArrow"
    }
  }


    
  if {$fea_visible == -1} {
    unset -nocomplain temp_linear_config_info($c,fea_visible)
  } else {
    set temp_linear_config_info($c,fea_visible) $fea_visible
  }
  if {$fea_fontfamily == -1} {
    set temp_linear_config_info($c,fea_fontfamily) "---"
  } else {
    set temp_linear_config_info($c,fea_fontfamily) $fea_fontfamily
  }
  if {$fea_fontsize == -1} {
    set temp_linear_config_info($c,fea_fontsize) "---"
  } else {
    set temp_linear_config_info($c,fea_fontsize) $fea_fontsize
  }
  if {$fea_label_angle == -720} {
    set temp_linear_config_info($c,fea_label_angle) "---"
  } else {
    set temp_linear_config_info($c,fea_label_angle) $fea_label_angle
  }
  
  if {$fea_label_color == -1 || $fea_label_color == 0} {
    set temp_linear_config_info($c,fea_label_color)  -1
  } else {
    set temp_linear_config_info($c,fea_label_color) $fea_label_color
  }

  if {$fea_box_type == -1 || $fea_box_type == "" || $fea_box_type == "---"} {
    set temp_linear_config_info($c,fea_box_type) "---"
    set  temp_linear_config_info($c,fea_box_type_label) "---"
  } else {
    set temp_linear_config_info($c,fea_box_type) $fea_box_type
    set  temp_linear_config_info($c,fea_box_type_label) [dict get $outline_box_types_dict $fea_box_type]
  }
  if {$fea_box_fill_color == -1 || $fea_box_fill_color == 0} {
    set temp_linear_config_info($c,fea_box_fill_color) -1 
  } else {
    set temp_linear_config_info($c,fea_box_fill_color) $fea_box_fill_color
  }
  if {$fea_box_outline_color == -1 || $fea_box_outline_color == 0} {
    set temp_linear_config_info($c,fea_box_outline_color) -1
  } else {
    set temp_linear_config_info($c,fea_box_outline_color) $fea_box_outline_color
  }
  if {$fea_box_width == -1 || $fea_box_width ==""} {
    set temp_linear_config_info($c,fea_box_outline_width) "---"
  } else {
    set temp_linear_config_info($c,fea_box_outline_width) $fea_box_width
  }

  if {$has_intron} {
    grid configure $dialog.tabframe.features.frame3.intron_frame
    if {$fea_intron_width == -1} {
      set temp_linear_config_info($c,fea_intron_width) "---"
    } else {
      set temp_linear_config_info($c,fea_intron_width) [expr {round($fea_intron_width)}]
    }
    if {$fea_intron_height == -1} {
      set temp_linear_config_info($c,fea_intron_height) "---"
    } else {
      set temp_linear_config_info($c,fea_intron_height) $fea_intron_height
    }
    if {$fea_intron_dip == -1} {
      set temp_linear_config_info($c,fea_intron_dip) "---"
    } else {
      set temp_linear_config_info($c,fea_intron_dip) $fea_intron_dip
    }
    if {$fea_intron_outline == -1} {
      set temp_linear_config_info($c,fea_intron_outline) "---"
    } else {
      set temp_linear_config_info($c,fea_intron_outline) [expr {round($fea_intron_outline)}]
    }
    if {$fea_intron_fg_color == 0} {
      set temp_linear_config_info($c,fea_intron_fg_color) -1
    } else {
      set temp_linear_config_info($c,fea_intron_fg_color) $fea_intron_fg_color
    }
    if {$fea_intron_bg_color == 0} {
      set temp_linear_config_info($c,fea_intron_bg_color) -1
    } else {
      set temp_linear_config_info($c,fea_intron_bg_color) $fea_intron_bg_color
    }
  } else {
    grid remove $dialog.tabframe.features.frame3.intron_frame
  }

  if {$fea_width == -1 || $fea_width == ""} {
    set temp_linear_config_info($c,fea_width) "---"
  } else {
    set temp_linear_config_info($c,fea_width) [expr {int($fea_width)}]
  }
  if {$fea_outline <= -1} {
    set temp_linear_config_info($c,fea_outline) "---"
  } else {
    set temp_linear_config_info($c,fea_outline) [expr {int($fea_outline)}]
  }
  if {$fea_fg_color == -1 || $fea_fg_color == 0} {
    set temp_linear_config_info($c,fea_fg_color) -1
    #$dialog.tabframe.features.frame3.ffg_frame.ffg_label configure -state disabled
  } else {
    set temp_linear_config_info($c,fea_fg_color) $this_fea_fg_color
   $dialog.tabframe.features.frame3.ffg_frame.ffg_label configure -state normal
  }
  if {$fea_bg_color == -1 || $fea_bg_color == 0} {
    set temp_linear_config_info($c,fea_bg_color) -1
    #$dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_label configure -state disabled
    #grid remove $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color_percent; grid remove $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color_percent_label
  } else {
    set temp_linear_config_info($c,fea_bg_color) $this_fea_bg_color
    $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_label configure -state normal
   # grid remove $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color_percent; grid remove $dialog.tabframe.features.frame3.ffg_frame.fbg_frame.fbg_color_percent_label
  }
  if {[dict exists $info(arrow_dict) $fea_fwd_arrow]} {
    set temp_linear_config_info($c,f_arrow_text) [dict get $info(arrow_dict) $fea_fwd_arrow]
    set temp_linear_config_info($c,f_arrow) $fea_fwd_arrow
  } else {
    set temp_linear_config_info($c,f_arrow_text) "----"
    set temp_linear_config_info($c,f_arrow) -1
  }
  if {[dict exists $info(arrow_dict) $fea_rev_arrow]} {
    set temp_linear_config_info($c,r_arrow_text) [dict get $info(arrow_dict) $fea_rev_arrow]
    set temp_linear_config_info($c,r_arrow) $fea_rev_arrow
  } else {
    set temp_linear_config_info($c,r_arrow_text) "----"
    set temp_linear_config_info($c,r_arrow) -1
  }
    
}

################
## 
################
proc linear_config_fea_treeview_apply {t c} {
    global temp_linear_config_info

  foreach e [$t selection] {
    if {$e eq "hidden"} {continue}
    set label_dict  [$c bind $e <<Label>>]
    set tag [regsub fn [dict get $label_dict tag] f]
    set gformat_dict [$c bind $tag <<Gformat>>]
    set direction [$c bind $tag <<Direction>>]
    set redraw 0
    if {[info exists temp_linear_config_info($c,fea_visible)]} {
      if {$temp_linear_config_info($c,fea_visible) == 1} {
        $c itemconfigure $tag -state "normal"
        dict set gformat_dict linear_state normal
        linear_feature_draw_arrow $c $tag
        $t move $e {} end
      } elseif {$temp_linear_config_info($c,fea_visible) == 0} {
        $c itemconfigure $tag -state "hidden"
        dict set gformat_dict linear_state hidden
        $t move $e hidden end
      }
    }


    set family [font actual [$c itemcget $e -font] -family]
    set size  [font actual [$c itemcget $e -font] -size]
    set new_font ""
    if {$temp_linear_config_info($c,fea_fontfamily) != "---"} {
      set family $temp_linear_config_info($c,fea_fontfamily)
      set new_font "[list $family] $size"

    }
    if {$temp_linear_config_info($c,fea_fontsize) != "---"} {
      set size $temp_linear_config_info($c,fea_fontsize)
      set new_font "[list $family] $size"
    }
    if {[info exists temp_linear_config_info($c,fea_fontitalic)] && $temp_linear_config_info($c,fea_fontitalic)} {
      if {$new_font eq {}} {
        set new_font "[list $family] $size"
      }
      set new_font  "$new_font italic"
      dict set gformat_dict circular_label_font $new_font
    }
    if {[info exists temp_linear_config_info($c,fea_fontunderline)] && $temp_linear_config_info($c,fea_fontunderline)} {
      if {$new_font eq {}} {
        set new_font "[list $family] $size"
      }
      set new_font  "$new_font underline"
      dict set gformat_dict circular_label_font $new_font
    }
    if {[info exists temp_linear_config_info($c,fea_fontbold)] && $temp_linear_config_info($c,fea_fontbold)} {
      if {$new_font eq {}} {
        set new_font "[list $family] $size"
      }
      set new_font  "$new_font bold"
      dict set gformat_dict circular_label_font $new_font
    }
    if {$new_font ne {}} {
      $c itemconfigure $e -font $new_font
      $c itemconfigure $tag&&linear_label -font $new_font
      dict set gformat_dict linear_font $new_font
      graphic_map_redraw_label_box $c $e
    }

    if {$temp_linear_config_info($c,fea_label_angle) != "---"} {
      set anchor n
      switch $temp_linear_config_info($c,fea_label_angle) {
	270 {set anchor w}
	315 {set anchor nw}
	0 {set anchor n}
	45 {set anchor ne}
	90 {set anchor e}
      }
      $c itemconfigure $tag&&feature&&label -angle  $temp_linear_config_info($c,fea_label_angle) -anchor $anchor
      $c itemconfigure $tag&&linear_label -angle  $temp_linear_config_info($c,fea_label_angle) -anchor $anchor
      dict set gformat_dict fea_label_angle $temp_linear_config_info($c,fea_label_angle)
    }
   if {[info exists temp_linear_config_info($c,fea_box_type)] && $temp_linear_config_info($c,fea_box_type) ne "---" } {
      set this_label_box_type $temp_linear_config_info($c,fea_box_type)
      set box_item [$c find withtag $e.box]
      set box_dict [$c bind $box_item <<Box>>]
      if {[dict exists $box_dict type]} {
        dict set box_dict type $this_label_box_type 
        $c bind $box_item <<Box>> $box_dict
        graphic_map_redraw_label_box $c $e
      }
    } 
    if {[info exists temp_linear_config_info($c,fea_box_fill_color)] && $temp_linear_config_info($c,fea_box_fill_color) != 0 && $temp_linear_config_info($c,fea_box_fill_color) != -1} {
      set new_box_fill_color $temp_linear_config_info($c,fea_box_fill_color)
      $c itemconfigure $e.box -fill $new_box_fill_color
      ##dict set gformat_dict linear_fea_label_box_fill_color $new_box_fill_color
    }
    if {[info exists temp_linear_config_info($c,fea_box_outline_color)] && $temp_linear_config_info($c,fea_box_outline_color) != 0 && $temp_linear_config_info($c,fea_box_outline_color) != -1} {
      set new_box_outline_color $temp_linear_config_info($c,fea_box_outline_color)
      $c itemconfigure $e.box -outline $new_box_outline_color
      $c bind $e <<Colors>> [lreplace [$c bind $e <<Colors>>] 3 3 $new_box_outline_color]
      #dict set gformat_dict linear_fea_label_box_ouline_color $new_box_fill_color
    }
    if {[info exists temp_linear_config_info($c,fea_box_outline_width)] && ![catch {expr {1*$temp_linear_config_info($c,fea_box_outline_width)}}]} {
      set this_box_outline_width $temp_linear_config_info($c,fea_box_outline_width)
      $c itemconfigure $e.box -width $this_box_outline_width
      if { $this_box_outline_width == 0} {
        $c itemconfigure $e.box -outline {}
        $c bind $e <<Colors>> [lreplace [$c bind $e <<Colors>>] 3 3 {}]
      }
      #dict set gformat_dict linear_fea_label_box_outline_width $this_box_outline_width
    } 

    if {[info exists temp_linear_config_info($c,fea_fg_color)] && $temp_linear_config_info($c,fea_fg_color)!= 0 && $temp_linear_config_info($c,fea_fg_color)!= -1} {
      set color_list [split $temp_linear_config_info($c,fea_fg_color) ","]
      set this_fea_fg_color [lindex $color_list 0]
      set temp_linear_config_info($c,fea_fg_color) [join [list {*}[lrange $color_list 1 end] $this_fea_fg_color] ","]
      set this_fea_fg_color [process_feature_color  $c $e $this_fea_fg_color]
      $c itemconfigure $tag&&foreground -fill $this_fea_fg_color
      $c bind $tag <<Colors>> [lreplace [$c bind $tag <<Colors>>] 0 0 $this_fea_fg_color]
      dict set gformat_dict graphic_fg_color_[$c bind $tag <<Direction>>] $this_fea_fg_color
      if {[winfo exists $t]} {
        $t tag configure $e -background $this_fea_fg_color -foreground [process_feature_color $c $e vis+fill_color+black+white]
      }
    } else {
      set this_fea_fg_color [$c itemcget $tag&&foreground&&exon -fill]
    }
      
    if {[info exists temp_linear_config_info($c,fea_bg_color)] && $temp_linear_config_info($c,fea_bg_color)!= 0 && $temp_linear_config_info($c,fea_bg_color)!= -1} {
      set this_fea_bg_color  $temp_linear_config_info($c,fea_bg_color)
      $c itemconfigure $tag&&outline&&exon -fill $this_fea_bg_color  -outline $this_fea_bg_color
      $c itemconfigure $tag&&outline&&fwd_arrow -fill $this_fea_bg_color  -outline $this_fea_bg_color
      $c itemconfigure $tag&&outline&&rev_arrow -fill $this_fea_bg_color  -outline $this_fea_bg_color
# linear intron configure here
      $c itemconfigure $tag&&outline&&intron -fill $this_fea_bg_color
      $c bind $tag <<Colors>> [lreplace [$c bind $tag <<Colors>>] 2 2 $this_fea_bg_color]
      dict set gformat_dict outline_color_[$c bind $tag <<Direction>>] $this_fea_bg_color
    }
    if {[$c find withtag $tag&&intron] != [list]} {
      if {[info exists temp_linear_config_info($c,fea_intron_fg_color)] && $temp_linear_config_info($c,fea_intron_fg_color) !=-1} {
        set color_list [split $temp_linear_config_info($c,fea_intron_fg_color) ","]
        set this_fea_intron_fg_color [lindex $color_list 0]
        set temp_linear_config_info($c,fea_intron_fg_color) [join [list {*}[lrange $color_list 1 end] $this_fea_intron_fg_color] ","]
        set this_fea_intron_fg_color [process_feature_color  $c $e $this_fea_intron_fg_color]
        $c itemconfigure $tag&&intron&&foreground -fill $this_fea_intron_fg_color
        #$c bind $tag <<Colors>> [lreplace [$c bind $tag <<Colors>>] xxx xxx $this_fea_intron_fg_color]
        dict set gformat_dict intron_fg_color_[$c bind $tag <<Direction>>] $this_fea_intron_fg_color
      } else {
        set this_fea_intron_fg_color [$c itemcget $tag&&foreground&&intron -fill]
      }

      if {[info exists temp_linear_config_info($c,fea_intron_bg_color)] &&  $temp_linear_config_info($c,fea_intron_bg_color) !=-1} {
        set this_fea_intron_bg_color  [process_feature_color  $c $e $temp_linear_config_info($c,fea_intron_bg_color)]
        $c itemconfigure $tag&&intron&&outline -fill  $this_fea_intron_bg_color
        #$c bind $tag <<Colors>> [lreplace [$c bind $tag <<Colors>>] xxx xxx $this_fea_intron_bg_color]
        dict set gformat_dict intron_outline_color_$direction $this_fea_intron_bg_color
      }

      if {[info exists temp_linear_config_info($c,fea_intron_width)] && ![catch {expr {1*$temp_linear_config_info($c,fea_intron_width)}}]} {
        $c itemconfigure $tag&&foreground&&intron -width [expr {$temp_linear_config_info($c,fea_intron_width)}]
        set this_fea_intron_width $temp_linear_config_info($c,fea_intron_width)
      } else {
        set this_fea_intron_width [$c itemcget $tag&&foreground&&intron -width]
      }
      dict set gformat_dict intron_width $this_fea_intron_width

      if {[info exists temp_linear_config_info($c,fea_intron_outline)] &&![catch {expr {1*$temp_linear_config_info($c,fea_intron_outline)}}]} {
        $c itemconfigure $tag&&outline&&intron -width [expr {$this_fea_intron_width + 2 * $temp_linear_config_info($c,fea_intron_outline)}]
        dict set gformat_dict intron_outline_width $temp_linear_config_info($c,fea_intron_outline)
      }
    }

    if {![catch {expr {1*$temp_linear_config_info($c,fea_width)}}] || ([info exists temp_linear_config_info($c,fea_intron_height)] && ![catch {expr {1*$temp_linear_config_info($c,fea_intron_height)}}]) ||([info exists temp_linear_config_info($c,fea_intron_dip)] && ![catch {expr {1*$temp_linear_config_info($c,fea_intron_dip)}}])} {
       #### feature drawing code
       #### set bg_box [$c create rectangle [expr {$x1}] [expr {$y-$width/2.0}] [expr {$x2}] [expr {$y+$width/2.0}] -tag [concat $tags exon outline] -fill $tag_bg_color -outline $tag_bg_color -state $state -width 2]
       #### set fg_box [$c create rectangle [expr {$x1}] [expr {$y-$width/2.0}] [expr {$x2}] [expr {$y+$width/2.0}] -tag [concat $tags exon foreground] -fill $tag_color -state $state -outline {}
       #### $c create line [expr {$x2+0}] [expr {$y+$width/2.0}] [expr {($x1+$x2)/2.0}]  [expr {$y+$width/2.0+5}] [expr {$x1}] [expr {$y+$width/2.0}] -tag [concat $tags intron] -state $state -fill $tag_color -width 2
       ####   linear_feature_draw_arrow $c $tag
       #### $c bind $tag <<Coord_list>> [list [list $first_exon $first_exon_bg $first_exon_coords] [list $last_exon $last_exon_bg $last_exon_coords]] 
      set exons [$c find withtag $tag&&exon]
      lassign [$c coords [lindex $exons 0]] x0 y0 x1 y1
      lassign [$c coords [lindex [$c find withtag $tag&&intron] 0]] ix0 iy0 ix1 iy1


      

      if {![catch {expr {1*$temp_linear_config_info($c,fea_width)}}]} {
        set this_fea_width $temp_linear_config_info($c,fea_width)
      } else {
        set this_fea_width [expr {$y1 - $y0}]
      }


      if {![catch {expr {1*$temp_linear_config_info($c,fea_intron_height)}}]} {
        set this_fea_intron_height $temp_linear_config_info($c,fea_intron_height)
      } elseif {![catch {expr {1*$temp_linear_config_info($c,this_fea_intron_width)}}]} {
        set this_fea_intron_height [expr {round(10.0*(($y1+$y0)/2.0-$iy0)/($this_fea_width -$this_fea_intron_width))/10.0}]
      }

      if {![catch {expr {1*$temp_linear_config_info($c,fea_intron_dip)}}]} {
        set this_fea_intron_dip $temp_linear_config_info($c,fea_intron_dip)
      } elseif {$iy0 ne {}} {
        set this_fea_intron_dip [expr { round(10.0*($iy0-$iy1)/$this_fea_width)/10.0}]
      } else {
        set this_fea_intron_dip [expr { round(10.0*(0)/$this_fea_width)/10.0}]
      }

      if {[llength $exons] >0} {
        lassign [$c coords [lindex $exons 0]] x0 y0 x1 y1
        set y [expr {($y1 + $y0) / 2.0}]
        set y_top [expr {$y- $this_fea_width/2.0}]
        set y_bottom [expr {$y+ $this_fea_width/2.0}]
        foreach exon $exons {
          set coords [$c coords $exon]
          lset coords 1 $y_top
          lset coords 3 $y_bottom
          $c coords $exon $coords
        }

## set intron coords here
## linear intron configure here
        foreach intron [$c find withtag $tag&&intron] {
          set coords [$c coords $intron]
          set end_y [expr {$y- $this_fea_intron_height * max (0,$this_fea_width -$this_fea_intron_width)}]
          set dip_y [expr {$end_y- $this_fea_intron_dip * max (0,$this_fea_width)}]
          lset coords 1 $end_y
          lset coords 3 $dip_y
          lset coords 5 $end_y
          $c coords $intron $coords
        }
        
        dict set gformat_dict width $this_fea_width

        set coord_list [$c bind $tag <<Coord_list>>]
        set y0 [lindex $coord_list 0 2 1]
        set y1 [lindex $coord_list 0 2 3]
        if {$y1 != {}} {
          set y [expr {($y1 + $y0) / 2.0}]
          set y0 [expr {$y- $this_fea_width/2.0}]
          set y1 [expr {$y+ $this_fea_width/2.0}]
          lset coord_list 0 2 1 $y0
          lset coord_list 0 2 3 $y1
        }
        set y0 [lindex $coord_list 1 2 1]
        set y1 [lindex $coord_list 1 2 3]
        if {$y1 != {}} {
          set y [expr {($y1 + $y0) / 2.0}]
          set y0 [expr {$y- $this_fea_width/2.0}]
          set y1 [expr {$y+ $this_fea_width/2.0}]
          lset coord_list 1 2 1 $y0
          lset coord_list 1 2 3 $y1
        }


	$c bind $tag <<Coord_list>> $coord_list
	set redraw 1
        #linear_feature_draw_arrow $c $tag
      }
    } 

    if {![catch {expr {1*$temp_linear_config_info($c,fea_outline)}}]} {
      set fea_outline [expr {round($temp_linear_config_info($c,fea_outline))}]
## linear intron configure here
      $c itemconfigure $tag&&outline&&exon -width [expr {2 * $fea_outline}]
      $c itemconfigure $tag&&outline&&fwd_arrow -width [expr {2 * $fea_outline }]
      $c itemconfigure $tag&&outline&&rev_arrow -width [expr {2 * $fea_outline }]
      dict set gformat_dict outline_width $fea_outline
    }


    set new_label_color ""
    if {[info exists temp_linear_config_info($c,fea_label_color)] && $temp_linear_config_info($c,fea_label_color) != 0  && $temp_linear_config_info($c,fea_label_color) != -1} {
      set new_label_color $temp_linear_config_info($c,fea_label_color)
    } 
    if {$new_label_color != ""} {
      $c itemconfigure $e -fill $new_label_color
      $c bind $e <<Colors>> [lreplace [$c bind $e <<Colors>>] 0 0 $new_label_color]
      #$t tag configure $e -foreground $new_label_color
      dict set gformat_dict linear_label_color_[$c bind $tag <<Direction>>] $new_label_color
    }

    if {[dict exists $gformat_dict arrow_data]} {
      set arrow_list [dict get $gformat_dict arrow_data]
      if {$temp_linear_config_info($c,f_arrow) != -1} {
        lset arrow_list 0 $temp_linear_config_info($c,f_arrow)
        set redraw 1
      }
      if {$temp_linear_config_info($c,r_arrow) != -1} {
        lset arrow_list 1 $temp_linear_config_info($c,r_arrow)
        set redraw 1
      }
      dict set gformat_dict arrow_data $arrow_list
    }

    $c bind $tag <<Gformat>> $gformat_dict
    if {$temp_linear_config_info($c,apply)} {
      set w [bind $c <<Window>>]
      set metadata [$w.textarea tag bind $tag <<Metadata>>]
      lset metadata 1 $gformat_dict
      $w.textarea tag bind $tag <<Metadata>> $metadata
      ## apply fill color to feature
      set revcolors [$w.textarea tag bind $tag <<Revcolors>>]
      lset revcolors [$c bind $tag <<Direction>>] $temp_linear_config_info($c,fea_fg_color)
      $w.textarea tag bind $tag <<Revcolors>> $revcolors
      if {[$w.textarea tag cget $tag -background] != {}} {
        textarea_tag_configure $w.textarea $tag -background $temp_linear_config_info($c,fea_fg_color)
      }
      register_undo_separator $w "Edit Feature"
      features_to_tree_view $w
    }
    graphic_map_redraw_label_box $c $e
    if {$redraw} {
      linear_feature_draw_arrow $c $tag
    }
    $c lower $tag&&intron $tag&&exon
    $c lower $tag&&outline $tag&&foreground
  }


  treeview_sort $t [bind $t <<Sort_column>>] 1
  #rebump moveablelabels
  linear_map_reset_all_features $c
  linear_map_bump_all_features $c
}

################
## 
################
proc linear_config_fea_treeview_apply_tag_properties_to_intron {t c  dialog} {
  global temp_circ_config_info
  foreach e [$t selection] {
    set label_dict [$c bind $e <<Label>>]
    set tag [regsub fn [dict get $label_dict tag] f]
    if {[$c find withtag $tag&&intron] != [list]} {
      set gformat_dict [$c bind $tag <<Gformat>>]

      set this_fea_outline [expr {( [$c itemcget $tag&&outline&&exon -width]) /2}]
      set this_fea_intron_width [$c itemcget [lindex [$c find withtag $tag&&foreground&&intron] 0] -width]
      $c itemconfigure $tag&&outline&&intron -width [expr {$this_fea_intron_width + 2 * $this_fea_outline}]
      dict set gformat_dict intron_outline_width  $this_fea_outline

      set direction [$c bind $tag <<Direction>>]
      set this_fea_fg_color [$c itemcget $tag&&foreground&&exon -fill]
      $c itemconfigure $tag&&intron&&foreground -fill $this_fea_fg_color
      dict set gformat_dict intron_fg_color_$direction $this_fea_fg_color

      set this_fea_bg_color [$c itemcget $tag&&outline&&exon -outline]
      $c itemconfigure $tag&&intron&&outline -fill  $this_fea_bg_color
      dict set gformat_dict intron_outline_color_$direction $this_fea_bg_color

      $c bind $tag <<Gformat>> $gformat_dict
    }
  }
  linear_config_fea_treeview_manageselection $t $c $dialog
}

################
## 
################
proc linear_config_formatting_to_seq {c} {
  global info
  
  #set w [bind $c <<Window>>]
  set w $info([winfo toplevel $c],linked_windows)
  if { $w == {}} {tk_messageBox -message [mc "The window this map refers to has been modified. The formatting can't be applied."];return}
  set edited 0
  foreach tag [lsearch -inline -all -regexp [$w.textarea tag names] {f[0-9]+#}] {
    set gformat_dict  [$c bind $tag <<Gformat>>]
    if {$gformat_dict  == {}} {continue}
    
    ## add feature label pos x,y to gformat_dict here
    if {[set item [$c find withtag $tag&&feature&&label]] !={} && [$c bind $item <<Moved>>] == 1} {
 
    }

    ## Replace the gformat data in the sequence
    set metadata [$w.textarea tag bind $tag <<Metadata>>]
    set old_gformat_dict [lindex $metadata 1]
    set new_gformat_dict [dict merge $old_gformat_dict $gformat_dict]
    if {$old_gformat_dict  != $new_gformat_dict} {
      lset metadata 1 $new_gformat_dict
      textarea_tag_bind $w.textarea $tag <<Metadata>> $metadata
      set edited 1
    }

  }
  if {$edited} {
    features_to_tree_view $w
    register_undo_separator $w "Edit Feature"
  }
  
  ## add baseline, crosshair and index data here
  set seq_gformat_dict $info($w,gformat_data)

  set info($w,gformat_data) $seq_gformat_dict
}


################
## Make a theme file using global item configurations and configurations that are set for each feature type in the canvas
################
## to do: move feature, feature label, feature tick, enzyme and enzyme tick elements if they are consistently positioned in the canvas
## get the index position and set it
## can we get the tagdepth data and look for consistent positions?
## todo: make the selection and select agnostic to the treeview existing- just send treeview_manageselection procs the label item numbers from the canvas find withtag directly
proc theme_generate_theme_data {c} {
  set w [winfo toplevel $c]
  if {![winfo exists $w.f_config.tabframe.features.frame1.tv]} {return}
  set ftv $w.f_config.tabframe.features.frame1.tv
  set etv $w.f_config.tabframe.enzymes.frame1.tv
  set ttv $w.f_config.tabframe.texts.frame1.tv

  $ttv selection set [$ttv children {}]
  $etv selection set [$etv children {}]
  $ftv selection set [$ftv children {}]
  event generate $ttv <<TreeviewSelect>> 
  event generate $etv <<TreeviewSelect>> 
  event generate $ftv <<TreeviewSelect>> 

  set base_config_data [theme_parse_config $c]
  set type_dict [dict create]
  set type_fwd_dict [dict create]
  set type_rev_dict [dict create]
  foreach e [$ftv children {}] {
    if {$e eq "Hidden"} {continue}
    dict lappend type_dict [$ftv set $e Type] $e
    if {[$ftv set $e Direction] eq ">>>"} {
      dict lappend type_fwd_dict [$ftv set $e Type] $e
    } else {
      dict lappend type_rev_dict [$ftv set $e Type] $e
    }
  }
  set type_config_dict [dict create]
  set type_fwd_config_dict [dict create]
  set type_rev_config_dict [dict create]
  foreach type [dict keys $type_dict] {
    if {$type eq ""} {continue}
    $ftv selection set [dict get $type_dict $type]
    event generate $ftv <<TreeviewSelect>> 
    set new_config_data [theme_parse_config $c]
    foreach property [dict keys $new_config_data] {
      if {$property ni [dict keys $base_config_data]} {
        dict set type_config_dict $type $property [dict get $new_config_data $property]
      }
    }

    if {[dict exists $type_fwd_dict $type]} {
    	$ftv selection set [dict get $type_fwd_dict $type]
		event generate $ftv <<TreeviewSelect>> 
		set new_config_data [theme_parse_config $c]
		foreach property [dict keys $new_config_data] {
		  if {$property ni [dict keys $base_config_data] && $property ni [dict keys [dict get $type_config_dict $type]]} {
			dict set type_fwd_config_dict $type $property [dict get $new_config_data $property]
		  }
		}
    }
    if {[dict exists $type_rev_dict $type]} {
      $ftv selection set [dict get $type_rev_dict $type]
		event generate $ftv <<TreeviewSelect>> 
		set new_config_data [theme_parse_config $c]
		foreach property [dict keys $new_config_data] {
		  if {$property ni [dict keys $base_config_data] && $property ni [dict keys [dict get $type_config_dict $type]]} {
			dict set type_rev_config_dict $type $property [dict get $new_config_data $property]
		  }
		}
    }

  }

  
  ## output the text file
  set filename [tk_getSaveFile -title [mc "Save Theme As Text File"] -defaultextension ".txt"  ]
  while {($filename != "") && ([catch {set text_file [open $filename w]}])} {
    catch {close $text_file}
    tk_messageBox -title [mc "Text File not Writable"] -message [mc "The file %s is not writable. It may be locked." $filename] -type ok -icon warning -default ok
    set filename [tk_getSaveFile -title [mc "Save Theme As Text File"] -initialdir $info(default_dnadir) -defaultextension ".txt"]
  }
  if {$filename != ""} {
    ###save the text file
    puts  $text_file "#ApE graphical theme file v1"
    puts  $text_file "Select_feature	Set	length > 0%"
    puts  $text_file "Configure $base_config_data"
    foreach type [dict keys $type_config_dict] {
      puts  $text_file ""
      puts  $text_file "Select_feature	Set	feature_type in $type"
      puts  $text_file "Configure [dict get $type_config_dict $type]"
    }

    foreach type [dict keys $type_fwd_config_dict] {
      puts  $text_file ""
      puts  $text_file "Select_feature	Set	feature_type in $type"
      puts  $text_file "Select_feature	Intersect	 direction 0"
      puts  $text_file "Configure [dict get $type_fwd_config_dict $type]"
    }
    foreach type [dict keys $type_rev_config_dict] {
      puts  $text_file ""
      puts  $text_file "Select_feature	Set	feature_type in $type"
      puts  $text_file "Select_feature	Intersect	 direction 1"
      puts  $text_file "Configure [dict get $type_rev_config_dict $type]"
    }

  }
  catch {close $text_file}
}


################
## Find all text, enzyme and feature configuration settings from the canvas that have a value set by the currently selected treeview items
################
proc theme_parse_config {c} {
  global temp_circ_config_info

  set result [list]

  if {![info exists temp_circ_config_info($c,baseline_fg_width)]} {return}

  set compare_list [list]
  set compare_list [list  fea_box_outline_color -1 fea_width --- fea_fontfamily ---  fea_fg_color -1  fea_box_fill_color -1  fea_outline ---   fea_box_outline_width 2.0 fea_bg_color -1  fea_label_align --- fea_tick_length {}  fea_f_arrow -1  fea_tick_color -1 fea_fontsize ---  fea_label_color -1 fea_r_arrow -1  fea_box_type ---]
  lappend  compare_list {*}[list  crosshair_bg_color -1 crosshair_fg_color -1 baseline_bg_color -1 baseline_fg_color -1  ]
  lappend  compare_list {*}[list  enz_box_outline_width --- enz_fontsize --- enz_box_fill_color -1 enz_box_type ---  enz_box_outline_color -1 enz_label_color -1   enz_fontfamily --- enz_tick_color -1 enz_tick_width --- enz_tick_length --- enz_label_subst "multiple" fea_intron_width ---  fea_intron_outline --- fea_intron_height --- fea_intron_bg_color -1  fea_intron_fg_color -1]
  lappend  compare_list {*}[list  text_fontsize --- text_label_color -1 text_fontfamily ---]

  foreach {property value}  $compare_list {
    if {[info exists temp_circ_config_info($c,$property)] && $temp_circ_config_info($c,$property) ne $value} {
      lappend result $property $temp_circ_config_info($c,$property)
    }
  }

  foreach property [list fea_label_arc fea_label_show_connector enz_label_show_connector fea_visible enz_visible text_visible  fea_fontbold  fea_fontunderline  fea_fontitalic  enz_fontitalic  enz_fontunderline  enz_fontbold] {
    if {[info exists temp_circ_config_info($c,$property)]} {
      lappend result $property $temp_circ_config_info($c,$property)
    }
  }
  lappend result baseline_fg_width [expr {round([$c itemcget circle -width])}]
  lappend result baseline_bg_width  [expr {round(([$c itemcget circle_background -width] - [$c itemcget circle -width]) /2 )}]
  lappend result crosshair_length [expr {round([lindex [$c coords crosshair&&vert] 3] / [lindex [$c coords circle] 2] * 100.0) /100.0}]
  lappend result crosshair_fg_width  [expr {round([$c itemcget crosshair -width])}]
  lappend result crosshair_bg_width  [expr {round(([$c itemcget crosshair_background -width] - [$c itemcget crosshair -width]) /2 )}]

  set old_tick_dict [$c bind 1 <<Tick_dict>>]
  foreach {d_val c_val} [list circular_map_index_max_tick_spacing index_bp_per_max circular_map_index_max_at_zero max_at_zero index_label_format index_label_format  index_text_angle_format index_text_angle_format  circular_index_max_tick_color  index_maj_tick_fg_color index_circular_text_color index_circular_text_color  circular_index_max_tick_width index_maj_tick_width  circular_index_min_tick_per_max index_min_per_max circular_index_min_tick_color index_min_tick_fg_color circular_index_min_tick_width index_min_tick_width] {
    lappend result "$c_val" [dict get $old_tick_dict $d_val]
  }
  lappend result index_tick_fontfamily [font actual [dict get $old_tick_dict circular_index_max_tick_font]  -family]
  lappend result index_tick_fontsize [font actual [dict get $old_tick_dict circular_index_max_tick_font]  -size]
  lappend result index_min_tick_length [expr {100* [dict get $old_tick_dict circular_index_min_tick_length]}]
  lappend result index_maj_tick_length [expr {100* [dict get $old_tick_dict circular_index_max_tick_length]}]
  return $result
}


################
## Parse theme files for circular map
################
proc parse_theme_file {c} {
  global temp_circ_config_info
  set filename [tk_getOpenFile -title [mc {Open Theme File}] -filetypes {{{Text Files} {.txt}} {{All Files} *}}]
  if {$filename eq {}} {return}
  if {![catch {open $filename r} fileid err]} {
    set selected_enzymes [list]
    set selected_features [list]
    set selected_texts [list]
    set filtered_enzymes [list]
    set filtered_features [list]
    set filtered_texts [list]
 
     if {[catch { set line [gets $fileid] } ] } {
       sputs File error in parse_theme_file
       return
     } elseif {$line ne "#ApE graphical theme file v1"} {
       sputs File error in parse_theme_file
       return
    }
    set temp_circ_config_info($c,depthdict) [tagdepth_features_canvas $c 0]
    while {[eof $fileid] != 1} {
      set line [gets $fileid]
#sputs line $line
      switch -regexp -nocase -matchvar match_list $line {
        {^Configure\s+(.*)} {
          parse_theme_file_configure $c [lindex $match_list 1] $filtered_features $filtered_enzymes $filtered_texts
        }
        {^Select_enzyme\s+(Inter[^\s]*|Set|Uni[^\s]*|Dif[^\s]*|And|Or|Desel[^\s]*|Sel[^\s]*)\s+(.*)} {
          set operator [lindex $match_list 1]
          set new_enzymes [parse_theme_file_select_enzymes $c [lindex $match_list 2]]
          set selected_enzymes [parse_theme_file_set_operator  $operator  $selected_enzymes $new_enzymes]
          set filtered_enzymes $selected_enzymes
          sputs selected enzymes $new_enzymes $selected_enzymes
        }
        {^Select_enzyme\s+(.*)} {
          set selected_enzymes [parse_theme_file_select_enzymes $c [lindex $match_list 1]]
          set filtered_enzymes $selected_enzymes
        }
        {^Move_enzymes\s+([lt]?)([\+\-]?[0-9\.]+)([p\%]?)} {
        }
        {^Select_feature\s+(Inter[^\s]*|Set|Uni[^\s]*|Dif[^\s]*|And|Or|Desel[^\s]*|Sel[^\s]*)\s+(.*)} {
          set operator [lindex $match_list 1]
          set new_features [parse_theme_file_select_features $c [lindex $match_list 2]]
#sputs oper $operator $selected_features $new_features 
          set selected_features [parse_theme_file_set_operator $operator $selected_features $new_features]
          set filtered_features $selected_features
#sputs filt $filtered_features
        }
        {^Select_feature\s+(.*)} {
          set selected_features [parse_theme_file_select_features $c  [lindex $match_list 1]]
          set filtered_features $selected_features
        }
        {^Select_texts\s+(.*)} {
          set selected_texts [parse_theme_file_select_texts $c  [lindex $match_list 1]]
          set filtered_texts $selected_texts
        }
        {^Move_feature\s+([flt]?)([\+\-]?[0-9\.]+)([pwf\%]?)} {
          lassign $match_list -- feature_or_label value pixel_or_percent_width
          if {$feature_or_label eq {}} {set feature_or_label "f"}
          if {$pixel_or_percent_width eq {}} {set pixel_or_percent_width "p"}
          if {$pixel_or_percent_width eq "%"} {set pixel_or_percent_width "w"}
          parse_theme_file_move_features $c $filtered_features $feature_or_label   $value   $pixel_or_percent_width
        }
        {^Recalculate_arc_text_depth\s*} {
          set temp_circ_config_info($c,depthdict) [tagdepth_features_canvas $c 1]
        }
        {^Recalculate_depth\s*} {
          set temp_circ_config_info($c,depthdict) [tagdepth_features_canvas $c 0]
        }
        {^Restack_arc_texts\s*} {
          restack_arc_texts $c
        }
        {^Move_enzyme\s+(.*)} {
          parse_theme_file_move_enzymes $c $filtered_enzymes
        }
        {^Move_index\s+([\+\-]?[0-9\.]+)} {
          lassign $match_list -- pixels
          parse_theme_file_move_index $c $pixels
        }
        {^\s*$} {
          #sputs blank line
        }
        {\#(.*)} {
          #sputs comment [lindex $match_list 1]
        }
        {default} {
          sputs bad line: $line
        }
      }
    }
  } else {
    tk_messageBox -message [mc "Error reading $filename: %s." $err] -type ok
    return
  }
  close $fileid

}

###########
## Configure features and enzymes using data_dict
     #boolean: fea_visible   fea_label_arc   fea_label_show_connector    enz_label_show_connector  enz_visible   text_visible  fea_fontbold  fea_fontunderline  fea_fontitalic  enz_fontitalic  enz_fontunderline  enz_fontbold
     #integer:   fea_box_outline_width   fea_width   fea_outline   fea_tick_width   fea_tick_length     fea_fontsize     enz_box_outline_width   enz_fontsize     text_fontsize   baseline_fg_width    crosshair_fg_width   crosshair_bg_width   baseline_bg_width  index_bp_per_max   index_maj_tick_width      index_min_per_max   index_min_tick_width      index_tick_fontsize enz_tick_width  enz_tick_length fea_intron_width  fea_intron_outline
     # real: fea_intron_height  index_maj_tick_length  index_min_tick_length  crosshair_length
     #font:   fea_fontfamily   enz_fontfamily   text_fontfamily   index_tick_fontfamily
     #color: (hex, text, label_color, text_color, fill_color, fg_color, bg_color, outline_color,box_color  mix+color+color+%%, vis+reference_color+option_color+option_color (max luminance difference?) process_feature_color):  fea_box_fill_color   fea_box_outline_color   fea_fg_color   fea_bg_color   fea_label_color   fea_tick_color     enz_label_color   enz_box_fill_color   enz_box_outline_color   text_label_color   baseline_fg_color   baseline_bg_color    crosshair_fg_color   crosshair_bg_color    index_maj_tick_fg_color   index_circular_text_color   index_min_tick_fg_color  index_min_tick_fg_color fea_intron_bg_color fea_intron_fg_color
     #box_type: ($outline_box_types_dict keys): fea_box_type   enz_box_type
     #index angle type ([list h r90 r45 r0ccw r0]) :index_text_angle_format
     #index angle format type {[list none 1000 1,000 "1 000" 1.000 "1.0 k" "1 k"]: index_label_format
     #align_type ([list "Center" "CCW" "CW" "5'" "3'"]): fea_label_align
     #arrow_value: fea_f_arrow fea_r_arrow
     #enz_label_subst: string

###########
proc parse_theme_file_configure {c data_dict features enzymes texts} {
  global info temp_circ_config_info outline_box_types_dict 

  #initialize the data array to default values
  #set temp_array [array get temp_circ_config_info]
  array set temp_circ_config_info [list  $c,fea_box_outline_color -1 $c,fea_width --- $c,fea_fontfamily ---  $c,fea_fg_color -1  $c,fea_box_fill_color -1  $c,fea_outline ---   $c,fea_box_outline_width 2.0 $c,fea_bg_color -1   $c,fea_box_type_label --- $c,fea_label_align --- $c,fea_tick_length {}  $c,fea_f_arrow -1  $c,fea_tick_color -1 $c,fea_fontsize ---  $c,fea_label_color -1 $c,fea_r_arrow -1  $c,fea_box_type ---]

  array set temp_circ_config_info [list  $c,crosshair_bg_color -1 $c,crosshair_fg_color -1 $c,baseline_bg_color -1 $c,baseline_fg_color -1  ]
  array set temp_circ_config_info [list  $c,enz_box_outline_width --- $c,enz_fontsize --- $c,enz_box_fill_color -1 $c,enz_box_type ---  $c,enz_box_outline_color -1 $c,enz_label_color -1 $c,enz_box_type_label ---  $c,enz_fontfamily --- $c,enz_tick_color -1 $c,enz_tick_width --- $c,enz_tick_length --- $c,enz_label_subst "multiple" $c,fea_intron_width ---  $c,fea_intron_outline --- $c,fea_intron_height --- $c,fea_intron_bg_color -1  $c,fea_intron_fg_color -1]
  array set temp_circ_config_info [list  $c,text_fontsize --- $c,text_label_color -1 $c,text_fontfamily ---]


  foreach it [list $c,fea_label_arc $c,fea_label_show_connector $c,enz_label_show_connector $c,fea_visible $c,enz_visible $c,text_visible  $c,fea_fontbold  $c,fea_fontunderline  $c,fea_fontitalic  $c,enz_fontitalic  $c,enz_fontunderline  $c,enz_fontbold] {
    unset -nocomplain temp_circ_config_info($it)
  }
  set temp_circ_config_info($c,baseline_fg_width) [expr {round([$c itemcget circle -width])}]
  set temp_circ_config_info($c,baseline_bg_width)  [expr {round(([$c itemcget circle_background -width] - [$c itemcget circle -width]) /2 )}]
  set temp_circ_config_info($c,crosshair_length) [expr {round([lindex [$c coords crosshair&&vert] 3] / [lindex [$c coords circle] 2] * 100.0) /100.0}]
  set temp_circ_config_info($c,crosshair_fg_width)  [expr {round([$c itemcget crosshair -width])}]
  set temp_circ_config_info($c,crosshair_bg_width)  [expr {round(([$c itemcget crosshair_background -width] - [$c itemcget crosshair -width]) /2 )}]


  set old_tick_dict [$c bind 1 <<Tick_dict>>]
  foreach {d_val c_val} [list circular_map_index_max_tick_spacing index_bp_per_max circular_map_index_max_at_zero max_at_zero index_label_format index_label_format  index_text_angle_format index_text_angle_format  circular_index_max_tick_color  index_maj_tick_fg_color index_circular_text_color index_circular_text_color  circular_index_max_tick_width index_maj_tick_width  circular_index_min_tick_per_max index_min_per_max circular_index_min_tick_color index_min_tick_fg_color circular_index_min_tick_width index_min_tick_width] {
    set temp_circ_config_info($c,$c_val) [dict get $old_tick_dict $d_val]
  }
  set temp_circ_config_info($c,index_tick_fontfamily) [font actual [dict get $old_tick_dict circular_index_max_tick_font]  -family]
  set temp_circ_config_info($c,index_tick_fontsize) [font actual [dict get $old_tick_dict circular_index_max_tick_font]  -size]
  set temp_circ_config_info($c,index_min_tick_length) [expr {100* [dict get $old_tick_dict circular_index_min_tick_length]}]
  set temp_circ_config_info($c,index_maj_tick_length) [expr {100* [dict get $old_tick_dict circular_index_max_tick_length]}]

  set w [winfo toplevel $c]
  set element_list [list]
sputs data_dict $data_dict
  foreach {element data} $data_dict {
sputs conf $element $data $features
    if {$element in [list fea_visible   fea_label_arc  fea_label_show_connector  enz_label_show_connector  enz_visible   text_visible fea_fontbold  fea_fontunderline  fea_fontitalic  enz_fontitalic  enz_fontunderline  enz_fontbold]} {
      if {[string is boolean $data]} {
        set temp_circ_config_info($c,$element) $data
        lappend element_list $element
      } else {
        sputs "bad configure data ($element): $data"
      }
    } elseif {$element in [list   index_min_tick_length  index_maj_tick_length  crosshair_length]} {
      if {[string is double $data]} {
        set temp_circ_config_info($c,$element) $data
        lappend element_list $element
      } else {
        sputs "bad configure data ($element): $data"
      }
    } elseif {$element in [list fea_intron_height ]} {
      if {[string is double $data] && $data <1 && $data > -1} {
        set temp_circ_config_info($c,$element) $data
        lappend element_list $element
      } else {
        sputs "bad configure data ($element): $data"
      }
    } elseif {$element in [list fea_box_outline_width   fea_width   fea_outline   fea_tick_width   fea_tick_length     fea_fontsize     enz_box_outline_width   enz_fontsize     text_fontsize   baseline_fg_width crosshair_fg_width   crosshair_bg_width   baseline_bg_width  index_bp_per_max   index_maj_tick_width    index_min_per_max   index_min_tick_width      index_tick_fontsize  enz_tick_width  enz_tick_length  fea_intron_width   fea_intron_outline]} {
      if {[string is integer $data]} {
        set temp_circ_config_info($c,$element) $data
        lappend element_list $element
      } else {
        sputs "bad configure data ($element): $data"
      }
    } elseif {$element in [list fea_fontfamily   enz_fontfamily   text_fontfamily   index_tick_fontfamily]} {
      if {$data in [font families]} {
        set temp_circ_config_info($c,$element) $data
        lappend element_list $element
      } else {
        sputs "bad configure data ($element): $data"
      }
    } elseif {$element in [list fea_box_fill_color   fea_box_outline_color   fea_fg_color   fea_bg_color   fea_label_color   fea_tick_color     enz_label_color   enz_box_fill_color   enz_box_outline_color   text_label_color   baseline_fg_color   baseline_bg_color    crosshair_fg_color   crosshair_bg_color    index_maj_tick_fg_color   index_circular_text_color   index_min_tick_fg_color  enz_tick_color  fea_intron_bg_color   fea_intron_fg_color]} {
      set test_color $data
sputs tc $test_color
      regsub -all -nocase {text_color|label_color|fg_color|fill_color|bg_color|outline_color|box_color}  $test_color  #000 test_color
      if {($test_color == {}) || ([string first "," $test_color] > -1) || ![catch {winfo rgb . $test_color}] || ([regexp {mix\+([^+]+)\+([^+]+)\+([0-9]+)} $test_color -- color1 color2 percent] && ![catch {winfo rgb . $color1}] && ![catch {winfo rgb . $color2}] && [string is integer $percent]) || ([regexp {vis\+([^+]+)\+([^+]+)\+([^+]+)} $test_color -- color1 color2 color3] && ![catch {winfo rgb . $color1}] && ![catch {winfo rgb . $color2}] && ![catch {winfo rgb . $color3}] ) } {
        set temp_circ_config_info($c,$element) $data
        lappend element_list $element
      } else {
        sputs "bad configure data ($element): $data"
      }
    } elseif {$element in [list  fea_box_type   enz_box_type]} {
      if { $data in [dict keys $outline_box_types_dict]} {
        set temp_circ_config_info($c,$element) $data
        lappend element_list $element
      } else {
        sputs "bad configure data ($element): $data"
      }
    } elseif {$element in [list  index_text_angle_format]} {
      if { $data in [list h r90 r45 r0ccw r0]} {
        set temp_circ_config_info($c,$element) $data
        lappend element_list $element
      } else {
        sputs "bad configure data ($element): $data"
      }
    } elseif {$element in [list index_label_format]} {
      if { $data in [list "none" "1000" "1,000" "1 000" 1.000 "1.0 k" "1 k"]} {
        set temp_circ_config_info($c,$element) $data
        lappend element_list $element
      } else {
        sputs "bad configure data ($element): $data"
      }
    } elseif {$element in [list  fea_label_align]} {
      if { $data in [list "Center" "CCW" "CW" "5'" "3'" "-CCW" "-CW" "-5'" "-3'"]} {
        set temp_circ_config_info($c,$element) $data
        lappend element_list $element
      } else {
        sputs "bad configure data ($element): $data"
      }
    } elseif {$element in [list  enz_label_subst]} {
        set temp_circ_config_info($c,$element) [string map {%s " "} $data]
        lappend element_list $element
    } elseif {$element in [list  fea_f_arrow fea_r_arrow]} {
      set valid 1
      if { [expr {[llength $data] % 2}] == 0} {
        foreach v $data {
          if {![string is double $v]} {
            set valid 0
             break
          }
        }
      } elseif {[set ix [lsearch -exact [dict values $info(arrow_dict)] $data]] > -1} {
        set data [lindex [dict keys $info(arrow_dict)] $ix]
      } else {
        set valid 0
      }
      if {$valid} {
        set temp_circ_config_info($c,$element) $data
        lappend element_list $element
      } else {
        sputs "bad configure data ($element): $data"
      }
    } else {
      sputs "bad configure element: $element"
    }
  }

  if { [lsearch -nocase -regexp $element_list {^baseline_.*}] >-1 || [lsearch -nocase $element_list{^crosshair_.*}] >-1} {

    circular_config_baseline_apply $c
  }
  if { [lsearch -nocase -regexp $element_list {^enz_.*}] >-1 } {
    circular_config_enz_treeview_apply $enzymes $c
  }
  if { [lsearch -nocase -regexp $element_list {^text_.*}] >-1 } {
    circular_config_text_treeview_apply $texts $c
  }
  if { [lsearch -nocase -regexp $element_list {^fea_.*}] >-1 } {
#sputs conf_features $features
    circular_config_fea_treeview_apply $features $c
  }
  if { [lsearch -nocase -regexp $element_list {^index_.*}] >-1 } {
    circular_config_index_apply  $c
  }
   
  #array set temp_circ_config_info $temp_array

  if {[winfo exists $w.f_config.tabframe.features.frame1.tv]} {
    event generate $w.f_config.tabframe.texts.frame1.tv <<TreeviewSelect>> 
    event generate $w.f_config.tabframe.enzymes.frame1.tv <<TreeviewSelect>> 
    event generate $w.f_config.tabframe.features.frame1.tv <<TreeviewSelect>> 
  }
  set temp_circ_config_info($c,baseline_fg_color) [$c itemcget circle -outline]
  set temp_circ_config_info($c,baseline_bg_color) [$c itemcget circle_background -outline]
  set temp_circ_config_info($c,crosshair_fg_color) [$c itemcget crosshair -fill]
  set temp_circ_config_info($c,crosshair_bg_color) [$c itemcget crosshair_background -fill]
  foreach it [list  $c,fea_fontbold  $c,fea_fontunderline  $c,fea_fontitalic  $c,enz_fontitalic  $c,enz_fontunderline  $c,enz_fontbold] {
    unset -nocomplain temp_circ_config_info($it)
  }
  #foreach e_val [list fea_visible enz_visible text_visible] {
  #  if {[dict exists $e_val $vis_dict]} {
  #    set temp_circ_config_info($c,$e_val) [dict get $e_val  $vis_dict]
  #  } else {
   #   unset -nocomplain temp_circ_config_info($c,$e_val)
  #  }
  #}
}

###########
#(location_start (<>==>=<=) (# #%))  (count (<>==>=<=) (#)) (name re_match) (dir (0 1)) (in_group $enzinfo(enz_groups_list) ($enzinfo(enz_groups,$group_name)))   
    #type enzyme location_start 1032 name XmnI tag XmnI count 1 dir 0 top_cut_site 1036 bottom_cut_site 1036
proc parse_theme_file_select_enzymes {c data_list} {
  global enzinfo
  set enz_set [$c find withtag enzyme&&label]
  foreach enz_element $enz_set {
     dict set enz_dict_dict $enz_element [$c bind $enz_element <<Label>>]
  }
  set total_length [$c bind 1 <<Total_length>>]

  foreach data_element [split $data_list \t] {
    set new_list [list]

    foreach enz_element $enz_set {
      set enz_dict [dict get $enz_dict_dict $enz_element]
      switch -regexp -nocase -matchvar match_list $data_element {
        {location[^\s]*\s*(<|>|==|>=|<=)\s*([0-9]+\%?)} {
          lassign $match_list -- comparison location
          if {[regexp {([0-9]+)\%} $location -- percent]} {
            set location [expr {round($total_length*$percent/100.0)}]
          }
          if "[dict get $enz_dict location_start] $comparison $location" {
            lappend new_list $enz_element
          }
        }
        {count\s*(<|>|==|>=|<=)\s*([0-9]+)} {
          lassign $match_list -- comparison count
          if "[dict get $enz_dict count] $comparison $count" {
            lappend new_list $enz_element
          }
        }
        {name\s*(.*)} {
          lassign $match_list -- re_match
          if "[regexp $re_match [dict get $enz_dict name] ]" {
            lappend new_list $enz_element
          }
        }
        {dir[^\s]*\s+(.*)} {
          lassign $match_list -- dir
          if {[string is boolean $dir] && ($dir?1:0) ==  [dict get $enz_dict dir]} {
            lappend new_list $enz_element
          }
        }
        {in_group\s+(.*)} {
          lassign $match_list -- group_name
          if {[info exists enzinfo(enz_groups,$group_name)] && [dict get $enz_dict name] in $enzinfo(enz_groups,$group_name)} {
            lappend new_list $enz_element
          }
        }
        default {
          sputs select_enz_element bad element: $data_element
        }
      }
    }
    set enz_set $new_list
    if {$enz_set == [list]} {
      break
    }
  }
  return $enz_set
}

###########
# (feature_type (in ni) $genbank_typelist) (location_start (<>==>=<=) (# #%)) (location_end (<>==>=<=) (# #%)) (length (<>==>=<=) (# #%)) (name re_match) (direction (0 1)) (overlap_depth (<>==>=<=) (#))
#type feature feature_type misc_recomb location_start 592 location_end 824 location_c 708 length 232 name attP4 tag f0# direction 0 fea_tick_length 10 show_connector 1 use_arc 0 arc_text_offset 8.5
# (set depthdict [tagdepth_features_window $w.textarea])
proc parse_theme_file_select_features {c  data_list} {
  global genbank_typelist temp_circ_config_info
  set fea_set [$c find withtag feature&&label]
  foreach fea_element $fea_set {
     dict set fea_dict_dict $fea_element [$c bind $fea_element <<Label>>]
  }
  set total_length [$c bind 1 <<Total_length>>]
  #set depthdict [tagdepth_features_window [bind $c <<Window>>].textarea]


sputs select $c $data_list
  foreach data_element [split $data_list \t] {
    set new_list [list]
    foreach fea_element $fea_set {
      set fea_dict [dict get $fea_dict_dict $fea_element]
      switch -regexp -nocase -matchvar match_list $data_element {
        {feature_type\s+(in|ni)\s+(.*)} {
          lassign $match_list -- comparison type_list
          if {[string is list $type_list]} {
            if "\"[dict get $fea_dict feature_type]\" $comparison \[list $type_list\]" {
              lappend new_list $fea_element 1
            }
          }
        }
        {location_start\s*(<|>|==|>=|<=)\s*([0-9]+\%?)} {
          lassign $match_list -- comparison location
          if {[regexp {([0-9]+)\%} $location -- percent]} {
            set location [expr {round($total_length*$percent/100.0)}]
          }
          if "[dict get $fea_dict location_start] $comparison $location" {
            lappend new_list $fea_element [dict get $fea_dict location_start]
          }
        }
        {location_end\s*(<|>|==|>=|<=)\s*([0-9]+\%?)} {
          lassign $match_list -- comparison location
          if {[regexp {([0-9]+)\%} $location -- percent]} {
            set location [expr {round($total_length*$percent/100.0)}]
          }
          if "[dict get $fea_dict location_end] $comparison $location" {
            lappend new_list $fea_element [dict get $fea_dict location_end]
          }
        }
        {length\s*(<|>|==|>=|<=)\s*([0-9]+\%?)} {
          lassign $match_list -- comparison length
          if {[regexp {([0-9]+)\%} $length -- percent]} {
            set length [expr {round($total_length*$percent/100.0)}]
          }
          if "[dict get $fea_dict length] $comparison $length" {
            lappend new_list $fea_element [dict get $fea_dict length]
          }
        }
        {name\s+(.*)} {
          lassign $match_list -- re_match

sputs name "[regexp -nocase $re_match [dict get $fea_dict name]] regexp -nocase $re_match [dict get $fea_dict name]"
          if "[regexp -nocase $re_match [dict get $fea_dict name] ]" {
            lappend new_list $fea_element 1
          }
        }
        {dir[^\s]*\s+(.*)} {
          lassign $match_list -- dir
          if {[string is boolean $dir] && ($dir?1:0) ==  [dict get $fea_dict direction]} {
            lappend new_list $fea_element  [dict get $fea_dict direction]
          }
        }
        {overlap[^\s]*\s*(<|>|==|>=|<=)\s*([0-9]+)} {
          lassign $match_list -- comparison overlap
          set tag [dict get $fea_dict tag]
          regsub {fn} $tag f tag
          if {[dict exists $temp_circ_config_info($c,depthdict) $tag]} {
            if "[dict get  $temp_circ_config_info($c,depthdict) $tag] $comparison $overlap" {
              lappend new_list $fea_element [dict get  $temp_circ_config_info($c,depthdict) $tag]
            }
          }
        }
        {arc_text_len[^\s]*\s*(<|>|==|>=|<=)\s*((:?len.*)|(:?[0-9\.]+\%))} {
          if {[dict get $fea_dict use_arc] } {
            lassign $match_list -- comparison  len 
            set tag [dict get $fea_dict tag]
            regsub fn $tag f tag
             if {[regexp {([0-9]+)\%} $len -- percent]} {
               set c_radius [lindex [$c coords 1] 2]
              set length [expr {round($percent/100.0  * $c_radius * 6.28)}]
            } else {
              set f_radius [lindex [$c coords [lindex [$c find withtag $tag&&exon] 0]] 2]
              set length [expr {1.0 * [dict get $fea_dict length] /$total_length * $f_radius * 6.28}] 
            }
            set item [lindex [$c find withtag $tag&&circular_label] 0]
            set arc_text_length  [font measure [$c itemcget $item -font] [dict get $fea_dict name] ]
            if "$arc_text_length $comparison $length" {
              lappend new_list $fea_element $arc_text_length
            }
          }
        }
        default {
          sputs select_fea_element bad element: $data_element
        }
      }
    }
    set fea_set [dict keys [lsort -integer -stride 2 -index 1 $new_list]]
  }
#sputs fs $fea_set
  return $fea_set
}

###########
# {title  seq_length  file_comment  enz_list feature_list}
proc parse_theme_file_select_texts {c  data_list} {

  set return [list]
  foreach text_element $data_list {
    set text_element [string tolower $text_element]
    if {$text_element in [list title  seq_length  file_comment  enz_list feature_list]} {
      lappend return [$c find withtag $text_element]
    } else {
      sputs select_text_element bad element: $text_element
    }
  }
  return $return
}

###########
## operator old_list  new_list
proc parse_theme_file_set_operator {operator set1 set2} {
  switch -nocase -regexp $operator {
    "Set" {
      return $set2
    }
    "Sel.*" -
    "Or" -
    "Uni.*" {
      return [lsort -integer -unique [concat $set1 $set2]]
    }
    "And" -
    "Inter.*" {
       set return [list]
       foreach a $set1 {
         if {$a in $set2} {
           lappend return $a
         }
       }
       return $return
    }
    "Desel.*" -
    "Dif.*" {
       set return [list]
       foreach a $set1 {
         if {$a ni $set2} {
           lappend return $a
         }
       }
       return $return
    }
    default {
      return $set2
     }
  }
}

###########
#(move [f l]+integer+[p w]): [proc circular_config_fea_treeview_apply_move  $e_list $c $value $item(f|l) $pixel(p|w)]
proc parse_theme_file_move_features {c filtered_features feature_or_label   value   pixel_or_percent} {
#sputs move feature $filtered_features $feature_or_label   $value   $pixel_or_percent
  circular_config_fea_treeview_apply_move  $filtered_features $c $value $feature_or_label $pixel_or_percent
}

###########
proc parse_theme_file_move_enzymes {c filtered_enzymes} {
}

###########
#[proc circular_map_change_scale_radius c r]
proc parse_theme_file_move_index {c tick_offset} {
  if {[$c type 1] == "oval"} {
    set map_radius [lindex [$c coords 1] 2]
    set tick_radius [expr {$tick_offset + $map_radius}]
    circular_map_change_scale_radius $c $tick_radius
  }
}

###########
## Restack arc feature labels that are outside of their feature anotations
###########
## brute force
proc restack_arc_texts {c} {
  set data [list]
  set j 0
  set temp [list]
sputs restack arcs
  foreach f [$c find withtag feature&&label] {
    lappend temp $f [expr {rand()}]
  }
  foreach f [dict keys [ lsort -real -index 1 -stride 2 $temp]] {
    set label_dict [$c bind $f <<Label>>]
    if {$j > 100} {break}
    if {[dict get $label_dict use_arc]  && [dict get $label_dict length] >0 } {
      incr j
      set tag [dict get $label_dict tag]
      regsub fn $tag f tag
      set arc_offset [dict get $label_dict arc_text_offset]
      set label_r 100
      set overlapping 1
      set i 0
      while {$i <500 && $label_r > 50 && [expr {abs($arc_offset)}] > .2 && $overlapping} {
       incr i
        set overlapping 0
        set this_circular_items [$c find withtag $tag&&circular_label]
        foreach char $this_circular_items {
          if {[$c bbox $char] eq {}} {continue}
          foreach item [$c find overlapping {*}[$c bbox $char]] {
            if {"circular_label" in [$c itemcget $item -tags] && $item ni $this_circular_items} {
              lassign [$c coords $char] cx cy
              lassign [$c coords $item] ix iy
              if {[expr {sqrt(($cx-$ix)**2+($cy-$iy)**2)}] < [font metrics [$c itemcget $char -font] -linespace] } {
                set overlapping 1 
                break
              }
            } 
          }
          if {$overlapping} {break}
        }
        if {!$overlapping} {continue}
        set f_radius [lindex [$c coords [lindex [$c find withtag $tag&&exon] 0]] 2]
        set label_dict [$c bind $f <<Label>>]
        set arc_offset [dict get $label_dict arc_text_offset]
        set label_r [expr {$f_radius+$arc_offset - [font metrics [$c itemcget $char -font] -linespace] }]
        canvas_circular_text $c $tag $label_r
      }
    }
  }
}


###############
## find feature overlap depth using canvas feaures, including arc texts
##############
proc tagdepth_features_canvas {c {use_text 0}} {

  set total_length [$c bind 1 <<Total_length>>]
  set circumference [expr {2*3.14 * [lindex [$c coords 1] 2]}]

  ## generated length sorted list of feature tags
  set tag_sorted_list [dict create]
  set tag_ranges [dict create]
  foreach label_item  [$c find withtag feature&&label] {
    set label_dict [$c bind $label_item <<Label>>]
    set tag [dict get $label_dict tag]
    regsub "fn" $tag f tag
    set location_start [dict get $label_dict location_start]
    set location_end [dict get $label_dict location_end]
    set direction [dict get $label_dict direction]
set seqlen ""
    if {$direction} {
      ## reverse feature
      set length [expr {($location_start - $location_end) % $total_length}]
      if {$use_text && [dict get $label_dict use_arc]} {
        set align [dict get $label_dict fea_label_align]
        set texlen [font measure [$c itemcget $label_item -font]  [$c itemcget $label_item -text]]
        set circumference [expr {2*3.14 * [lindex [$c coords [lindex [$c find withtag exon] 0]] 2]}]
        set seqlen [expr {int(1.0 * $texlen/ $circumference * $total_length)}]
        if {$align in [list -CCW -3']} {
          set location_end [expr {($location_end - $seqlen) % $total_length}]
        } elseif {$align in [list -CW -5']} {
          set location_start [expr {($location_start + $seqlen) % $total_length}]
        } elseif {$seqlen > $length} {
          if {$align in [list CW 5']} {
           set location_end [expr {($location_start - $seqlen) % $total_length}]
          } elseif {$align in [list CCW 3']} {
            set location_start [expr {($location_end + $seqlen) % $total_length}]
          } elseif {$align in [list Center]} {
            set location_end [expr {($location_end - int(($seqlen-$length)/2)) % $total_length}]
            set location_start [expr {($location_start + int(($seqlen-$length)/2)) % $total_length}]
          }
        }
#sputs rev $tag $seqlen [$c itemcget $label_item -text]
      }
      if {$location_start > $location_end} {
        dict set tag_ranges $tag [list $location_end $location_start]
      } else {
        dict set tag_ranges $tag [list 0 $location_start  $location_end $total_length]
      }

    } else {
      #forward feature
      set length [expr {($location_end - $location_start) % $total_length}]
       if {$use_text &&[dict get $label_dict use_arc]} {
        set align [dict get $label_dict fea_label_align]
        set texlen [font measure [$c itemcget $label_item -font]  [$c itemcget $label_item -text]]
        set circumference [expr {2*3.14 * [lindex [$c coords [lindex [$c find withtag exon] 0]] 2]}]
        set seqlen [expr {int(1.0 * $texlen/ $circumference * $total_length)}]
        if {$align in [list -CW -3']} {
          set location_end [expr {($location_end + $seqlen) % $total_length}]
        } elseif {$align in [list -CCW -5']} {
          set location_start [expr {($location_start - $seqlen) % $total_length}]
        } elseif {$seqlen > $length} {
          if {$align in [list CCW 5']} {
           set location_end [expr {($location_start + $seqlen) % $total_length}]
          } elseif {$align in [list CW 3']} {
            set location_start [expr {($location_end - $seqlen) % $total_length}]
          } elseif {$align in [list Center]} {
            set location_end [expr {($location_end + int(($seqlen-$length)/2)) % $total_length}]
            set location_start [expr {($location_start - int(($seqlen-$length)/2)) % $total_length}]
          }
        }
#sputs fwd $tag $seqlen [$c itemcget $label_item -text]
      }
      if {$location_start < $location_end} {
        dict set tag_ranges $tag [list $location_start  $location_end]
      } else {
        dict set tag_ranges $tag [list 0 $location_end $location_start $total_length]
      }
    }
    dict set tag_sorted_list $tag $length
  }
  set tag_sorted_list [lsort -integer -decreasing -index 1 -stride 2 $tag_sorted_list]
#sputs tsl $tag_sorted_list
#sputs tr $tag_ranges
  set f_tag_result [list]
  set f_range_result [list]
  set result {}
  foreach tag [dict keys $tag_sorted_list] {
    if {1} {
      set tag_range [dict get $tag_ranges $tag]
      set i 0
      set overlap 1
      foreach ll $f_range_result tl $f_tag_result {
        set overlap 0
        foreach {a b} $tag_range {
          foreach {c d} $ll {
            if {!($b <= $c ||  $a >= $d )} {
              set overlap 1 
              break
            }
          }
          if {$overlap} {
            break
          }
        }
        if {!$overlap} {
          dict set result $tag $i
          lappend tl $tag
          #lset f_tag_result $i $tl
          lappend ll {*}$tag_range
          lset f_range_result $i $ll
          break
        }
        incr i
      }
      if {$overlap} {
        dict set result $tag $i
        #lset f_tag_result $i $tag
        lset f_range_result $i $tag_range
      }

    }
  }
sputs r
  return $result
}



################
## Return a grayed version of input color
################
proc gray_color {color} {
  set c [format "\#%04X%04X%04X" [expr {int([lindex [winfo rgb . $color] 0] * 0.6)}] [expr {int([lindex [winfo rgb . $color] 1] * 0.6)}] [expr {int([lindex [winfo rgb . $color] 2] * 0.6)}]]
}

proc mix_color {color1 color2 percent} {
  if {$percent > 1} {set percent [expr {$percent / 100.0}]}
  foreach {r1 g1 b1} [winfo rgb . $color1] {r2 g2 b2} [winfo rgb . $color2] {}
  return [format "\#%04X%04X%04X" [expr {min(65535,int($r1 * $percent + $r2 * (1-$percent)))}] [expr {min(65535,int($g1 * $percent + $g2 * (1-$percent)))}] [expr {min(65535,int($b1 * $percent + $b2 * (1-$percent)))}]]
}

################
## Add circular feature to a graphic map
################
proc draw_circular_feature {w c tag} {
  global modifier info

      #tag the labels with the tag name too
      #$c addtag $tag withtag "$tag\_label" 

      if {[string match fn* $tag]} {
        regsub "fn" $tag "f" tag2
      } else {
        set tag2 $tag
      }

      set hidden_state 0
      #if {[catch {set tag_color [format "\#%04X%04X%04X" {*}[winfo rgb . [$w.textarea tag cget $tag2 -background]]]}]} {
      #  set tag_color [lindex [$w.textarea tag bind $tag2 <<Revcolors>>] [lindex [$w.textarea tag bind $tag2 <<Metadata>>] 3]]
      #  set hidden_state "hidden"
      #}

      set config_treeview "[winfo toplevel $c].f_config.tabframe.features.frame1.tv"
      set label_item_number [$c find withtag label&&$tag2]


       # circular feature binding
      #if across origin
      if {[llength [set ranges [$w.textarea tag ranges $tag]]] > 2} {
        $c bind $tag2 <Shift-Button-1> "select_region $w \[bp2ix $w.textarea [ix2bp $w.textarea [lindex $ranges 2]]\] \[bp2ix $w.textarea [ix2bp $w.textarea [lindex $ranges 3]]\]; if {\[winfo exists $config_treeview\]} {$config_treeview selection add $label_item_number; $config_treeview see $label_item_number}" 
       # $c bind $id <Shift-Double-Button-1> "select_region $w \[bp2ix $w.textarea [ix2bp $w.textarea [lindex $ranges 2]]\] \[bp2ix $w.textarea [ix2bp $w.textarea [lindex $ranges 3]]\]; event generate $c <<Return>>;break"
        lappend info($w,linked_events) [list $c $tag2 <Shift-Button-1>] [list $c $tag2 <Shift-Double-Button-1>]
      } else {
        $c bind $tag2 <Shift-Button-1> "if {\[winfo exists $config_treeview\]} {$config_treeview selection add $label_item_number; $config_treeview see $label_item_number}" 
      }

      if {[string match fn* $tag]} {
        #split tag
  ##use get_feature_exons_indexes
        set fnranges $ranges
        set ranges [$w.textarea tag ranges $tag2]
        set start_i [lindex $fnranges 2]
        set start_i_i [lsearch -exact $ranges $start_i]
        #rotate ranges to start with first exon
        set ranges [concat [lrange $ranges $start_i_i end] [lrange $ranges 0 [expr {$start_i_i - 1}]]]
        #check for exon across origin 
        if {([set one_i [lsearch -exact $ranges 1.0]] > -1) && ([lindex $ranges [expr {$one_i -1}]] eq [end_ix $w.textarea])} {
          set ranges [lreplace $ranges [expr {$one_i -1}] $one_i]
        }
      } elseif {[llength $ranges] == 4} {
        #non-split tag that crosses the origin
        set ranges [list [lindex $ranges 2]  [lindex $ranges 1]]
      }


      set total_length [ix2bp $w.textarea end]
      set direction [lindex [$w.textarea tag bind $tag2 <<Metadata>>] 3]
      



      ###need to get width, radius, arrow_list from Metadata 1
      set gformat [lindex [$w.textarea tag bind $tag2 <<Metadata>>] 1]
      set width [dict get $gformat width]
      if {$width == ""} {set width 1}
      set width [expr {$width * $info(tk_scaling)}]
      set arrow_list [dict get $gformat arrow_data]

  
      if {[dict exists $gformat graphic_fg_color_$direction]} {
        set tag_color [dict get $gformat graphic_fg_color_$direction]
      } else {
	set tag_color [lindex [$w.textarea tag bind $tag2 <<Revcolors>>] [lindex [$w.textarea tag bind $tag2 <<Metadata>>] 3]]
      }
  
      if {[dict exists $gformat outline_color_$direction]} {
        set tag_bg_color [dict get $gformat outline_color_$direction]
      } else {
        set tag_bg_color [gray_color $tag_color]
      }

      if {[dict exists $gformat outline_width]} {
        set tag_outline_width [dict get $gformat outline_width]
      } else {
        set tag_outline_width 1
      }
  
      ## intron formatting
      if {[dict exists $gformat intron_fg_color_$direction]} {
        set tag_intron_fg_color [dict get $gformat intron_fg_color_$direction]
      } else {
        set tag_intron_fg_color $tag_color
      }

      if {[dict exists $gformat intron_width]} {
        set tag_intron_width [dict get $gformat intron_width]
      } else {
        set tag_intron_width 1
      }

      if {[dict exists $gformat intron_outline_color_$direction]} {
        set tag_intron_bg_color [dict get $gformat outline_color_$direction]
      } else {
        set tag_intron_bg_color $tag_bg_color
      }

      if {[dict exists $gformat intron_outline_width]} {
        set tag_intron_outline_width [dict get $gformat intron_outline_width]
      } else {
        set tag_intron_outline_width $tag_outline_width
      }

      if {[dict exists $gformat intron_height]} {
        set tag_intron_height [dict get $gformat intron_height]
      } else {
        set tag_intron_height 0
      }


      set radius [lindex [$c coord circle] 2]
      if {[dict exists $gformat feature_relative_radius]} {
        set feature_radius [expr {[dict get $gformat feature_relative_radius] + $radius}]
      } else {
        set feature_radius $radius
        dict set gformat feature_relative_radius 0
      }
      set r [expr {$feature_radius }]
      ## intron radius
      set ri [expr {(1-2 * $direction ) * (max(0,($width- $tag_intron_width)) *  $tag_intron_height ) + $r}]

      set last_stop -1000
      foreach {start stop} $ranges {
        set start_angle [expr {90.0-(360.0*[ix2bp $w.textarea $start]/$total_length)}]

        set extent_angle [expr {1.0 *(([ix2bp $w.textarea $stop]-[ix2bp $w.textarea $start]-1)%$total_length)/$total_length * -360}]
        #bug in arc drawing for extents <0.45, on windows
        if {([tk windowingsystem] == "win32") && ([expr {abs($extent_angle)}] < 0.9)} {set extent_angle [expr {sign($extent_angle)*0.9}]}
        $c create arc [expr {-$r}] [expr {-$r}] $r $r -style arc -width [expr {$width+2*$tag_outline_width}] -start [expr {$start_angle+0.5}] -extent [expr {$extent_angle -1.0}] -outline $tag_bg_color  -tags [list $tag2 outline exon]
        $c create arc [expr {-$r}] [expr {-$r}] $r $r -style arc -width $width -start $start_angle -extent $extent_angle -outline $tag_color -tags [list $tag2 foreground exon]
        lappend coord_list $start_angle $extent_angle
        #draw introns
# circular intron configure here
        if {$last_stop != -1000} {
          set start_anglei [expr {90.0-(360.0*[ix2bp $w.textarea $last_stop]/$total_length)}]
          set extent_anglei [expr {1.0 *(([ix2bp $w.textarea $start]-[ix2bp $w.textarea $last_stop]-1)%$total_length+2)/$total_length * -360}]
          if {([tk windowingsystem] == "win32") && ([expr {abs($extent_anglei)}] < 0.9)} {set extent_anglei [expr {$extent_anglei/abs($extent_anglei)*0.9}]}
          $c create arc [expr {-$ri}] [expr {-$ri}] $ri $ri -style arc -width [expr {$tag_intron_width + 2*$tag_intron_outline_width}] -start [expr {$start_anglei+0.5}] -extent [expr {$extent_anglei -1.0}] -outline $tag_intron_bg_color -tags [list $tag2 outline intron]
          $c create arc [expr {-$ri}] [expr {-$ri}] $ri $ri -style arc -width $tag_intron_width -start $start_anglei -extent $extent_anglei -outline $tag_intron_fg_color -tags [list $tag2 foreground intron]
        }
        set last_stop $stop
      }
      $c raise foreground outline
      #make dummy arrow items - coordinates are set later
      ## bezier arrow data change here -  arrow points list can be dict of pts min_x_scale and smooth
      $c create polygon 0 0 -outline $tag_bg_color -width [expr {max (0,2 * $tag_outline_width )}] -joinstyle round  -tags [list $tag2 fwd_arrow outline]
      $c create polygon 0 0 -fill $tag_color   -outline {} -joinstyle round -tags [list $tag2 fwd_arrow foreground] 
                     #$c create line 0 0 0 0 -fill $tag_bg_color -width 2 -tags [list $tag2 fwd_arrow outline]
      $c create polygon 0 0 -outline $tag_bg_color -width [expr {max(0,2 * $tag_outline_width )}] -joinstyle round -tags [list $tag2 rev_arrow outline]
      $c create polygon 0 0 -fill $tag_color -outline {} -joinstyle round -tags [list $tag2 rev_arrow foreground]
                       #$c create line 0 0 0 0 -fill $tag_bg_color -width 2 -tags [list $tag2 rev_arrow outline]
  if {([dict exists $gformat circular_state] && [dict get $gformat circular_state] eq "hidden")  || (![dict exists $gformat circular_state] && [$w.textarea tag cget $tag2 -background] == {})} {
        $c itemconfigure $tag2 -state hidden
      }
      $c bind $tag2 <<Arrow_list>> $arrow_list
      $c bind $tag2 <<Coord_list>> $coord_list
      $c bind $tag2 <<Direction>> $direction
      $c bind $tag2 <<Gformat>>  $gformat
      #redraw feature to set arrows etc.
      change_radius $c $tag2 $r
      $c bind $tag2&&(exon||intron||fwd_arrow||rev_arrow) <$modifier-Button1-Motion> "circular_feature_drag $c $tag2 \[$c canvasx %x\] \[$c canvasy %y\]"
      $c bind $tag2 <Enter> "$c raise label&&$tag2; $c itemconfigure (connector||label||tick)&&$tag2 -fill \[lindex \[$c bind [$c find withtag label&&$tag2] <<Colors>>] 1\]; $c itemconfigure label_box&&$tag2 -outline \[lindex \[$c bind [$c find withtag label&&$tag2] <<Colors>>] 1\]; $c itemconfigure (fwd_arrow||rev_arrow)&&outline&&$tag2 -outline \[lindex \[$c bind $tag2 <<Colors>>\] 1\]; $c itemconfigure exon&&outline&&$tag2 -outline \[lindex \[$c bind $tag2 <<Colors>>\] 1\]"

      $c bind $tag2 <Leave> "$c itemconfigure (label)&&$tag2 -fill \[lindex \[$c bind [$c find withtag label&&$tag2] <<Colors>>] 0\]; $c itemconfigure (connector||tick)&&$tag2 -fill \[lindex \[$c bind [$c find withtag label&&$tag2] <<Colors>>] 2\]; $c itemconfigure label_box&&$tag2 -outline \[lindex \[$c bind \[$c find withtag label&&$tag2] <<Colors>>\] 3\]; $c itemconfigure (fwd_arrow||rev_arrow)&&outline&&$tag2 -outline \[lindex \[$c bind $tag2 <<Colors>>\] 2\]; $c itemconfigure exon&&outline&&$tag2 -outline \[lindex \[$c bind $tag2 <<Colors>>\] 2\]"

     # draw circular texts to features
      # arrange circular text- has to come after defining <<Label>> for the name to be defined, also after feature is drwn so <<Coords>> is defined
      if {[dict exists $gformat arc_text_offset]} {
	set arc_text_radius [expr { $r + [dict get $gformat arc_text_offset]}]
      } else {
        set font [list $info(graphicfontfamily) $info(graphicfontsize)]
	set arc_text_radius  [expr {[font metrics $font -ascent] * .5 + $r +$width/2+$tag_outline_width}]
      }
      canvas_circular_text $c [regsub fn $tag f] $arc_text_radius



      if {$info(android)} {
        $c bind $tag2&&(exon||intron||fwd_arrow||rev_arrow) <Button-1> [ $c bind $tag2&&(exon||intron||fwd_arrow||rev_arrow) <$modifier-Button1-Motion>]
      }
 
      # circular feature binding
      regsub "fn" $tag "f" tag
      set label_dict [$c bind $tag <<Label>>]
      $c bind $tag <Enter> "+ if {!\[info exists move_delay\]} {$c lower seqtext; $c itemconfigure seqtext -text {[dict get $label_dict name] [dict get $label_dict location_start]..[dict get $label_dict location_end]}}"
      $c bind $tag <Leave> "+$c itemconfigure seqtext -text {}"
      $c bind $tag <<Colors>> [list $tag_color red $tag_bg_color]
      $c bind $tag <$modifier-Button-1> continue
      $c bind $tag <Button-1> "select_region $w \[bp2ix $w.textarea [ix2bp $w.textarea [lindex $ranges 0]]\] \[bp2ix $w.textarea [ix2bp $w.textarea [lindex $ranges end]]\];  if {\[winfo exists $config_treeview\]} {$config_treeview selection set $label_item_number; $config_treeview see $label_item_number}" 
      $c bind $tag <Double-Button-1> "select_region $w \[bp2ix $w.textarea [ix2bp $w.textarea [lindex $ranges 0]]\] \[bp2ix $w.textarea [ix2bp $w.textarea [lindex $ranges end]]\]; event generate $c <<Return>>;break" 
      lappend info($w,linked_events) [list $c $tag <Button-1>] [list $c $tag <Double-Button-1>]
} 

################
## Drag a circular feature- moves feturre, labels and circular_labels
################
proc circular_feature_drag {c tag x y} {
  global move_delay
  if {[info exists move_delay]} {
    after cancel $move_delay
  }
  set move_delay [after 1000 {unset move_delay}]
  $c itemconfigure seqtext -text {}

  set degtorad 0.017453292522222223
  set old_r [lindex [$c coords $tag&&exon] 2]
  set new_r [expr {sqrt($x*$x+$y*$y)}]

  change_radius $c $tag $new_r
  set label_dict [$c bind [$c find withtag $tag&&moveablelabel] <<Label>>]
  # don't move the label if the tick is locked to a raduis rather than to the feature
  if {![dict exists $label_dict  tick_anchor_raduis ] || [dict get $label_dict  tick_anchor_raduis] eq {}} {
    if {1} {
      ## radial move
      set r_diff [expr {$new_r-$old_r}]
      foreach e1 [$c find withtag $tag&&(tick||connector||tick_aa||connector_aa||moveablelabel)] {
        set c_list [list]
        foreach {x0 y0} [$c coords $e1] {
           lappend c_list [expr {$r_diff * $x0 / sqrt($x0**2 + $y0**2) + $x0}] [expr {$r_diff * $y0 / sqrt($x0**2 + $y0**2) + $y0}]
        }
        $c coords $e1 {*}$c_list
      }
    } else {
     ## cartesian move
      foreach {x0 y0 x1 y1} [$c coords [$c find withtag $tag&&tick]] {}
      set tick_len [expr {sqrt(($x0-$x1)**2 + ($y0-$y1)**2)}]
      $c move ($tag&&(tick||connector||tick_aa||connector_aa||moveablelabel) [expr {($new_r-$old_r)*abs($x1-$x0)/$tick_len}] [expr {($new_r-$old_r)*abs($y1-$y0)/$tick_len}]
    }

    if {[$c find withtag $tag&&circular_label] != {}} {
      foreach {lx ly} [$c coords $tag&&circular_label] {}
      set label_r [expr {sqrt($lx*$lx+$ly*$ly)}]
      canvas_circular_text $c $tag [expr {$label_r+$new_r-$old_r}]
    }
  }
  #rebump moeablelabels
  foreach i [$c find withtag moveablelabel] {
    if {[$c bind $i <<Moved>>] ==""} {
      circular_map_reset_moveablelabel $c $i
    }
  }
  ## set last arg to 1 to avoid connectors in bump process
  circular_map_bump_all_moveablelabel $c "" 1
}

################
## Change radius of a circular feature- can also be used to redraw feature
################
proc change_radius {c tag r} {
  set degtorad 0.017453292522222223
  set direction [$c bind $tag <<Direction>>]
  set outline_width [expr {([$c itemcget exon&&outline&&$tag -width] - [$c itemcget exon&&foreground&&$tag -width]) / 2}]
  set width [$c itemcget [lindex [$c find withtag exon&&foreground&&$tag] 0] -width]
  #set width [expr {$width + $outline_width/2.0} ]


  set r_0 [lindex [$c coords [lindex [$c find withtag $tag&&exon] 0]] 2]
  if {$r == {}} {
    set r $r_0
  } 
  set circle_radius [lindex [$c coords [$c find withtag circle]] 2]
  set label_dict  [$c bind $tag <<Label>>]
  dict set label_dict feature_relative_radius [expr {$r - $circle_radius}]
  $c bind $tag <<Label>> $label_dict

  #change radius of exons and introns
  foreach i [$c find withtag exon&&$tag] {
    $c coords $i [expr {-$r}] [expr {-$r}] [expr {$r}] [expr {$r}]
  }

# circular intron configure here
  set ri_0 [lindex [$c coords [lindex [$c find withtag $tag&&intron] 0]] 2]
  if {$ri_0 ne {}} {
    #set ri [expr {(-2 * $direction +1) * ($width / 2-1) + $r}]
    set ri [expr {$ri_0 -$r_0 + $r}]
    foreach i [$c find withtag intron&&$tag] {
      $c coords $i [expr {-$ri}] [expr {-$ri}] [expr {$ri}] [expr {$ri}]
    }
  }

  #set the arrow coordinates
  if {$direction} {
    set fwd_pts [lindex [$c bind $tag <<Arrow_list>>] 1]
    set rev_pts [lindex [$c bind $tag <<Arrow_list>>] 0]
  } else {
    set fwd_pts [lindex [$c bind $tag <<Arrow_list>>] 0]
    set rev_pts [lindex [$c bind $tag <<Arrow_list>>] 1]
  }
  set flip [lindex [$c bind $tag <<Arrow_list>>] 2]
  set flip 0
  ## bezier arrow data change here-  arrow points list can be dict of pts min_x_scale and smooth
  ## look for b in arrow data to set -smooth raw
  if {[dict exists $fwd_pts pts]} {
    if {[dict exists $fwd_pts min_x_scale]} {
      set fwd_min_x_scale  [dict get $fwd_pts min_x_scale]
    } else {
      set fwd_min_x_scale  0.2
    }
    if {[dict exists $fwd_pts smooth]} {
      set fwd_smooth  [dict get $fwd_pts smooth]
    } else {
      set fwd_smooth 0
    }
    set fwd_pts [dict get $fwd_pts pts]
  } else {
    set fwd_min_x_scale  0.2
    set fwd_smooth 0
  }
  if {[dict exists $rev_pts pts]} {
    if {[dict exists $rev_pts min_x_scale]} {
      set rev_min_x_scale  [dict get $rev_pts min_x_scale]
    } else {
      set rev_min_x_scale  0.2
    }
    if {[dict exists $rev_pts smooth]} {
      set rev_smooth  [dict get $rev_pts smooth]
    } else {
      set rev_smooth 0
    }
    set rev_pts [dict get $rev_pts pts]
  } else {
    set rev_min_x_scale  0.2
    set rev_smooth 0
  }
  $c itemconfigure fwd_arrow&&foreground&&$tag -smooth $fwd_smooth
  $c itemconfigure rev_arrow&&foreground&&$tag -smooth $rev_smooth
  $c itemconfigure fwd_arrow&&background&&$tag -smooth $fwd_smooth
  $c itemconfigure rev_arrow&&background&&$tag -smooth $rev_smooth


  set first_exon [lindex [$c find withtag exon&&foreground&&$tag] 0]
  set first_exon_outline [lindex [$c find withtag exon&&outline&&$tag] 0]
  set rev_angle [lindex [$c bind $tag <<Coord_list>>] 0]

  set last_exon [lindex [$c find withtag exon&&foreground&&$tag] end]
  set last_exon_outline [lindex [$c find withtag exon&&outline&&$tag] end]
  set fwd_angle [expr {[lindex [$c bind $tag <<Coord_list>>] end-1] + [lindex [$c bind $tag <<Coord_list>>] end]}]

  set r_max_x 0
  foreach {x y} $rev_pts {
    set r_max_x [expr {max($x, $r_max_x)}]
  }

  set f_max_x 0
  foreach {x y} $fwd_pts {
    set f_max_x [expr {max($x, $f_max_x)}]
  }

  set rev_angle_adjust [expr {1.0* min(($r_max_x+.01) *$width, max($r, 10))  / max($r, 10)  / $degtorad }]
  set fwd_angle_adjust [expr {1.0* min(($f_max_x+.01) *$width, max($r, 10)) / max($r, 10)  / $degtorad }]

  ## if fwd_adjust or rev_adjust are longer than first or last exon, center the fwd and/or rev arrow on the first and/or last exon
  #set rev_angle_adjust [expr {min ($rev_angle_adjust, ($rev_angle_adjust -[lindex [$c bind $tag <<Coord_list>>] 1]) / 2.0)}]
  #set fwd_angle_adjust [expr {min ($fwd_angle_adjust, ($fwd_angle_adjust- [lindex [$c bind $tag <<Coord_list>>] end]) / 2.0)}]
  set center_long_arrows 0
  # if fwd_adust +rev_adjust are longer than the total extent of the feature
  set feature_length [expr {$rev_angle - $fwd_angle}]
  while {$feature_length < 360} {
    set feature_length [expr {$feature_length +360}]
  }
  if {[expr {$rev_angle_adjust + $fwd_angle_adjust}] > $feature_length} {
      set x_scale [expr {1.0*($feature_length) / max (2,($rev_angle_adjust + $fwd_angle_adjust))}]
      if {$x_scale < $rev_min_x_scale || $x_scale < $fwd_min_x_scale} {
        if {$rev_min_x_scale  < $fwd_min_x_scale} {
          set fwd_x_scale [expr {max($x_scale , $fwd_min_x_scale)}]
          set fwd_angle_adjust [expr {$fwd_angle_adjust * $fwd_x_scale}]
          set rev_x_scale [expr {max($rev_min_x_scale, 1.0*($feature_length) / max (2,($rev_angle_adjust + $fwd_angle_adjust)))}]
          set rev_angle_adjust [expr {$rev_angle_adjust * $rev_x_scale}]
        } else {
          set rev_x_scale [expr {max($x_scale , $rev_min_x_scale)}]
          set rev_angle_adjust [expr {$rev_angle_adjust * $rev_x_scale}]
          set fwd_x_scale [expr {max ($fwd_min_x_scale, 1.0*($feature_length) / max (2,($rev_angle_adjust + $fwd_angle_adjust)))}]
          set fwd_angle_adjust [expr {$fwd_angle_adjust * $fwd_x_scale}]
        }
      } else {
          set fwd_x_scale $x_scale
          set fwd_angle_adjust [expr {$fwd_angle_adjust * $fwd_x_scale}]
          set rev_x_scale $x_scale
          set rev_angle_adjust [expr {$rev_angle_adjust * $rev_x_scale}]
      }
      set new_pts [list]
      foreach {x y} $rev_pts {
        lappend new_pts [expr {$x * $rev_x_scale}] $y
      }
      set rev_pts $new_pts
      set new_pts [list]
      foreach {x y} $fwd_pts {
        lappend new_pts [expr {$x * $fwd_x_scale}] $y
      }
      set fwd_pts $new_pts
      if {[expr {$rev_angle_adjust + $fwd_angle_adjust}] > [expr {$rev_angle - $fwd_angle}]} {
        # i fthey are still too big, center the two
        set rev_angle_adjust0 $rev_angle_adjust
        set fwd_angle_adjust0 $fwd_angle_adjust
        set rev_angle_adjust [expr {$rev_angle_adjust0 - (($rev_angle_adjust0 + $fwd_angle_adjust0)-($rev_angle - $fwd_angle))/2.0}]
        set fwd_angle_adjust [expr {$fwd_angle_adjust0 - (($rev_angle_adjust0 + $fwd_angle_adjust0)-($rev_angle - $fwd_angle))/2.0}]
      }  
  }

  set rev_angle [expr {$rev_angle- $rev_angle_adjust }]
  set fwd_angle [expr {$fwd_angle + $fwd_angle_adjust}]



  #adjust the start and extent of the 1st and last exons to make proper space for the arrows
  if {$first_exon == $last_exon} {
    set extent_angle [expr {min (0, [lindex [$c bind $tag <<Coord_list>>] 1] + $rev_angle_adjust  + $fwd_angle_adjust -0.06*$width)}]
    if {([tk windowingsystem] == "win32") && ([expr {abs($extent_angle)}] < 0.9)} {set extent_angle [expr {sign($extent_angle)*0.9}]}
    $c itemconfigure $first_exon -start [expr {$rev_angle+ 0.03*$width}] -extent $extent_angle
    $c itemconfigure $first_exon_outline -start [expr {$rev_angle+ 0.03*$width}] -extent $extent_angle
  } else {
    set extent_angle [expr {min (0, [lindex [$c bind $tag <<Coord_list>>] 1] + $rev_angle_adjust -0.06*$width)}]
    if {([tk windowingsystem] == "win32") && ([expr {abs($extent_angle)}] < 0.9)} {set extent_angle [expr {sign($extent_angle)*0.9}]}
    $c itemconfigure $first_exon -start [expr {$rev_angle+ 0.03*$width}] -extent $extent_angle
    $c itemconfigure $first_exon_outline -start [expr {$rev_angle+ 0.03*$width}] -extent $extent_angle
    set extent_angle [expr {min (0,[lindex [$c bind $tag <<Coord_list>>] end] + $fwd_angle_adjust -0.1)}]
    if {([tk windowingsystem] == "win32") && ([expr {abs($extent_angle)}] < 0.9)} {set extent_angle [expr {sign($extent_angle)*0.9}]}
    $c itemconfigure $last_exon -extent $extent_angle
    $c itemconfigure $last_exon_outline -extent $extent_angle
  }
#sputs ext  $tag $extent_angle $fwd_angle $fwd_angle_adjust $rev_angle $rev_angle_adjust [$c bind $tag <<Coord_list>>]  

   #linear arrow coords
  #set r_arrow_y [expr {-($r) * sin($rev_angle * $degtorad)}]
  #set r_arrow_x [expr {($r) * cos($rev_angle * $degtorad)}]
  #set rev_coords [arrow_coords $r_arrow_x $r_arrow_y [expr {180 -$rev_angle}] 0 $width $rev_pts $flip]
  ## bezier arrow data change here-  arrow points list can be dict of pts min_x_scale and smooth
  set rev_coords [circ_arrow_coords $r [expr {$rev_angle * $degtorad}] 1 $width $rev_pts [expr {$direction ^ $flip}]]
  if {[llength $rev_coords] == 0} {
    $c coords rev_arrow&&foreground&&$tag {}
    $c coords rev_arrow&&outline&&$tag {}
  } else {
    $c coords rev_arrow&&foreground&&$tag {*}$rev_coords
    # needed for line outline; #if {[llength $rev_coords] < 4} {set rev_coords_outline [list 0 0 0 0]} else {set rev_coords_outline $rev_coords}
    set rev_coords_outline $rev_coords
    $c coords rev_arrow&&outline&&$tag $rev_coords_outline
  }


  #set f_arrow_y [expr {-($r) * sin($fwd_angle * $degtorad)}]
  #set f_arrow_x [expr {($r) * cos($fwd_angle * $degtorad)}]
  #set fwd_coords [arrow_coords $f_arrow_x $f_arrow_y [expr {-$fwd_angle}] 0 $width $fwd_pts $flip]
  ## bezier arrow data change here-  arrow points list can be dict of pts min_x_scale and smooth
  set fwd_coords [circ_arrow_coords $r [expr {$fwd_angle * $degtorad}] 0 $width $fwd_pts [expr {$direction ^ $flip}]]


  if {[llength $fwd_coords] == 0} {
    $c coords fwd_arrow&&foreground&&$tag {}
    $c coords fwd_arrow&&outline&&$tag {}
  } else {
    $c coords fwd_arrow&&foreground&&$tag {*}$fwd_coords
    # needed for line outline; #if {[llength $fwd_coords] < 4} {set fwd_coords_outline [list 0 0 0 0]} else {set fwd_coords_outline $fwd_coords}
    set fwd_coords_outline $fwd_coords
    $c coords fwd_arrow&&outline&&$tag $fwd_coords_outline
  }
#$c itemconfigure fwd_arrow&&foreground&&$tag -fill {} -outline red -width 1
#$c itemconfigure fwd_arrow&&outline&&$tag -fill {} -outline red -width 1


  #adjust the extent angles of the exon outlines
#  foreach a [$c find withtag exon&&outline&&$tag] b [$c find withtag exon&&foreground&&$tag] {
 #   $c itemconfigure $a -start [expr {[$c itemcget $b -start]+ ($b != $first_exon || ($direction ? ($fwd_coords!={}) : ($rev_coords!={}))) * $outline_width * 180 / pi() / $r}] -extent [expr {[$c itemcget $b -extent] - (($b != $first_exon || ($direction ? ($fwd_coords!={}) : ($rev_coords!={}))) + ($b != $last_exon || ($direction ? ($rev_coords!={}) : ($fwd_coords!={})))) * $outline_width  * 180 / pi() / $r}]
#sputs here1 $tag $a  [$c itemcget $a -start] [$c itemcget $a -extent]
 #sputs here1 $tag $b $first_exon $fwd_coords $direction [expr { ($b != $first_exon || ($direction ? ($fwd_coords!={}) : ($rev_coords!={})))}] [expr { (($b != $first_exon || ($direction ? ($fwd_coords!={}) : ($rev_coords!={}))) + ($b != $last_exon || ($direction ? ($rev_coords!={}) : ($fwd_coords!={}))))}]
 # }

  $c raise foreground&&$tag outline&&$tag

}

################
## Return a list of arrow coordinates
################
proc arrow_coords {x y angle dir width pts {flip 0}} {
  set degtorad 0.017453292522222223
  set pts_list [list]
  if {$dir} {
    set angle [expr {$angle +180}]
  }
  foreach {pt1 pt2} $pts {
    if {$flip} {
      set pt2 [expr {(-1)*$pt2}]
    }
    lappend pts_list [expr {$x+ (cos($angle * $degtorad) * $pt2 - sin($angle * $degtorad) *$pt1) * 1.0 * $width}]  [expr { $y- (sin($angle * $degtorad) * $pt2 + cos($angle * $degtorad) *$pt1) * 1.0 *(.0+ $width)}]
  }
  return $pts_list
}

################
## Return a list of arrow coordinates in radial coordinates
################
proc circ_arrow_coords {radius angle dir width pts {flip 0}} {
#sputs radius angle dir $radius $angle $dir $pts
  set pts_list [list]
  foreach {pt1 pt2} $pts {
    set a_angle [expr {$angle+$pt1/max($radius,3)*$width*($dir?1:-1)}]
    set a_radius [expr {$radius+$pt2*$width*($flip?-1:1)}]
    lappend pts_list [expr {$a_radius*cos($a_angle)}]  [expr {$a_radius*-sin($a_angle)}]
  }
  return $pts_list
}


if {0} {
  toplevel .t
  grid [canvas .t.c -bg white -scroll {-100 -100 100 100}] -sticky nswe
  set b [.t.c create polygon 0 0 -smooth raw -fill gray80 -outline red]
  set text [.t.c create text 0 0 -text "Test 1 Test" -font {Helvetica 24} -angle 0]
  .t.c coords $b [create_label_box_coords [.t.c bbox $text] chip 0]
  .t.c coords $b [create_label_box_coords [.t.c bbox $text] parallelogram 0]
}
################
## Return a list of label box coordinates for raw smoothed polygon- rectangle, chip and r_rect
################
proc create_label_box_coords {bbox padding type {angle 0} {anchorx 0} {anchory 0}} {
  lassign $bbox x1 y1 x2 y2
  if {$x2 == {} || $x1 =={}} {
    return {}
  }
  set w [expr {$x2-$x1+2*$padding}]
  set h [expr {$y2-$y1+2*$padding}]
  set s  0
  set c 1

  switch $type {
    none {
      set res [list]
    }
    rectangle {
      set res [list  [expr {$x1 }] [expr {$y1}] ]
      lappend res  [expr {$x1+$w  * $c  }] [expr {$y1 + $s *$w }]  [expr {$x1}] [expr {$y1}]  [expr {$x1+$w  * $c }] [expr {$y1+ $s *$w }] 
      lappend res [expr {$x1+$w * $c - $s *$h }] [expr {$y1+$h * $c + $s * $w}] [expr {$x1+$w * $c}] [expr {$y1+ $s *$w}] [expr {$x1+$w * $c - $s *$h }] [expr {$y1+$h * $c + $s *$w}] 
      lappend res  [expr {$x1 - $s *$h}] [expr {$y1+$h* $c }]  [expr {$x1+$w  * $c - $s *$h}] [expr {$y1+$h* $c + $s *$w }]  [expr {$x1 - $s *$h}] [expr {$y1+$h* $c }] 
      lappend res  [expr {$x1  }]  [expr {$y1 }] [expr {$x1  - $s *$h }]  [expr {$y1+$h * $c }] [expr {$x1  }]  [expr {$y1 }] 
      lappend res  [expr {$x1 }] [expr {$y1 }] 
    }
    chip {
      set r [expr {$h/2.0}]
      set k  [expr {$r*4.0/3*(sqrt(2)-1)}] 
      set res [list  [expr {$x1+$r* $c }] [expr {$y1+ $s *$r}] ]
      lappend res  [expr {$x1+($w -$r) * $c  }] [expr {$y1 + $s *($w -$r)}]  [expr {$x1+$r * $c }] [expr {$y1+ $s *$r}]  [expr {$x1+($w -$r) * $c }] [expr {$y1+ $s *($w -$r)}] 
      lappend res  [expr {$x1+($w -$r+$k) * $c }] [expr {$y1+ $s * ($w -$r+$k)}] [expr {$x1+$w * $c - $s *($r-$k)}] [expr {$y1+($r-$k)* $c + $s * $w}] [expr {$x1+$w * $c - $s *$r}] [expr {$y1+$r* $c + $s *$w }]
      lappend res [expr {$x1+$w * $c - $s *($h -$r+$k)}] [expr {$y1+($h -$r+$k)* $c + $s *$w}]  [expr {$x1+($w -$r+$k) * $c - $s *$h}] [expr {$y1+$h* $c + $s * ($w -$r+$k)}]  [expr {$x1+($w -$r) * $c - $s *$h}] [expr {$y1+$h* $c + $s *($w -$r)}] 
      lappend res  [expr {$x1+$r * $c - $s *$h}] [expr {$y1+$h* $c + $s *$r}]  [expr {$x1+($w -$r) * $c - $s *$h}] [expr {$y1+$h* $c + $s *($w -$r)}]  [expr {$x1+$r * $c - $s *$h}] [expr {$y1+$h* $c + $s *$r}] 
      lappend res  [expr {$x1+($r-$k) * $c - $s *$h}] [expr {$y1+$h* $c + $s *($r-$k)}] [expr {$x1  - $s *($h -$r+$k)}]  [expr {$y1+($h -$r+$k)* $c }] [expr {$x1  - $s *($h -$r)}]  [expr {$y1+($h -$r)* $c }]
      lappend res [expr {$x1 - $s *($r-$k)}]  [expr {$y1+($r-$k)* $c }]  [expr {$x1+($r-$k) * $c }] [expr {$y1 + $s *($r-$k)}]  [expr {$x1+$r * $c }] [expr {$y1+ $s *$r}] 
      lappend res  [expr {$x1+$r * $c }] [expr {$y1 + $s *$r}] 
    }
    parallelogram -
    parallelogram_l {
      set r [expr {$h/2.0}]
      set x1 [expr {$x1-$h/4}]
      set w [expr {$w+$h/2}]
      set res [list  [expr {$x1- $r*$c }] [expr {$y1-$r* $s}] ]
      lappend res  [expr {$x1+($w-$r)  * $c  }] [expr {$y1 + $s *($w-$r) }]  [expr {$x1- $r*$c}] [expr {$y1- $r* $s}]  [expr {$x1+($w-$r)  * $c }] [expr {$y1+ $s *($w-$r) }] 
      lappend res [expr {$x1+($w+$r) * $c - $s *$h }] [expr {$y1+$h * $c + $s * ($w+$r)}] [expr {$x1+($w-$r) * $c}] [expr {$y1+ $s *($w-$r)}] [expr {$x1+($w+$r) * $c - $s *$h }] [expr {$y1+$h * $c + $s *($w+$r)}] 
      lappend res  [expr {$x1+ $r*$c - $s *$h}] [expr {$y1+$h* $c + $r*$s}]  [expr {$x1+($w+$r)  * $c - $s *$h}] [expr {$y1+$h* $c + $s *($w+$r) }]  [expr {$x1+ $r*$c  - $s *$h}] [expr {$y1+$h* $c + $r*$s }] 
      lappend res  [expr {$x1- $r*$c   }]  [expr {$y1- $r*$s }] [expr {$x1+ $r*$c   - $s *$h }]  [expr {$y1+$h * $c + $r*$s}] [expr {$x1- $r*$c   }]  [expr {$y1- $r*$s }] 
      lappend res  [expr {$x1- $r*$c  }] [expr {$y1 -$r*$s}] 
    }
    parallelogram_r {
      set r [expr {$h/2.0}]
      set x1 [expr {$x1-$h/4}]
      set w [expr {$w+$h/2}]
      set res [list  [expr {$x1+ $r*$c }] [expr {$y1+$r* $s}] ]
      lappend res  [expr {$x1+($w+$r)  * $c  }] [expr {$y1 + $s *($w+$r) }]  [expr {$x1+ $r*$c}] [expr {$y1+ $r* $s}]  [expr {$x1+($w+$r)  * $c }] [expr {$y1+ $s *($w+$r) }] 
      lappend res [expr {$x1+($w-$r) * $c - $s *$h }] [expr {$y1+$h * $c + $s * ($w-$r)}] [expr {$x1+($w+$r) * $c}] [expr {$y1+ $s *($w+$r)}] [expr {$x1+($w-$r) * $c - $s *$h }] [expr {$y1+$h * $c + $s *($w-$r)}] 
      lappend res  [expr {$x1- $r*$c - $s *$h}] [expr {$y1+$h* $c - $r*$s}]  [expr {$x1+($w-$r)  * $c - $s *$h}] [expr {$y1+$h* $c + $s *($w-$r) }]  [expr {$x1-$r*$c  - $s *$h}] [expr {$y1+$h* $c - $r*$s }] 
      lappend res  [expr {$x1+$r*$c   }]  [expr {$y1+ $r*$s }] [expr {$x1- $r*$c   - $s *$h }]  [expr {$y1+$h * $c - $r*$s}] [expr {$x1+ $r*$c   }]  [expr {$y1+ $r*$s }] 
      lappend res  [expr {$x1+ $r*$c  }] [expr {$y1 +$r*$s}]
    }
    trapezoid -
    trapezoid_b {
      set r [expr {$h/2.0}]
      set x1 [expr {$x1-$h/4}]
      set w [expr {$w+$h/2}]
      set res [list  [expr {$x1+ $r*$c }] [expr {$y1+$r* $s}] ]
      lappend res  [expr {$x1+($w-$r)  * $c  }] [expr {$y1 + $s *($w-$r) }]  [expr {$x1+ $r*$c}] [expr {$y1+ $r* $s}]  [expr {$x1+($w-$r)  * $c }] [expr {$y1+ $s *($w-$r) }] 
      lappend res [expr {$x1+($w+$r) * $c - $s *$h }] [expr {$y1+$h * $c + $s * ($w+$r)}] [expr {$x1+($w-$r) * $c}] [expr {$y1+ $s *($w-$r)}] [expr {$x1+($w+$r) * $c - $s *$h }] [expr {$y1+$h * $c + $s *($w+$r)}] 
      lappend res  [expr {$x1-$r*$c - $s *$h}] [expr {$y1+$h* $c - $r*$s}]  [expr {$x1+($w+$r)  * $c - $s *$h}] [expr {$y1+$h* $c + $s *($w+$r) }]  [expr {$x1-$r*$c  - $s *$h}] [expr {$y1+$h* $c - $r*$s }] 
      lappend res  [expr {$x1+$r*$c   }]  [expr {$y1+ $r*$s }] [expr {$x1- $r*$c   - $s *$h }]  [expr {$y1+$h * $c - $r*$s}] [expr {$x1+ $r*$c   }]  [expr {$y1+ $r*$s }] 
      lappend res  [expr {$x1+ $r*$c  }] [expr {$y1 +$r*$s}]
    }
    trapezoid_t {
      set r [expr {$h/2.0}]
      set x1 [expr {$x1-$h/4}]
      set w [expr {$w+$h/2}]
      set res [list  [expr {$x1- $r*$c }] [expr {$y1-$r* $s}] ]
      lappend res  [expr {$x1+($w+$r)  * $c  }] [expr {$y1 + $s *($w+$r) }]  [expr {$x1- $r*$c}] [expr {$y1- $r* $s}]  [expr {$x1+($w+$r)  * $c }] [expr {$y1+ $s *($w+$r) }] 
      lappend res [expr {$x1+($w-$r) * $c - $s *$h }] [expr {$y1+$h * $c + $s * ($w-$r)}] [expr {$x1+($w+$r) * $c}] [expr {$y1+ $s *($w+$r)}] [expr {$x1+($w-$r) * $c - $s *$h }] [expr {$y1+$h * $c + $s *($w-$r)}] 
      lappend res  [expr {$x1+$r*$c - $s *$h}] [expr {$y1+$h* $c + $r*$s}]  [expr {$x1+($w-$r)  * $c - $s *$h}] [expr {$y1+$h* $c + $s *($w-$r) }]  [expr {$x1+$r*$c  - $s *$h}] [expr {$y1+$h* $c + $r*$s }] 
      lappend res  [expr {$x1-$r*$c   }]  [expr {$y1- $r*$s }] [expr {$x1+ $r*$c   - $s *$h }]  [expr {$y1+$h * $c + $r*$s}] [expr {$x1- $r*$c   }]  [expr {$y1- $r*$s }] 
      lappend res  [expr {$x1- $r*$c  }] [expr {$y1 -$r*$s}]
    }
    half_circle -
    half_circle_l {
      set r [expr {$h}]
      set k  [expr {$r*4.0/3*(sqrt(2)-1)}] 
      set x1 [expr {$x1-$h/2}]
      set w [expr {$w+$h}]
      set res [list  [expr {$x1 }] [expr {$y1}] ]
      lappend res  [expr {$x1+($w -$r) * $c  }] [expr {$y1 + $s *($w -$r)}]  [expr {$x1}] [expr {$y1}]  [expr {$x1+($w -$r) * $c }] [expr {$y1+ $s *($w -$r)}] 
      lappend res  [expr {$x1+($w -$r+$k) * $c }] [expr {$y1+ $s * ($w -$r+$k)}] [expr {$x1+$w * $c - $s *($r-$k)}] [expr {$y1+($r-$k)* $c + $s * $w}] [expr {$x1+$w * $c - $s *$r}] [expr {$y1+$r* $c + $s *$w }]
      lappend res  [expr {$x1+$r * $c - $s *$h}] [expr {$y1+$h* $c + $s *$r}]  [expr {$x1+($w -$r) * $c - $s *$h}] [expr {$y1+$h* $c + $s *($w -$r)}]  [expr {$x1+$r * $c - $s *$h}] [expr {$y1+$h* $c + $s *$r}] 
      lappend res  [expr {$x1+($r-$k) * $c - $s *$h}] [expr {$y1+$h* $c + $s *($r-$k)}] [expr {$x1  - $s *($k)}]  [expr {$y1+($k)* $c }] [expr {$x1 }]  [expr {$y1 }]
      lappend res  [expr {$x1 }] [expr {$y1}] 
    }
    half_circle_r {
      set r [expr {$h}]
      set k  [expr {$r*4.0/3*(sqrt(2)-1)}] 
      set x1 [expr {$x1-$h/2}]
      set w [expr {$w+$h}]
      set res [list  [expr {$x1+$r* $c }] [expr {$y1+ $s *$r}] ]
      lappend res  [expr {$x1+($w) * $c}] [expr {$y1 + $s *($w) }]  [expr {$x1+$r* $c }] [expr {$y1+ $s *$r}]  [expr {$x1+($w) * $c}] [expr {$y1 + $s *($w) }] 
      lappend res  [expr {$x1+($w) * $c- $s *$k }] [expr {$y1+$k* $c + $s * ($w )}]     [expr {$x1+($w-$r+$k) * $c - $s *($h)}] [expr {$y1+($h)* $c + $s * ($w-$r+$k)}]    [expr {$x1+($w-$r) * $c - $s *$h}] [expr {$y1+$h* $c + $s *($w-$r) }]
      lappend res  [expr {$x1 -$s * $h}] [expr {$y1+$h* $c}]  [expr {$x1+($w-$r) * $c - $s *$h}] [expr {$y1+$h* $c + $s *($w-$r) }] [expr {$x1 -$s * $h}] [expr {$y1+$h* $c}] 

      lappend res  [expr {$x1 - $s *($h-$k)}] [expr {$y1+($h-$k)* $c + $s *($r-$k)}]    [expr {$x1 +($r-$k) * $c}]  [expr {$y1 + $s *($r-$k) }]        [expr {$x1+$r* $c }] [expr {$y1+ $s *$r}] 

      lappend res  [expr {$x1+$r* $c }] [expr {$y1+ $s *$r}] 
    }
    arrow_l {
      set r [expr {$h/2}]
      set res [list  [expr {$x1 }] [expr {$y1}] ]
      lappend res  [expr {$x1+$w  * $c  }] [expr {$y1 + $s *$w }]  [expr {$x1}] [expr {$y1}]  [expr {$x1+$w  * $c }] [expr {$y1+ $s *$w }] 
      lappend res  [expr {$x1+$w  * $c - $s *$h}] [expr {$y1+$h* $c + $s *$w }]    [expr {$x1+$w  * $c }] [expr {$y1+ $s *$w }]     [expr {$x1+$w  * $c - $s *$h}] [expr {$y1+$h* $c + $s *$w }]
      lappend res  [expr {$x1 - $s *$h}] [expr {$y1+$h* $c }]  [expr {$x1+$w  * $c - $s *$h}] [expr {$y1+$h* $c + $s *$w }]  [expr {$x1 - $s *$h}] [expr {$y1+$h* $c }]
      lappend res [expr {$x1-$r * $c - $s *($r ) }] [expr {$y1+($r ) * $c + $s * -$r}]   [expr {$x1 - $s *$h}] [expr {$y1+$h* $c }]  [expr {$x1-$r * $c - $s *($r ) }] [expr {$y1+($r ) * $c + $s * -$r}] 
      lappend res  [expr {$x1}] [expr {$y1}]     [expr {$x1-$r * $c - $s *($r ) }] [expr {$y1+($r ) * $c + $s * -$r}]       [expr {$x1}] [expr {$y1}] 
      lappend res  [expr {$x1 }] [expr {$y1 }] 
    }
    arrow_r {
      set r [expr {$h/2}]
      set res [list  [expr {$x1 }] [expr {$y1}] ]
      lappend res  [expr {$x1+$w  * $c  }] [expr {$y1 + $s *$w }]  [expr {$x1}] [expr {$y1}]  [expr {$x1+$w  * $c }] [expr {$y1+ $s *$w }] 
      lappend res [expr {$x1+($w +$r) * $c - $s *($h -$r) }] [expr {$y1+($h -$r) * $c + $s * ($w +$r)}] [expr {$x1+$w * $c}] [expr {$y1+ $s *$w}] [expr {$x1+($w +$r) * $c - $s *($h -$r) }] [expr {$y1+($h -$r) * $c + $s * ($w +$r)}]
      lappend res [expr {$x1+($w) * $c - $s *($h ) }] [expr {$y1+($h ) * $c + $s * ($w )}]  [expr {$x1+($w +$r) * $c - $s *($h -$r) }] [expr {$y1+($h -$r) * $c + $s * ($w +$r)}]   [expr {$x1+($w) * $c - $s *($h ) }] [expr {$y1+($h ) * $c + $s * ($w )}]
      lappend res  [expr {$x1 - $s *$h}] [expr {$y1+$h* $c }]  [expr {$x1+$w  * $c - $s *$h}] [expr {$y1+$h* $c + $s *$w }]  [expr {$x1 - $s *$h}] [expr {$y1+$h* $c }] 
      lappend res  [expr {$x1  }]  [expr {$y1 }] [expr {$x1  - $s *$h }]  [expr {$y1+$h * $c }] [expr {$x1  }]  [expr {$y1 }] 
      lappend res  [expr {$x1 }] [expr {$y1 }] 
    }
    hexagon {
      set r [expr {$h/2}]
      set res [list  [expr {$x1 }] [expr {$y1}] ]
      lappend res  [expr {$x1+$w  * $c  }] [expr {$y1 + $s *$w }]  [expr {$x1}] [expr {$y1}]  [expr {$x1+$w  * $c }] [expr {$y1+ $s *$w }] 
      lappend res [expr {$x1+($w +$r) * $c - $s *($h -$r) }] [expr {$y1+($h -$r) * $c + $s * ($w +$r)}] [expr {$x1+$w * $c}] [expr {$y1+ $s *$w}] [expr {$x1+($w +$r) * $c - $s *($h -$r) }] [expr {$y1+($h -$r) * $c + $s * ($w +$r)}]
      lappend res [expr {$x1+($w) * $c - $s *($h ) }] [expr {$y1+($h ) * $c + $s * ($w )}]  [expr {$x1+($w +$r) * $c - $s *($h -$r) }] [expr {$y1+($h -$r) * $c + $s * ($w +$r)}]   [expr {$x1+($w) * $c - $s *($h ) }] [expr {$y1+($h ) * $c + $s * ($w )}]
      lappend res  [expr {$x1 - $s *$h}] [expr {$y1+$h* $c }]  [expr {$x1+$w  * $c - $s *$h}] [expr {$y1+$h* $c + $s *$w }]  [expr {$x1 - $s *$h}] [expr {$y1+$h* $c }]
      lappend res [expr {$x1-$r * $c - $s *($r ) }] [expr {$y1+($r ) * $c + $s * -$r}]   [expr {$x1 - $s *$h}] [expr {$y1+$h* $c }]  [expr {$x1-$r * $c - $s *($r ) }] [expr {$y1+($r ) * $c + $s * -$r}] 
      lappend res  [expr {$x1}] [expr {$y1}]     [expr {$x1-$r * $c - $s *($r ) }] [expr {$y1+($r ) * $c + $s * -$r}]       [expr {$x1}] [expr {$y1}] 
      lappend res  [expr {$x1 }] [expr {$y1 }] 
    }
    cloud {
      set r [expr {$h/2}]
      set n [expr {int($w/$r)}]
      set p [expr {1.0*$w/$n}]
      set k  [expr {$r*3/4}]
      set res [list  [expr {$x1 }] [expr {$y1}] ]
      for {set i 0} {$i < $n} {incr i} {
        lappend res [expr {$x1+($i*$p) * $c - $s * (-$k)}] [expr {$y1+(-$k)*$c + $s * ($i*$p)}]    [expr {$x1+($i*$p+$p) * $c - $s * (-$k)}] [expr {$y1+(-$k)*$c + $s * ($i*$p+$p)}]    [expr {$x1+($i*$p+$p) * $c - $s * (0)}] [expr {$y1+(0)*$c + $s * ($i*$p+$p)}]   
      }
      for {set i 0} {$i < 2} {incr i} {
        lappend res [expr {$x1+($w+$k) * $c - $s * ($i*$r)}] [expr {$y1+($i*$r)*$c + $s * ($w+$k)}]     [expr {$x1+($w+$k) * $c - $s * ($i*$r+$r)}] [expr {$y1+($i*$r+$r)*$c + $s * ($w+$k)}]    [expr {$x1+($w) * $c - $s * ($i*$r+$r)}] [expr {$y1+($i*$r+$r)*$c + $s * ($w)}] 
      }
      for {set i 0} {$i < $n} {incr i} {
        lappend res [expr {$x1+($w-$i*$p) * $c - $s * ($h+$k)}] [expr {$y1+($h+$k)*$c + $s * ($w-$i*$p)}]    [expr {$x1+($w-$i*$p-$p) * $c - $s * ($h+$k)}] [expr {$y1+($h+$k)*$c + $s * ($w-$i*$p-$p)}]    [expr {$x1+($w-$i*$p-$p) * $c - $s * ($h)}] [expr {$y1+($h)*$c + $s * ($w-$i*$p-$p)}]   
      }
      for {set i 0} {$i < 2} {incr i} {
        lappend res [expr {$x1+(-$k) * $c - $s * ($i*$r)}] [expr {$y1+($h-$i*$r)*$c + $s * (-$r)}]     [expr {$x1+(-$k) * $c - $s * ($i*$r+$r)}] [expr {$y1+($h-$i*$r-$r)*$c + $s * (-$r)}]    [expr {$x1+(0) * $c - $s * ($i*$r+$r)}] [expr {$y1+($h-$i*$r-$r)*$c + $s * (0)}] 
      }
    }
    callout_lt {
      set m [expr {$w/2.0}]
      set r [expr {$h/2.0}]
      set res [list  [expr {$x1 }] [expr {$y1}] ]
      lappend res  [expr {$x1+($r)  * $c  - $s *-$h }] [expr {$y1-$r * $c + $s *($m) }]    [expr {$x1 }] [expr {$y1}]   [expr {$x1+($r)  * $c  - $s *-$h }] [expr {$y1-$r * $c + $s *($m) }] 
      lappend res  [expr {$x1+($r+$r)  * $c}] [expr {$y1+ $s *($r+$r)}]    [expr {$x1+($r)  * $c  - $s *-$h }] [expr {$y1-$r * $c + $s *($m) }]  [expr {$x1+($r+$r)  * $c}] [expr {$y1+ $s *($r+$r)}]
      lappend res  [expr {$x1+$w  * $c  }] [expr {$y1 + $s *$w }] [expr {$x1+($r+$r)  * $c}] [expr {$y1+ $s *($r+$r)}]  [expr {$x1+$w  * $c }] [expr {$y1+ $s *$w }] 
      lappend res [expr {$x1+$w * $c - $s *$h }] [expr {$y1+$h * $c + $s * $w}] [expr {$x1+$w * $c}] [expr {$y1+ $s *$w}] [expr {$x1+$w * $c - $s *$h }] [expr {$y1+$h * $c + $s *$w}] 
      lappend res  [expr {$x1 - $s *$h}] [expr {$y1+$h* $c }]  [expr {$x1+$w  * $c - $s *$h}] [expr {$y1+$h* $c + $s *$w }]  [expr {$x1 - $s *$h}] [expr {$y1+$h* $c }] 
      lappend res  [expr {$x1  }]  [expr {$y1 }] [expr {$x1  - $s *$h }]  [expr {$y1+$h * $c }] [expr {$x1  }]  [expr {$y1 }] 
      lappend res  [expr {$x1 }] [expr {$y1 }] 
    }
    callout_ct {
      set m [expr {$w/2.0}]
      set r [expr {$h/2.0}]
      set res [list  [expr {$x1 }] [expr {$y1}] ]
      lappend res  [expr {$x1+($m-$r)  * $c  }] [expr {$y1 + $s *($m-$r) }]    [expr {$x1}] [expr {$y1}]    [expr {$x1+($m-$r)  * $c  }] [expr {$y1 + $s *($m-$r) }]
      lappend res  [expr {$x1+($m)  * $c  - $s *-$h }] [expr {$y1-$r * $c + $s *($m) }]     [expr {$x1+($m-$r)  * $c  }] [expr {$y1 + $s *($m-$r) }]     [expr {$x1+($m)  * $c  - $s *-$r }] [expr {$y1-$r * $c + $s *($m) }] 
      lappend res  [expr {$x1+($m+$r)  * $c}] [expr {$y1+ $s *($m+$r)}]  [expr {$x1+($m)  * $c  - $s *-$r }] [expr {$y1-$r * $c + $s *($m) }]    [expr {$x1+($m+$r)  * $c}] [expr {$y1+ $s *($m+$r)}]
      lappend res  [expr {$x1+$w  * $c  }] [expr {$y1 + $s *$w }]  [expr {$x1+($m+$h)  * $c}] [expr {$y1+ $s *($m+$h)}]  [expr {$x1+$w  * $c }] [expr {$y1+ $s *$w }] 
      lappend res [expr {$x1+$w * $c - $s *$h }] [expr {$y1+$h * $c + $s * $w}] [expr {$x1+$w * $c}] [expr {$y1+ $s *$w}] [expr {$x1+$w * $c - $s *$h }] [expr {$y1+$h * $c + $s *$w}] 
      lappend res  [expr {$x1 - $s *$h}] [expr {$y1+$h* $c }]  [expr {$x1+$w  * $c - $s *$h}] [expr {$y1+$h* $c + $s *$w }]  [expr {$x1 - $s *$h}] [expr {$y1+$h* $c }] 
      lappend res  [expr {$x1  }]  [expr {$y1 }] [expr {$x1  - $s *$h }]  [expr {$y1+$h * $c }] [expr {$x1  }]  [expr {$y1 }] 
      lappend res  [expr {$x1 }] [expr {$y1 }] 
    }
    callout_rt {
      set m [expr {$w/2.0}]
      set r [expr {$h/2.0}]
      set res [list  [expr {$x1 }] [expr {$y1}] ]
      lappend res  [expr {$x1+($w-$r-$r)  * $c  }] [expr {$y1 + $s *($w-$r-$r) }]  [expr {$x1 }] [expr {$y1}]  [expr {$x1+($w-$r-$r)  * $c  }] [expr {$y1 + $s *($w-$r-$r) }]
      lappend res  [expr {$x1+($w-$r)  * $c  - $s *-$r }] [expr {$y1-$r * $c + $s *($w-$r) }]   [expr {$x1+($w-$r-$r)  * $c  }] [expr {$y1 + $s *($w-$r-$r) }]  [expr {$x1+($w-$r)  * $c  - $s *-$r }] [expr {$y1-$r * $c + $s *($w-$r) }]
      lappend res  [expr {$x1+$w  * $c  }] [expr {$y1 + $s *$w }] [expr {$x1+($w-$r)  * $c  - $s *-$r }] [expr {$y1-$r * $c + $s *($w-$r) }]  [expr {$x1+$w  * $c }] [expr {$y1+ $s *$w }] 
      lappend res [expr {$x1+$w * $c - $s *$h }] [expr {$y1+$h * $c + $s * $w}] [expr {$x1+$w * $c}] [expr {$y1+ $s *$w}] [expr {$x1+$w * $c - $s *$h }] [expr {$y1+$h * $c + $s *$w}] 
      lappend res  [expr {$x1 - $s *$h}] [expr {$y1+$h* $c }]  [expr {$x1+$w  * $c - $s *$h}] [expr {$y1+$h* $c + $s *$w }]  [expr {$x1 - $s *$h}] [expr {$y1+$h* $c }] 
      lappend res  [expr {$x1  }]  [expr {$y1 }] [expr {$x1  - $s *$h }]  [expr {$y1+$h * $c }] [expr {$x1  }]  [expr {$y1 }] 
      lappend res  [expr {$x1 }] [expr {$y1 }] 
    }
    r_rect -
    default {
      set r [expr {$h/4.0}]
      set k  [expr {$r*4.0/3*(sqrt(2)-1)}] 
      set res [list  [expr {$x1+$r* $c }] [expr {$y1+ $s *$r}] ]
      lappend res  [expr {$x1+($w -$r) * $c  }] [expr {$y1 + $s *($w -$r)}]  [expr {$x1+$r * $c }] [expr {$y1+ $s *$r}]  [expr {$x1+($w -$r) * $c }] [expr {$y1+ $s *($w -$r)}] 
      lappend res  [expr {$x1+($w -$r+$k) * $c }] [expr {$y1+ $s * ($w -$r+$k)}] [expr {$x1+$w * $c - $s *($r-$k)}] [expr {$y1+($r-$k)* $c + $s * $w}] [expr {$x1+$w * $c - $s *$r}] [expr {$y1+$r* $c + $s *$w }]
      lappend res [expr {$x1+$w * $c - $s *($h -$r)}] [expr {$y1+($h -$r)* $c + $s * $w}] [expr {$x1+$w * $c - $s *$r}] [expr {$y1+$r* $c + $s *$w}] [expr {$x1+$w * $c - $s *($h -$r)}] [expr {$y1+($h -$r)* $c + $s *$w}] 
      lappend res [expr {$x1+$w * $c - $s *($h -$r+$k)}] [expr {$y1+($h -$r+$k)* $c + $s *$w}]  [expr {$x1+($w -$r+$k) * $c - $s *$h}] [expr {$y1+$h* $c + $s * ($w -$r+$k)}]  [expr {$x1+($w -$r) * $c - $s *$h}] [expr {$y1+$h* $c + $s *($w -$r)}] 
      lappend res  [expr {$x1+$r * $c - $s *$h}] [expr {$y1+$h* $c + $s *$r}]  [expr {$x1+($w -$r) * $c - $s *$h}] [expr {$y1+$h* $c + $s *($w -$r)}]  [expr {$x1+$r * $c - $s *$h}] [expr {$y1+$h* $c + $s *$r}] 
      lappend res  [expr {$x1+($r-$k) * $c - $s *$h}] [expr {$y1+$h* $c + $s *($r-$k)}] [expr {$x1  - $s *($h -$r+$k)}]  [expr {$y1+($h -$r+$k)* $c }] [expr {$x1  - $s *($h -$r)}]  [expr {$y1+($h -$r)* $c }]
      lappend res  [expr {$x1  - $s *$r}]  [expr {$y1+$r* $c }] [expr {$x1  - $s *($h -$r)}]  [expr {$y1+($h -$r)* $c }] [expr {$x1  - $s *$r}]  [expr {$y1+$r* $c }] 
      lappend res [expr {$x1 - $s *($r-$k)}]  [expr {$y1+($r-$k)* $c }]  [expr {$x1+($r-$k) * $c }] [expr {$y1 + $s *($r-$k)}]  [expr {$x1+$r * $c }] [expr {$y1+ $s *$r}] 
      lappend res  [expr {$x1+$r * $c }] [expr {$y1 + $s *$r}] 
    }
  }
  set res1 [list]
  if {$angle == 0} {
    foreach {x y} $res {
      lappend res1 [expr {$x - $padding}] [expr {$y - $padding}]
    }
    return $res1
  }
  set sin [expr {sin(-$angle /180.0*3.14159)}]
  set cos [expr {cos(-$angle /180.0*3.14159)}]
  set xoffset [expr {$anchorx -($anchorx * $cos - $anchory * $sin)}] 
  set yoffset [expr {$anchory -($anchorx * $sin + $anchory * $cos)}]
  foreach {x y} $res {
    lappend res1 [expr {($x - $padding) * $cos - ($y - $padding) * $sin + $xoffset}] [expr {($x - $padding) * $sin + ($y - $padding)* $cos + $yoffset}]
  }
  return $res1
}


################
## Redraw a label box after scaling the canvas or resizing the text
################
proc graphic_map_redraw_label_box {c i} {

  set box [$c find withtag $i.box]
  set dict [$c bind $box <<Box>>]
  if {![dict exists $dict type] || [$c bbox $box] =={} || [$c bbox $i] =={}} {return}
  if {[dict get $dict type] eq "none"} {
    $c coords $box [list]
    dict set dict xy_offset [list 0 0]
    $c bind $box <<Box>> $dict
     return
  } elseif {[$c itemcget $i -angle] == 0} {
    $c coords $box  {*}[create_label_box_coords [set bbox_e [$c bbox $i]] [$c itemcget $box -width] [dict get $dict type]]
  } else {
    lassign [$c coords $i] x y
    set font [$c itemcget $i -font]
    set width [font measure $font [$c itemcget $i -text]]
    set height [font metr $font -linespace]
    set x0 [expr {$x - $width / 2.0}]
    set y0 [expr {$y - $height / 2.0}]
    set anchor [$c itemcg $i -anchor]
    if {$anchor ne "center" } {
      if {[string first "n" $anchor] > -1} {
        set y0 [expr {$y0 + $height / 2.0}]
      } elseif {[string first "s" $anchor] > -1} {
        set y0 [expr {$y0 - $height / 2.0}]
      }
      if {[string first "w" $anchor] > -1} {
        set x0 [expr {$x0 + $width / 2.0}]
      } elseif {[string first "e" $anchor] > -1} {
        set x0 [expr {$x0 - $width / 2.0}]
      }
    }
    set x1 [expr {$x0 + $width}]
    set y1 [expr {$y0 + $height}]
    $c coords $box  {*}[create_label_box_coords [list $x0 $y0 $x1 $y1] [$c itemcget $box -width] [dict get $dict type] [$c itemcget $i -angle] $x $y]
  }
  lassign [$c bbox $box] bx0 by0 bx1 by1
  lassign [$c bbox $i]  ex0 ey0 ex1 ey1
  dict set dict xy_offset [list [expr {$bx0 - $ex0}] [expr {$by0-$ey0 }]]
  $c bind $box <<Box>> $dict
}

################
## Recenter a label box to a text item
################
proc graphic_map_recenter_label_box {c i} {
  set box [$c find withtag $i.box]
  if {$box == {} || [$c bbox $i] =={}} {return}
  set boxdict [$c bind $box <<Box>>]
  if {![dict exists $boxdict xy_offset]} {return}
  lassign [dict get $boxdict xy_offset] x0 y0
  lassign [$c bbox $i] bx0 by0 bx1 by1
  $c moveto $box [expr {$bx0+$x0}] [expr {$by0 + $y0}]
}

################
## Return a list of {site name} list pairs for a set of enzyme lists,with pairs sorted into quadrants, 2nd and 4th quadrants reversed in order
################
proc circ_enz_sort {w enz_list len} {
  global info
# returns a list of positions, and dict: type enzyme/feature, location location string, name name string, tag: tag name, count feature count
  set templist [list]
  set a1 -1
  set a2 -1
  set a3 -1

  findenzymes $w
  foreach enzyme $enz_list {
    foreach site $info($w,$enzyme) dir $info($w,enzdir,$enzyme) {
      lappend templist [list $site [list type enzyme location_start $site name $enzyme tag $enzyme count [llength $info($w,$enzyme)] dir $dir]]
    }
  }

  foreach {name text_tag} [feature_find $w] {
    if {[$w.textarea tag cget [regsub "fn" $text_tag "f"] -background] == ""} {
      #continue
    }
    if {[llength [$w.textarea tag ranges $text_tag]] == 2} {
      set tx1 [ix2bp $w.textarea [lindex [$w.textarea tag ranges $text_tag] 0]]
      set tx2 [ix2bp $w.textarea [lindex [$w.textarea tag ranges $text_tag] 1]]
    } else {
      set tx1 [ix2bp $w.textarea [lindex [$w.textarea tag ranges $text_tag] 2]]
      set tx2 [ix2bp $w.textarea [lindex [$w.textarea tag ranges $text_tag] 1]]

    }
    set length [expr {($tx2  - $tx1) % $len}]
    set ttg $text_tag
    regsub fn $text_tag f ttg

      #set coord_text [feature_coords_text $w $ttg]
      #set  location_start [regexp -inline {^[0-9]+} $coord_text] 
      #set location_end [regexp -inline {[0-9]+$} $coord_text]
      set direction [lindex [$w.textarea tag bind $ttg <<Metadata>>] 3]
      if {$direction} {
        set  location_start $tx2
        set location_end $tx1
      } else {
        set  location_start $tx1
        set location_end $tx2
      }
      set gformat [$w.textarea tag bind $ttg <<Gformat>>]
      if {[dict exists $gformat circular_label_align]} {
        switch [dict get $gformat circular_label_align] {
          "Center" {
             set loc [expr { ($tx1 +$length / 2) % $len}] 
           }
          "CW" {
             set loc $tx2
           }
           "CCW" {
             set loc $tx1
           }
           "5'" {
             set loc $location_start
           }
           "3'" {
             set loc $location_end
           }
        }
      } elseif {$info(circ_map_feature_names_centered)} {
           set loc [expr { ($tx1 +$length / 2) % $len}] 
      } else {
         set loc $tx1
      }
    lappend templist [list $loc [list type feature feature_type [lindex [$w.textarea tag bind $ttg <<Metadata>>] 2] location_start $location_start location_end [expr {$location_end % $len}] location_c [expr { ($tx1 +$length / 2) % $len}]  length $length name $name tag $text_tag direction $direction]]
  }

  set templist [lsort -integer -index 0 $templist]
  set i 0
  foreach element $templist {
    set index [lindex $element 0]
    if {$index < [expr .25 *$len]} {set a1 $i}
    if {$index < [expr .5 *$len]} {set a2 $i}
    if {$index < [expr .75 *$len]} {set a3 $i}
    incr i
  }
  return [concat [lsort -integer -index 0 -decreasing [lrange $templist -1 $a1]] [lrange $templist [expr $a1+1] $a2] [lsort -integer -index 0 -decreasing [lrange $templist [expr $a2+1] $a3]] [lrange $templist [expr $a3+1] $i]]
}

################
## Return a list of {site name} list pairs for a set of enzyme lists
################
proc linear_enz_sort {w enz_list start end} {
  global info

  findenzymes $w
  set end_bp [ix2bp $w.textarea end]
  if {$end > $end_bp} {
    set end [expr {$end-$end_bp}]
  }

  set templist [list]
  if {$start< $end} {
    foreach enzyme $enz_list {
      foreach site $info($w,$enzyme) dir $info($w,enzdir,$enzyme) {
          if {$site > $end} {break}
          if {$site >= $start} {lappend templist [list $site $enzyme $dir $site]}
      }
    }
  } else {
    foreach enzyme $enz_list {
      foreach site $info($w,$enzyme) dir $info($w,enzdir,$enzyme) {
          if {($site <= $end) || ($site >= $start)} {lappend templist [list $site $enzyme $dir [expr {($site <= $end)?($site+$end_bp):$site}]]}
      }
    }
  }
  set templist [lsort -integer -index 3 $templist]
}

################
## draw arrows on the linear graphic map - new
################
proc linear_feature_draw {c y w start end x_offset total_length tag {tags [list]} {x_right 390}} {
  global info modifier

  lappend tags $tag
  set tags [lsort -unique $tags]

  set ranges [list]
  foreach {x1 x2} [$w.textarea tag ranges $tag] {
    set x1 [ix2bp $w.textarea  $x1]
    set x2 [ix2bp $w.textarea  $x2]
    incr x2 -1
      lappend ranges [list $x1 $x2]
  }
  set pos 0
  set fntag_ranges [$w.textarea tag ranges [regsub f $tag fn]]

  if {$fntag_ranges == ""} {set fntag_ranges [$w.textarea tag ranges $tag]}
  if {[llength $fntag_ranges]> 2} {
    set s [ix2bp $w.textarea [lindex $fntag_ranges 2]]
    while {([lindex $ranges $pos 0] < $s) && ($pos < [llength $ranges])} {incr pos}
  }

  if {$pos == 0 || $pos == [llength $ranges] } {
     set ranges [linsert $ranges 0 [list -1 -1]]
     lappend ranges [list -2 -2]
   } else {
     set ranges [linsert $ranges $pos [list -2 -2]  [list -1 -1]]
   }

  if {$ranges == {}} {return}

  set seq_len [string length [textarea_get $w.textarea 1.0 end]]
  if {$end < $start} {
    set end [expr {$end+$seq_len}]
  }
  if {$end > $seq_len} {
    foreach part $ranges {
      if {[lindex $part 0] < 0} {
        lappend ranges $part   
      } else {
        lappend ranges [list [expr {[lindex $part 0]+$seq_len}] [expr {[lindex $part 1]+$seq_len}] ]
      }
    }
    for {set i 0} {$i < [expr {[llength $ranges]-1}]} {incr i} {
      if {[lindex $ranges $i 1] == [expr {$seq_len-1}] &&  [lindex $ranges [expr {$i+1}] 0] == $seq_len} {
        set ranges [lreplace $ranges $i [expr {$i+1}] [list [lindex $ranges $i 0] [lindex $ranges [expr {$i+1}] 1]]]
      }
    }
  }

  if {[$w.textarea tag cget $tag -background] == ""} {
    set state "hidden"
  } else {
    set state "normal"
  }

 

  set direction [lindex [$w.textarea tag bind $tag <<Metadata>>] 3]
  set label [lindex [$w.textarea tag bind $tag <<Metadata>>] 0]
  set gformat [lindex [$w.textarea tag bind $tag <<Metadata>>] 1]
  set feature_type [lindex [$w.textarea tag bind $tag <<Metadata>>] 2]
  set width [dict get $gformat width]
  if {$width == ""} {set width 1}
  set width [expr {$width * $info(tk_scaling)}]



  if {[dict exists $gformat outline_width]} {
    set tag_outline_width [dict get $gformat outline_width]
  } else {
    set tag_outline_width 1
  }

  if {[dict exists $gformat intron_width]} {
    set intron_width [dict get $gformat intron_width]
  } else {
    set intron_width 1
  }

  if {[dict exists $gformat tag_intron_outline_width]} {
    set intron_outline_width [dict get $gformat tag_intron_outline_width]
  } else {
    set tag_intron_outline_width 1
  }

  if {[dict exists $gformat intron_height]} {
    set intron_height [dict get $gformat intron_height]
  } else {
    set intron_height 0.5
  }

  if {[dict exists $gformat fea_intron_dip]} {
    set fea_intron_dip [dict get $gformat fea_intron_dip]
  } else {
    set fea_intron_dip 0.5
  }

  if { [dict exists $gformat linear_font]} {
    set font [dict get $gformat linear_font]
  } else {
    set font [list $info(graphicfontfamily) $info(graphicfontsize)]
    dict set gformat linear_font $font
  }

  if {[dict exists $gformat linear_label_color_$direction]} {
    set font_color [dict get $gformat linear_label_color_$direction]
  } else {
    set font_color $info(graphic_fg_color)
  }
  
  if { [dict exists $gformat fea_label_angle]} {
    set label_angle [dict get $gformat fea_label_angle]
  } else {
    set label_angle 0
  }
  
  if {[dict exists $gformat graphic_fg_color_$direction]} {
    set tag_color [dict get $gformat graphic_fg_color_$direction]
  } else {
    set tag_color [format "\#%04X%04X%04X" {*}[winfo rgb . [lindex [$w.textarea tag bind $tag <<Revcolors>>] [lindex [$w.textarea tag bind $tag <<Metadata>>] 3]]]]
  }
  
  if {[dict exists $gformat outline_color_$direction]} {
    set tag_bg_color [dict get $gformat outline_color_$direction]
  } else {
    set tag_bg_color [gray_color $tag_color]
  }

  if {[dict exists $gformat intron_fg_color_$direction]} {
    set tag_intron_fg_color [dict get $gformat intron_fg_color_$direction]
  } else {
    set tag_intron_fg_color $tag_color
  }

  if {[dict exists $gformat intron_outline_color_$direction]} {
    set tag_intron_bg_color [dict get $gformat outline_color_$direction]
  } else {
    set tag_intron_bg_color $tag_bg_color
  }

  #set arrow_list [dict get $gformat arrow_data]
  set fntag [regsub f $tag fn]
  set x_left 0

  set first_exon {}
  set first_exon_coords {}
  set first_exon_bg {}
  set last_exon {}
  set last_exon_coords {}
  set last_exon_bg {}
  set exon_list [list]

  #draw all exons and all introns (draw to the left of the current exon)

  for {set i 0} {$i < [llength $ranges]} {incr i} {

    if {[lindex $ranges $i 0] < 0 || [lindex $ranges $i 1] < $start || ([lindex $ranges $i 0] > $end && ([lindex $ranges [expr {$i -1}] 1] < 0 || [lindex $ranges [expr {$i -1}] 1] > $end)) } {continue}
    if {[lindex $ranges $i 0] > $end} {
      #draw right side intron- no exon corresponds. could use a proc here
      set left_coord $end
      set x1 [expr {$x_left + $x_right * ($left_coord - $start + $x_offset) / $total_length}]
## linear intron configure here
      if {[lindex $ranges [expr {$i -1}] 1] < $start} {
        set left_intron_coord $start
        #broken intron on left
        $c create line [expr {$x_left}] $y [expr {$x_left-1}] $y -tag [concat $tags intron_ext] -fill $tag_intron_bg_color -width [expr {$tag_intron_outline_width *2 + $intron_width}] -state normal
        $c create line [expr {$x_left-3}] $y [expr {$x_left-4}] $y -tag [concat $tags intron_ext] -fill $tag_intron_bg_color -width [expr {$tag_intron_outline_width *2 + $intron_width}] -state normal
        $c create line [expr {$x_left-6}] $y [expr {$x_left-7}] $y -tag [concat $tags intron_ext] -fill $tag_intron_bg_color -width [expr {$tag_intron_outline_width *2 + $intron_width}] -state normal
      } else {
        set left_intron_coord [lindex $ranges [expr {$i -1}] 1]
      }
      set x2 [expr {$x_left + $x_right * ($left_intron_coord - $start + $x_offset) / $total_length}]
      #  broken on the right
      $c create line [expr {$x2+0}] [expr {$y+$width/2.0-$width*$intron_height}] [expr {($x1+$x2)/2.0}]  [expr {$y+$width/2.0-$width*$intron_height+5}] [expr {$x1}] [expr {$y+$width/2.0-$width*$intron_height}] -tag [concat $tags intron] -state normal -fill $tag_intron_bg_color -width $intron_width
      $c create line [expr {$x_left + $x_right}] $y [expr {$x_left + $x_right+1}] $y -tag [concat $tags intron_ext] -fill $tag_intron_bg_color -width [expr {$tag_intron_outline_width *2 + $intron_width}] -state normal
      $c create line [expr {$x_left + $x_right+3}] $y [expr {$x_left + $x_right+4}] $y -tag [concat $tags intron_ext] -fill $tag_intron_bg_color -width [expr {$tag_intron_outline_width *2 + $intron_width}] -state normal
      $c create line [expr {$x_left + $x_right+6}] $y [expr {$x_left + $x_right+7}] $y -tag [concat $tags intron_ext] -fill $tag_intron_bg_color -width [expr {$tag_intron_outline_width *2 + $intron_width}] -state normal
      continue
    }

    if {[lindex $ranges $i 0] < $start} {
      set left_break 1
      set left_coord $start
    } else {
      set left_break 0
      set left_coord [lindex $ranges $i 0]
    }
    if {[lindex $ranges $i 1] > $end} {
      set right_break 1
      set right_coord $end
    } else {
      set right_break 0
      set right_coord [lindex $ranges $i 1]
    }
    lappend exon_list "[expr {$left_coord+1}]..[expr {$right_coord+1}]"

    set x1 [expr {$x_left + $x_right * ($left_coord - $start + $x_offset) / $total_length}]
    set x2 [expr {$x_left + $x_right * ($right_coord - $start + $x_offset) / $total_length}]
    set bg_box [$c create rectangle [expr {$x1}] [expr {$y-$width/2.0}] [expr {$x2}] [expr {$y+$width/2.0}] -tag [concat $tags exon outline] -fill $tag_bg_color -outline $tag_bg_color -state normal -width [expr {2*$tag_outline_width}]]
    set fg_box [$c create rectangle [expr {$x1}] [expr {$y-$width/2.0}] [expr {$x2}] [expr {$y+$width/2.0}] -tag [concat $tags exon foreground] -fill $tag_color -state normal -outline {}]
    if {!$left_break} {
      if {[lindex $ranges [expr {$i -1}] 0] >= 0} {
        #draw intron
        if {[lindex $ranges [expr {$i -1}] 1] < $start} {
          set left_intron_coord $start
          #broken intron on left
          $c create line [expr {$x_left}] $y [expr {$x_left-1}] $y -tag [concat $tags intron_ext] -fill $tag_intron_bg_color -width [expr {$tag_intron_outline_width *2 + $intron_width}] -state normal
          $c create line [expr {$x_left-3}] $y [expr {$x_left-4}] $y -tag [concat $tags intron_ext] -fill $tag_intron_bg_color -width [expr {$tag_intron_outline_width *2 + $intron_width}] -state normal
          $c create line [expr {$x_left-6}] $y [expr {$x_left-7}] $y -tag [concat $tags intron_ext] -fill $tag_intron_bg_color -width [expr {$tag_intron_outline_width *2 + $intron_width}] -state normal
        } else {
          set left_intron_coord [lindex $ranges [expr {$i -1}] 1]
        }
        set x2 [expr {$x_left + $x_right * ($left_intron_coord - $start + $x_offset) / $total_length}]
        $c create line [expr {$x2+0}] [expr {$y+$width/2.0-$width*$intron_height}] [expr {($x1+$x2)/2.0}]  [expr {$y+$width/2.0-$width*$intron_height+$width*$fea_intron_dip}] [expr {$x1}] [expr {$y+$width/2.0-$width*$intron_height}] -capstyle projecting -tag [concat $tags intron outline] -state normal -fill $tag_intron_bg_color -width [expr {$tag_intron_outline_width *2 + $intron_width}] 
        $c create line [expr {$x2+0}] [expr {$y+$width/2.0-$width*$intron_height}] [expr {($x1+$x2)/2.0}]  [expr {$y+$width/2.0-$width*$intron_height+$width*$fea_intron_dip}] [expr {$x1}] [expr {$y+$width/2.0-$width*$intron_height}] -capstyle projecting -tag [concat $tags intron foreground] -state normal -fill $tag_intron_fg_color -width $intron_width
      } else {
        set first_exon $fg_box
        set first_exon_bg $bg_box
        set first_exon_coords [$c coords $first_exon]
      }
    } else {
      # left  break
      $c create line [expr {$x_left}] $y [expr {$x_left-1}] $y -tag [concat $tags intron_ext] -fill $tag_intron_bg_color -width [expr {$tag_intron_outline_width *2 + $intron_width}] -state normal
      $c create line [expr {$x_left-3}] $y [expr {$x_left-4}] $y -tag [concat $tags intron_ext] -fill $tag_intron_bg_color -width [expr {$tag_intron_outline_width *2 + $intron_width}] -state normal
      $c create line [expr {$x_left-6}] $y [expr {$x_left-7}] $y -tag [concat $tags intron_ext] -fill $tag_intron_bg_color -width [expr {$tag_intron_outline_width *2 + $intron_width}] -state normal
    }
    if {$right_break} {
      $c create line [expr {$x_left + $x_right}] $y [expr {$x_left + $x_right+1}] $y -tag [concat $tags intron_ext] -fill $tag_intron_bg_color -width 4 -state normal
      $c create line [expr {$x_left + $x_right+3}] $y [expr {$x_left + $x_right+4}] $y -tag [concat $tags intron_ext] -fill $tag_intron_bg_color -width 4 -state normal
      $c create line [expr {$x_left + $x_right+6}] $y [expr {$x_left + $x_right+7}] $y -tag [concat $tags intron_ext] -fill $tag_intron_bg_color -width 4 -state normal
    } elseif {[lindex $ranges [expr {$i +1}] 0] < 0} {
      set last_exon $fg_box
      set last_exon_bg $bg_box
      set last_exon_coords [$c coords $last_exon]

    }
  }

  #draw label
  set anchor n
  switch $label_angle {
    270 {set anchor w}
    315 {set anchor nw}
    0 {set anchor n}
    45 {set anchor ne}
    90 {set anchor e}
  }

  if {$last_exon_coords != {} && $first_exon_coords != {} && [lindex $last_exon_coords 2] < [lindex $first_exon_coords 0]} {
    set x1 [expr {[lindex $last_exon_coords 2]/2.0}]
    set featurelabelid [$c create text [expr {$x1}] [expr {$y+$width/2.0+2}] -text "$label" -anchor $anchor -angle $label_angle -font $font -fill $font_color -tag [concat $tags feature label moveabletext] -state normal]
    ## bug work here
    set x1 [expr {([lindex $first_exon_coords 0] + ($x_left + $x_right * ($end - $start + $x_offset)/ $total_length)) / 2.0}]
    set featurelabelid [$c create text [expr {$x1}] [expr {$y+$width/2.0+2}] -text "$label" -anchor $anchor -angle $label_angle -font $font -fill $font_color -tag [concat $tags feature label moveabletext] -state normal]
  } else {
    set fea_coords [$c bbox $tag]
    if {$fea_coords != {}} {
      set x1 [expr {([lindex $fea_coords 0] + [lindex $fea_coords 2])/2}]
      set featurelabelid [$c create text [expr {$x1}] [expr {$y+$width/2.0+2}] -text "$label" -anchor $anchor -angle $label_angle -font $font -fill $font_color -tag [concat $tags feature label moveabletext] -state normal]
      set coord_text [feature_coords_text $w $tag]
      set location_start [regexp -inline {^[0-9]+} $coord_text]
      set  location_end [regexp -inline {[0-9]+$} $coord_text]
      if {$location_start > $location_end} {
        set length [expr {$seq_len - $location_start + $location_end +1}]
      } else {
        set length [expr {$location_end - $location_start +1}]
      }
      $c bind $featurelabelid <<Label>> [list type feature feature_type $feature_type location_start  $location_start location_end $location_end length $length name $label tag $tag direction $direction]
      $c bind $featurelabelid <<Colors>> [list black red]
    }
  }
  ## draw label backing box
  if {[catch { set label_box_type  [dict get $gformat label_box_type]}]} {
    set label_box_type r_rect; #rrect
  }
  if {[catch { set label_box_fill_color  [dict get $gformat label_box_fill_color]}]} {
    set label_box_fill_color white
    set label_box_fill_color {}
  }
  if {[catch { set label_box_outline_color  [dict get $gformat label_box_outline_color]}]} {
    #set label_box_outline_color $tag_color
    set label_box_outline_color white
    set label_box_outline_color {}
  }
  if {[catch { set label_box_outline_width  [dict get $gformat label_box_outline_width]}]} {
    set label_box_outline_width 0
  }

  set boxid [$c create polygon  0 0 -smooth raw  -fill $label_box_fill_color -outline $label_box_outline_color -width $label_box_outline_width -tags [list feature $tag label_box $featurelabelid.box]]
  $c bind $boxid <<Box>> [dict create type $label_box_type]
  graphic_map_redraw_label_box $c $featurelabelid
  $c raise $featurelabelid $boxid


  #draw arrows
  #move this to a proc, get coords, direction and arrows from tag binding, scale the x coords based on [lindex [$c coords line] 2], keep y coords

  # $c create line 0 $y 0 $y -tag  [concat $tags fwd_arrow outline]  -fill $tag_bg_color -width [expr {2*$tag_outline_width}] -state normal
  ## bezier arrow data change here-  arrow points list can be dict of pts min_x_scale and smooth
  set item [$c create polygon 0 $y -tag  [concat $tags fwd_arrow outline]  -fill $tag_bg_color -outline $tag_bg_color -width [expr {max(0,2*$tag_outline_width-1)}] -state normal]
  $c create polygon 0 $y -tag  [concat $tags fwd_arrow foreground]  -fill $tag_color  -outline {} -state normal
  # $c create line 0 $y 0 $y -tag  [concat $tags rev_arrow outline]  -fill $tag_bg_color -width [expr {max(2*$tag_outline_width}] -state normal
  $c create polygon 0 $y -tag  [concat $tags rev_arrow outline]  -fill $tag_bg_color  -outline $tag_bg_color -width [expr {max(0,2*$tag_outline_width-1)}] -state normal
  $c create polygon 0 $y -tag  [concat $tags rev_arrow foreground]  -fill $tag_color  -outline {}  -state normal

  if {([dict exists $gformat linear_state] && [dict get $gformat linear_state] eq "hidden") || (![dict exists $gformat linear_state] && [$w.textarea tag cget $tag -background] == {})} {
    dict set gformat linear_state hidden
  } else {
    dict set gformat linear_state normal
  }
  $c bind $tag <<Gformat>> $gformat
  $c bind $tag <<Coord_list>> [list [list $first_exon $first_exon_bg $first_exon_coords] [list $last_exon $last_exon_bg $last_exon_coords]]
  $c bind $tag <<Direction>> $direction
  $c bind $tag <<Colors>> [list $tag_color red $tag_bg_color $label_box_outline_color]

  
  linear_feature_draw_arrow $c $tag
  
  $c lower intron exon
  
  if {[dict get $gformat linear_state] eq "hidden"} {
    $c itemconfigure $tag -state hidden
  }
      
  #linear label bindings
  if {[info exists featurelabelid]} {
    $c bind $tag <Any-Enter> "$c itemconfigure $tag&&feature&&label -fill \[lindex \[$c bind $featurelabelid <<Colors>>\] 1\];$c itemconfigure seqtext -text \{[lindex [$w.textarea tag bind $tag <<Metadata>>] 0]([join $exon_list ,])\}; $c itemconfigure $tag&&outline&&exon -outline \[lindex \[$c bind $tag <<Colors>>\] 1\]; $c itemconfigure $tag&&outline&&(fwd_arrow||rev_arrow) -outline \[lindex \[$c bind $tag <<Colors>>\] 1\]; $c itemconfigure $tag&&label_box -outline \[lindex \[$c bind $tag <<Colors>>\] 1\]"
    $c bind $tag <Any-Leave> "$c itemconfigure $tag&&feature&&label -fill \[lindex \[$c bind $featurelabelid <<Colors>>\] 0\];$c itemconfigure seqtext -text {}; $c itemconfigure $tag&&outline&&exon -outline \[lindex \[$c bind $tag <<Colors>>\] 2\]; $c itemconfigure $tag&&outline&&(fwd_arrow||rev_arrow) -outline \[lindex \[$c bind $tag <<Colors>>\] 2\]; $c itemconfigure $tag&&label_box  -outline \[lindex \[$c bind $tag <<Colors>>\] 3\]"
  }

  $c bind $tag <<Tag>> $tag


  $c bind $tag <$modifier-Button-1> "if {\[$c find withtag current&&moveabletext\] ==\"\"} {set cmdy %y; break}"
  $c bind $tag&&(exon||intron||fwd_arrow||rev_arrow) <$modifier-B1-Motion> "if {\[info exists cmdy\]} {$c move $tag 0 \[expr {%y-\$cmdy}\]; set cmdy %y; $c bind \[$c find withtag $tag&&moveabletext\] <<Moved>> 1}"
  $c bind $tag&&(exon||intron||fwd_arrow||rev_arrow) <$modifier-ButtonRelease-1> "unset -nocomplain cmoveitem cmdy; $c configure -scrollregion \[$c bbox all\]"


  if {$info(android)} {
    $c bind $tag <Button-1> [$c bind $tag <$modifier-Button-1>]
    $c bind $tag&&(exon||intron||fwd_arrow||rev_arrow) <B1-Motion> [$c bind $tag&&(exon||intron||fwd_arrow||rev_arrow) <$modifier-B1-Motion>]
    $c bind $tag&&(exon||intron||fwd_arrow||rev_arrow) <ButtonRelease-1> [$c bind $tag&&(exon||intron||fwd_arrow||rev_arrow) <$modifier-ButtonRelease-1>]
  }

  if {[$w.textarea tag ranges $fntag] == {}} {
    set linktag $tag
  } else {
    set linktag $fntag
  }
  set linkranges [$w.textarea tag ranges $linktag]
  ## needs work here for selection through origin - should each exon/ intron get a link now?
  if {$end < $seq_len && [$w.textarea compare [lindex $linkranges 1] < [bp2ix $w.textarea $start]]} {
    set linkranges [lrange $linkranges 2 3] 
  }
  if {([llength $linkranges] > 2) && [$w.textarea compare [lindex $linkranges 2] > [bp2ix $w.textarea $end]]} {
    set linkranges [lrange $linkranges 0 1] 
  }
  if {[$w.textarea compare [lindex $linkranges 0] < [bp2ix $w.textarea $start]]} {
    set linkranges [lreplace $linkranges 0 0 [bp2ix $w.textarea $start]] 
  }
  if {$end < $seq_len && ([llength $linkranges] > 2) && [$w.textarea compare [lindex $linkranges 3] > [bp2ix $w.textarea $end]]} {
    set linkranges [lreplace $linkranges 3 3 [bp2ix $w.textarea $end]] 
  } elseif {$end < $seq_len && ([llength $linkranges] == 2) && [$w.textarea compare [lindex $linkranges 1] > [bp2ix $w.textarea $end]]} {
    set linkranges [lreplace $linkranges 1 1 [bp2ix $w.textarea $end]] 
  }

  # linear feature binding
      set config_treeview "[winfo toplevel $c].f_config.tabframe.features.frame1.tv"
  $c bind $tag <Button-1> "select_region $w \[bp2ix $w.textarea [ix2bp $w.textarea [lindex $linkranges 0]]\] \[bp2ix $w.textarea [ix2bp $w.textarea [lindex $linkranges 1]]\];if {\[winfo exists $config_treeview\]} {$config_treeview selection set $featurelabelid; $config_treeview see $featurelabelid}"
  $c bind $tag <Double-Button-1> "select_region $w \[bp2ix $w.textarea [ix2bp $w.textarea [lindex $linkranges 0]]\] \[bp2ix $w.textarea [ix2bp $w.textarea [lindex $linkranges 1]]\]; event generate $c <<Return>>; break"
  lappend info($w,linked_events) [list $c $tag <Button-1>] [list $c $tag <Double-Button-1>]

  if {[llength $linkranges] == 4} {
    $c bind $tag <Shift-Button-1> "select_region $w \[bp2ix $w.textarea [ix2bp $w.textarea [lindex $linkranges 2]]\] \[bp2ix $w.textarea [ix2bp $w.textarea [lindex $linkranges 3]]\]; if {\[winfo exists $config_treeview\]} {$config_treeview selection add $featurelabelid; $config_treeview see $featurelabelid}" 
    $c bind $tag <Shift-Double-Button-1> "select_region $w \[bp2ix $w.textarea [ix2bp $w.textarea [lindex $linkranges 2]]\] \[bp2ix $w.textarea [ix2bp $w.textarea [lindex $linkranges 3]]\]; event generate $c <<Return>>; break" 
    lappend info($w,linked_events) [list $c $tag <Shift-Button-1>] [list $c $tag <Shift-Double-Button-1>]
  } else {
    $c bind $tag <Shift-Button-1> "if {\[winfo exists $config_treeview\]} {$config_treeview selection add $featurelabelid; $config_treeview see $featurelabelid}"
  }
}

################
## set the arrow coordinates for a linear feature
################
## NOT USED
proc linear_feature_draw_arrow0 {c tag} {
  global info
  if {[$c itemcget fwd_arrow&&foreground&&$tag -state] == "hidden" && [$c itemcget rev_arrow&&foreground&&$tag -state] == "hidden"} {
    return
  }
  set gformat [$c bind $tag <<Gformat>>]
  set width [dict get $gformat width]

  if {$width == "" || $width < 1} {set width 1}
  set width [expr {$width * $info(tk_scaling)}]
  set arrow_list [dict get $gformat arrow_data]
  set coord_list [$c bind $tag <<Coord_list>>]

  set tag_outline_width [expr {[$c itemcget exon&&outline&&$tag -width]/2-1}]

  if {[$c find withtag baseline] != ""} {
    set x_scale [expr {[lindex [$c coords line] 2]/390}]
  } else {
    set x_scale 1
  }

  foreach {a b} $coord_list {}
  foreach {first_exon first_exon_bg first_exon_coords} $a {}


  if {$first_exon_coords != {}} {
    lset first_exon_coords 0 [expr {[lindex $first_exon_coords 0]*$x_scale}]
    lset first_exon_coords 2 [expr {[lindex $first_exon_coords 2]*$x_scale}]
    lset first_exon_coords 1 [lindex [$c coords $first_exon] 1]
    lset first_exon_coords 3 [lindex [$c coords $first_exon] 3]
  }
  foreach {last_exon last_exon_bg last_exon_coords} $b {}
  if {$last_exon_coords != {}} {
    lset last_exon_coords 0 [expr {[lindex $last_exon_coords 0]*$x_scale}]
    lset last_exon_coords 2 [expr {[lindex $last_exon_coords 2]*$x_scale}]
    lset last_exon_coords 1 [lindex [$c coords $last_exon] 1]
    lset last_exon_coords 3 [lindex [$c coords $last_exon] 3]
  }

  set direction [$c bind $tag <<Direction>>]
  if {$direction} {
    set fwd_pts [lindex $arrow_list 1]
    set rev_pts [lindex $arrow_list 0]
  } else {
    set fwd_pts [lindex $arrow_list 0]
    set rev_pts [lindex $arrow_list 1]
  }
  set flip [lindex $arrow_list 2]

  if {[llength [$c find withtag fwd_arrow]] > 0} {
    set f_max_x 0
    foreach {xp yp} $fwd_pts {
      set f_max_x [expr {max($xp, $f_max_x)}]
    }
    set f_max_x [expr {$f_max_x * $width}]

    if {$last_exon_coords != {}} {
      foreach {fx0 fy0 fx1 fy1 } $last_exon_coords {}
      set last_w [expr {$fx1 - $fx0}]
      set fwd_adjust [expr {min ($f_max_x, ($f_max_x + $last_w) / 2.0)}]
      set fwd_x [expr {$fx1 - $fwd_adjust}]
      set y [expr {([lindex [$c coords $last_exon] 1] + [lindex [$c coords $last_exon] 3])/ 2.0}]
      set fwd_coords [arrow_coords $fwd_x [expr {$y+0}] -90 0 $width $fwd_pts [expr {!$direction ^ $flip}]]
      $c coords fwd_arrow&&foreground&&$tag $fwd_coords
      if {$fwd_coords != {} ||  [$c type fwd_arrow&&outline&&$tag] eq "polygon"} {

        $c coords fwd_arrow&&outline&&$tag $fwd_coords
      } 
    } else {
      set last_w 0
      set fwd_adjust 0
      $c itemconfigure fwd_arrow&&foreground&&$tag -state hidden
      $c itemconfigure fwd_arrow&&outline&&$tag -state hidden
    }
  } elseif {$last_exon_coords != {}} {
    foreach {fx0 fy0 fx1 fy1 } $last_exon_coords {}
    set last_w [expr {$fx1 - $fx0}]
    set fwd_adjust 0
  } else {
    set last_w 0
    set fwd_adjust 0
  }

  if {[llength [$c find withtag rev_arrow]] > 0 && $first_exon_coords != {}} {
    set r_max_x 0
    foreach {xp yp} $rev_pts {
      set r_max_x [expr {max($xp, $r_max_x)}]
    }
    set r_max_x [expr {$r_max_x * $width}]
    if {$first_exon_coords != {}} {
      foreach {rx0 ry0 rx1 ry1 } $first_exon_coords {}
      set first_w [expr {$rx1 - $rx0}]
    } else {
      set first_w 0
    }
    set rev_adjust [expr {min ($r_max_x, ($r_max_x + $first_w) / 2.0)}]
    set rev_x [expr {$rx0 + $rev_adjust}]
    set y [expr {([lindex [$c coords $first_exon] 1] + [lindex [$c coords $first_exon] 3])/ 2.0}]
    set rev_coords [arrow_coords $rev_x [expr {$y+0}] -90 1 $width $rev_pts  [expr {$direction ^ $flip}]]
    $c coords rev_arrow&&foreground&&$tag $rev_coords
    if {$rev_coords != {} ||  [$c type rev_arrow&&outline&&$tag] eq "polygon"} {
      $c coords rev_arrow&&outline&&$tag $rev_coords
    } 

  } elseif {$first_exon_coords != {}} {
    foreach {rx0 ry0 rx1 ry1 } $first_exon_coords {}
    set first_w [expr {$rx1 - $rx0}]
    set rev_adjust 0
  } else {
      $c itemconfigure rev_arrow&&foreground&&$tag -state hidden
      $c itemconfigure rev_arrow&&outline&&$tag -state hidden
    set first_w 0
    set rev_adjust 0
  }

  if {$first_exon == $last_exon && $first_exon != {}} {
    if {[expr {$fwd_adjust+$rev_adjust}] > $first_w} {
      $c itemconfigure $first_exon -state hidden
      $c itemconfigure $first_exon_bg  -state hidden
    } else {
      $c coords $first_exon [expr {$fx0+$rev_adjust-(($rev_adjust>0)?1:0)}] $fy0 [expr {$fx1-$fwd_adjust+(($fwd_adjust>0)?1:0)}] $fy1
      $c coords $first_exon_bg [expr {$fx0+$tag_outline_width+$rev_adjust}] $fy0 [expr {$fx1-$tag_outline_width-$fwd_adjust}] $fy1
      $c itemconfigure $first_exon -state normal
      $c itemconfigure $first_exon_bg  -state normal
    }
  } else {
    if {$fwd_adjust > $last_w} {
      $c itemconfigure $last_exon -state hidden
      $c itemconfigure $last_exon_bg -state hidden
    } elseif {$last_exon != {}} {
      $c coords $last_exon $fx0 $fy0 [expr {$fx1-$fwd_adjust+(($fwd_adjust>0)?1:0)}] $fy1
      $c coords $last_exon_bg [expr {$fx0}] $fy0 [expr {$fx1-$tag_outline_width-$fwd_adjust}] $fy1
      $c itemconfigure $last_exon -state normal
      $c itemconfigure $last_exon_bg  -state normal
    }
    if {$rev_adjust > $first_w} {
      $c itemconfigure $first_exon -state hidden
      $c itemconfigure $first_exon_bg -state hidden
    } elseif {$first_exon != {}} {
      $c coords $first_exon [expr {$rx0+$rev_adjust-(($rev_adjust>0)?1:0)}] $ry0 $rx1 $ry1
      $c coords $first_exon_bg [expr {$rx0+$tag_outline_width +$rev_adjust}] $ry0 [expr {$rx1}] $ry1
      $c itemconfigure $first_exon -state normal
      $c itemconfigure $first_exon_bg  -state normal
    }
  }
  $c raise $tag&&foreground $tag&&outline
}

################
## set the arrow coordinates for a linear feature
################
proc linear_feature_draw_arrow {c tag} {
  global info

  if {[$c itemcget fwd_arrow&&foreground&&$tag -state] == "hidden" && [$c itemcget rev_arrow&&foreground&&$tag -state] == "hidden"} {
    return
  }
  set gformat [$c bind $tag <<Gformat>>]
  set width [dict get $gformat width]

  if {$width == "" || $width < 1} {set width 1}
  set width [expr {$width * $info(tk_scaling)}]
  set arrow_list [dict get $gformat arrow_data]
  set direction [$c bind $tag <<Direction>>]
  set tag_outline_width [expr {[$c itemcget exon&&outline&&$tag -width]/2-1}]

  if {[$c find withtag baseline] != ""} {
    set x_scale [expr {[lindex [$c coords line] 2]/390}]
  } else {
    set x_scale 1
  }


  lassign  [$c bind $tag <<Coord_list>>]  a b

  lassign $a first_exon first_exon_bg first_exon_coords


  if {$first_exon_coords != {}} {
    set first_exon_coords [list [expr {[lindex $first_exon_coords 0]*$x_scale}] [lindex [$c coords $first_exon] 1]  [expr {[lindex $first_exon_coords 2]*$x_scale}] [lindex [$c coords $first_exon] 3]]
  } else {
     catch {$c itemconfigure rev_arrow&&foreground&&$tag -state hidden}
     catch {$c itemconfigure rev_arrow&&outline&&$tag -state hidden}
     catch {$c itemconfigure fwd_arrow&&foreground&&$tag -state hidden}
     catch {$c itemconfigure fwd_arrow&&outline&&$tag -state hidden}
    return
  }

  lassign $b last_exon last_exon_bg last_exon_coords
  if {$last_exon_coords != {}} {
    set last_exon_coords [list [expr {[lindex $last_exon_coords 0]*$x_scale}] [lindex [$c coords $last_exon] 1] [expr {[lindex $last_exon_coords 2]*$x_scale}] [lindex [$c coords $last_exon] 3]]
  } else {
     catch {$c itemconfigure rev_arrow&&foreground&&$tag -state hidden}
     catch {$c itemconfigure rev_arrow&&outline&&$tag -state hidden}
     catch {$c itemconfigure fwd_arrow&&foreground&&$tag -state hidden}
     catch {$c itemconfigure fwd_arrow&&outline&&$tag -state hidden}
     return
  }


  set exon_y [expr {([lindex [$c coords $last_exon] 1] + [lindex [$c coords $last_exon] 3])/ 2.0}]

  if {$direction} {
    set fwd_pts [lindex $arrow_list 1]
    set rev_pts [lindex $arrow_list 0]
  } else {
    set fwd_pts [lindex $arrow_list 0]
    set rev_pts [lindex $arrow_list 1]
  }
  set flip [lindex $arrow_list 2]

   ## bezier arrow data change here-  arrow points list can be dict of pts min_x_scale and smooth
  if {[dict exists $fwd_pts pts]} {
    if {[dict exists $fwd_pts min_x_scale]} {
      set fwd_min_x_scale  [dict get $fwd_pts min_x_scale]
    } else {
      set fwd_min_x_scale  0.2
    }
    if {[dict exists $fwd_pts smooth]} {
      set fwd_smooth  [dict get $fwd_pts smooth]
    } else {
      set fwd_smooth 0
    }
    set fwd_pts [dict get $fwd_pts pts]
  } else {
    set fwd_min_x_scale  0.2
    set fwd_smooth 0
  }
  if {[dict exists $rev_pts pts]} {
    if {[dict exists $rev_pts min_x_scale]} {
      set rev_min_x_scale  [dict get $rev_pts min_x_scale]
    } else {
      set rev_min_x_scale  0.2
    }
    if {[dict exists $rev_pts smooth]} {
      set rev_smooth  [dict get $rev_pts smooth]
    } else {
      set rev_smooth 0
    }
    set rev_pts [dict get $rev_pts pts]
  } else {
    set rev_min_x_scale  0.2
    set rev_smooth 0
  }

  catch {$c itemconfigure rev_arrow&&foreground&&$tag -smooth $rev_smooth}
  catch {$c itemconfigure rev_arrow&&outline&&$tag -smooth $rev_smooth}
  catch {$c itemconfigure fwd_arrow&&foreground&&$tag -smooth $fwd_smooth}
  catch {$c itemconfigure fwd_arrow&&outline&&$tag -smooth $fwd_smooth}

  set f_max_x 0
  foreach {xp yp} $fwd_pts {
    set f_max_x [expr {max($xp, $f_max_x)}]
  }
  set fwd_adjust [expr {$f_max_x * $width}]
  set r_max_x 0
  foreach {xp yp} $rev_pts {
    set r_max_x [expr {max($xp, $r_max_x)}]
  }
  set rev_adjust [expr {$r_max_x * $width}]

  if {[$c find withtag fwd_arrow&&foreground&&$tag] == {}} {
    set fwd_adjust 0
  }

  if {[$c find withtag rev_arrow&&foreground&&$tag] == {}} {
    set rev_adjust 0
  }
  
  lassign $last_exon_coords fx0 fy0 fx1 fy1 
  set last_w [expr {$fx1 - $fx0}]

  lassign $first_exon_coords rx0 ry0 rx1 ry1 
  set first_w [expr {$rx1 - $rx0}]


  set center_long_arrows 1
  # if fwd_adust +rev_adjust are longer than the total extent of the feature
  if {[expr {$rev_adjust + $fwd_adjust}] > [expr {$fx1 - $rx0}]} {
    ## scale the arows to fit
    set x_scale [expr {1.0*($fx1 - $rx0) / max (2,($rev_adjust + $fwd_adjust))}]
    if {$x_scale == [expr {max($x_scale, $fwd_min_x_scale, $rev_min_x_scale)}]} {
      set fwd_x_scale $x_scale
      set rev_x_scale $x_scale      
    } elseif {$fwd_min_x_scale > $rev_min_x_scale} {
      set fwd_x_scale $fwd_min_x_scale
      set rev_x_scale [expr {max($rev_min_x_scale, 1.0*($fx1 - $rx0 -$fwd_adjust*$fwd_min_x_scale) / max (1,$rev_adjust ))}]
   } else {
      set rev_x_scale $rev_min_x_scale
      set fwd_x_scale [expr {max($fwd_min_x_scale, 1.0*($fx1 - $rx0 -$rev_adjust*$rev_min_x_scale) / max (1,$fwd_adjust ))}]
    }
    set rev_adjust [expr {$rev_adjust * $rev_x_scale}]
    set fwd_adjust [expr {$fwd_adjust * $fwd_x_scale}]
    set new_pts [list]
    foreach {x y} $rev_pts {
      lappend new_pts [expr {$x * $rev_x_scale}] $y
    }
    set rev_pts $new_pts
    set new_pts [list]
    foreach {x y} $fwd_pts {
      lappend new_pts [expr {$x * $fwd_x_scale}] $y
    }
    set fwd_pts $new_pts
    if {[expr {$rev_adjust + $fwd_adjust}] > [expr {$fx1 - $rx0}]} {
      # preserve arrow sizes, center the two
      set rev_adjust0 $rev_adjust
      set fwd_adjust0 $fwd_adjust
      set rev_adjust [expr {$rev_adjust0 - (($rev_adjust0 + $fwd_adjust0)-($fx1 - $rx0))/2.0}]
      set fwd_adjust [expr {$fwd_adjust0 - (($rev_adjust0 + $fwd_adjust0)-($fx1 - $rx0))/2.0}]
    }
  }

  set fwd_x [expr {$fx1 - $fwd_adjust}]
  set rev_x [expr {$rx0 + $rev_adjust}]

## set arrow coords
  if {[$c find withtag fwd_arrow] ne {}} {
    set fwd_coords [arrow_coords $fwd_x [expr {$exon_y+0}] -90 0 $width $fwd_pts [expr {!$direction ^ $flip}]]
## bezier arrow data change here
    $c coords fwd_arrow&&foreground&&$tag $fwd_coords
    $c coords fwd_arrow&&outline&&$tag $fwd_coords
  }
  if {[$c find withtag rev_arrow] ne {}} {
## bezier arrow data change here
      set rev_coords [arrow_coords $rev_x [expr {$exon_y+0}] -90 1 $width $rev_pts  [expr {$direction ^ $flip}]]
      $c coords rev_arrow&&foreground&&$tag $rev_coords
      $c coords rev_arrow&&outline&&$tag $rev_coords
  }

  if {$first_exon == $last_exon && $first_exon != {}} {
    if {[expr {$fwd_adjust+$rev_adjust}] > $first_w} {
      $c itemconfigure $first_exon -state hidden
      $c itemconfigure $first_exon_bg  -state hidden
    } else {
      $c coords $first_exon [expr {$fx0+$rev_adjust-(($rev_adjust>0)?1:0)}] $fy0 [expr {$fx1-$fwd_adjust+(($fwd_adjust>0)?1:0)}] $fy1
      $c coords $first_exon_bg [expr {$fx0+$tag_outline_width+$rev_adjust}] $fy0 [expr {$fx1-$tag_outline_width-$fwd_adjust}] $fy1
      $c itemconfigure $first_exon -state normal
      $c itemconfigure $first_exon_bg  -state normal
    }
  } else {
    if {$fwd_adjust > $last_w} {
      $c itemconfigure $last_exon -state hidden
      $c itemconfigure $last_exon_bg -state hidden
    } elseif {$last_exon != {}} {
      $c coords $last_exon $fx0 $fy0 [expr {$fx1-$fwd_adjust+(($fwd_adjust>0)?1:0)}] $fy1
      $c coords $last_exon_bg [expr {$fx0}] $fy0 [expr {$fx1-$tag_outline_width-$fwd_adjust}] $fy1
      $c itemconfigure $last_exon -state normal
      $c itemconfigure $last_exon_bg  -state normal
    }
    if {$rev_adjust > $first_w} {
      $c itemconfigure $first_exon -state hidden
      $c itemconfigure $first_exon_bg -state hidden
    } elseif {$first_exon != {}} {
      $c coords $first_exon [expr {$rx0+$rev_adjust-(($rev_adjust>0)?1:0)}] $ry0 $rx1 $ry1
      $c coords $first_exon_bg [expr {$rx0+$tag_outline_width +$rev_adjust}] $ry0 [expr {$rx1}] $ry1
      $c itemconfigure $first_exon -state normal
      $c itemconfigure $first_exon_bg  -state normal
    }
  }

  $c raise $tag&&foreground $tag&&outline
}


#################
##
#################
proc linear_map_bump_features_find_overlap_and_move {c item {exclude {}}} {
  ## don't bump previously moved items:[$c bind $item <<Moved>>] == 1
  if {[lsearch $exclude $item] > -1 || [$c bind $item <<Moved>>] == 1} {return}

  #don't bump hidden items
  if {[$c bbox $item] == {}} {return}
  ##spacing info global?
  set spacing -3
  foreach {lx1 ly1 lx2 ly2} [$c bbox $item] {}

  foreach i [$c find overlapping $lx1 $ly1 $lx2 $ly2] {
    ## if overlapping an excluded (locked in) item, move out of the way of that item
    set ftag [lsearch -regexp -inline [$c gettags $i] {f[0-9]+#}]
    if {(($ftag == $item) || [lsearch $exclude $ftag] == -1 || ($ftag == {}))} {continue}
    foreach {bx1 by1 bx2 by2} [$c bbox $ftag] {}
    $c move $item 0 [expr {$by2-$ly1+$spacing}]  

    lset exclude [lsearch $exclude $ftag] {}
    linear_map_bump_features_find_overlap_and_move $c $item $exclude
    break
  }
}

################
## 
################
proc linear_map_bump_all_features {c {item ""}} {
  set exclude [list $item]
  foreach i [lsort -integer [$c find withtag feature&&label]] {
    if {[$c bind $i <<Moved>>]==1 } { continue}
    set ftag [lsearch -regexp -inline [$c gettags $i] {f[0-9]+#}]
    linear_map_bump_features_find_overlap_and_move $c $ftag $exclude
    lappend exclude $ftag
  }
}

################
## 
################
proc linear_map_reset_all_features {c} {
  if {[catch {set top_of_features [expr {370+ 2* [font metrics [$c itemcget title -font] -displayof . -linespace]}]}]} {
    set top_of_features 400
  } 
  foreach i [lsort -integer [$c find withtag feature&&label]] {
    if {[$c bind $i <<Moved>>]==1 } { continue}
    set ftag [lsearch -regexp -inline [$c gettags $i] {f[0-9]+#}]
    set gformat_dict [$c bind $ftag <<Gformat>>]
    if {[dict get $gformat_dict linear_state] eq "hidden"} {
      continue
    }
    set by1 {}
    lassign  [$c bbox $ftag&&exon] bx1 by1 bx2 by2
    if {$by1 == {}} {
      lassign [$c bbox $ftag&&(fwd_arrow||rev_arrow)] bx1 by1 bx2 by2
    }
    if {$by1 == {}} {
      lassign [$c bbox $ftag] bx1 by1 bx2 by2
    }

    if {$by1 != {}} {
      lassign [$c bbox $i] lx1 ly1 lx2 ly2
      if {$ly2 ne {}} {
        $c move $i [expr {($bx2+$bx1)/2.0-($lx1+$lx2)/2.0}] [expr {$by2-$ly1}]

        graphic_map_recenter_label_box $c $i
      }
      $c move $ftag 0 [expr {$top_of_features-$by1}]
    } else {
      sputs $ftag no y value
    }
  }
}

################
## 
################
proc linear_map_bump_boxlabels_find_overlap_and_move {c item {exclude {}}} {
  ## don't bump previously moved items:[$c bind $item <<Moved>>] == 1
  if {[lsearch $exclude $item] > -1 || [$c bind $item <<Moved>>] == 1} {return}

  #don't bump hidden items
  if {[$c bbox $item] == {}} {return}
  ##spacing info global?
  set spacing 0
  foreach {lx1 ly1 lx2 ly2} [$c bbox $item] {}

  foreach id [$c find overlapping $lx1 $ly1 $lx2 $ly2] {
    ## if overlapping an excluded (locked in) item, move out of the way of that item
    if {(($id == $item) || [lsearch $exclude $id] == -1 || ($id == {}))} {continue}
    foreach {bx1 by1 bx2 by2} [$c bbox $id] {}
    $c move $item 0 [expr {$by1-$ly2-$spacing}]  
    set boxid [$c find withtag "$item.box"]
    $c move $boxid 0 [expr {$by1-$ly2-$spacing}]  
    set connectorid [$c find withtag "$item.connector"]
    $c coords $connectorid [lreplace [$c coords $connectorid] 3 3 [expr {$by1-$spacing}] ]
    set connectorid_aa [$c find withtag "$item.connector_aa"]
    $c coords $connectorid_aa [$c coords $connectorid]
    lset exclude [lsearch $exclude $id] {}
    linear_map_bump_boxlabels_find_overlap_and_move $c $item $exclude
    break
  }
}

################
## 
################
proc linear_map_bump_all_boxlabels {c {item ""}} {
  set exclude [list $item]
  foreach id [lsort -integer [$c find withtag enzyme&&moveableboxlabel]] {
    linear_map_bump_boxlabels_find_overlap_and_move $c $id $exclude
    lappend exclude $id
  }
}

################
## 
################
proc linear_map_reset_all_boxlabels {c} {
  set bottom_of_features [expr {335}]
  foreach id [lsort -integer [$c find withtag enzyme&&moveableboxlabel]] {
    set boxid [$c find withtag "$id.box"]
    set connectorid [$c find withtag "$id.connector"]
    set connectorid_aa [$c find withtag "$id.connector_aa"]
    if {[$c bbox $boxid] ne {}} {
      foreach {bx1 by1 bx2 by2} [$c bbox $boxid] {}
    } elseif {[$c bbox $id] ne {}} {
      foreach {bx1 by1 bx2 by2} [$c bbox $id] {}
    } else {
      return
    }
    if {$by2 != {}} {
      $c move $id 0 [expr {$bottom_of_features-$by2}]
      $c move $boxid 0 [expr {$bottom_of_features-$by2}]
      $c coords $connectorid [lreplace [$c coords $connectorid] 3 3 335]
      $c coords $connectorid_aa [$c coords $connectorid]
    } else {
      sputs no y value
    }
  }
}


################
## bump all featurelabel items to not overlap, but be as close as possible to their items
################
proc linear_feature_label_bump {c} {
  foreach l [lreverse [$c find withtag feature&&label]] {
    while {[llength [set ollist [linear_feature_overlapping_labels $c $l]]] > 0} {
      set newy 0
      foreach i $ollist {
        set newy [expr {max($newy, [lindex [$c bbox $i] 3]+3)}]
      }
      $c coords $l [lindex [$c coords $l] 0] $newy
    }
  }
}

proc linear_feature_overlapping_labels {c l} {
  if {[$c bbox $l] eq {}} {return {}}
  set ollist [$c find overlapping {*}[$c bbox $l]]
  set result [list]
  set ltag [lsearch -regexp -inline [$c gettags $l] {f.*#}]
  foreach k $ollist {
    if {$k != $l && ([lsearch -regexp -inline [$c gettags $k] {f.*#}] != $ltag)} {
      lappend result $k
    }
  }
  return $result
}

proc linear_feature_rebump_labels {c} {
  foreach l [lreverse [$c find withtag feature&&label]] {
    set ltag [lsearch -regexp -inline [$c gettags $l] {f.*#}]
    set newy [expr {[lindex [$c bbox {*}[$c find withtag $ltag&&(!label)]] 3]-2}]
    $c coords $l [lindex [$c coords $l] 0] $newy
  }
  linear_feature_label_bump $c
}

################
## returns a count of features that are below a feature and overlap it- not used-see tagdepth
################
proc features_below {w feature} {
##needs to use recursion, since two features below might not overlap each other
##needs to return one more than the result of features_below for all overlapping features below
  set feature_list [regexp -inline -all {f[0-9]+#} [$w.textarea tag names]]
  set ftag [regsub fn* $feature f]
  set fntag [regsub fn* $feature fn]
  set index [lsearch $feature_list $ftag]
  if {$index == -1} {return -1}
  incr index -1
  set below [lrange $feature_list 0 $index]
  set i 0
  if {[$w.textarea tag ranges $fntag] == {}} {set fntag $ftag}
  foreach b_tag $below {
    if {($b_tag == $ftag) || ($b_tag == $fntag)} continue
    if {[$w.textarea tag ranges [regsub f $b_tag fn]] != {}} {
      set b_tag [regsub f $b_tag fn]
    }
    foreach {x1 x2} [$w.textarea tag ranges $fntag] {
      foreach {y1 y2} [$w.textarea tag ranges $b_tag] {
        if {!([$w.textarea compare $x1 > $y2] || [$w.textarea compare $x2 < $y1])} {
          incr i
        }
      }
    }
  }
  return $i
}

################
## returns a dictionary of tags and depth between indices start and end
################
proc tagdepth {t start end} {
  set toptags [list]
  set tagtaglist [list]

  set ixlist [list]
  set taglist [lsearch -inline -regexp -all -not [$t tag names $start] {trans[0-9]+#|fn[0-9]+#|tempsel|sel|foundf|foundr}]
  if {$taglist != [list ]} {lappend ixlist $start}
  set taglist [lsearch -inline -regexp -all -not [$t tag names $end] {trans[0-9]+#|fn[0-9]+#|tempsel|sel|foundf|foundr}]
  if {$taglist != [list ]} {lappend ixlist $end}
  foreach {type tag index} [$t dump -tag $start+1char $end+1chars] {
    if {[lsearch -inline -regexp -all -not $tag {trans[0-9]+#|fn[0-9]+#|tempsel|sel|foundf|foundr}] != [list]} {
      lappend ixlist $index
    }
  }
  set ixlist [lsort -unique $ixlist]
  foreach i $ixlist {
    set taglist [lsearch -inline -regexp -all -not [$t tag names $i] {trans[0-9]+#|fn[0-9]+#|tempsel|sel|foundf|foundr}]
    for {set j 0} {$j < [llength $taglist]} {incr j} {
      foreach tag [lrange $taglist [expr {$j +1}] end] {
        if {(![info exists tagbelow([lindex $taglist $j])]) || ([lsearch -exact $tagbelow([lindex $taglist $j]) $tag] == -1)} {
          lappend tagbelow([lindex $taglist $j]) $tag
        }
      }
    }
  }
  set below_list_dict [array get tagbelow]
  set depth_dict [list]
  foreach tag [dict keys $below_list_dict] {
    set depth_dict [recurs_tagbelow $tag $below_list_dict $depth_dict]
  }
  return $depth_dict

#### old
##bug: current version doesn't work. need to make an array of all tags above the index tag at each i and then recursively add 1 level to each tag above
  foreach i $ixlist {
    set taglist [lsearch -inline -regexp -all -not [$t tag names $i] {trans[0-9]+#|fn[0-9]+#|tempsel|sel|foundf|foundr}]
    for {set j 0} {$j < [llength $taglist]} {incr j} {
      set tag [lindex $taglist $j]
      if {[info exists tags($tag)]} {
        set tags($tag) [expr {max($j,$tags($tag))}]
      } else {
        set tags($tag) $j
      }
    }
  }
  return [array get tags]


### old
  foreach {a b c} [lrange [$t dump -tag $start $end] 0 end-3] {d e f} [lrange [$t dump -tag $start $end] 3 end] {
    if {($c != $f)} {
      set taglist [lsearch -inline -regexp -all -not [$t tag names $c] {trans[0-9]+#|fn[0-9]+#|tempsel|sel|foundf|foundr}]
      if {[llength $taglist] > 1} {
        lappend tagtaglist $taglist
      }
    }
  }
  set c 1
  set z 0
  while {$c && ($z < 15)} {
    set c 0
    foreach taglist $tagtaglist {
      set i 0
      foreach tag $taglist {
        if {![dict exists $toptags $tag] || ($i > [dict get $toptags $tag])} {
          dict set toptags $tag $i
          set c 1
        } elseif {($i < [dict get $toptags $tag])} {
          set i [dict get $toptags $tag]
        }
        incr i
      }
    }
    incr z
  }
  return $toptags
}

################
## returns a dictionary of tags and depth between indices start and end
################
### NOT USED
proc tagdepth_features0 {t start end} {
  set toptags [list]
  set tagtaglist [list]

  set ixlist [list]
  set taglist [lsearch -inline -regexp -all [$t tag names $start] {f[0-9]+#}]
  if {$taglist != [list ]} {lappend ixlist $start}
  set taglist [lsearch -inline -regexp -all [$t tag names $end]  {f[0-9]+#}]
  if {$taglist != [list ]} {lappend ixlist $end}
  foreach {type tag index} [$t dump -tag $start+1char $end+1chars] {
    if {[lsearch -inline -regexp -all $tag  {f[0-9]+#}] != [list]} {
      lappend ixlist $index
    }
  }
  set ixlist [lsort -unique $ixlist]
  foreach i $ixlist {
    set taglist [lsearch -inline -regexp -all [$t tag names $i]  {f[0-9]+#}]
    for {set j 0} {$j < [llength $taglist]} {incr j} {
      foreach tag [lrange $taglist [expr {$j +1}] end] {
        if {(![info exists tagbelow([lindex $taglist $j])]) || ([lsearch -exact $tagbelow([lindex $taglist $j]) $tag] == -1)} {
          lappend tagbelow([lindex $taglist $j]) $tag
        }
      }
    }
  }
  set below_list_dict [array get tagbelow]
  set depth_dict [list]
  foreach tag [dict keys $below_list_dict] {
    set depth_dict [recurs_tagbelow $tag $below_list_dict $depth_dict]
  }
  return $depth_dict
}


################
## returns a dictionary of tags and depth between indices start and end- new, non-recusive form
################
### NOT USED
proc tagdepth_features1 {t start end} {
  set depth_dict [dict create]
  set last_tagnames [list]
  for {set index $start} {[$t compare $index < $end]} {set index [$t index $index+1c]} {
    set z 0
    if {[set new_tagnames [$t tag names $index]] == $last_tagnames} {continue}
    foreach tag [lsearch -inline -regexp -all $new_tagnames {fn?[0-9]+#}] {
      if {[lsearch -exact $new_tagnames [regsub f $tag fn]] > -1} {continue}
      if {![dict exists $depth_dict $tag] || [dict get $depth_dict $tag] < $z} {
        dict set depth_dict $tag $z
      }
      incr z
    }
    set last_tagnames $new_tagnames
  }
  foreach key [dict keys $depth_dict fn*] {
    dict set depth_dict [regsub fn $key f] [dict get $depth_dict $key]
  }
  return $depth_dict
}

################
## returns a dictionary of tags and depth between indices start and end- new, second non-recusive form- this one looks at the depth of each tag below to make a new depth measurement
## preserves z depth info at the expense of wasting white space
################
## NOT USED, but could be useful
proc tagdepth_features2 {t start end} {
  global tags_below_dict tag_dict
  set tags_below_dict [dict create]
  set tag_dict [dict create]
  set last_tagnames [list]
  for {set index $start} {[$t compare $index < $end]} {set index [$t index $index+1c]} {
    if {[set new_tagnames [$t tag names $index]] == $last_tagnames} {continue}
    set tag_below_list [list]
    foreach tag [lsearch -inline -regexp -all $new_tagnames {fn?[0-9]+#}] {
      if {[lsearch -exact $new_tagnames [regsub f $tag fn]] > -1} {continue}
      dict set tag_dict [regsub fn $tag f]  {}
      foreach tag_below $tag_below_list {
        dict set tags_below_dict [regsub fn $tag f] $tag_below {}
      }
      lappend tag_below_list [regsub fn $tag f]
    }
    set last_tagnames $new_tagnames
  }
  set depth_dict [dict create]
  while {[dict keys $tag_dict] != {}} {
    foreach tag [dict keys $tag_dict] {
      if {![dict exists $tags_below_dict $tag]} {
        dict set depth_dict $tag 0
        dict unset tag_dict $tag
      } else {
        set z 0
        set found 1
        foreach tag_below [dict keys [dict get $tags_below_dict $tag]] {
          if {[dict exists $depth_dict $tag_below]} {
            set z [expr {max($z, ([dict get $depth_dict $tag_below]+1))}]
          } else {
            set found 0
            break
          }
        }
        if {$found} {
          dict set depth_dict $tag $z
          dict unset tag_dict $tag
        }
      }
    }
  }
  return $depth_dict
}

################
## returns a dictionary of tags and depth between indices start and end- new, third non-recusive form- this one looks at the depth of each tag below to make a new depth measurement
## picks the lowest avalable depth consistent with no overlap with lower features- conserves whitespace, but can distort stacking order
################
## NOT USED
proc tagdepth_features3 {t start end} {
  global tags_below_dict tag_dict
  set tags_below_dict [dict create]
  set tag_dict [dict create]
  set last_tagnames [list]
  if {[$t compare $start < $end]} {
    set range 1
  } else {
    set range 0
  }


  set index [$t index $start-1c]
  set stop 0
  while {$stop < 10000 && ($range == 0 || [$t compare $index < $end])} {
    incr stop
    set index [$t index $index+1c]
    if {[$t compare $index == end-1c]} {
      set index 1.0
      set range 1
    }
    if {[set new_tagnames [$t tag names $index]] == $last_tagnames} {continue}
    set tag_below_list [list]
    foreach tag [lsearch -inline -regexp -all $new_tagnames {fn?[0-9]+#}] {
      if {[lsearch -exact $new_tagnames [regsub f $tag fn]] > -1} {continue}
      dict set tag_dict [regsub fn $tag f]  {}
      foreach tag_below $tag_below_list {
        dict set tags_below_dict [regsub fn $tag f] $tag_below {}
      }
      lappend tag_below_list [regsub fn $tag f]
    }
    set last_tagnames $new_tagnames

  }

  set depth_dict [dict create]
  while {[dict keys $tag_dict] != {}} {
    foreach tag [dict keys $tag_dict] {
      if {![dict exists $tags_below_dict $tag]} {
        dict set depth_dict $tag 0
        dict unset tag_dict $tag
      } else {
        set z_list [list]
        set found 1
        foreach tag_below [dict keys [dict get $tags_below_dict $tag]] {
          if {[dict exists $depth_dict $tag_below]} {
            lappend z_list [dict get $depth_dict $tag_below]
          } else {
            set found 0
            break
          }
        }
        for {set i 0} {$i <= [llength $z_list] && [lsearch $z_list $i] > -1} {incr i} {}
        if {$found} {
          dict set depth_dict $tag $i
          dict unset tag_dict $tag
        }
      }
    }
  }
  return $depth_dict
}

################
## returns a dictionary of tags and depth between indices start and end- new, fouth non-recusive form
################
proc tagdepth_features {text start end} {
  set f_tag_result [list]
  set f_range_result [list]
  set result {}
  foreach tag [$text tag names] {
    if {[regexp {f[0-9]+#} $tag]} {
      set new_tag_range [list] 
      foreach {a b} [$text tag ranges $tag] {
        if {!([$text compare $start > $b] || [$text compare $end < $a] )} {
          if {[$text compare $start < $a]} {
            lappend new_tag_range $a
          } else {
            lappend new_tag_range $start
          }
          if {[$text compare $end > $b]} {
            lappend new_tag_range $b
          } else {
            lappend new_tag_range $end
          }
        }
      }
      if {$new_tag_range == {}} {
        continue
      }
      set i 0
      set overlap 1
      foreach ll $f_range_result tl $f_tag_result {
        set overlap 0
        foreach {a b} $new_tag_range {
          foreach {c d} $ll {
            if {!([$text compare $b <= $c] || [$text compare $a >= $d] )} {
              set overlap 1 
              break
            }
          }
          if {$overlap} {
            break
          }
        }
        if {!$overlap} {
          lappend tl $tag
          dict set result $tag $i
          lset f_tag_result $i $tl
          lappend ll {*}$new_tag_range
          lset f_range_result $i $ll
          break
        }
        incr i

      }
      if {$overlap} {
        dict set result $tag $i
        lset f_tag_result $i $tag
        lset f_range_result $i $new_tag_range
      }
    }
  }
  return $result
}

################
## returns a dictionary of tags and depth. Looks at entire window, so faster
################
proc tagdepth_features_window {text} {
  set f_tag_result [list]
  set f_range_result [list]
  set result {}

  ## generated length sorted list of feature tags
  set taglist [list]
  foreach ftag  [lsearch -all -inline -regexp [$text tag names] {f[0-9]}] {
    regsub {f} $ftag fn fntag
    if {[$text tag ranges $fntag] != {} && [$text tag cget $fntag -background] !={}} {
      lappend taglist $fntag
    } elseif {[$text tag ranges $ftag] != {} && [$text tag cget $ftag -background] !={}} {
      lappend taglist $ftag
    }
  }
  set tag_sorted_list [dict create]
  foreach ftag $taglist {
    lassign [$text tag ranges $ftag] r1 r2 r3 r4
    set r1 [ix2bp $text $r1]
    set r2 [ix2bp $text $r2]
    if {$r3 == {}} {
      dict set tag_sorted_list  $ftag [expr {$r2 - $r1}]
    } else {
      set r3 [ix2bp $text $r3]
      set r4 [ix2bp $text $r4]
      dict set tag_sorted_list $ftag [expr {$r2 - $r1+ $r4- $r3}]
    }
  }
  set tag_sorted_list [lsort -integer -decreasing -index 1 -stride 2 $tag_sorted_list]

  foreach tag [dict keys $tag_sorted_list] {
    if {[regexp {f[0-9]+#} $tag] && [$text tag cget $tag -background] !={}} {
      set tag_range [$text tag ranges $tag]
      set i 0
      set overlap 1
      foreach ll $f_range_result tl $f_tag_result {
        set overlap 0
        foreach {a b} $tag_range {
          foreach {c d} $ll {
            if {!([$text compare $b <= $c] || [$text compare $a >= $d] )} {
              set overlap 1 
              break
            }
          }
          if {$overlap} {
            break
          }
        }
        if {!$overlap} {
          dict set result $tag $i
          lappend tl $tag
          #lset f_tag_result $i $tl
          lappend ll {*}$tag_range
          lset f_range_result $i $ll
          break
        }
        incr i
      }
      if {$overlap} {
        dict set result $tag $i
        #lset f_tag_result $i $tag
        lset f_range_result $i $tag_range
      }

    }
  }
  return $result
}

################
## returns a dictionary of tags and depth. Looks at entire window, so faster
################
proc tagdepth_features_window0 {text} {
  set tagdata [list]
  set taglist [list]
  set result [dict create]
  foreach ftag  [lsearch -all -inline -regexp [$text tag names] {f[0-9]}] {
    regsub {f} $ftag fn fntag
    if {[$text tag ranges $fntag] != {} && [$text tag cget $fntag -background] !={}} {
      lappend taglist $fntag
      dict set result $fntag 0
    } elseif {[$text tag ranges $ftag] != {} && [$text tag cget $ftag -background] !={}} {
      lappend taglist $ftag
      dict set result $ftag 0
    }
  }
  foreach ftag $taglist {
    lassign [$text tag ranges $ftag] r1 r2 r3 r4
    set r1 [ix2bp $text $r1]
    set r2 [ix2bp $text $r2]
    if {$r3 == {}} {
      lappend tagdata [list $ftag $r1 $r2 [expr {$r2 - $r1}]]
    } else {
      set r3 [ix2bp $text $r3]
      set r4 [ix2bp $text $r4]
      lappend tagdata [list $ftag $r1 $r2 [expr {$r2 - $r1+ $r4- $r3}]]
      lappend tagdata [list $ftag $r3 $r4 [expr {$r2 - $r1+ $r4- $r3}]]
    }
  }
  for {set i 0} {$i < [llength $tagdata]} {incr i} {
    for {set j [expr {$i +1}]} {$j < [llength $tagdata]} {incr j} {
      lassign [lindex $tagdata $i] tagi r1i r2i leni
      lassign [lindex $tagdata $j] tagj r1j r2j lenj
      set overlap 0
      if {$r1i <= $r1j} {
        if {$r2i > $r1j} {
          set overlap 1
        }
      } elseif {$r1i <= $r2j} {
        set ovelap 1
      }
      if {$overlap} {
        if {$leni <= $lenj} {
          dict incr result $tagi
        } else {
          dict incr result $tagj
        }
      }
    }
  }
  return $result
}

################
## recursive function to generate a list of tag depths
################
proc recurs_tagbelow {tag below_list_dict depth_dict} {
  if {(![dict exists $below_list_dict $tag]) || ([dict get $below_list_dict $tag] == [list])} {
    dict set depth_dict $tag 0
    return $depth_dict
  } else {
    set max 0
    foreach btag [dict get $below_list_dict $tag] {
      set depth_dict [recurs_tagbelow $btag $below_list_dict $depth_dict]
      set max [expr {max($max, [dict get $depth_dict $btag])}]
    }
    dict set depth_dict $tag [incr max]
    return $depth_dict
  }
}

################
## changes the scale of a canvas analysis window (as a percent)
################
proc scale_canvas {c} {
  global info

  if {[catch {set info([winfo toplevel $c],scale)}]} {
    set info([winfo toplevel $c],scale) 100
    set info([winfo toplevel $c],new_scale) 100
    sputs [winfo toplevel $c] has not set scale variable.
  }
  set old_scale $info([winfo toplevel $c],scale)
  set new_scale $info([winfo toplevel $c],new_scale)
  if {$old_scale != $new_scale} {
    set xviewstore [lindex [$c xview] 0]
    set yviewstore [lindex [$c yview] 0]
#    $c scale all [lindex [$c bbox all] 0] [lindex [$c bbox all] 1] [expr {1.0 * $new_scale / $old_scale}] [expr {1.0 * $new_scale / $old_scale}]
    $c scale all 0 0 [expr {1.0 * $new_scale / $old_scale}] [expr {1.0 * $new_scale / $old_scale}]
    set new_font_size [expr {int($info(graphicfontsize) * 1.0 *$new_scale/100.0)}]
    foreach item [$c find all] {
      if {[$c type $item] == "text"} {
        $c itemconfigure $item -font [list $info(graphicfontfamily) $new_font_size [font actual [$c itemcget $item -font] -weight]] 
        if {[$c itemcget $item -width] != ""} {
          $c itemconfigure $item -width [expr {1.0 * $new_scale / $old_scale * [$c itemcget $item -width]}]
        }
      } elseif {[$c type $item] == "arc"} {
        $c itemconfigure $item -width [expr {[$c itemcget $item -width] * $new_scale / $old_scale}] 
      }
    }
    $c configure -scrollregion [$c bbox all]
    $c xview moveto $xviewstore
    $c yview moveto $yviewstore
    event generate $c <Configure>
    set info([winfo toplevel $c],scale) $new_scale
  }
}

################
## Select a region of the DNA textarea
################
proc select_region {w from_index to_index} {
  global info
  if {![winfo exists $w.textarea]} {return}
  if {[$w.textarea compare $from_index == end]} {set from_index [end_ix $w.textarea]}
  if {[$w.textarea compare $to_index == end]} {set to_index [end_ix $w.textarea]}
  $w.textarea tag remove tempsel 1.0 end
  $w.textarea tag raise tempsel
  $w.textarea tag remove sel 1.0 end
  if {$info(selection_on_top)} {
    $w.textarea tag raise sel
  } else {
    $w.textarea tag lower sel
  }
  $w.textarea mark set insert $to_index
  $w.textarea mark set anchor $from_index
  $w.textarea mark set tk::anchor$w.textarea $from_index
  if {[$w.textarea compare insert > tk::anchor$w.textarea]} {
    $w.textarea tag add tempsel tk::anchor$w.textarea insert
    $w.textarea tag add sel tk::anchor$w.textarea insert
  } else {
    $w.textarea tag add tempsel insert tk::anchor$w.textarea 
    $w.textarea tag add sel insert tk::anchor$w.textarea 
#selection used here - set
  }
  $w.textarea see insert

  vertindexbalancer $w
  selection_manager $w
}

################
## Select from anchor to new x y position (mouse movement selections
################
proc text_select_xy {w x y} {
  global info

  #if {$y < 0} {
  #  vertscrollmanager $w scroll -2 units
  #} elseif {$y >= [winfo height $w.textarea]} {
  #  vertscrollmanager $w scroll 2 units
  #}

  set cur [text_closest_gap $w.textarea $x $y]
  if {[$w.textarea compare $cur > [end_ix $w.textarea]]} {
    set cur [end_ix $w.textarea]
  }
  if {[catch {$w.textarea index tk::anchor$w.textarea}]} {
    $w.textarea mark set anchor $cur
    $w.textarea mark set tk::anchor$w.textarea $cur
  }
  #set anchor [$w.textarea index tk::anchor$w.textarea]

  if {[$w.textarea compare $cur < tk::anchor$w.textarea]} {
    set first $cur
    set last tk::anchor$w.textarea
  } else {
    set first tk::anchor$w.textarea
    set last $cur
  }
  $w.textarea tag remove sel 1.0 end
  $w.textarea tag remove tempsel 1.0 end
  $w.textarea mark set insert $cur
  $w.textarea tag add tempsel $first $last
  $w.textarea tag add sel $first $last
  selection_manager $w
  update idletasks

    if {$y < 0 || $y >= [winfo height $w.textarea]} {
      mouse_left_DNA $w $x $y
    } else {
      cancel_scrolling_DNA
    }
}

################
## scroll and select if mouse leaves DNA with button down
################
proc mouse_left_DNA {w x y} {
  global info
  #$w.infobox configure -text ""
  if {[winfo exists $w]} {
    set x [expr {[winfo pointerx $w]-[winfo rootx $w.textarea]}]
    set y [expr {[winfo pointery $w]-[winfo rooty $w.textarea]}]
    if {$y < 0} {
      vertscrollmanager $w scroll -2 units
      text_select_xy $w $x 3
    } elseif {$y >= [winfo height $w.textarea]} {
      vertscrollmanager $w scroll 2 units
      text_select_xy $w $x [expr {[winfo height $w.textarea]-5}]
    } else {
     # return
   }
    set info(cancel_scroll) [after 70 [list mouse_left_DNA $w $x $y]]
  } else {
    cancel_scrolling_DNA
  }
}

################
## Stop scrolling when mouse re-enters
################
proc cancel_scrolling_DNA {} {
  global info
  if {$info(cancel_scroll) != "" } {
    after cancel $info(cancel_scroll)
    set info(cancel_scroll) ""
  }
}

########
## deletes unneeded scrollbars from the grid manager, and sends scrollbar coordinates to the scrollbar if needed
########
proc optionscrollbar {s args} {
  global info
  if {$args == {0 0}} {return}
  if {$args == {0 1} || $args == {0.0 1.0}} {
    if {[set grid_info [grid info $s]] != {}} {
      #if {[tk windowingsystem] == "aqua"} {
      #  update
      #}
      grid remove $s
      bind $s <<Grid_info>> $grid_info
    }
  } else {
     # after cancel "if {\[winfo exists $s\]} {grid remove $s}"
     # grid configure $s
     # after 700 "if {\[winfo exists $s\]} {grid remove $s}"
      if {$info(hide_scrollbar)} {
        grid configure $s
        set grid_info [grid info $s]
        bind $s <<Grid_info>> $grid_info
        after cancel "grid remove $s"
        after 750 "grid remove $s"
      } else {
        if {[grid info $s] == ""} {
          grid configure $s
          update idletasks
       }
    } 
  }
  $s set {*}$args
#sputs here $s [grid info $s]
}

########
## deletes unneeded scrollbars from the grid manager, and sends scrollbar coordinates to the scrollbar if needed
########
proc optionxscrollbar {s args} {
  if {$args == {0 0}} {return}
  regexp {([0-9]*)x([0-9]*)\+} [wm geometry [winfo toplevel $s]] g x y
  if {$args == {0 1}} {
    if {[grid info $s] != {}} {
      grid remove $s
      wm geometry [winfo toplevel $s] "$x\x[expr {$y-[$s cget -width]}]"
    }
  } else {
    if {[grid info $s] == ""} {
      wm geometry [winfo toplevel $s] "$x\x[expr {$y+[$s cget -width]}]"
      grid configure $s
      update idletasks
    } 
  }
  $s set {*}$args
}

########
## deletes unneeded scrollbars from the grid manager, and sends scrollbar coordinates to the scrollbar if needed
########
proc optionyscrollbar {s args} {
  if {$args == {0 0}} {return}
  regexp {([0-9]*)x([0-9]*)\+} [wm geometry [winfo toplevel $s]] g x y
  if {$args == {0 1}} {
    if {[grid info $s] != {}} {
      grid remove $s
      wm geometry [winfo toplevel $s] "[expr {$x-[$s cget -width]-1}]x$y"
    }
  } else {
    if {[grid info $s] == ""} {
      wm geometry [winfo toplevel $s] "[expr {$x+[$s cget -width]+1}]x$y"
      grid configure $s
      update idletasks
    } 
  }
  $s set {*}$args
}

##############
## toggle the comment textbox on and off (see next proc def)
##############
proc toggle_comment {w} {
    if {[grid info $w.comframe] == ""} {
      grid configure $w.comframe
    } else {
      grid remove $w.comframe
      focus $w.textarea
    }
}

##############
## open an abi file and create a new window
##############
proc open_abi {filename {interactive_opening 1}} {
  global abi_info abiwinum


  foreach win [lsearch -all -inline -regexp [winfo children .] {.abi_window[0-9]+$}] {
    if {$abi_info($win,filename) == $filename} {
      if {$interactive_opening} {
        tk_messageBox -message [mc "The file is already being edited."] -type ok -icon info
      }
      wm deiconify $win
      raise $win
      after 100 "focus $win"
      return $win
    }
  }

  set w ".abi_window$abiwinum"
  incr abiwinum
  set error_status [read_abi_info $filename $w]

  if {$error_status =="ok"} {
    new_abi_window $w
    return $w
    #update_open_previous_menu
  } else {
    array unset abi_info $w*
    tk_messageBox -message [mc "Error opening file:$error_status"] -type ok -title [mc "Error Opening File"] -icon warning -default ok
    return $error_status
  }
}

##############
## read the header info for an abi file
##############
proc read_abi_info {filename w} {
  global abi_info

  set error_status ok
  foreach track [list 0 1 2 3] {
    set abi_info($w,scale_track,$track) 0
    set abi_info($w,processed_data,$track) [list]
  }
  set abi_info($w,filter_wheel) ACGT
  set abi_info($w,basecall,edited) ""
  set abi_info($w,basecall,original) ""
  set abi_info($w,basecall_loc,edited) [list]
  set abi_info($w,basecall_loc,original) [list]
  set abi_info($w,sample_name) ""
  set abi_info($w,run_time,1) "00:00:00"
  set abi_info($w,run_date,1) "01/01/00"
  set abi_info($w,run_time,2) "00:00:00"
  set abi_info($w,run_date,2) "01/01/00"
  set abi_info($w,filename) $filename
  set abi_info($w,basecall_prob_called,original) [list]
  set abi_info($w,basecall_prob_called,edited) [list]
  set abi_info($w,basecall_prob_a,original) [list]
  set abi_info($w,basecall_prob_a,edited) [list]
  set abi_info($w,basecall_prob_c,original) [list]
  set abi_info($w,basecall_prob_c,edited) [list]
  set abi_info($w,basecall_prob_g,original) [list]
  set abi_info($w,basecall_prob_g,edited) [list]
  set abi_info($w,basecall_prob_t,original) [list]
  set abi_info($w,basecall_prob_t,edited) [list]
  set fid [open $filename r]
  fconfigure $fid -translation binary
  seek $fid 0
  set magnum [read $fid 4]


  if {$magnum == "ABIF"} {
  #####read ABI format data
    set record_list [list]
    set scf_comments [list]
    seek $fid 18
    set bindata [read $fid 4]
    binary scan $bindata I numrecords
    seek $fid 26
    set bindata [read $fid 4]
    binary scan $bindata I records_offset

    seek $fid 0 end
    set file_size [tell $fid]
    if {[expr {$records_offset+28*$numrecords}]<= $file_size} {
      seek $fid $records_offset
      for {set rec_num 0} {$rec_num < $numrecords} {incr rec_num} {
        binary scan [read $fid 28] a4ISSIIII tag_name tag_number data_type ele_len num_ele rec_len rec_data blank
        set file_pointer [tell $fid]
        switch -glob -- $tag_name {
          DATA {#raw and processed data tracks
            if {$tag_number < 0 } {#set to <5 to read in raw data
              #raw data traces- not read at this time, see line above
              set track [expr $tag_number-1]
              seek $fid $rec_data
              binary scan [read $fid [expr {2*$num_ele}]] S* abi_info($w,raw_data,$track)
            } elseif {$tag_number < 9 } {
               #runtime data
            } else {
              #processed data
              set track [expr {$tag_number-9}]
              seek $fid $rec_data
              binary scan [read $fid [expr {2*$num_ele}]] S* abi_info($w,processed_data,$track)
            }
          } 
          FWO_ {#filter wheel order
            set abi_info($w,filter_wheel) [binary format I $rec_data]
          } 
          PBAS {#basecalls
            if {$tag_number == 1 } {
              set type edited
            } else {
              set type original
            }
            seek $fid $rec_data
            set abi_info($w,basecall,$type) [read $fid $num_ele]
          }
          PLOC {#basecalls positions
            if {$tag_number == 1 } {
              set type edited
            } else {
              set type original
            }
            seek $fid $rec_data
            binary scan [read $fid [expr {2*$num_ele}]] S* abi_info($w,basecall_loc,$type)
          }
          RUND {
            binary scan [binary format I $rec_data] Scc year month day
            set abi_info($w,run_date,$tag_number) "$month/$day/$year"
          }
          RUNT {
            binary scan [binary format I $rec_data]  ccc hour min sec
            set abi_info($w,run_time,$tag_number) [format %1s:%02s:%02s $hour $min $sec]
          }
          SMPL {
            seek $fid [expr {$rec_data+1}]
            set abi_info($w,sample_name) [read $fid [expr {$num_ele-1}]]
          }
          S/N% {
            seek $fid [expr $rec_data]
            binary scan [read $fid 8] SSSS abi_info($w,scale_track,0) abi_info($w,scale_track,1) abi_info($w,scale_track,2) abi_info($w,scale_track,3)
          }
          PCON {
          #KB basecaller phred confidence 
            if {$tag_number == 1 } {
              set type edited
            } else {
              set type original
            }
            seek $fid $rec_data
            binary scan [read $fid [expr {$num_ele}]] c* abi_info($w,basecall_prob_called,$type)
            set abi_info($w,basecall_prob_a,$type) [string repeat "0 " $num_ele]
            set abi_info($w,basecall_prob_c,$type) $abi_info($w,basecall_prob_a,$type)
            set abi_info($w,basecall_prob_g,$type) $abi_info($w,basecall_prob_a,$type)
            set abi_info($w,basecall_prob_t,$type) $abi_info($w,basecall_prob_a,$type)

          }
          MODL {
            lappend scf_comments "MODL=[binary format I $rec_data]"
          }
          default {
            if {($data_type == 18) } {
              #PASCAL string (leading size byte)
              seek $fid [expr {$rec_data+1}]
              set string_contents [read $fid [expr {$num_ele-1}]]
              #sputs "untrapped string data($data_type):$tag_name=$string_contents"
              lappend scf_comments "$tag_name=$string_contents"
            } elseif {($data_type == 19)} {
              #C string (0 terminated)
              seek $fid [expr {$rec_data}]
              set string_contents [read $fid [expr {$num_ele-1}]]
              lappend scf_comments "$tag_name=$string_contents"

            } elseif {($data_type == 1024)} {
              seek $fid [expr {$rec_data}]
              set data_contents [read $fid [expr {$num_ele}]]
              binary scan $data_contents c* c_data
              #sputs "untrapped c data($data_type):$rec_data, $num_ele, $tag_name=$c_data"
              #lappend scf_comments "$tag_name=$c_data"
            } elseif {($data_type == 4) } {
              binary scan [binary format I $rec_data] S int_data
              #sputs "untrapped short integer data($data_type):$tag_name=$int_data"
              lappend scf_comments "$tag_name=$int_data"
            } elseif {($data_type == 5) } {
              #sputs "untrapped long integer data($data_type):$tag_name=$rec_data"
              lappend scf_comments "$tag_name=$rec_data"
            } elseif {($data_type == 7) } {
              binary scan [binary format I $rec_data] f float_data
              #sputs "untrapped float data($data_type):$tag_name=$float_data"
              lappend scf_comments "$tag_name=$float_data"
            } else {
              binary scan [binary format I $rec_data] c* c_data
              #sputs "untrapped data:$tag_name $tag_number $data_type $ele_len $num_ele $rec_len $rec_data, $c_data"
            }
          }
        } ;#switch
        seek $fid $file_pointer
      }
    } else {
      set error_status "Wrong Filetype- Data Past End of File"
    }
    set scf_comments [concat "SIGN=[string index $abi_info($w,filter_wheel) 0]=$abi_info($w,scale_track,0),[string index $abi_info($w,filter_wheel) 1]=$abi_info($w,scale_track,1),[string index $abi_info($w,filter_wheel) 2]=$abi_info($w,scale_track,2),[string index $abi_info($w,filter_wheel) 3]=$abi_info($w,scale_track,3)" $scf_comments]
    set scf_comments [concat "STRT=$abi_info($w,run_date,1) $abi_info($w,run_time,1)" "STOP=$abi_info($w,run_date,2) $abi_info($w,run_time,2)" $scf_comments]
    set abi_info($w,scf_comments) [join $scf_comments \n]

    ## assign individual prob of calls based on the phred data, this is needed to save as scf
    for {set i 0} {$i < [llength $abi_info($w,basecall_prob_called,edited)]} {incr i} {
      set char [string tolower [string index $abi_info($w,basecall,edited) $i]]
      if {[regexp {[acgt]} $char]} {
        lset abi_info($w,basecall_prob_$char,edited) $i [lindex $abi_info($w,basecall_prob_called,edited) $i]
      }
    }
  } elseif {$magnum == ".scf"} {
    ########read scf file
  global header
    set header [read $fid 52]
    binary scan $header IIIIIIIIa4IIII samples samples_offset bases left_clip right_clip bases_offset comments_size comments_offset version sample_size code_set private_size private_offset

  global h2
  set h2 $header
  #sputs $w,scf file version $version
  #sputs $samples $samples_offset $bases $left_clip $right_clip $bases_offset $comments_size $comments_offset $version $sample_size $code_set $private_size $private_offset

    #read comments section
    seek $fid $comments_offset
    set comments [read $fid $comments_size]
    set abi_info($w,scf_comments) $comments
    #sputs scf comments:$comments
    #read private section
    seek $fid $private_offset
    set private [read $fid $private_size]
    #sputs p:$private
    set abi_info($w,filter_wheel) ACGT

    if {$version >= 3.00} {
    #read V 3 files
      #read sample points section 
sputs reading scf ver 3
      seek $fid $samples_offset

      foreach track [list 0 1 2 3] {
        if {$sample_size ==  1} {
          binary scan [read $fid $samples] c* data
        } else {
          binary scan [read $fid [expr {2*$samples}]] S* data
        }
        set p_sample 0
        set new_data [list]
        for {set i 0} {$i < $samples} {incr i} {
          lappend new_data [set p_sample [expr {[lindex $data $i]+$p_sample}]]
        }
        set p_sample 0
        set abi_info($w,processed_data,$track) [list]
        for {set i 0} {$i < $samples} {incr i} {
          lappend abi_info($w,processed_data,$track) [set p_sample [expr {[lindex $new_data $i]+$p_sample}]]
        }
      }
      unset data new_data
      #read basecall section
      seek $fid $bases_offset
      set data [list]
      binary scan [read $fid [expr {4*$bases}]] I* abi_info($w,basecall_loc,edited)
      binary scan [read $fid $bases] c* abi_info($w,basecall_prob_a,edited)
      binary scan [read $fid $bases] c* abi_info($w,basecall_prob_c,edited)
      binary scan [read $fid $bases] c* abi_info($w,basecall_prob_g,edited)
      binary scan [read $fid $bases] c* abi_info($w,basecall_prob_t,edited)
      set abi_info($w,basecall,edited) [read $fid $bases]
      foreach char [split $abi_info($w,basecall,edited) ""] prob(a) $abi_info($w,basecall_prob_a,edited) prob(c) $abi_info($w,basecall_prob_c,edited) prob(g) $abi_info($w,basecall_prob_g,edited) prob(t) $abi_info($w,basecall_prob_t,edited) {
        if {[regexp {[acgtACGT]} $char]} {
          lappend abi_info($w,basecall_prob_called,edited) $prob([string tolower $char])
        } else {
          lappend abi_info($w,basecall_prob_called,edited) 0
        }
      }
    } else {
      #read v 1 and 2
      #read sample points section
sputs reading scf ver 2
      seek $fid $samples_offset
      for {set i 0} {$i < $samples} {incr i} {
        if {$sample_size ==  1} {
          binary scan [read $fid 4] cccc apoint cpoint gpoint tpoint
        } else {
          binary scan [read $fid 8] SSSS apoint cpoint gpoint tpoint
        }
        lappend adata $apoint
        lappend cdata $cpoint
        lappend gdata $gpoint
        lappend tdata $tpoint
      }
      set abi_info($w,processed_data,0) $adata
      set abi_info($w,processed_data,1) $cdata
      set abi_info($w,processed_data,2) $gdata
      set abi_info($w,processed_data,3) $tdata
      for {set i 0} {$i < $bases} {incr i} {
        binary scan [read $fid 12] Iccccac3 point prob(a) prob(c) prob(g) prob(t) char reserved
        lappend abi_info($w,basecall_loc,edited) $point
        lappend abi_info($w,basecall_prob_a,edited) $prob(a)
        lappend abi_info($w,basecall_prob_c,edited) $prob(c)
        lappend abi_info($w,basecall_prob_g,edited) $prob(g)
        lappend abi_info($w,basecall_prob_t,edited) $prob(t)
        append abi_info($w,basecall,edited) $char
        if {[regexp {[acgtACGT]} $char]} {
          lappend abi_info($w,basecall_prob_called,edited) $prob([string tolower $char])
        } else {
          lappend abi_info($w,basecall_prob_called,edited) 0
        }
      }
#sputs $abi_info($w,basecall_loc,edited) $abi_info($w,basecall,edited)
    }
  } else {
    set error_status "Wrong Filetype- ABIF not found"
  } 
  if {$abi_info($w,basecall_prob_called,edited) == [list]} {
     set abi_info($w,basecall_prob_a,edited) [lrepeat [string length $abi_info($w,basecall,edited)] 0]
     set abi_info($w,basecall_prob_called,edited) $abi_info($w,basecall_prob_a,edited)
     set abi_info($w,basecall_prob_c,edited) $abi_info($w,basecall_prob_a,edited)
     set abi_info($w,basecall_prob_g,edited) $abi_info($w,basecall_prob_a,edited)
     set abi_info($w,basecall_prob_t,edited) $abi_info($w,basecall_prob_a,edited)
  }
  close $fid
  return $error_status
}

##############
## Make a new ABI trace window
##############
proc new_abi_window {w} {
  global abi_info
  global modstring modifier tk_patchLevel
  global info abiwinum  toolbar_images

  set abi_info($w,vert_scale) 1
  set abi_info($w,horiz_scale) 1
  set abi_info($w,sequence) $abi_info($w,basecall,edited)
  set abi_info($w,rev_com) 0

  toplevel $w

  if {!$info(android)} {
    wm withdraw $w
    bind $w <Map> "event generate . <<RaiseDialogs>>"
    bind $w <FocusIn> "after 200 event generate . <<RaiseDialogs>>"
    bind $w <Activate> "after 200 event generate . <<RaiseDialogs>>"

    bind $w <$modifier-Key-n> "create_window"
    bind $w <$modifier-Key-q> "if {!$info(use_cocoa)} {exit}"

    if {[tk windowingsystem] == "aqua"} {
        bind $w <$modifier-Key-m> "catch \{aqua_minimize $w\}"
        bind $w <$modifier-Key-quoteleft> "catch {raise \[lindex \[wm stackorder .\] 0\]}"
      if {[file exists $abi_info($w,filename)]} {
          wm attributes $w -titlepath $abi_info($w,filename)
      }
    }

    wm protocol $w WM_DELETE_WINDOW "if {!\$dialogblock} {closewindow $w}"
    wm title $w [file tail $abi_info($w,filename)]
  } else {
    wm attributes $w -fullscreen 1
  }
  if {!$info(use_cocoa)} {
    set bugdelay 1
  } else {
    set bugdelay 1
  }

  grid [canvas $w.c  -xscrollcommand "$w.xs set" -height $info(abi_default_canvas_height) -width $info(abi_default_canvas_width)] -row 1 -rowspan 1 -column 0 -sticky nswe

  grid [scrollbar $w.xs -command "$w.c xview" -orient horizontal] -row 2 -column 0 -sticky nwe

  if {$info(use_tile)} {
    grid [ttk::scale $w.ys -from 10 -to 50 -command "abi_scale $w" -orient vertical -value [expr {60-$abi_info($w,vert_scale)*10.0}]] -row 1 -column 1 -sticky nswe
    grid [ttk::scale $w.xs2 -from 5 -to 50 -command "abi_x_scale $w" -orient vertical -value [expr {55-$abi_info($w,horiz_scale)*10.0}]] -row 1 -column 2 -sticky nswe
  } else {
    grid [scale $w.ys -from 10 -to 50 -sliderrelief raised -showvalue 0 -resolution 1 -troughcolor white -background $info(bg_color) -width 10 -command "abi_scale $w" -orient vertical] -row 1 -column 1 -sticky nswe
    $w.ys set [expr {60-$abi_info($w,vert_scale)*10.0}]
    grid [scale $w.xs2 -from 5 -to 50 -sliderrelief raised -showvalue 0 -resolution 1 -troughcolor white -background $info(bg_color) -width 10 -command "abi_x_scale $w" -orient vertical] -row 1 -column 2 -sticky nswe
    $w.xs2 set [expr {55-$abi_info($w,horiz_scale)*10.0}]
  }
  grid [label $w.yslabel -text y] -row 2 -column 1 -sticky nswe
  grid [label $w.xslabel -text x] -row 2 -column 2 -sticky nswe

  grid [frame $w.fileframe] -row 3 -column 0 -sticky wes
  grid [label $w.fileframe.label -text $abi_info($w,filename) -width 5] -row 3 -column 0 -sticky wes
  grid [label $w.fileframe.linked_abi -image $toolbar_images(button_link) -borderwidth 0 -relief flat] -row 3 -column 1 -sticky ws
  bind $w.fileframe.linked_abi <ButtonPress-1> "set tooltip_x %x; set tooltip_y %y; sputs %W"
  bind $w.fileframe.linked_abi <B1-Motion> "abi_drag $w.fileframe.linked_abi %X %Y"
  bind $w.fileframe.linked_abi <ButtonRelease-1> "catch {unset tooltip_x tooltip_y}; if {(\[winfo containing %X %Y\] != \"\") && \[winfo exists .abitooltip\]} {destroy .abitooltip; abi_drop $w %X %Y}"
  tooltip_install $w.fileframe.linked_abi "Drag to a sequence window\nto link"
  grid columnconfigure $w.fileframe 0 -weight 1

  grid rowconfigure $w 1 -weight 1
  grid columnconfigure $w 0 -weight 1

  set b [menu $w.menubar]

  ##file menu
  $b add cascade -menu [menu $b.filemenu] -label [mc "File"] -underline 0
  $b.filemenu add command -label [mc "Open..."] -accelerator "$modstring+O" -command "after $bugdelay open_file_dialog"
  bind $w <$modifier-KeyPress-o> "after $bugdelay open_file_dialog"
  menu $b.filemenu.open_previous
  $b.filemenu add cascade -label [mc "Open Recent Files"] -menu $b.filemenu.open_previous
  $b.filemenu add command -label [mc "Save Window as EPS image"] -accelerator "$modstring+Shift+S" -command "abi_save_eps $w.c"
  bind $w <$modifier-Shift-KeyPress-s> "abi_save_eps $w.c"
  $b.filemenu add command -label [mc "Export as SCF"] -accelerator "$modstring+S" -command "after $bugdelay abi_save_scf $w"
  bind $w <$modifier-KeyPress-s> "after $bugdelay abi_save_scf $w.c"
  if {([lsearch -glob [info loaded] "*MacCarbonPrint.dylib*"] > -1) ||  ([lsearch -exact [package names] "wmf"] > -1)} {
    $b.filemenu add command -label [mc "Page Setup"] -accelerator "$modstring+Shift+P" -command "page_setup_dialog $w"
    bind $w <$modifier-KeyPress-P> "page_setup_dialog $w"
  }
  $b.filemenu add command -label [mc "Print"] -accelerator "$modstring+P" -command "print_abi $w.c"
  bind $w <$modifier-KeyPress-p> "print_abi $w.c"
  $b.filemenu add command -label [mc "New DNA from basecalls"] -accelerator "$modstring+Shift+N" -command "create_window \$abi_info($w,sequence) \"\" \"\[file tail \$abi_info($w,filename)\] basecalls\" linear 0 1 \"\[file tail \$abi_info($w,filename)\] basecalls\""
  bind $w <Shift-$modifier-KeyPress-N> "create_window \$abi_info($w,sequence) \"\" \"\[file tail \$abi_info($w,filename)\] basecalls\" linear 0 1 \"\[file tail \$abi_info($w,filename)\] basecalls\""
  $b.filemenu add separator
  $b.filemenu add command -label [mc "File Info"] -command "after $bugdelay abi_file_info $w"
  $b.filemenu add separator
  $b.filemenu add command -label [mc "Close"] -accelerator "$modstring+W" -command "closewindow $w"
  bind $w <$modifier-KeyPress-w> "closewindow $w"

  ##edit menu
  $b add cascade -menu [menu $b.editbmenu] -label [mc "Edit "] -underline 0
  $b.editbmenu add command -label [mc "Copy"] -command "after $bugdelay abi_clip_copy $w" -accelerator "$modstring+C"
  bind $w <$modifier-KeyPress-c> "after $bugdelay abi_clip_copy $w"
  bind $w.c <$modifier-KeyPress-c> "after $bugdelay abi_clip_copy $w"
  $b.editbmenu add command -label [mc "Copy Rev-Com"] -command "after $bugdelay abi_clip_copy $w rev-com" -accelerator "$modstring+Shift+C"
  bind $w <$modifier-Shift-KeyPress-C> "after $bugdelay abi_clip_copy $w rev-com"
  bind $w.c <$modifier-Shift-KeyPress-C> "after $bugdelay abi_clip_copy $w rev-com"
  if {([lsearch -exact [package names] "wmf"] > -1)} {
## this is too ugly- fix before restoring
    #$b.editbmenu add command -label [mc "Copy as Metafile"] -accelerator "$modstring+C" -command "event generate $w.c <<CopyEMF>>"
  }

  $b.editbmenu add separator
  if {[tk windowingsystem] != "aqua"} {
    $b.editbmenu add command -label [mc "Preferences..."] -command "configure_preferences $w" -accelerator "$modstring+,"
    bind $w <$modifier-KeyPress-comma> "configure_preferences $w"
  }
  $b.editbmenu add command -label [mc "Find..."] -command "after $bugdelay abi_find_dialog $w" -accelerator "$modstring+F"
  bind $w <$modifier-KeyPress-f> "after $bugdelay abi_find_dialog $w"
  bind $w <$modifier-KeyPress-g> "abi_do_find $w \$abi_info(last_find) \$abi_info(find_revcom) \$abi_info(find_literal) \$abi_info(find_wrap)"
  if {[tk windowingsystem] != "aqua"} {
    $b.editbmenu add checkbutton -label [mc "Reverse-Complement"] -command "abi_revcom $w" -variable abi_info($w,rev_com) -onvalue 1 -offvalue 0 -accelerator "$modstring+/"
  } else {
    $b.editbmenu add checkbutton -label [mc "Reverse-Complement"] -command "abi_revcom $w" -variable abi_info($w,rev_com) -onvalue 1 -offvalue 0 
  }
  bind $w <$modifier-KeyPress-slash> "set abi_info($w,rev_com) \[expr {!\$abi_info($w,rev_com)}\];abi_revcom $w"
  $b.editbmenu add separator
  $b.editbmenu add command -label [mc "Align..."] -command "after $bugdelay align_dialog2 $w" -accelerator "$modstring+L"
  bind $w <$modifier-KeyPress-l> "after $bugdelay align_dialog2 $w"
  if  {([lsearch -glob [info loaded] "*TclSpeech2.0.dylib*"] > -1) || ([lsearch -index 1 [info loaded] Snack] > -1) } {
    $b.editbmenu add separator
    $b.editbmenu add command -label [mc "Start/Stop Speak Text..."] -accelerator "" -command "if {!\[info exists info($w,speak_cancel)\]} {speak $w 0} else {speak $w stop}"

  }
 
  $b.editbmenu add separator
  $b.editbmenu add command -label [mc "Toggle Phred"] -accelerator "" -command "abi_toggle_phred $w"
 
if {!$info(android)} {
  #add Windows menu stub (menu items are maintained by update_windows_menu procedure)
  $b add cascade -menu [menu $b.windows] -label [mc "Window"] -underline 0
} else {
  menu $w.windowsmenu
}


  ##help menu
  $b add cascade -menu [menu $b.help] -label [mc "Help"] -underline 0
  $b.help add command -label [mc "Standard Genetic Code"] -command "after $bugdelay genetic_code_dialog $w"
  $b.help add command -label [mc "Amino Acid Info"] -command "after $bugdelay aa_info_dialog $w"

  ##platform specific menu items
  if {[tk windowingsystem] != "aqua"} {
    #Exit is automatically on the apple menu in Aqua
    $b.filemenu add separator
    $b.filemenu add command -label [mc "Exit"] -accelerator "$modstring+Q" -command exit

    #About... goes on the apple menu in aqua
    $b.help add separator
    $b.help add command -label [mc "About ApE..."] -command "about_dialog $w"
  } else {
    if {!$info(use_cocoa)} {
      menu $b.apple 
      $b add cascade -menu $b.apple
      $b.apple add command -label [mc "About ApE"] -command "about_dialog $w"
      $b.apple add separator
    } else {
    }
    #catch {.menubar.filemenu entryconfigure [mc "New"] -state disabled}
    #catch {.menubar.filemenu entryconfigure [mc "Open..."] -state disabled}
    #catch {  .menubar.filemenu entryconfigure [mc "Open Recent Files"] -state disabled}
      #.menubar.apple entryconfigure [mc "Preferences..."] -state disabled
    # catch { .menubar.apple entryconfigure [mc "About ApE"] -state disabled}

    ##set the new window coordinates
    wm geometry $w "+$info(newaquax)+$info(newaquay)"
    incr info(newaquax) 20
    incr info(newaquay) 20
    if {$info(newaquax) > 100} {set info(newaquax) 20}
    if {$info(newaquay) > 100} {set info(newaquay) 20}
  }
  bind $w <$modifier-KeyPress-q> "exit"
  bind $w <$modifier-KeyPress-0> "if {\[info commands console\] != \"\"} \{
               console show
               set info(suppress_output) 0
               uplevel #0 \{set w $w\}
               \}"

  if {$info(android)} {
    android_action_bar $w
  } else {
    $w configure -menu $b
  }

  set outputmenu [menu $w.c.outputmenu]
  $outputmenu add command -label [mc "Copy"] -command "after $bugdelay abi_clip_copy $w" -accelerator "$modstring+C"
  $outputmenu  add command -label [mc "Copy Rev-Com"] -command "after $bugdelay abi_clip_copy $w rev-com" -accelerator "$modstring+C"
  if {([lsearch -exact [package names] "wmf"] > -1)} {
## this is too ugly- fix before restoring
   # $outputmenu add command -label [mc "Copy as Metafile"] -accelerator "$modstring+C" -command "event generate $w.c <<CopyEMF>>"
   # bind $w.c <$modifier-KeyPress-c> "event generate $w.c <<CopyEMF>>"
    #bind $w.c <<CopyEMF>> "abi_copy_metafile $w.c both"
  }
  $outputmenu add separator
  $outputmenu add command -label [mc "Save Window"] -accelerator "$modstring+S" -command "abi_save_eps $w.c" 
  $outputmenu add command -label [mc "Print"] -accelerator "$modstring+P" -command "print_abi $w.c"
  $outputmenu add command -label [mc "New DNA from basecalls"] -accelerator "$modstring+Shift+N" -command "create_window \$abi_info($w,sequence) \"\" \"\[file tail \$abi_info($w,filename)\] basecalls\" linear 0 1 \"\[file tail \$abi_info($w,filename)\] basecalls\""

  $outputmenu add command -label [mc "Align..."] -command "align_dialog2 $w" -accelerator "$modstring+L"
  if {[tk windowingsystem] != "aqua"} {
    $outputmenu add checkbutton -label [mc "Reverse-Complement"] -command "abi_revcom $w" -variable abi_info($w,rev_com) -onvalue 1 -offvalue 0 -accelerator "$modstring+/"
  } else {
    $outputmenu add checkbutton -label [mc "Reverse-Complement"] -command "abi_revcom $w" -variable abi_info($w,rev_com) -onvalue 1 -offvalue 0 
  }
  $outputmenu add separator
  $outputmenu add command -label [mc "Toggle Phred"] -accelerator "" -command "abi_toggle_phred $w"


  bind $w.c <<RightClick>> "tk_popup $outputmenu %X %Y"

  for {set track 0} {$track < 4} {incr track} {
    set i 0
    set trace [list]
    foreach point $abi_info($w,processed_data,$track) {
      #lappend trace $i [expr {300-$point/8.0}]
      #set trace [concat $trace $i [expr {300-$point/8.0}]]
      set trace [concat $trace $i $point]
      incr i
    } 
    set trace [$w.c create line $trace -fill $abi_info(colors,[string index $abi_info($w,filter_wheel) $track]) -tags [list scalable trace [string index $abi_info($w,filter_wheel) $track]]]
    $w.c scale $trace 0 0 1 -0.125
  }
  set i 0

  set linespace [font metrics dnafont -linespace]
  foreach call [split $abi_info($w,basecall,edited) ""] x $abi_info($w,basecall_loc,edited) {
## scf error- call is unprintable
    if {![info exists abi_info(colors,[string toupper $call])]} {set abi_info(colors,[string toupper $call]) $abi_info(colors,N)}
    $w.c create text $x $linespace -text $call -anchor n -font dnafont -width 0 -fill $abi_info(colors,[string toupper $call]) -tags [list basecall [string toupper $call]]
    incr i
    if {[expr {$i % 10}] == 0} {
       $w.c create text $x 0 -text $i -anchor n -font dnafont -width 0  -fill $info(graphic_fg_color) -tags indextext
    }
  }

  if {$info(android)} {
    $w.c itemconfigure trace -width 3
  
  }

   set trace_top [lindex [$w.c bbox trace] 1]
   set trace_bottom [lindex [$w.c bbox trace] 3]
   $w.c move trace 0 [expr {35-$trace_top}] 
   $w.c scale trace  0 35 1 [expr {($info(abi_default_canvas_height)-45.0)/($trace_bottom-$trace_top*1.0)}]


  #bug in canvas scale?
    #w set trace_top [lindex [$w.c bbox trace] 1]
    #w set trace_bottom [lindex [$w.c bbox trace] 3]
    #w $w.c move trace 0 [expr {35-$trace_top}] 
    #w $w.c scale trace  0 35 1 [expr {($info(abi_default_canvas_height)-45.0)/($trace_bottom-$trace_top)}]

   #create fred_graph polygon item (graphs the phred score)
   set phred_graph [$w.c create polygon {-2 300 -2 300 -2 300} -fill {} -outline {} -tags [list phred_graph scalable]]
   $w.c lower $phred_graph
    abi_draw_phred $w
 
  #create edit box and editing bindings
  $w.c create rectangle 0 0 0 0 -tag editbox -fill {} -outline {}
  $w.c lower editbox
  $w.c bind basecall <Double-Button-1> "abi_edit_mode $w \[$w.c find withtag current\]"
  bind $w.c <$modifier-Button-1> "abi_add_base $w \[$w.c canvasx %x\]"
  bind $w.c <<ClearEdit>> "
    $w.c coord editbox 0 0 0 0
    $w.c lower editbox
    $w.c itemconfigure editbox -outline {} -fill {}
    bind $w.c <Any-ButtonPress> {}
    bind $w.c <FocusOut> {}
    bind $w.c <Any-Key> {}
  "

  $w.c configure -scrollregion [list 0 0 [lindex [$w.c bbox all] 2] $info(abi_default_canvas_height)]
  wm deiconify $w
  raise $w
  focus $w
  focus $w.c
  #in aqua, the window height isn't assigned until after updating (needed to assign selection rectangle size)
  # calling update causes a crash in aqua when called at startup
  if {([tk windowingsystem] != "aqua")} {
    update
  }

  bind $w.c <Configure> "if {\[winfo height $w.c\] > 80} {
    $w.c scale scalable  0 35 1 \[expr {(\[winfo height $w.c\]-45.0)/(\[lindex \[$w.c bbox trace\] 3\]-\[lindex \[$w.c bbox trace\] 1\])*\$abi_info($w,vert_scale)}\] 
    $w.c scale selection 0 -2 1 \[expr {\[winfo height $w.c\]/\[lindex \[$w.c coords selection\] 3\]}\]
    set info(abi_default_canvas_height) \[winfo height $w.c\]
    set info(abi_default_canvas_width) \[winfo width $w.c\]
  } else {
    set info(abi_default_canvas_height) 80
    set info(abi_default_canvas_width) \[winfo width $w.c\]
  }"
  bind $w <Any-MouseWheel> {[winfo toplevel %W].c xview scroll [expr {int(1.0 * %D/-$info(mousewheelunits))}] units}
  bind $w.c <Shift-Button-3> {console show}

  $w.c create rectangle -2 -2 -2 [winfo reqheight $w.c] -tags [list selection] -fill gray90
  $w.c lower selection
  $w.c lower $phred_graph
  if {$info(android)} {
    bind $w <<<<PinchToZoom>> "android_abi_pinch %x %y %s $w" 
    bind $w.c <Button-2> "$w.c scan mark \[expr {%x}\]  0"
    bind $w.c <Button2-Motion> "$w.c scan dragto \[expr {%x}\] 0"
    bind $w.c <Button-1> "$w.c scan mark \[expr {%x}\] 0"
    bind $w.c <Button1-Motion> "$w.c scan dragto \[expr {%x}\] 0"
    bind $w.c <Button-3> "abi_click_select $w.c %x"
  } else {
    bind $w.c <Button-1> "abi_click_select $w.c %x"
    bind $w.c <Shift-Button-1> "abi_shift_select $w.c %x"
  }
 
  if {[info procs HandleFileDrop] ne {}} {
    tkdnd::drop_target register $w CF_HDROP 
    bind $w <<Drop:DND_Files>> {HandleFileDrop  %D %T}
  }

  if {$info(android)} {
    event generate $w.c <Configure>
  }
  update_windows_menu
  set info(open_previous) [linsert $info(open_previous) 0 $abi_info($w,filename)]
  update_open_previous_menu
}

###########
## abi copy text
###########
proc abi_clip_copy {w  {direction normal}} {
  global info
  global tcl_platform

  set text [lindex [abi_get_seq $w sel.first sel.last] 1]
  if {$direction == "rev-com"} {
        set text [revcom $text]
  }
  clipboard clear 
  clipboard_append -displayof $w $text
  set info(clipboard_text) $text
  if {($tcl_platform(platform) == "unix") && ([tk windowingsystem] != "aqua")} {
    selection own -selection CUT_BUFFER0 $w
    selection own -selection CLIPBOARD $w
  }
}

###########
## drag and drop for abi sequence linking
###########
proc abi_drag {w x y} {
  global tooltip_x tooltip_y toolbar_images
  if {[winfo exists .abitooltip] && [info exists tooltip_x]} {
    wm geometry .abitooltip +[expr {$x-$tooltip_x}]+[expr {$y-$tooltip_y}]
  } elseif {![info exists tooltip_x]} {
    set tooltip_x $x
    set tooltip_y $y
  } elseif {([expr {abs($x - $tooltip_x)}] > 3) || ([expr {abs($y - $tooltip_y)}] > 3)} {
    toplevel .abitooltip -borderwidth 1 -background black
    if {([tk windowingsystem] == "aqua")} {
      tk::unsupported::MacWindowStyle style .abitooltip help {}; after 40 "catch {raise .abitooltip}"
    } else { 
      wm overrideredirect .abitooltip 1
    }
    catch {wm attributes .abitooltip -alpha .4}
    grid [set c [canvas .abitooltip.c]] -row 0 -column 0 -sticky nswe
    .abitooltip.c create image 0 0 -image $toolbar_images(button_link)
    .abitooltip.c configure -scrollregion [$c bbox 1] -width [expr {[lindex [$c bbox 1] 2] - [lindex [$c bbox 1] 0]}] -height [expr {[lindex [$c bbox 1] 3] - [lindex [$c bbox 1] 1]}] 
    #set tooltip_x [expr {round($x - [winfo rootx $w])}]
    #set tooltip_y [expr {round($y - [winfo rooty $w])}]
    wm geometry .abitooltip +[expr {$x-$tooltip_x}]+[expr {$y-$tooltip_y}]
  }
}

###########
## drag and drop for abi sequence linking
###########
proc abi_drop {from_abi X Y} {
  if {[catch {set to_window [winfo toplevel [winfo containing $X $Y]]}]} {
    set to_window ""
  }
  #sputs $from_abi $to_window
  if {[regexp {.dna_window[0-9]+} $to_window]} {
    link_abi $to_window $from_abi
  }
}

######
##
######
proc link_abi {w abi} {
  global info abi_info toolbar_images
  foreach element [list sample_name run_time,1 run_date,1 run_time,2 run_date,2 filename filter_wheel scale_track,0 scale_track,1 scale_track,2 scale_track,3 basecall processed_data,0 processed_data,1 processed_data,2 processed_data,3 basecall_loc basecall_prob_called basecall_prob_a basecall_prob_c basecall_prob_g basecall_prob_t] {
    if {$element in [list processed_data,0 processed_data,1 processed_data,2 processed_data,3]} {
      lappend result [binary format S* $abi_info($abi,$element)]
    } elseif {$element eq "basecall_loc"} {
      if {$abi_info($abi,$element\,edited) == $abi_info($abi,$element\,original)} {
        lappend result [list [binary format S* $abi_info($abi,$element\,edited)] [list]]
      } else {
        lappend result [list [binary format S* $abi_info($abi,$element\,edited)] [binary format S* $abi_info($abi,$element\,original)]]
      }
    } elseif {$element eq "basecall"} {  
      if {$abi_info($abi,$element\,edited) == $abi_info($abi,$element\,original)} {
        lappend result [list $abi_info($abi,$element\,edited) [list]]
      } else {
        lappend result [list $abi_info($abi,$element\,edited) $abi_info($abi,$element\,original)]
      }
    } elseif {$element in [list basecall_prob_called basecall_prob_a basecall_prob_c basecall_prob_g basecall_prob_t]} {
      if {$abi_info($abi,$element\,edited) == $abi_info($abi,$element\,original)} {
        if {[lsearch -not $abi_info($abi,$element\,edited) 0] > -1} {
          lappend result [list [binary format c* $abi_info($abi,$element\,edited)] [list]]
        } else {
          lappend result [list [list] [list]]
        }
      } else {
        lappend result [list [binary format c* $abi_info($abi,$element\,edited)] [binary format c* $abi_info($abi,$element\,original)]]
      }
    } elseif {$element eq "filename"} {
      lappend result [file tail $abi_info($abi,$element)]
    } else {
      lappend result $abi_info($abi,$element)
    }
  }
  if {![info exists info($w,linked_abi_list)] || !($result in $info($w,linked_abi_list)) } {
    lappend info($w,linked_abi_list) $result
    set info($w,saved) 0
    if {[tk windowingsystem] == "aqua"} {wm attributes $w -modified 1}
  } else {
    sputs duplicate abi link
  }
  grid configure $w.infoframe.linked_abi
  return {}
}

######
##
######
proc open_linked_abi {w index} {
  global info abi_info abiwinum data

  set data_list [lindex $info($w,linked_abi_list) $index]

  set abi ".abi_window$abiwinum"
  incr abiwinum
  foreach element [list  sample_name run_time,1 run_date,1 run_time,2 run_date,2 filename filter_wheel scale_track,0 scale_track,1 scale_track,2 scale_track,3 basecall processed_data,0 processed_data,1 processed_data,2 processed_data,3 basecall_loc basecall_prob_called basecall_prob_a basecall_prob_c basecall_prob_g basecall_prob_t] data $data_list {
    if {$element in [list processed_data,0 processed_data,1 processed_data,2 processed_data,3]} {
      binary scan $data S* abi_info($abi,$element)
    } elseif {$element eq "basecall_loc"} {
      if {[lindex $data 1] == [list]} {
        binary scan [lindex $data 0] S* abi_info($abi,$element\,edited)
        binary scan [lindex $data 0] S* abi_info($abi,$element\,original)
      } else {
        binary scan [lindex $data 0] S* abi_info($abi,$element\,edited)
        binary scan [lindex $data 1] S* abi_info($abi,$element\,original)
      }
    } elseif {$element eq "basecall"} {  
      if {[lindex $data 1] == [list]} {
        set abi_info($abi,$element\,edited) [lindex $data 0]
        set abi_info($abi,$element\,original) [lindex $data 0]
      } else {
        set abi_info($abi,$element\,edited) [lindex $data 0]
        set abi_info($abi,$element\,original) [lindex $data 1]
      }
    } elseif {$element in [list basecall_prob_called basecall_prob_a basecall_prob_c basecall_prob_g basecall_prob_t]} {
       if {[lindex $data 1] == [list]} {
         if {[lindex $data 0] == [list]} {
           set abi_info($abi,$element\,edited) [lrepeat [llength $abi_info($abi,basecall_loc,edited)] 0]
           set abi_info($abi,$element\,original) [lrepeat [llength $abi_info($abi,basecall_loc,edited)] 0]
         } else {
          binary scan [lindex $data 0] c* abi_info($abi,$element\,edited)
          binary scan [lindex $data 0] c* abi_info($abi,$element\,original)
         }
      } else {
        binary scan [lindex $data 0] c* abi_info($abi,$element\,edited)
        binary scan [lindex $data 1] c* abi_info($abi,$element\,original)
      }
    } else {
      set abi_info($abi,$element) $data
    }
  }

  new_abi_window $abi
  #update_open_previous_menu
}

######
##
######
proc remove_linked_abi {w index} {
  global info
  if {[tk_messageBox -title [mc "Remove Linked ABI File..."] -message [mc {Are You Sure You Want to Remove %1$s} [lindex [lindex $info($w,linked_abi_list) $index] 5]] -type okcancel -default cancel] == "cancel"} {
    return
  } else {
    set info($w,linked_abi_list) [lreplace $info($w,linked_abi_list) $index $index]
    set info($w,saved) 0
    if {[tk windowingsystem] == "aqua"} {wm attributes $w -modified 1}
    if {[llength $info($w,linked_abi_list)] == 0} {
      grid remove $w.infoframe.linked_abi
    } else {
      grid configure $w.infoframe.linked_abi
    }
    return {}
  }
}

#######
##
#######
proc linked_seguid_popup {w rootx rooty} {
  global info toolbar_images
  if {[winfo exists .w_tooltip]} {destroy .w_tooltip}
  if {![winfo exists $w.infoframe.checksum.popupmenu ]} {
    menu $w.infoframe.checksum.popupmenu 
  }
  $w.infoframe.checksum.popupmenu delete 0 end
  set circular [expr {$info($w,circular) == "circular"}]
  set seguid_text [expr {$circular ? "cdseguid" : "ldseguid"}]

  if {[info exists info($w,SEGUID)] && $info($w,SEGUID)  ne {}} {
    set verify_seguid [seguid $w]
    if {$info($w,SEGUID) ne $verify_seguid} {
      ## invalid SEGUID, shouldn't get to here
      $w.infoframe.checksum.popupmenu add command -label [mc "Warning- $seguid_text is not synchronized!"] -state disabled
      set info($w,SEGUID) $verify_seguid
    }
    $w.infoframe.checksum.popupmenu add command -label [mc "Copy the Unique Identifier for this Sequence as Text: %s" $info($w,SEGUID)] -command "clipboard clear; clipboard_append -displayof $w \$info($w,SEGUID) "
    $w.infoframe.checksum.popupmenu add command -label [mc "Remove Unique Identifier from this Sequence"] -command "set info($w,SEGUID) {}; $w.infoframe.checksum configure -image $toolbar_images(fingerprint_off)"
  } else {
    ## no SEGUID set on the file
    set cswprefix [seguid $w]
    $w.infoframe.checksum.popupmenu add command -label [mc "Copy Unique Identifier for this Sequence as Text: %s" [seguid $w]] -command "clipboard clear; clipboard_append -displayof $w $cswprefix"
    $w.infoframe.checksum.popupmenu add command -label [mc "Apply Unique Identifier to this Sequence"] -command "set info($w,SEGUID) \[seguid $w\]; $w.infoframe.checksum configure -image $toolbar_images(fingerprint_on)"

  }
  $w.infoframe.checksum.popupmenu add separator
  $w.infoframe.checksum.popupmenu add radiobutton -label [mc "Lock Sequence Edits when Uniqe Identifier is Applied"] -variable info(seguid_mode) -value 1
  #$w.infoframe.checksum.popupmenu add radiobutton -label [mc "Discard any %s when it becomes invalid." $seguid_text] -variable info(seguid_mode) -value 2
  $w.infoframe.checksum.popupmenu add radiobutton -label [mc "Update Unique Identifiers when Squences are Edited"] -variable info(seguid_mode) -value 3 -command "set info(seguid_notify_on_invalid) 0"
  $w.infoframe.checksum.popupmenu add radiobutton -label [mc "Update Unique Identifiers and Notify when Squences are Edited"] -variable info(seguid_mode) -value 3 -command "set info(seguid_notify_on_invalid) 1"
  #$w.infoframe.checksum.popupmenu add separator
  #$w.infoframe.checksum.popupmenu add checkbutton -label [mc "Notify when Sequence is Edited"] -variable info(seguid_notify_on_invalid)
  #$w.infoframe.checksum.popupmenu add radiobutton -label [mc "Discard %s when it becomes invalid." $seguid_text] -variable info(seguid_copy_mode) -value 0
  #$w.infoframe.checksum.popupmenu add radiobutton -label [mc "Copy old %s to file comments when it becomes invalid." $seguid_text] -variable info(seguid_copy_mode) -value 1
  #$w.infoframe.checksum.popupmenu add radiobutton -label [mc "Create source features containing old %s when it becomes invalid." $seguid_text] -variable info(seguid_copy_mode) -value 2
  tk_popup $w.infoframe.checksum.popupmenu $rootx $rooty
}

#######
##
#######
proc linked_abi_popup {w rootx rooty} {
  global info

  if {[winfo exists .w_tooltip]} {destroy .w_tooltip}
  if {![winfo exists $w.infoframe.linked_abi.popupmenu]} {
    menu $w.infoframe.linked_abi.popupmenu
  }
  if {![winfo exists $w.infoframe.linked_abi.popupmenu.open]} {
    menu $w.infoframe.linked_abi.popupmenu.open
    $w.infoframe.linked_abi.popupmenu add cascade -label [mc "Open"] -menu $w.infoframe.linked_abi.popupmenu.open
  }
  if {![winfo exists $w.infoframe.linked_abi.popupmenu.remove]} {
    menu $w.infoframe.linked_abi.popupmenu.remove
    $w.infoframe.linked_abi.popupmenu add cascade -label [mc "Remove"] -menu $w.infoframe.linked_abi.popupmenu.remove
  }
  $w.infoframe.linked_abi.popupmenu.open delete 0 end
  $w.infoframe.linked_abi.popupmenu.remove delete 0 end
  set i 0
  foreach abi $info($w,linked_abi_list) {
    set filename [lindex $abi 5]
    $w.infoframe.linked_abi.popupmenu.open add command -label [file tail $filename] -command "open_linked_abi $w $i"
    $w.infoframe.linked_abi.popupmenu.remove add command -label [file tail $filename] -command  "remove_linked_abi $w $i"
    incr i
  }
  tk_popup $w.infoframe.linked_abi.popupmenu $rootx $rooty
}

#######
##
#######
proc phred_popup {w rootx rooty} {
  global info

  if {[winfo exists .w_tooltip]} {destroy .w_tooltip}
  if {![winfo exists $w.infoframe.phred.popupmenu]} {
    menu $w.infoframe.phred.popupmenu
  }
  $w.infoframe.phred.popupmenu delete 0 end
  $w.infoframe.phred.popupmenu add command -label [mc "Find Low Phred Bases"] -command "find_phred_dialog $w"
  #$w.infoframe.phred.popupmenu add command -label [mc "Remove Phred Data"] -command "phred_remove_data $w"
  tk_popup $w.infoframe.phred.popupmenu $rootx $rooty
}


######
##
######
proc encode_abi {w index} {
  global info
  set result ""
  set data_list [lindex $info($w,linked_abi_list) $index]
  set basecall [lindex [lindex $data_list 11] 0]
  set locus_line "[format "LOCUS       %-16s %+11s bp ds-DNA     %-8s %-3s %-11s" linked_abi [string length $basecall] linear SYN [string toupper [clock format [clock seconds] -format "%d-%h-%Y"]]]\n"

  #first comment line: sample_name run_time,1 run_date,1 run_time,2 run_date,2 filename filter_wheel scale_track,0 scale_track,1 scale_track,2 scale_track,3
  set s "COMMENT     "
  set result $locus_line
  append s [lrange $data_list 0 10]
  append result [join [regexp -all -inline "[string repeat . 79]"  $s] \n] \n
  append result [string range $s end-[expr {([string length $s] % 79)-1}] end] \n

  #2nd comment line: basecall,original data
  set s "COMMENT     [lindex [lindex $data_list 11] 1]"
  append result [join [regexp -all -inline "[string repeat . 79]"  $s] \n] \n
  append result [string range $s end-[expr {([string length $s] % 79)-1}] end] \n

  #3rd-18th comment line: processed_data,0 processed_data,1 processed_data,2 processed_data,3 basecall_loc basecall_prob_called basecall_prob_a basecall_prob_c basecall_prob_g basecall_prob_t
  foreach element [lrange $data_list 12 end] {
    set s "COMMENT      [::base64::encode -maxlen 0 $element]"
    append result [join [regexp -all -inline "[string repeat . 79]"  $s] \n] \n
    append result [string range $s end-[expr {([string length $s] % 79)-1}] end] \n
  }
  regsub -all \n\n $result \n result
    append result "ORIGIN\n"

    ##sequence output
    set i 0
    while {$i < [string length $basecall]} {
      append result "[format "%+9s %s %s %s %s %s %s" [expr {$i+1}] [string range $basecall $i [expr {$i+9}]] [string range $basecall [expr {$i+10}] [expr {$i+19}]] [string range $basecall [expr {$i+20}] [expr {$i+29}]] [string range $basecall [expr {$i+30}] [expr {$i+39}]] [string range $basecall [expr {$i+40}] [expr {$i+49}]] [string range $basecall [expr {$i+50}] [expr {$i+59}]]]\n"
      incr i 60
    }
    append result "//"
  return $result
}


######
##
######
proc decode_abi {text} {
  global info data_list basecall return_list
  
  set data_list [split [regsub -all {ORIGIN} $text \x0] \x0]
  set header [lindex $data_list 0]
  regsub -all \n $header "" header
  set basecall  [lindex $data_list 1]
  regsub -all {[\s/0-9]} $basecall "" basecall
  set data_list [split [regsub -all {COMMENT\s\s\s\s\s} $header \x0] \x0]
  set data_list [lrange $data_list 1 end]
  set return_list [lindex $data_list 0]
  lappend return_list [list $basecall [lindex $data_list 1]]
  foreach element [lrange $data_list 2 end] {
    lappend return_list [::base64::decode $element]
  }
 return $return_list
}


###########
## change the selection with button1
###########
proc abi_draw_phred {w} {
  global abi_info info
  #sputs $w, [info exists abi_info($w,basecall_prob_called,edited)]
  if {(![info exists abi_info($w,basecall_prob_called,edited)]) || ($abi_info($w,basecall_prob_called,edited) == [list])} {return}

  set abi_info($w,basecall_prob_called,edited) [lrange $abi_info($w,basecall_prob_called,edited) 0 [expr {[llength $abi_info($w,basecall_loc,edited)] - 1}]]
###need to put in the xscale!!!
  set c $w.c
  set p [$c find withtag phred_graph]
  set atrace [$c find withtag "trace && A"]
  set horiz_scale $abi_info($w,horiz_scale)
  set y1 [lindex [$c bbox $atrace] 3]
  set x0 [lindex [$c bbox $atrace] 0]
  set x1 [lindex [$c bbox $atrace] 2]
  set y0 [lindex [$c bbox [lindex [$c find withtag basecall] 0]] 3] 
  set yrange [expr {$y1 - $y0 *1.0}]
  if {!$abi_info($w,rev_com)} {
    set phred_coord_list [list $x1 $y1 $x0 $y1 $x0 [expr {$y1-[lindex $abi_info($w,basecall_prob_called,edited) 0]/100.0*$yrange}]]
    foreach prob0 [lrange $abi_info($w,basecall_prob_called,edited) 0 end-1] prob1 [lrange $abi_info($w,basecall_prob_called,edited) 1 end] basex0 [lrange $abi_info($w,basecall_loc,edited) 0 end-1] basex1 [lrange $abi_info($w,basecall_loc,edited) 1 end] {
      #lappend phred_coord_list [set tx [expr {($basex1+$basex0)/2.0* $horiz_scale}]] [expr {$y1-$prob0/100.0*$yrange}] $tx [expr {$y1-$prob1/100.0*$yrange}]
      set phred_coord_list [concat $phred_coord_list [set tx [expr {($basex1+$basex0)/2.0* $horiz_scale}]] [expr {$y1-$prob0/100.0*$yrange}] $tx [expr {$y1-$prob1/100.0*$yrange}]]
    }
    #lappend phred_coord_list $x1 [expr {$y1-$prob1/100.0*$yrange}]
    set phred_coord_list [concat $phred_coord_list $x1 [expr {$y1-$prob1/100.0*$yrange}]]
  } else {
   ##rev com
   set phred_coord_list [list $x0 $y1 $x1 $y1 $x1 [expr {$y1-[lindex $abi_info($w,basecall_prob_called,edited) 0]/100.0*$yrange}]]
    foreach prob0 [lrange $abi_info($w,basecall_prob_called,edited) 0 end-1] prob1 [lrange $abi_info($w,basecall_prob_called,edited) 1 end] basex0 [lrange $abi_info($w,basecall_loc,edited) 0 end-1] basex1 [lrange $abi_info($w,basecall_loc,edited) 1 end] {
      #lappend phred_coord_list [set tx [expr {$x1- (($basex1+$basex0)/2.0* $horiz_scale)}]] [expr {$y1-$prob0/100.0*$yrange}] $tx [expr {$y1-$prob1/100.0*$yrange}]
      set phred_coord_list [concat $phred_coord_list [set tx [expr {$x1- (($basex1+$basex0)/2.0* $horiz_scale)}]] [expr {$y1-$prob0/100.0*$yrange}] $tx [expr {$y1-$prob1/100.0*$yrange}]]
    }
    #lappend phred_coord_list $x0 [expr {$y1-$prob1/100.0*$yrange}]
    set phred_coord_list [concat $phred_coord_list $x0 [expr {$y1-$prob1/100.0*$yrange}]]
  }
  $c coords $p $phred_coord_list
  $c itemconfig $p  -fill [mix_color #8080FF $info(graphic_bg_color) 20] -outline [mix_color #8080FF $info(graphic_bg_color) 35] 
  $c lower $p

}

###########
## change the selection with button1
###########
proc abi_toggle_phred {w} {
  global info
  set c $w.c
  set p [$c find withtag phred_graph]
  if {[$c itemcget $p  -fill] == {}} {
    $c itemconfig $p  -fill [mix_color #8080FF $info(graphic_bg_color) 20] -outline [mix_color #8080FF $info(graphic_bg_color) 35] 
  } else {
    $c itemconfig $p  -fill {} -outline {}
  }
}

###########
## change the selection with button1
###########
proc abi_click_select {c mouse_x} {
  set x [abi_get_gap $c [$c canvasx $mouse_x]]
  $c coords selection $x -2 $x [winfo height $c]
}

###########
## change the selection with shift-button1
###########
proc abi_shift_select {c mouse_x} {
  set x [abi_get_gap $c [$c canvasx $mouse_x]]
  if {$x < [expr {([lindex [$c coords selection] 0]+[lindex [$c coords selection] 2])/2}]} {
    $c coords selection $x -2 [lindex [$c coords selection] 2] [winfo height $c]
  } else {
    $c coords selection [lindex [$c coords selection] 0] -2 $x [winfo height $c]
  }
}


###########
## change the selection from from_c to to_c
###########
proc abi_select_region {w from_c to_c} {
  global abi_info
  if {![winfo exists $w.c]} {return}
  foreach {x0 i x1 j} [$w.c bbox all] {break}
  foreach {s0 i s1 j} [$w.c coords selection] {break}

  if {[expr {$from_c+1}] > [llength $abi_info($w,basecall_loc,edited)]} {
    set from_c [expr {[llength $abi_info($w,basecall_loc,edited)]-1}]
  }
  if {($to_c ne "select") && ([expr {$to_c+1}] > [llength $abi_info($w,basecall_loc,edited)])} {
    set to_c [expr {[llength $abi_info($w,basecall_loc,edited)]-1}]
  }
  if {$from_c < 0 } {
    set from_c 0
  }
  if {$to_c < 0 } {
    set to_c 0
  }

  set a [lindex $abi_info($w,basecall_loc,edited) [expr {$from_c-1}]]
  set b [lindex $abi_info($w,basecall_loc,edited) $from_c]
  set c [lindex $abi_info($w,basecall_loc,edited) [expr {$from_c+1}]]

  if {$from_c == 0} {
    set loc_list [concat 0 [expr {($b+$c)/2}]]
  } elseif {[expr {$from_c+1}] == [llength $abi_info($w,basecall_loc,edited)]} {
    set loc_list [concat [expr {($a+$b)/2}] $x1]
  } else {
    set loc_list [list [expr {($a+$b)/2}] [expr {($b+$c)/2}]]
  }

  if {$to_c eq "select"} {
    set from_mid [expr {([lindex $loc_list 0]+[lindex $loc_list 1]) / 2.0}]
    set from_mid [expr {$abi_info($w,rev_com)?($x1-$abi_info($w,horiz_scale)*($from_mid+3)):($abi_info($w,horiz_scale)*$from_mid)}]
    set sel_mid [expr {($s0 + $s1) / 2.0}]
    if {$from_mid < $sel_mid} {
      $w.c coords selection [expr {$abi_info($w,rev_com)?($x1-$abi_info($w,horiz_scale)*([lindex $loc_list 1]+3)):($abi_info($w,horiz_scale)*[lindex $loc_list 0])}] -2 $s1 [winfo height $w.c]
    } else {
      $w.c coords selection $s0 -2 [expr {$abi_info($w,rev_com)?($x1-$abi_info($w,horiz_scale)*([lindex $loc_list 0]+3)):($abi_info($w,horiz_scale)*[lindex $loc_list 1])}] [winfo height $w.c]
    }
    $w.c xview moveto [expr {([lindex [$w.c coords selection] 0]-[winfo width $w.c]/2.0)/$x1}]
  } else {
    set a [lindex $abi_info($w,basecall_loc,edited) [expr {$to_c-1}]]
    set b [lindex $abi_info($w,basecall_loc,edited) $to_c]
    set c [lindex $abi_info($w,basecall_loc,edited) [expr {$to_c+1}]]

    if {$to_c == 0} {
      set loc_list [concat $loc_list 0 [expr {($b+$c)/2}]]
    } elseif {[expr {$to_c+1}] == [llength $abi_info($w,basecall_loc,edited)]} {
      set loc_list [concat $loc_list [expr {($a+$b)/2}] $x1]
    } else {
      set loc_list [concat $loc_list [expr {($a+$b)/2}] [expr {($b+$c)/2}]]
    }
    set loc_list [lsort -integer $loc_list]
    $w.c coords selection [expr {$abi_info($w,rev_com)?($x1-$abi_info($w,horiz_scale)*([lindex $loc_list 0]+3)):($abi_info($w,horiz_scale)*[lindex $loc_list 0])}] -2 [expr {$abi_info($w,rev_com)?($x1-$abi_info($w,horiz_scale)*([lindex $loc_list 3]+3)):($abi_info($w,horiz_scale)*[lindex $loc_list 3])}] [winfo height $w.c]
    $w.c xview moveto [expr {([lindex [$w.c coords selection] 0]-[winfo width $w.c]/2.0)/$x1}]
  }
}

###########
## get x value of gap nearest x
###########
proc abi_get_gap {c x} {
  set bclist [$c find withtag basecall]
  for  {set i 0} {($i < [llength $bclist]) && ([lindex [$c coord [lindex $bclist $i]] 0] < $x)} {incr i} {
  }
  if {$i== 0} {
    set result [lindex [$c bbox [lindex $bclist $i]] 0]
  } elseif {$i < [llength $bclist]} {
    set result [expr {([lindex [$c coord [lindex $bclist $i]] 0] + [lindex [$c coord [lindex $bclist [expr {$i-1}]]] 0]) /2}]
  } else {
    set result [lindex [$c bbox [lindex $bclist [expr {$i-1}]]] 2]
  }
  return $result
}

###########
## get x value of gap nearest x
###########
proc abi_indices {c x {dir +}} {
  set bclist [$c find withtag basecall]
  for  {set i 0} {($i < [llength $bclist]) && ([lindex [$c coord [lindex $bclist $i]] 0] < $x)} {incr i} {
  }
  return $i
}

###########
## get sequence and indicies can use pixel values, "start", "end", "sel.first", "sel.last"
###########
proc abi_get_seq {w from to} {
  global abi_info

  foreach {x0 i x1 j} [$w.c bbox all] {}
  foreach {s0 i s1 j} [$w.c coords selection] {}
  if {$s0 == $s1} {
    set s0 $x0
    set s1 $x1
  }

  set from [string map "start $x0 end $x1 sel.first $s0 sel.last $s1" $from]
  set to [string map "start $x0 end $x1 sel.first $s0 sel.last $s1" $to]

  if {$from > $to} {
    set i $from
    set from $to
    set to $i   
  }

  set seq ""
  set first 0
  foreach base [$w.c find withtag basecall] {
    set basex [lindex [$w.c coord $base] 0]
    if {$basex > $to} {break}
    if {$basex >= $from} {
     # lappend indices $basex
      append seq [$w.c itemcget $base -text]
    } else {
      incr first
    }
  }

  if {$seq != ""} {
    return [list $first $seq]
  } else {
    return [list 0 $seq]
  }
}

###########
## reverse complement an abi window
###########
proc abi_revcom {w} {
  global abi_info
  set c $w.c

  set x0 [lindex [$c bbox all] 0]
  set x1 [lindex [$c bbox all] 2]
  $c scale all [expr {($x1+$x0)/2}] 0 -1 1

  if {$abi_info($w,rev_com)} {
    foreach base {A C G T} rc_base {T G C A} {
      $c itemconfigure $base -fill $abi_info(colors,$rc_base)
    }
  } else {
    foreach base {A C G T} {
      $c itemconfigure $base -fill $abi_info(colors,$base)
    }
  }
  set lowest [lindex [$c find withtag basecall] 0]
  foreach call [$c find withtag basecall] {
    $c itemconfigure $call -text [string map {A T B V C G D H G C H D K M M K N N * * R Y S S T A V B W W Y R a t b v c g d h g c h d k m m k n n r y s s t a v b w w y r} [$c itemcget $call -text]]
    $c lower $call $lowest
    set lowest $call
  }
  set abi_info($w,sequence) [revcom $abi_info($w,sequence)]

  $w.c xview moveto [expr {1.0-[lindex [$w.xs get] 1]}]
}

###########
## use a scrollbar instead of slider on aqua
## $w.ys -from 5 -to 1  $w.xs2 -from 5 -to 0.5
###########
proc abi_aqua_scale {w dir command args} {
  global abi_info

  if {$dir == "x"} {

  } else {
   if {$command == "moveto"} {
     set newscale [expr {5.0 - 4.0*[lindex $args 0]}]
     $w.ys set [lindex $args 0] [lindex $args 0]
   } else {
     set newscale [expr {$abi_info($w,vert_scale) - 0.1*[lindex $args 0]}]
     if {$newscale < 0} {set newscale 0}
     if {$newscale > 5} {set newscale 5}
     $w.ys set [expr {1.0 - ($newscale-1)/4.0}] [expr {1.0 - ($newscale-1)/4.0}]
   }
   abi_scale $w $newscale
  }
}

###########
## change x and y scaling of the traces in an abi window with android pinch
###########
proc android_abi_pinch {zoom angle state w} {
  global abi_info
  if {$state == 1} {
    set abi_info(android_pinch_start_zoom) $zoom
    set abi_info(android_pinch_start_x_scale) $abi_info($w,horiz_scale) 
  } elseif {[info exists abi_info(android_pinch_start_zoom)]} {
    # set degtorad 0.017453292522222223
    if {1 || [expr {abs(cos($angle / 64.0 * $degtorad))}] > 0.82 } {
      #set x_zoom [expr {$abi_info($w,horiz_scale) *10.0 * (1.0 * $zoom / $info(android_pinch_start_zoom))}]
      set x_zoom [expr {$abi_info(android_pinch_start_x_scale) * 10 * (1.0 * $zoom / $abi_info(android_pinch_start_zoom))}]
      abi_x_scale $w $x_zoom
    } elseif {[expr {abs(cos($angle / 64.0 * $degtorad))}] < 0.57 } {
      set y_zoom [expr {$abi_info($w,horiz_scale) *10.0 * (1.0 * $zoom / $abi_info(android_pinch_start_zoom))}]
      abi_scale $w $y_zoom
    }
  }
}

###########
## change y scaling of the traces in an abi window
## 10-50 range maps to 5-1 zoom
###########
proc abi_scale {w new_scale} {
  global abi_info
    set new_scale [expr {6-$new_scale/10.0}]
    if {![winfo exists $w.c] || ([$w.c find withtag trace] == {})} {return}
    set baseline [lindex [$w.c bbox trace] 3]
    set ratio [expr {$new_scale/$abi_info($w,vert_scale)}]
    $w.c scale trace  0 $baseline 1 $ratio
    set abi_info($w,vert_scale) $new_scale
}

###########
## change x scaling of the traces in an abi window
## 5-50 range maps to 5-0.5 zoom
###########
proc abi_x_scale {w new_scale} {
  global abi_info
    set new_scale [expr {5.5-$new_scale/10.0}]
    if {![winfo exists $w.c] || ![winfo exists $w.xs]} {return}
    set left [lindex [$w.c cget -scrollregion] 0] 
    set center [expr {([lindex [$w.xs get] 1] + [lindex [$w.xs get] 0]) / 2.0}]
    set ratio [expr {$new_scale/$abi_info($w,horiz_scale)}]
    $w.c scale all  0 0 $ratio 1
    $w.c configure -scrollregion [lreplace [$w.c cget -scrollregion] 2 2  [expr {$ratio* [lindex [$w.c cget -scrollregion] 2]}]]
    set abi_info($w,horiz_scale) $new_scale
    set half_width [expr {([lindex [$w.xs get] 1] - [lindex [$w.xs get] 0]) / 2.0/$ratio}]
    $w.c xview moveto [expr {$center-$half_width}]
}

###########
## abi file info dialog
###########
proc abi_file_info {w} {
  global abi_info
  global info

  if {[winfo exists $w.info] == 1} {
    wm deiconify $w.info
    raise $w.info
  } else {
    toplevel $w.info
    #wm withdraw $w.info
    wm title $w.info "[mc {File Info:}]$abi_info($w,filename)"
    wm protocol $w WM_DELETE_WINDOW "closewindow $w"
    grid [text $w.info.text -height 5 -width 50  -insertontime 0 -insertofftime 1000] -row 0 -column 0 -sticky nsew
    grid rowconfigure $w.info 0 -weight 1
    grid columnconfigure $w.info 0 -weight 1
    $w.info.text insert end "[mc Sample:]$abi_info($w,sample_name) \n"
    $w.info.text insert end "[mc Scaling:][string index $abi_info($w,filter_wheel) 0]:$abi_info($w,scale_track,0),[string index $abi_info($w,filter_wheel) 1]:$abi_info($w,scale_track,1),[string index $abi_info($w,filter_wheel) 2]:$abi_info($w,scale_track,2),[string index $abi_info($w,filter_wheel) 3]:$abi_info($w,scale_track,3)\n"
    $w.info.text insert end "[mc {Run began:}][clock format [clock scan "$abi_info($w,run_date,1) $abi_info($w,run_time,1)"] -format "%l:%M%p %a,%b %d, %Y"]\n"
    $w.info.text insert end "[mc {Run ended:}][clock format [clock scan "$abi_info($w,run_date,2) $abi_info($w,run_time,2)"] -format "%l:%M%p %a,%b %d, %Y"]\n"
    wm deiconify $w.info 
  }
}

###########
## returns new canvas with copy of abi trace canvas c from x1 to x2.  
###########
proc abi_copy_region {fromc fromx1 fromx2 toc tox1 toy1 xscale yscale {clip_y 0}} {
  global abi_info
  regexp {(-?[0-9]*) (-?[0-9]*) (-?[0-9]*) (-?[0-9]*)} [$fromc bbox all] l x0 fromy1 x3 fromy2


#copy the non-trace objects (should be all text)
  set objects [$fromc find enclosed [expr {$fromx1-15.0}] $fromy1 [expr {$fromx2+15.0}] $fromy2]
  foreach object $objects {
    switch [$fromc type $object] {
      text {
        regexp {([0-9]*.[0-9]*) ([0-9]*.[0-9]*)} [$fromc coords $object] l textx texty
        $toc create text [expr {($textx-$fromx1)*$xscale+$tox1}] [expr {$texty*$yscale+$toy1}] -text [$fromc itemcget $object -text] -fill [$fromc itemcget $object -fill] -anchor [$fromc itemcget $object -anchor] -font [$fromc itemcget $object -font]
        #need to adjust scale if yscale<1
      }
      default {#sputs [$fromc type $object]}
    }
  }

 ##do all traces at once so you can do only the x region between fromx1 to fromx2

  set Aline [$fromc find withtag {trace && A}] 
  set Cline [$fromc find withtag {trace && C}] 
  set Gline [$fromc find withtag {trace && G}] 
  set Tline [$fromc find withtag {trace && T}] 
  set newAcoords [list]
  set newCcoords [list]
  set newGcoords [list]
  set newTcoords [list]
  if {$abi_info([winfo toplevel $fromc],rev_com)} {
    foreach {xA yA} [$fromc coords $Aline] {xC yC} [$fromc coords $Cline] {xG yG} [$fromc coords $Gline] {xT yT} [$fromc coords $Tline] {
      if {$xA < $fromx1} break
      if {$xA < $fromx2} {
         if {$yA < $clip_y} {set yA $clip_y}
#concat over lappend here?
         lappend newAcoords [expr {($xA-$fromx1)*$xscale+$tox1}] [expr {$yA*$yscale+$toy1}]
         if {$yC < $clip_y} {set yC $clip_y}
         lappend newCcoords [expr {($xC-$fromx1)*$xscale+$tox1}] [expr {$yC*$yscale+$toy1}] 
         if {$yG < $clip_y} {set yG $clip_y}
         lappend newGcoords [expr {($xG-$fromx1)*$xscale+$tox1}] [expr {$yG*$yscale+$toy1}] 
         if {$yT < $clip_y} {set yT $clip_y}
         lappend newTcoords [expr {($xT-$fromx1)*$xscale+$tox1}] [expr {$yT*$yscale+$toy1}]     
      }
    }
  } else {
    foreach {xA yA} [$fromc coords $Aline] {xC yC} [$fromc coords $Cline] {xG yG} [$fromc coords $Gline] {xT yT} [$fromc coords $Tline] {
      if {$xA > $fromx2} break
      if {$xA > $fromx1} {
         if {$yA < $clip_y} {set yA $clip_y}
         lappend newAcoords [expr {($xA-$fromx1)*$xscale+$tox1}] [expr {$yA*$yscale+$toy1}]
         if {$yC < $clip_y} {set yC $clip_y}
         lappend newCcoords [expr {($xC-$fromx1)*$xscale+$tox1}] [expr {$yC*$yscale+$toy1}] 
         if {$yG < $clip_y} {set yG $clip_y}
         lappend newGcoords [expr {($xG-$fromx1)*$xscale+$tox1}] [expr {$yG*$yscale+$toy1}] 
         if {$yT < $clip_y} {set yT $clip_y}
         lappend newTcoords [expr {($xT-$fromx1)*$xscale+$tox1}] [expr {$yT*$yscale+$toy1}]     
      }
    }
  }
  $toc create line $newAcoords -fill [$fromc itemcget $Aline -fill]
  $toc create line $newCcoords -fill [$fromc itemcget $Cline -fill]
  $toc create line $newGcoords -fill [$fromc itemcget $Gline -fill]
  $toc create line $newTcoords -fill [$fromc itemcget $Tline -fill]
}

###########
## save trace file as .scf
###########
proc abi_save_scf {w} {
  global info abi_info

  set mag_num ".scf"
  set num_samples [llength $abi_info($w,processed_data,0)]
  set samples_offset 128
  set num_bases [llength $abi_info($w,basecall_loc,edited)]
  set left_clip 0
  set right_clip 0
  set bases_offset [expr {$samples_offset+ $num_samples * 8}]
  if {[catch {set comments $abi_info($w,scf_comments)}]} {
    set comments {}
  }
  set comments_size [string length $comments]
  set comments_offset [expr {$bases_offset+$num_bases*12}]
  set version "3.00"
  set sample_size 2
  set code_set 2
  set private_size 0
  set private_offset [expr {$comments_offset+$comments_size}]

  set header [binary format a4IIIIIIIIa4IIIIx72 $mag_num $num_samples $samples_offset $num_bases $left_clip $right_clip $bases_offset $comments_size $comments_offset $version $sample_size $code_set $private_size $private_offset]
  set filename [tk_getSaveFile -title [mc "Save SCF File"] -parent $w -initialdir [file dirname $abi_info($w,filename)] -defaultextension ".scf" -initialfile [file rootname [file tail $abi_info($w,filename)]] -filetypes {{{Sequence Coloring Format} {.scf}}}  ]
   if {$filename eq {}} {return}
  if {[file extension $filename] == {}} {set filename "$filename.scf"}
  if {[catch {set fid [open $filename w]}]} {
    tk_messageBox -title [mc "Error Saving File"] -message [mc "There was an error saving the file. The location may be locked."] -type ok 
    return
  }
  fconfigure $fid -translation binary
  puts -nonewline $fid $header
  
  #write trace info (samples section)
  foreach track [list 0 1 2 3] base [split $abi_info($w,filter_wheel) ""] {
    set p_delta 0
    set data [list]
    for {set i 0} {$i < $num_samples} {incr i} {
      set p_sample [lindex $abi_info($w,processed_data,$track) $i]
#concat over lappend here?
      lappend data [expr {$p_sample-$p_delta}]
      set p_delta $p_sample
    }
    set p_delta 0
    set new_data($base) [list]
    for {set i 0} {$i < $num_samples} {incr i} {
      set p_sample [lindex $data $i]
#concat over lappend here?
      lappend new_data($base) [expr {$p_sample-$p_delta}]
      set p_delta $p_sample
    }
  }
  foreach base {A C G T} {
    puts -nonewline $fid  [binary format S* $new_data($base)]
  }

  #write basecall section
  puts -nonewline $fid [binary format I* $abi_info($w,basecall_loc,edited)]

  ## if there is phred data in basecall_prob_called, but the individual prob tracks are empty, fill them in
  if {[lsearch -not $abi_info($w,basecall_prob_called,edited) 0] > -1 && [lsearch -not $abi_info($w,basecall_prob_a,edited) 0] == -1 && [lsearch -not $abi_info($w,basecall_prob_c,edited) 0] == -1 && [lsearch -not $abi_info($w,basecall_prob_g,edited) 0] == -1 && [lsearch -not $abi_info($w,basecall_prob_t,edited) 0] == -1} {
    for {set i 0} {$i < [llength $abi_info($w,basecall_prob_called,edited)]} {incr i} {
      set char [string tolower [string index $abi_info($w,basecall,edited) $i]]
      if {[regexp {[acgt]} $char]} {
        lset abi_info($w,basecall_prob_$char,edited) $i [lindex $abi_info($w,basecall_prob_called,edited) $i]
      }
    }
  }
  puts -nonewline $fid [binary format c* $abi_info($w,basecall_prob_a,edited)]
  puts -nonewline $fid [binary format c* $abi_info($w,basecall_prob_c,edited)]
  puts -nonewline $fid [binary format c* $abi_info($w,basecall_prob_g,edited)]
  puts -nonewline $fid [binary format c* $abi_info($w,basecall_prob_t,edited)]
  puts -nonewline $fid $abi_info($w,basecall,edited)
  puts -nonewline $fid [binary format "x[expr {$num_bases*3}]"]

  #write comments section
  puts -nonewline $fid $comments

  close $fid
}

###########
## edit a base (after entering edit mode)
###########
proc abi_edit_base {w item call} {
  global abi_info
  set c $w.c
  if {[regexp {Shift_L|Alt_L|Meta_L|Ctrl_L} $call]} return

  set bclist [$c find withtag basecall]
  set i [lsearch -exact -integer $bclist $item] 
  if {$i == -1} {sputs $item not found in abi_edit; return}
  #need to set $i if rev_com):
  if {$abi_info($w,rev_com)} {
    set i [expr {[llength $bclist] - $i -1}]
  }

  ###need to scroll to see the edited base

  #delete basecall element if it is invalid and set to invalid
  if {(![string match -nocase {[ACGTNBDHKMRSVWY]} $call]) && (![string match -nocase {[ACGTNBDHKMRSVWY]} [$c itemcget $item -text]])} {
    set call "BackSpace"
  }

  if {[string match -nocase {[ACGTNBDHKMRSVWY]} $call]} {
   ###Edit base here
    if {$abi_info($w,rev_com)} {set call_text [revcom $call]} else {set call_text $call}
    $c itemconfigure $item -text $call -fill $abi_info(colors,[string toupper $call]) -tags [list basecall [string toupper $call_text]]
    if {$abi_info($w,basecall_prob_called,edited) != [list]} {
      foreach acgt {a c g t} {
        set abi_info($w,basecall_prob_$acgt,edited) [lreplace $abi_info($w,basecall_prob_$acgt,edited) $i $i 0]
      }
      set abi_info($w,basecall_prob_called,edited) [lreplace $abi_info($w,basecall_prob_called,edited) $i $i 0]
    }
    set abi_info($w,basecall,edited) [string replace $abi_info($w,basecall,edited) $i $i $call_text]
    abi_draw_phred $w
  } elseif {($call eq "BackSpace") || ($call eq "space") || ($call eq "Delete")} {
  ####Delete base here
    $c delete $item
    if {$abi_info($w,basecall_prob_called,edited) != [list]} {
      foreach acgt {a c g t} {
        set abi_info($w,basecall_prob_$acgt,edited) [lreplace $abi_info($w,basecall_prob_$acgt,edited) $i $i]
      }
      set abi_info($w,basecall_prob_called,edited) [lreplace $abi_info($w,basecall_prob_called,edited) $i $i]
    }
    set abi_info($w,basecall,edited) [string replace $abi_info($w,basecall,edited) $i $i]
    set abi_info($w,basecall_loc,edited) [lreplace $abi_info($w,basecall_loc,edited) $i $i]
    abi_draw_phred $w
   # abi_redraw_indices $w
  } else {
sputs bad base edit char: $call
  }
  if {$abi_info($w,rev_com)} {
    set abi_info($w,sequence) [revcom $abi_info($w,basecall,edited)]
  } else {
    set abi_info($w,sequence) $abi_info($w,basecall,edited)
  }
  event generate $c <<ClearEdit>>
}

###########
## enter edit mode on a basecall (draw the edit box and set up bindings, use abi_edit_base to make the change)
###########
proc abi_edit_mode {w item} {
  set c $w.c
  event generate $c <<ClearEdit>>
  if {$item == ""} return
  $c coord editbox [$c bbox $item]
  $c lower editbox
  $c itemconfigure editbox -outline black -fill yellow
  bind $c <Any-ButtonPress> "event generate $c <<ClearEdit>>"
  bind $c <FocusOut> "event generate $c <<ClearEdit>>"
  #need to do ClearEdit on scroll
  #bind $c <Any-Key> "sputs %K"
  bind $c <Any-Key> "abi_edit_base $w $item %K"
}

###########
## insert a basecall into an abi file then enter edit mode to set the contents
###########
proc abi_add_base {w x} {
  global abi_info
  set c $w.c

  if {1} {
    set new_call [$c create text $x 15 -text "n" -anchor n -font dnafont -fill $abi_info(colors,N) -width 0 -tags {basecall tempbasecall}]
    set bclist [$c find withtag basecall]
    for  {set i 0} {($i < [llength $bclist]) && ([lindex [$c coord [lindex $bclist $i]] 0] < $x)} {incr i} {
    }
    if {$i > 0} {
      $c raise $new_call [lindex $bclist [expr {$i-1}]]
    } else {
      $c lower $new_call [lindex $bclist 0]
    }

    #need to set $i if rev_com
    if {$abi_info($w,rev_com)} {
      set i [expr {[llength $bclist] - $i}]
    }
    if {$abi_info($w,basecall_prob_called,edited) != [list]} {
      foreach acgt {a c g t} {
       set abi_info($w,basecall_prob_$acgt,edited) [linsert $abi_info($w,basecall_prob_$acgt,edited) $i 0]
      }
      set abi_info($w,basecall_prob_called,edited) [linsert $abi_info($w,basecall_prob_called,edited) $i 0]
    }
    set abi_info($w,basecall,edited) "[string range $abi_info($w,basecall,edited) 0 [expr {$i-1}]]n[string range $abi_info($w,basecall,edited) $i end]"
    if {!$abi_info($w,rev_com)} {
      set abi_info($w,basecall_loc,edited) [linsert $abi_info($w,basecall_loc,edited) $i [expr {int($x / $abi_info($w,horiz_scale))}]]
      set abi_info($w,sequence) $abi_info($w,basecall,edited)
    } else {
      set abi_info($w,basecall_loc,edited) [linsert $abi_info($w,basecall_loc,edited) $i [expr {int([lindex [$w.c bbox 1] 2] - ($x / $abi_info($w,horiz_scale)) -2)}]]
      set abi_info($w,sequence) [revcom $abi_info($w,basecall,edited)]
    }
    abi_draw_phred $w
  }
    #abi_redraw_indices $w
    abi_edit_mode $w $new_call
}

###########
## save current view as eps file
###########
proc abi_save_eps {c} {
  set regionx1 [$c canvasx [expr {[winfo x $c]+2}]]
  set regionx2 [$c canvasx [expr {[winfo x $c]+[winfo width $c]-4}]]
  set c2 [canvas .print_canvas -width [expr {$regionx2-$regionx1}] -height [winfo height $c]]
  abi_copy_region $c $regionx1 $regionx2 $c2 0 0 1.0 1.0
  canvas_save $c2
  destroy $c2
}

###########
## copy current view to clipboard as metafile
###########
## this is too ugly- fix before restoring
proc abi_copy_metafile {c {mode both}} {
  set regionx1 [$c canvasx [expr {[winfo x $c]+2}]]
  set regionx2 [$c canvasx [expr {[winfo x $c]+[winfo width $c]-4}]]
  set c2 [canvas .print_canvas -width [expr {$regionx2-$regionx1}] -height [winfo height $c]]
  abi_copy_region $c $regionx1 $regionx2 $c2 0 0 1.0 1.0
  canvas_to_metafile copy $c2 both
  destroy $c2
}

###########
## print current view
###########
proc abi_print {c} {
  set regionx1 [$c canvasx [expr {[winfo x $c]+2}]]
  set regionx2 [$c canvasx [expr {[winfo x $c]+[winfo width $c]-4}]]
  set c2 [canvas .print_canvas -width [expr {$regionx2-$regionx1}] -height [winfo height $c]]
  abi_copy_region $c $regionx1 $regionx2 $c2 0 0 1.0 1.0
  print_canvas $c2 $c
  destroy $c2
}


###########
## print abi files
###########
proc print_abi {c} {
global info abi_info tcl_platform
  foreach {xmin ymin xmax ymax} [$c bbox all] {}
  set ymin [expr {($ymin <= 0) ? 0 : $ymin}]
  set w [winfo toplevel $c]
  set header_text "[mc "File:"] $abi_info($w,filename)\n[mc {Run ended:}][clock format [clock scan "$abi_info($w,run_date,2) $abi_info($w,run_time,2)"] -format "%l:%M%p %a,%b %d, %Y"]\n(page %P)"
  if {[tk windowingsystem] == "win32"} {
    set page_width 8500
    set page_height 11000
    set pm_left 1000
    set pm_right 1000
    set pm_top 1000
    set pm_bottom 1000
    set ppi_x 1000
    set ppi_y 1000
    set attr_list [printer attr]
    foreach attr $attr_list {
      switch -exact [lindex $attr 0] {
        "page dimensions" {
          set page_width [lindex [lindex $attr 1] 0]
          set page_height [lindex [lindex $attr 1] 1]
        }
        "page margins" {
          set pm_left [lindex [lindex $attr 1] 0]
          set pm_top [lindex [lindex $attr 1] 1]
          set pm_right [lindex [lindex $attr 1] 2]
          set pm_bottom [lindex [lindex $attr 1] 3]
        }
        "pixels per inch" {
          set ppi_x [lindex [lindex $attr 1] 0]
          set ppi_y [lindex [lindex $attr 1] 1]
        }
      }
    }

   
    set print_width [expr {($page_width-$pm_left-$pm_right)/1000.0}]
    set print_height [expr {($page_height-$pm_top-$pm_bottom)/1000.0}]
    set line_height_inches [expr {1.0*($print_height)/$info(print_abi_lines_per_page)-0.5}]
    set line_width_abi_pixels [expr {int($print_width * ($ymax-$ymin)/$line_height_inches)}] 
    set total_lines [expr {int(ceil (1.0*($xmax- $xmin) / $line_width_abi_pixels))}]
    set total_pages [expr {int(ceil (1.0*$total_lines/$info(print_abi_lines_per_page)))}]


    if {[set print_parameters [windows_print_dialog [list 1 $total_pages]]] != ""} {
      #START PRINTING here
      foreach {hDC page_width page_height pm_left pm_top pm_right pm_bottom ppi_x ppi_y first_page last_page copies spool_copies print_flag} $print_parameters {}

      #reset the lines/page and total pages after getting possibly new printer margin info
      set print_width [expr {($page_width-$pm_left-$pm_right)/1000.0}]
      set print_height [expr {($page_height-$pm_top-$pm_bottom)/1000.0}]

      set header_height_inches 0.5

      set line_height_inches [expr {1.0*($print_height-$header_height_inches+0.5)/$info(print_abi_lines_per_page)-0.5}]
      set line_width_abi_pixels [expr {int($print_width * ($ymax-$ymin)/$line_height_inches)}] 
      set total_lines [expr {int(ceil (1.0*($xmax- $xmin) / $line_width_abi_pixels))}]
      set total_pages [expr {int(ceil (1.0*$total_lines/$info(print_abi_lines_per_page)))}]
      switch $print_flag {
        all {
        }
        selection {
          set xmin [expr {int([lindex [$c coords selection] 0])}]
          set xmax [expr {int([lindex [$c coords selection] 2])}]
          if {$xmin == $xmax} {
            foreach {xmin i xmax j} [$c bbox all] {} 
          }
        }
        pagenums {
            set xmin [expr {$xmin + ($first_page - 1) * $info(print_abi_lines_per_page) * $line_width_abi_pixels}]
            set xmax_temp [expr {$xmin + ($last_page- $first_page + 1)  * $info(print_abi_lines_per_page) * $line_width_abi_pixels}]
            set xmax [expr {($xmax < $xmax_temp) ? $xmax : $xmax_temp}]
        }
      } 

      set first_line 1
      set last_line [expr {int(ceil (1.0*($xmax- $xmin) / $line_width_abi_pixels))}]

      set Aline [$c find withtag {trace && A}] 
      set Cline [$c find withtag {trace && C}] 
      set Gline [$c find withtag {trace && G}] 
      set Tline [$c find withtag {trace && T}] 


      if {$abi_info($w,rev_com)} {
        set trace_i $last_line
        set temp_line_start [expr {$xmin + ($last_line-$first_line) * $line_width_abi_pixels}]
        foreach {xA yA} [$c coords $Aline] {xC yC} [$c coords $Cline] {xG yG} [$c coords $Gline] {xT yT} [$c coords $Tline] {
          if {$xA > $xmax} continue
          if {$xA < $xmin} break
          if {$xA < $temp_line_start} {
            incr trace_i -1
            incr temp_line_start [expr {-$line_width_abi_pixels}]
          }
#concat over lappend here?
          lappend newAcoords($trace_i) [expr {$xA-$temp_line_start}] [expr {($yA<0)?0: $yA}]
          lappend newCcoords($trace_i) [expr {$xC-$temp_line_start}] [expr {($yC<0)?0: $yC}]
          lappend newGcoords($trace_i) [expr {$xG-$temp_line_start}] [expr {($yG<0)?0: $yG}]
          lappend newTcoords($trace_i) [expr {$xT-$temp_line_start}] [expr {($yT<0)?0: $yT}]    
        }
      } else {
        set temp_line_start $xmin
        set temp_line_end [expr {$xmin + $line_width_abi_pixels}]
        set trace_i $first_line
        foreach {xA yA} [$c coords $Aline] {xC yC} [$c coords $Cline] {xG yG} [$c coords $Gline] {xT yT} [$c coords $Tline] {
          if {$xA > $xmax} break
          if {$xA < $xmin} continue
          if {$xA > $temp_line_end} {
            incr temp_line_start $line_width_abi_pixels
            incr temp_line_end $line_width_abi_pixels
            incr trace_i
          }
#concat over lappend here?
          lappend newAcoords($trace_i) [expr {$xA-$temp_line_start}] [expr {($yA<0)?0: $yA}]
          lappend newCcoords($trace_i) [expr {$xC-$temp_line_start}] [expr {($yC<0)?0: $yC}]
          lappend newGcoords($trace_i) [expr {$xG-$temp_line_start}] [expr {($yG<0)?0: $yG}]
          lappend newTcoords($trace_i) [expr {$xT-$temp_line_start}] [expr {($yT<0)?0: $yT}]    
        }
      }
      set element [lindex [$c find withtag basecall] 0]
      if {$element != {}} {
        set print_font [list [font actual [$c itemcget $element -font] -family] [expr {int ([font actual [$c itemcget $element -font] -size]/  ($line_width_abi_pixels/$print_width)*([tk scaling]*72) +0.5)}]]
      } else {
        set print_font [list Courier [expr {int (10 /($line_width_abi_pixels/$print_width)*([tk scaling]*72) +0.5)}]]
      } 
sputs $hDC
      printer job -hdc $hDC start
      toplevel .printer_notifier
      set dialogblock 1
      set bind_store [bind . <<RaiseDialogs>>]
      bind . <<RaiseDialogs>> "wm deiconify .printer_notifier; raise .printer_notifier"
      wm overrideredirect .printer_notifier 1
      wm title .printer_notifier "Printing..."
      regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $w] wgeom winx winy
      wm geometry .printer_notifier "+[expr (($winx<0)?0:$winx)+100]+[expr (($winy<0)?0:$winy)+100]"
      pack [frame .printer_notifier.frame -relief ridge -bd 3 -width 200]      
      pack [label .printer_notifier.frame.message -text "" -width 50 -height 4]
      for {set copies_spooled 1} {$copies_spooled <= $spool_copies} {incr copies_spooled} {
        for {set next_line $first_line} {$next_line <= $last_line} {incr next_line $info(print_abi_lines_per_page)} {
          if {[expr {$next_line+$info(print_abi_lines_per_page)-1}] > $last_line} {
            set last_page_line $last_line
          } else {
            set last_page_line [expr {$next_line+$info(print_abi_lines_per_page)-1}]
          }
          for {set copies_printed 1} {$copies_printed <= $copies} {incr copies_printed} {
            if {$copies == 1} {
              if {$spool_copies == 1} {
                .printer_notifier.frame.message configure -text "Printing page [expr {$next_line/$info(print_abi_lines_per_page)+1}] of [expr {int(ceil(1.0*$last_line/$info(print_abi_lines_per_page)))}]."
              } else {
                .printer_notifier.frame.message configure -text "Printing page [expr {$next_line/$info(print_abi_lines_per_page)+1}] of [expr {int(ceil(1.0*$last_line/$info(print_abi_lines_per_page)))}], copy $copies_spooled of $spool_copies."
              } 
            } else {
                .printer_notifier.frame.message configure -text "Printing page [expr {$next_line/$info(print_abi_lines_per_page)+1}] of [expr {int(ceil(1.0*$last_line/$info(print_abi_lines_per_page)))}], copy $copies_printed of $copies."
            }
            update idletasks

            printer page -hdc $hDC start
            set current_page_line 0
              #put header at top of page
            gdi map $hDC -logical [expr {int ($line_width_abi_pixels/$print_width)}] -physical $ppi_x -offset [list [expr {int(($pm_left* $ppi_x / 1000))}] [expr {int(($pm_top* $ppi_x / 1000))}]]
            gdi text $hDC 0 0 -text [regsub -all {%P} $header_text [expr {$next_line/$info(print_abi_lines_per_page)+1}]] -font [list [font actual dnafont -family] 8] -anchor nw -justify left 

            for {set current_line $next_line} {$current_line <= $last_page_line} {incr current_line} {
              set line_xmin [expr {$xmin + ($current_line - 1) * $line_width_abi_pixels}]
              if {$current_line == $last_line} {
               set line_xmax $xmax
              } else {
               set line_xmax [expr {$line_xmin + $line_width_abi_pixels}]
              }
              gdi map $hDC -logical [expr {int ($line_width_abi_pixels/$print_width)}] -physical $ppi_x -offset [list [expr {int(($pm_left* $ppi_x / 1000))}] [expr {int(($pm_top / 1000 + (($current_page_line + 1)* 0.5)+ ($current_page_line * $line_height_inches))* $ppi_x)}]]
              foreach element [$c find overlapping $line_xmin $ymin $line_xmax $ymax] {
                if {[$c type $element] eq "text"} {
                  gdi text $hDC [expr {[lindex [$c coords $element] 0]-$line_xmin}] [expr {[lindex [$c coords $element] 1]-$ymin}] -text [$c itemcget $element -text] -fill [$c itemcget $element -fill] -font $print_font -anchor n
                }
              }
              gdi rectangle $hDC -45 $ymin -1 $ymax -fill white -outline white
              gdi rectangle $hDC [expr {$line_xmax-$line_xmin+1}] $ymin [expr {$line_xmax-$line_xmin+45}] $ymax -fill white -outline white
              gdi rectangle $hDC 0 $ymin [expr {$line_xmax-$line_xmin}] $ymax
              if {[catch {gdi line $hDC  {*}$newAcoords($current_line) -fill {[$c itemcget [$c find withtag {trace && A}] -fill]}}] } {
                sputs error:$current_line [array names newAcoords]
              }
              catch {gdi line $hDC  {*}$newCcoords($current_line) -fill {[$c itemcget [$c find withtag {trace && C}] -fill]} }
              catch {gdi line $hDC  {*}$newGcoords($current_line) -fill {[$c itemcget [$c find withtag {trace && G}] -fill]} }
              catch {gdi line $hDC  {*}$newTcoords($current_line) -fill {[$c itemcget [$c find withtag {trace && T}] -fill]} }
              incr current_page_line
            }
            printer page -hdc $hDC end
          }
        }
      }
      printer job -hdc $hDC end
      printer close -hdc $hDC
      destroy .printer_notifier
      set dialogblock 0
      bind . <<RaiseDialogs>> $bind_store
    }
  } elseif {[tk windowingsystem] == "aqua" && ([lsearch -glob [info loaded] "*libcocoaprint*"] > -1 || [info commands ::tk::print::_print] ne {})} {
   #####Aqua printing here
    set preview_file [file join [tempdir] "[file rootname [wm title [winfo toplevel $c]]].pdf"]
    ::pdf4tcl::new pdf
    pdf configure -margin {36 36} -paper letter
    add_window_to_pdf pdf $c abi
    pdf write -file $preview_file
    pdf destroy
    if {[lsearch -glob [info loaded] "*libcocoaprint*"] > -1} {
      cocoaprint::print $preview_file [winfo toplevel $c]
    } elseif {[info commands ::tk::print::_print] ne {}} {
      ::tk::print::_print $preview_file
    } 
  } elseif {$tcl_platform(os) == "Linux" || $tcl_platform(os) == "Darwin"} {
    if {[llength [set print_parameters [unix_print_dialog [winfo toplevel $c]]]] > 3} {
      #puts $print_parameters
      foreach {printer page_width page_height pm_left pm_top pm_right pm_bottom ppi_x ppi_y copies orient scale} $print_parameters {}
      ::pdf4tcl::new pdf
      pdf configure -margin {36 36} -paper letter -landscape [expr {$orient=="landscape"?1:0}]
      add_window_to_pdf pdf $c abi
      set preview_file [file join [tempdir] "[file rootname [wm title [winfo toplevel $c]]].pdf"]
      pdf write -file $preview_file
      pdf destroy
      if {$orient=="landscape"} {
        exec lpr -P $printer -o landscape $preview_file
      } else {
        exec lpr -P $printer $preview_file
      }
    }
  } else {
    warning_dialog "Printing isn't available from non-windows or -unix"
  }
}

###########
## pint abi using cocoa print
###########
### NOT USED
proc print_abi_cocoa {c} {
  global info abi_info
  set print_parameters [list 8.5 11 .5 .5 .5 .5 0 nw]
  foreach {page_width page_height marginx1 marginy1 marginx2 marginy2 rotate anchor} $print_parameters {}
  set print_width [expr {$page_width-$marginx1-$marginx2}]
  set print_height [expr {$page_height-$marginy1-$marginy2}]
  foreach {xmin ymin xmax ymax} [$c cget -scrollregion] {}
  set ymin [expr {($ymin <= 0) ? 0 : $ymin}]
  set w [winfo toplevel $c]
  set linespace 0.5
  set line_height_inches [expr {1.0*($print_height-$linespace*($info(print_abi_lines_per_page)-1))/$info(print_abi_lines_per_page)}]

  #set ppi [expr {1.0* ($ymax-$ymin)/$line_height_inches}]
  set ppi [expr {1.0* ([winfo height $c])/$line_height_inches}]
  set line_width_abi_pixels [expr {int($print_width * $ppi)}] 
  set total_lines [expr {int(ceil (1.0*($xmax- $xmin) / $line_width_abi_pixels))}]
  set total_pages [expr {int(ceil (1.0*$total_lines/$info(print_abi_lines_per_page)))}]
  set print_x0 0
  set print_dir [tempdir]
  set Aline [$c coords [$c find withtag {trace && A}]]
  set Cline [$c coords [$c find withtag {trace && C}]]
  set Gline [$c coords [$c find withtag {trace && G}]] 
  set Tline [$c coords [$c find withtag {trace && T}]] 
  if {$abi_info($w,rev_com)} {
    set trace_i 1
    set Aline [lreverse $Aline]
    set Cline [lreverse $Cline]
    set Gline [lreverse $Gline] 
    set Tline [lreverse $Tline]
  } else {
    set trace_i 0
  }
  #set yscale [expr {($ymax-$ymin)}]
  set yscale [winfo height $c]
  if {[winfo exists .c]} {destroy .c}
  set c1 [canvas .c]
  for {set page 0} {$page < $total_pages} {incr page} {
    #$c1 delete all
    canvas_delete_all $c1
    set print_y0 0
    for {set l 0} {($l<$info(print_abi_lines_per_page) && ($print_x0< $xmax) )} {incr l} {
      set print_x1 [expr {min($xmax, ($print_x0+$line_width_abi_pixels))}]
      set print_y1 [expr {$print_y0+$line_height_inches*$ppi}]
      $c1 create rectangle 0 $print_y0 [expr {$print_x1-$print_x0}] $print_y1 -outline black
      set Acoords [list];set Ccoords [list];set Gcoords [list];set Tcoords [list];
      for {set trace_i $trace_i} {($trace_i < [llength $Aline]) && ([lindex $Aline $trace_i] < $print_x1)} {incr trace_i [expr {$abi_info($w,rev_com)?3:1}]} {
#concat over lappend here? could get an lrange of the coords and lset elements over ymin
        lappend Acoords [expr {[lindex $Aline $trace_i]-$print_x0}]
        lappend Ccoords [expr {[lindex $Cline $trace_i]-$print_x0}]
        lappend Gcoords [expr {[lindex $Gline $trace_i]-$print_x0}]
        lappend Tcoords [expr {[lindex $Tline $trace_i]-$print_x0}]
        incr trace_i [expr {$abi_info($w,rev_com)?-1:1}]
        lappend Acoords [expr {max($ymin,[lindex $Aline $trace_i]+$print_y0)}]
        lappend Ccoords [expr {max($ymin,[lindex $Cline $trace_i]+$print_y0)}]
        lappend Gcoords [expr {max($ymin,[lindex $Gline $trace_i]+$print_y0)}]
        lappend Tcoords [expr {max($ymin,[lindex $Tline $trace_i]+$print_y0)}]
      }
      $c1 create line {*}$Acoords -fill [$c itemcget [$c find withtag {trace && A}] -fill]
      $c1 create line {*}$Ccoords -fill [$c itemcget [$c find withtag {trace && C}] -fill]
      $c1 create line {*}$Gcoords -fill [$c itemcget [$c find withtag {trace && G}] -fill]
      $c1 create line {*}$Tcoords -fill [$c itemcget [$c find withtag {trace && T}] -fill]
      foreach element [$c find overlapping $print_x0 $ymin $print_x1 $ymax] {
        if {[$c type $element] eq "text"} {
          $c1 create text [expr {[lindex [$c coords $element] 0]-$print_x0}] [expr {[lindex [$c coords $element] 1]-$ymin+$print_y0}] -text [$c itemcget $element -text] -fill [$c itemcget $element -fill] -anchor n
        }
      }
      set print_x0 [expr {1 + $print_x1}]
      set print_y0 [expr {$print_y1 + $linespace * $ppi}]
    }
    update idletasks
    set temp_ps_file [file join $print_dir "ApE_temp_print_file.ps"]
    foreach {x1 y1 x2 y2} [$c1 bbox all] {}
    $c1 postscript -x [expr {$x1-$marginx1*$ppi}] -y [expr {$y1-$marginy1*$ppi}] -width [expr {$page_width*$ppi}] -height [expr {$page_height*$ppi}] -pagewidth "$page_width\i" -file $temp_ps_file
    set temp_pdf_file [file join $print_dir "ApE_temp_print_file[format "%03d" $page].pdf"]
    exec /usr/bin/pstopdf $temp_ps_file -o $temp_pdf_file
    lappend pdf_list $temp_pdf_file
    update idletasks
  }
  destroy $c1
  exec /System/Library/Automator/Combine\ PDF\ pages.action/Contents/Resources/join.py -o [file join $print_dir "ApE_temp_print_file[format "%03d" $page].pdf"] {*}$pdf_list
  cocoaprint::print [file join $print_dir "ApE_temp_print_file[format "%03d" $page].pdf"] $w
}

###########
## print abi using tk print
###########
## send in printable area w and h in points, margins in points (summs to page width and height)
#margins: left right top bottom
proc abi_to_canvases {window page_w page_h {margins {0 0 0 0}}} {
    global info abi_info
    # for pdf pages
    #lassign [pdf getDrawableArea] page_w page_h
    set c $window
    set print_width [expr {$page_w/1}]
    set print_height [expr {$page_h/1}]
    lassign $margins m_left m_right m_top m_bottom
    foreach {xmin ymin xmax ymax} [$c cget -scrollregion] {}
    if {[lindex [$c coords selection] 2] > [lindex [$c coords selection] 0]} {
      set xmin1 [expr {int([lindex [$c coords selection] 0])}]
      set xmax1 [expr {int([lindex [$c coords selection] 2])}]
    } 
    set ymin [expr {($ymin <= 0) ? 0 : $ymin}]
    set w [winfo toplevel $c]
    set linespace 36
    set line_height_pts [expr {1.0*($print_height-$linespace*($info(print_abi_lines_per_page)-1))/$info(print_abi_lines_per_page)}]

    set screen_pixels_per_print_points [expr {1.0* ($ymax-$ymin)/$line_height_pts}]
sputs r $line_height_pts $screen_pixels_per_print_points
    set line_width_abi_pixels [expr {int($print_width * $screen_pixels_per_print_points)}] 
    set total_lines [expr {int(ceil (1.0*($xmax- $xmin) / $line_width_abi_pixels))}]
    set total_pages [expr {int(ceil (1.0*$total_lines/$info(print_abi_lines_per_page)))}]
    set print_x0 0
    set Aline [$c coords [$c find withtag {trace && A}]]
    set Cline [$c coords [$c find withtag {trace && C}]]
    set Gline [$c coords [$c find withtag {trace && G}]] 
    set Tline [$c coords [$c find withtag {trace && T}]] 
    if {$abi_info($w,rev_com)} {
      set trace_i 1
      set Aline [lreverse $Aline]
      set Cline [lreverse $Cline]
      set Gline [lreverse $Gline] 
      set Tline [lreverse $Tline]
    } else {
      set trace_i 0
    }
    set result [list]
    catch {destroy .t}
    toplevel .t
    wm withdraw .t
    wm geometry .t [expr {int([tk scaling]*($page_w+$m_left+$m_right))}]x[expr {int([tk scaling]*($page_h+$m_top+$m_bottom))}]
    for {set page 0} {$page < $total_pages} {incr page} {

      if {[winfo exists .c$page]} {destroy .c$page}
      set c1 [canvas .t.c$page -width [expr {[tk scaling]*($page_w+$m_left+$m_right)}] -height [expr {[tk scaling]*($page_h+$m_top+$m_bottom)}]]
      grid $c1 -sticky nswe
      $c1 delete all
      set print_y0 0
      for {set l 0} {($l<$info(print_abi_lines_per_page) && ($print_x0< $xmax) )} {incr l} {
sputs line $l
        set print_x1 [expr {min($xmax, ($print_x0+$line_width_abi_pixels))}]
        set linewidth [expr {$print_x1 - $print_x0}]
        set print_y1 [expr {$print_y0+$line_height_pts*$screen_pixels_per_print_points}]
        $c1 create rectangle 0 $print_y0 [expr {$print_x1-$print_x0}] $print_y1 -outline black -width [expr {1.0 /$screen_pixels_per_print_points}]
        set Acoords [list];set Ccoords [list];set Gcoords [list];set Tcoords [list];
        for {set trace_i $trace_i} {($trace_i < [llength $Aline]) && ([lindex $Aline $trace_i] < $print_x1)} {incr trace_i [expr {$abi_info($w,rev_com)?3:1}]} {
#concat over lappend here? could get an lrange of the coords and lset elements over ymin
          lappend Acoords [expr {[lindex $Aline $trace_i]-$print_x0}]
          lappend Ccoords [expr {[lindex $Cline $trace_i]-$print_x0}]
          lappend Gcoords [expr {[lindex $Gline $trace_i]-$print_x0}]
          lappend Tcoords [expr {[lindex $Tline $trace_i]-$print_x0}]
          incr trace_i [expr {$abi_info($w,rev_com)?-1:1}]
          lappend Acoords [expr {max($ymin,[lindex $Aline $trace_i]+$print_y0)}]
          lappend Ccoords [expr {max($ymin,[lindex $Cline $trace_i]+$print_y0)}]
          lappend Gcoords [expr {max($ymin,[lindex $Gline $trace_i]+$print_y0)}]
          lappend Tcoords [expr {max($ymin,[lindex $Tline $trace_i]+$print_y0)}]
        }
        $c1 create line {*}$Acoords -fill [$c itemcget [$c find withtag {trace && A}] -fill] -width [expr {[$c itemcget [$c find withtag {trace && A}] -width] / $screen_pixels_per_print_points}]
        $c1 create line {*}$Ccoords -fill [$c itemcget [$c find withtag {trace && C}] -fill] -width [expr {[$c itemcget [$c find withtag {trace && C}] -width] / $screen_pixels_per_print_points}]
        $c1 create line {*}$Gcoords -fill [$c itemcget [$c find withtag {trace && G}] -fill] -width [expr {[$c itemcget [$c find withtag {trace && G}] -width] / $screen_pixels_per_print_points}]
        $c1 create line {*}$Tcoords -fill [$c itemcget [$c find withtag {trace && T}] -fill] -width [expr {[$c itemcget [$c find withtag {trace && T}] -width] / $screen_pixels_per_print_points}]
        foreach element [$c find overlapping $print_x0 $ymin $print_x1 $ymax] {
          if {[$c type $element] eq "text"} {
            $c1 create text [expr {[lindex [$c coords $element] 0]-$print_x0}] [expr {[lindex [$c coords $element] 1]-$ymin+$print_y0}] -text [$c itemcget $element -text] -fill [$c itemcget $element -fill] -anchor n -font [font_scale [$c itemcget $element -font] $screen_pixels_per_print_points]
          }
        }
        set print_x0 [expr {1 + $print_x1}]
        set print_y0 [expr {$print_y1 + $linespace * $screen_pixels_per_print_points}]
      }
      $c1 configure -scrollregion [list [expr {-[tk scaling]*$m_left}] [expr {-[tk scaling]*$m_top}] {*}[lrange [$c bbox all] 2 3]]
      $c1 scale all 0 0 [expr {1.0/$screen_pixels_per_print_points}] [expr {1.0/$screen_pixels_per_print_points}]
      $c1 xview moveto 0
      $c1 yview moveto 0
      lappend result $c1
    }
  return $result
}

proc font_scale {font scale} {
  return [list [font actual $font -family] [expr {int([font actual $font -size] / $scale)}]]
}


###########
## find dialog
###########
proc abi_find_dialog {w} {
  global abi_info
  global info
  global ok dialogblock
  if {$dialogblock == 1} {return}
  set dialogblock 1
  bind . <<RaiseDialogs>> "wm deiconify .find_dialog; raise .find_dialog"
  set ok 0
  set s [toplevel .find_dialog]
  wm title $s "[mc Find]..."
  wm protocol $s WM_DELETE_WINDOW {set ok -1}
  bind $s <KeyPress-Escape>  "set ok -1"
  raise $s

  set wgeomlist [split [wm geometry $w] "x+"]
  set sgeom "+[expr [lindex $wgeomlist 2]+3]+[expr [lindex $wgeomlist 3]+150]"
  wm geometry $s $sgeom

  #label $s.parent_info -text [mc "Find:"]
  entry $s.find -width 50
  $s.find insert 0 $abi_info(last_find)
  frame $s.mod_frame 
    pack [checkbutton  $s.mod_frame.revcom -text [mc "Also find rev-com of string"] -onvalue 1 -offvalue 0 -variable abi_info(find_revcom)] -side left
    pack [checkbutton  $s.mod_frame.exact -text [mc "As literal"] -onvalue 1 -offvalue 0 -variable abi_info(find_literal) ] -side left 
    pack [checkbutton  $s.mod_frame.wrap -text [mc "Wrap"] -onvalue 1 -offvalue 0 -variable abi_info(find_wrap) ] -side left 
  frame $s.action_frame
    pack [button $s.action_frame.next -text [mc "find next"] -command "set abi_info(last_find) \[$s.find get\]; abi_do_find $w \$abi_info(last_find) \$abi_info(find_revcom) \$abi_info(find_literal) \$abi_info(find_wrap) " -default active] -side left  -padx 10 -pady 3
    pack [button $s.action_frame.prev -text [mc "find previous"] -command "set abi_info(last_find) \[$s.find get\]; abi_do_find $w \$abi_info(last_find) \$abi_info(find_revcom) \$abi_info(find_literal) \$abi_info(find_wrap) prev"] -side left  -padx 10 -pady 3
    pack [button $s.action_frame.cancel -text [mc "cancel"] -command "set ok -1"] -side left  -padx 10 -pady 3

  #pack $s.parent_info -side top -fill x -expand true
  pack $s.find -side top -fill x -expand true
  pack $s.mod_frame -side top -fill x -expand true
  pack $s.action_frame -side top -fill x -expand true
 

  bind $s <Key-Return> "$s.action_frame.next invoke"
  focus $s
  focus $s.find

  vwait ok
  set dialogblock 0
  bind . <<RaiseDialogs>> ""
  destroy $s
}

############
## Find text in a trace window
############
### NOT used
proc abi_do_find {w search_text revcom find_literal wrap} {
  global abi_info

  if {$search_text == ""} {return}
  set left_x [lindex [$w.c coord selection] 0]
  set target [abi_get_seq $w $left_x end]
  set text [string range [string toupper [lindex $target 1]] 1 end]
  set start_index [expr {1 + [lindex $target 0]}]
  set seq_len [llength [$w.c find withtag basecall]]

  set search_text [string toupper $search_text]
  if {!$find_literal} {
    set search_text [regsubpattern $search_text]
  }
  if {$revcom == 1} {
    set search_text "$search_text|[revcom_regexp $search_text]"
  }
  if {[regexp -indices $search_text $text index] == 1} {
    if {!$abi_info($w,rev_com)} {
      abi_select_region $w [expr {[lindex $index 0]+$start_index }] [expr {[lindex $index 1]+ $start_index}]
    } else {
      abi_select_region $w [expr {$seq_len-[lindex $index 0]-$start_index-1}] [expr {$seq_len-[lindex $index 1] - $start_index-1}]
    }
  } elseif {$wrap} {
    set target [abi_get_seq $w start end]
    set text [string range [string toupper [lindex $target 1]] 1 end]
    if {[regexp -indices $search_text $text index] == 1} {
      if {!$abi_info($w,rev_com)} {
        abi_select_region $w [expr {[lindex $index 0]+1}] [expr {[lindex $index 1]+1}]
      } else {
        abi_select_region $w [expr {$seq_len-[lindex $index 0] - 2}] [expr {$seq_len-[lindex $index 1] -2}]
      }
    } else {
      bell
    }
  } else {
    bell
  }
}

############
## Find text in a trace window
############
proc abi_do_find {w search_text revcom find_literal wrap {dir next}} {
  global abi_info

  if {$search_text == ""} {return}
  set left_x [lindex [$w.c coord selection] 0]
  set target [abi_get_seq $w $left_x end]
  set text [string range [string toupper [lindex [abi_get_seq $w start end] 1]] 1 end]
  set start_index [expr {1 + [lindex $target 0]}]
  set seq_len [llength [$w.c find withtag basecall]]

  set search_text [string toupper $search_text]
  if {!$find_literal} {
    set search_text [regsubpattern $search_text]
  }
  if {$revcom == 1} {
    set search_text "$search_text|[revcom_regexp $search_text]"
  }

  if {[llength [set index_list [regexp -inline -indices -all $search_text $text]]] > 0} {
    set found 0
    for {set i 0} {$i < [llength $index_list]} {incr i} {
      if {[lindex $index_list $i 0] >= $start_index} {
        set found 1
        break
      }
    }
    if {$dir == "next"} {
      if {!$found} {
        if {$wrap} {
          set index [lindex $index_list 0]
        } else {
          bell 
          return
        }
      } else {
        set index [lindex $index_list $i]
      }
    } else {
      if {!$found} {
          set index [lindex $index_list end]
      } else {
        while {$i > -1 && [lindex $index_list $i 0]>= [expr {$start_index-2}]} {
          incr i -1
        }
        if {$i > -1} {
          set index [lindex $index_list $i]
        } elseif {$wrap} {
          set index [lindex $index_list end]
        } else {
          bell 
          return
        }
      }
    }

    if {!$abi_info($w,rev_com)} {
      abi_select_region $w [expr {[lindex $index 0]+1 }] [expr {[lindex $index 1] +1}]
    } else {
      abi_select_region $w [expr {$seq_len-[lindex $index 0]-1}] [expr {$seq_len-[lindex $index 1] -1}]
    }
  } else {
    bell
  }
}

##############
## base64 encoding from base64 package
##############
    namespace eval base64 {
	variable base64 {}
	variable base64_en {}

	# We create the auxiliary array base64_tmp, it will be unset later.
	variable base64_tmp
	variable i

	set i 0
	foreach char {A B C D E F G H I J K L M N O P Q R S T U V W X Y Z \
		a b c d e f g h i j k l m n o p q r s t u v w x y z \
		0 1 2 3 4 5 6 7 8 9 + /} {
	    set base64_tmp($char) $i
	    lappend base64_en $char
	    incr i
	}

	#
	# Create base64 as list: to code for instance C<->3, specify
	# that [lindex $base64 67] be 3 (C is 67 in ascii); non-coded
	# ascii chars get a {}. we later use the fact that lindex on a
	# non-existing index returns {}, and that [expr {} < 0] is true
	#

	# the last ascii char is 'z'
	variable char
	variable len
	variable val

	scan z %c len
	for {set i 0} {$i <= $len} {incr i} {
	    set char [format %c $i]
	    set val {}
	    if {[info exists base64_tmp($char)]} {
		set val $base64_tmp($char)
	    } else {
		set val {}
	    }
	    lappend base64 $val
	}

	# code the character "=" as -1; used to signal end of message
	scan = %c i
	set base64 [lreplace $base64 $i $i -1]

	# remove unneeded variables
	unset base64_tmp i char len val

	namespace export encode decode
    }
    proc ::base64::encode {args} {
	set base64_en $::base64::base64_en
	
	# Set the default wrapchar and maximum line length to match
	# the settings for MIME encoding (RFC 3548, RFC 2045). These
	# are the settings used by Trf as well. Various RFCs allow for
	# different wrapping characters and wraplengths, so these may
	# be overridden by command line options.
	set wrapchar "\n"
	set maxlen 76

	if { [llength $args] == 0 } {
	    error "wrong # args: should be \"[lindex [info level 0] 0]\
		    ?-maxlen maxlen? ?-wrapchar wrapchar? string\""
	}

	set optionStrings [list "-maxlen" "-wrapchar"]
	for {set i 0} {$i < [llength $args] - 1} {incr i} {
	    set arg [lindex $args $i]
	    set index [lsearch -glob $optionStrings "${arg}*"]
	    if { $index == -1 } {
		error "unknown option \"$arg\": must be -maxlen or -wrapchar"
	    }
	    incr i
	    if { $i >= [llength $args] - 1 } {
		error "value for \"$arg\" missing"
	    }
	    set val [lindex $args $i]

	    # The name of the variable to assign the value to is extracted
	    # from the list of known options, all of which have an
	    # associated variable of the same name as the option without
	    # a leading "-". The [string range] command is used to strip
	    # of the leading "-" from the name of the option.
	    #
	    # FRINK: nocheck
	    set [string range [lindex $optionStrings $index] 1 end] $val
	}
    
	# [string is] requires Tcl8.2; this works with 8.0 too
	if {[catch {expr {$maxlen % 2}}]} {
	    return -code error "expected integer but got \"$maxlen\""
	} elseif {$maxlen < 0} {
	    return -code error "expected positive integer but got \"$maxlen\""
	}

	set string [lindex $args end]

	set result {}
	set state 0
	set length 0


	# Process the input bytes 3-by-3

	binary scan $string c* X

	foreach {x y z} $X {
	    ADD [lindex $base64_en [expr {($x >>2) & 0x3F}]]
	    if {$y != {}} {
		ADD [lindex $base64_en [expr {(($x << 4) & 0x30) | (($y >> 4) & 0xF)}]]
		if {$z != {}} {
		    ADD [lindex $base64_en [expr {(($y << 2) & 0x3C) | (($z >> 6) & 0x3)}]]
		    ADD [lindex $base64_en [expr {($z & 0x3F)}]]
		} else {
		    set state 2
		    break
		}
	    } else {
		set state 1
		break
	    }
	}
	if {$state == 1} {
	    ADD [lindex $base64_en [expr {(($x << 4) & 0x30)}]]
	    ADD =
	    ADD =
	} elseif {$state == 2} {
	    ADD [lindex $base64_en [expr {(($y << 2) & 0x3C)}]]
	    ADD =
	}
	return $result
    }

    proc ::base64::ADD {x} {
	# The line length check is always done before appending so
	# that we don't get an extra newline if the output is a
	# multiple of $maxlen chars long.

	upvar 1 maxlen maxlen length length result result wrapchar wrapchar
	if {$maxlen && $length >= $maxlen} {
	    append result $wrapchar
	    set length 0
	}
	append result $x
	incr length
	return
    }

    # ::base64::decode --
    #
    #	Base64 decode a given string.
    #
    # Arguments:
    #	string	The string to decode.  Characters not in the base64
    #		alphabet are ignored (e.g., newlines)
    #
    # Results:
    #	The decoded value.

    proc ::base64::decode {string} {
	if {[string length $string] == 0} {return ""}

	set base64 $::base64::base64
	set output "" ; # Fix for [Bug 821126]

	binary scan $string c* X
	foreach x $X {
	    set bits [lindex $base64 $x]
	    if {$bits >= 0} {
		if {[llength [lappend nums $bits]] == 4} {
		    foreach {v w z y} $nums break
		    set a [expr {($v << 2) | ($w >> 4)}]
		    set b [expr {(($w & 0xF) << 4) | ($z >> 2)}]
		    set c [expr {(($z & 0x3) << 6) | $y}]
		    append output [binary format ccc $a $b $c]
		    set nums {}
		}		
	    } elseif {$bits == -1} {
		# = indicates end of data.  Output whatever chars are left.
		# The encoding algorithm dictates that we can only have 1 or 2
		# padding characters.  If x=={}, we must (*) have 12 bits of input 
		# (enough for 1 8-bit output).  If x!={}, we have 18 bits of
		# input (enough for 2 8-bit outputs).
		#
		# (*) If we don't then the input is broken (bug 2976290).

		foreach {v w z} $nums break

		# Bug 2976290
		if {$w == {}} {
		    return -code error "Not enough data to process padding"
		}

		set a [expr {($v << 2) | (($w & 0x30) >> 4)}]
		if {$z == {}} {
		    append output [binary format c $a ]
		} else {
		    set b [expr {(($w & 0xF) << 4) | (($z & 0x3C) >> 2)}]
		    append output [binary format cc $a $b]
		}		
		break
	    } else {
		# RFC 2045 says that line breaks and other characters not part
		# of the Base64 alphabet must be ignored, and that the decoder
		# can optionally emit a warning or reject the message.  We opt
		# not to do so, but to just ignore the character. 
		continue
	    }
	}
	return $output
    }

##############
## sha1 and hmac hashing from tcllib
##############
namespace eval ::sha1 {
	variable K

	proc initK {} {
	    variable K {}
	    foreach t {
		0x5A827999
		0x6ED9EBA1
		0x8F1BBCDC
		0xCA62C1D6
	    } {
		for {set i 0} {$i < 20} {incr i} {
		    lappend K [expr {int($t)}]
		}
	    }
	}
	initK
    }

 

    proc ::sha1::sha1 {msg} {
	variable K

	#
	# 4. MESSAGE PADDING
	#

	# pad to 512 bits (512/8 = 64 bytes)

	set msgLen [string length $msg]

	# last 8 bytes are reserved for msgLen
	# plus 1 for "1"

	set padLen [expr {56 - $msgLen%64}]
	if {$msgLen % 64 >= 56} {
	    incr padLen 64
	}

	# 4a. and b. append single 1b followed by 0b's
	append msg [binary format "a$padLen" \200]

	# 4c. append 64-bit length
	# Our implementation obviously limits string length to 32bits.
	append msg \0\0\0\0[binary format "I" [expr {8*$msgLen}]]
    
	#
	# 7. COMPUTING THE MESSAGE DIGEST
	#

	# initial H buffer

	set H0 [expr {int(0x67452301)}]
	set H1 [expr {int(0xEFCDAB89)}]
	set H2 [expr {int(0x98BADCFE)}]
	set H3 [expr {int(0x10325476)}]
	set H4 [expr {int(0xC3D2E1F0)}]

	#
	# process message in 16-word blocks (64-byte blocks)
	#

	# convert message to array of 32-bit integers
	# each block of 16-words is stored in M($i,0-16)

	binary scan $msg I* words
	set blockLen [llength $words]

	for {set i 0} {$i < $blockLen} {incr i 16} {
	    # 7a. Divide M[i] into 16 words W[0], W[1], ...
	    set W [lrange $words $i [expr {$i+15}]]

	    # 7b. For t = 16 to 79 let W[t] = ....
	    set t   16
	    set t3  12
	    set t8   7
	    set t14  1
	    set t16 -1
	    for {} {$t < 80} {incr t} {
		set x [expr {[lindex $W [incr t3]] ^ [lindex $W [incr t8]] ^ \
			[lindex $W [incr t14]] ^ [lindex $W [incr t16]]}]
		lappend W [expr {($x << 1) | (($x >> 31) & 1)}]
	    }

	    # 7c. Let A = H[0] ....
	    set A $H0
	    set B $H1
	    set C $H2
	    set D $H3
	    set E $H4

	    # 7d. For t = 0 to 79 do
	    for {set t 0} {$t < 20} {incr t} {
		set TEMP [expr {(($A << 5) | (($A >> 27) & 0x1f)) + \
			(($B & $C) | ((~$B) & $D)) \
			+ $E + [lindex $W $t] + [lindex $K $t]}]
		set E $D
		set D $C
		set C [expr {($B << 30) | (($B >> 2) & 0x3fffffff)}]
		set B $A
		set A $TEMP
	    }
	    for {} {$t<40} {incr t} {
		set TEMP [expr {(($A << 5) | (($A >> 27) & 0x1f)) + \
			($B ^ $C ^ $D) \
			+ $E + [lindex $W $t] + [lindex $K $t]}]
		set E $D
		set D $C
		set C [expr {($B << 30) | (($B >> 2) & 0x3fffffff)}]
		set B $A
		set A $TEMP
	    }
	    for {} {$t<60} {incr t} {
		set TEMP [expr {(($A << 5) | (($A >> 27) & 0x1f)) + \
			(($B & $C) | ($B & $D) | ($C & $D)) \
			+ $E + [lindex $W $t] + [lindex $K $t]}]
		set E $D
		set D $C
		set C [expr {($B << 30) | (($B >> 2) & 0x3fffffff)}]
		set B $A
		set A $TEMP
	    }
	    for {} {$t<80} {incr t} {
		set TEMP [expr {(($A << 5) | (($A >> 27) & 0x1f)) + \
			($B ^ $C ^ $D) \
			+ $E + [lindex $W $t] + [lindex $K $t]}]
		set E $D
		set D $C
		set C [expr {($B << 30) | (($B >> 2) & 0x3fffffff)}]
		set B $A
		set A $TEMP
	    }

	    set H0 [expr {int(($H0 + $A) & 0xffffffff)}]
	    set H1 [expr {int(($H1 + $B) & 0xffffffff)}]
	    set H2 [expr {int(($H2 + $C) & 0xffffffff)}]
	    set H3 [expr {int(($H3 + $D) & 0xffffffff)}]
	    set H4 [expr {int(($H4 + $E) & 0xffffffff)}]
	}

	return [format %0.8x%0.8x%0.8x%0.8x%0.8x $H0 $H1 $H2 $H3 $H4]
    }

    ### These procedures are either inlined or replaced with a normal [format]!
    #
    #proc ::sha1::f {t B C D} {
    #    switch [expr {$t/20}] {
    #	 0 {
    #	     expr {($B & $C) | ((~$B) & $D)}
    #	 } 1 - 3 {
    #	     expr {$B ^ $C ^ $D}
    #	 } 2 {
    #	     expr {($B & $C) | ($B & $D) | ($C & $D)}
    #	 }
    #    }
    #}
    #
    #proc ::sha1::byte0 {i} {expr {0xff & $i}}
    #proc ::sha1::byte1 {i} {expr {(0xff00 & $i) >> 8}}
    #proc ::sha1::byte2 {i} {expr {(0xff0000 & $i) >> 16}}
    #proc ::sha1::byte3 {i} {expr {((0xff000000 & $i) >> 24) & 0xff}}
    #
    #proc ::sha1::bytes {i} {
    #    format %0.2x%0.2x%0.2x%0.2x [byte3 $i] [byte2 $i] [byte1 $i] [byte0 $i]
    #}

    # hmac: hash for message authentication
    proc ::sha1::hmac {key text} {
	# if key is longer than 64 bytes, reset it to SHA1(key).  If shorter, 
	# pad it out with null (\x00) chars.
	set keyLen [string length $key]
	if {$keyLen > 64} {
	    set key [binary format H32 [sha1 $key]]
	    set keyLen [string length $key]
	}

	# ensure the key is padded out to 64 chars with nulls.
	set padLen [expr {64 - $keyLen}]
	append key [binary format "a$padLen" {}]

	# Split apart the key into a list of 16 little-endian words
	binary scan $key i16 blocks

	# XOR key with ipad and opad values
	set k_ipad {}
	set k_opad {}
	foreach i $blocks {
	    append k_ipad [binary format i [expr {$i ^ 0x36363636}]]
	    append k_opad [binary format i [expr {$i ^ 0x5c5c5c5c}]]
	}
    
	# Perform inner sha1, appending its results to the outer key
	append k_ipad $text
	append k_opad [binary format H* [sha1 $k_ipad]]

	# Perform outer sha1
	sha1 $k_opad
    }

##############
## zipper package for generating gzipped files
##############
namespace eval zipper {
  namespace export initialize addentry finalize

  namespace eval v {
    variable fd
    variable base
    variable toc
  }

  proc initialize {fd} {
    set v::fd $fd
    set v::base [tell $fd]
    set v::toc {}
    fconfigure $fd -translation binary -encoding binary
  }

  proc emit {s} {
    puts -nonewline $v::fd $s
  }

  proc dostime {sec} {
    set f [clock format $sec -format {%Y %m %d %H %M %S} -gmt 1]
    regsub -all { 0(\d)} $f { \1} f
    foreach {Y M D h m s} $f break
    set date [expr {(($Y-1980)<<9) | ($M<<5) | $D}]
    set time [expr {($h<<11) | ($m<<5) | ($s>>1)}]
    return [list $date $time]
  }

  proc addentry {name contents {date ""} {force 0}} {
    if {$date == ""} { set date [clock seconds] }
    foreach {date time} [dostime $date] break
    set flag 0
    set type 0 ;# stored
    set fsize [string length $contents]
    set csize $fsize
    set fnlen [string length $name]

    if {$force > 0 && $force != [string length $contents]} {
      set csize $fsize
      set fsize $force
      set type 8 ;# if we're passing in compressed data, it's deflated
    }

    if {[catch { zlib crc32 $contents } crc]} {
      set crc 0
    } elseif {$type == 0} {
      set cdata [zlib deflate $contents]
      if {[string length $cdata] < [string length $contents]} {
	set contents $cdata
	set csize [string length $cdata]
	set type 8 ;# deflate
      }
    }

    lappend v::toc "[binary format a2c6ssssiiiss4ii PK {1 2 20 0 20 0} \
    			$flag $type $time $date $crc $csize $fsize $fnlen \
			{0 0 0 0} 128 [tell $v::fd]]$name"

    emit [binary format a2c4ssssiiiss PK {3 4 20 0} \
    		$flag $type $time $date $crc $csize $fsize $fnlen 0]
    emit $name
    emit $contents
  }

  proc finalize {} {
    set pos [tell $v::fd]

    set ntoc [llength $v::toc]
    foreach x $v::toc { emit $x }
    set v::toc {}

    set len [expr {[tell $v::fd] - $pos}]
    incr pos -$v::base

    emit [binary format a2c2ssssiis PK {5 6} 0 0 $ntoc $ntoc $len $pos 0]

    return $v::fd
  }
}

########
### PDF report code
#######
proc add_window_to_pdf {pdf window {type {}}} {
  if {[winfo class $window] eq "Text"} {
    ### add Text items to pdf
    set text $window
    lassign  [$pdf getDrawableArea] pdf_w pdf_h
    # find the longest line and scale the font size down until the longest line fits in the pdf width
    set max_line 0
    set longest_line 1
    for {set i 1.0} {[$text compare $i < end]} {set i [$text index "$i+1line"]} {
      if {[regexp {[0-9]+\.([0-9]+)} [$text index "$i lineend"] -- line_length] && $max_line < $line_length} {
        set max_line $line_length
        set longest_line $i
      }
    }
    set line [$text get $longest_line "$longest_line lineend"]
    # set the max font size to 36 and scale down until the line fits
    set font_size 36
    set text_font [$text cget -font] 
    set font_name [pdf_make_font [font actual $text_font -family]]
    if {$font_name eq ""} {
      set font_name "Courier"
    }
    $pdf setFont $font_size $font_name
    while {[$pdf getStringWidth $line] > $pdf_w} {
      incr font_size -1
      $pdf setFont $font_size $font_name
    }
    #incr font_size
    #sputs font size $font_size
    set pdf_x_scaling [expr {1.0 * [$pdf getStringWidth $line]/ [font measure $text_font $line]}]
    set pdf_y_scaling [expr {1.0 * [$pdf getFontMetric height]/[font metrics $text_font -linespace]}]
    #sputs scaling $pdf_x_scaling $pdf_y_scaling
    if {$pdf_x_scaling > $pdf_y_scaling} {
      set pdf_y_scaling $pdf_x_scaling
    }
    set bg_formatted_tags [list]
    foreach tag [$text tag names] {
      if {([$text tag cget $tag -background] != "") && ($tag ne "sel")} {
        lappend bg_formatted_tags $tag
      }
    } 
    ## find the y pixel coordinate of the top of each line
    set start_y_list [list 0]
    set next_y 0
    for {set i 1} {$i < [$text index end]} {incr i} {
      incr next_y [$text count -ypixels [expr {1.0*$i}] [expr {1.0 * ($i+1)}]]
      lappend start_y_list $next_y
    }
    
    set char_x [$pdf getCharWidth A]
    set char_y [$pdf getFontMetric height]
    set char_y_descent 0;# [expr {[$pdf getFontMetric bboxt]*1}]
    #set lines_per_page [expr {floor($pdf_h/$char_y)}]
    set pdf_y_top [$pdf getFontMetric bboxt]
    #set pdf_y $pdf_y_top
    set startline 1.0
    set text_y_offset 0
    while {[$text compare $startline < end]} {
      $pdf startPage
      set endline $startline
      while {[expr {$endline + 1}] < [llength $start_y_list] && [expr {([lindex $start_y_list [expr {int($endline+1)}]] - $text_y_offset)* $pdf_y_scaling }] < $pdf_h} {
        set endline [expr {$endline + 1}]
      }

      if {$type eq "textarea" && [expr {int($endline) % 2}]} {set endline [expr {$endline -1}]}
      foreach tag $bg_formatted_tags {
        $pdf setFillColor [$text tag cget $tag -background]
        foreach {row1 col1 row2 col2} [split [$text tag ranges $tag] ". "] {
          for {set i $row1} {$i < $row2} {incr i} {
            if {($i < $startline)} {set col1 0; continue}
            if {($i > $endline)} break
            $pdf rectangle [expr {$col1*$char_x}] [expr {([lindex $start_y_list [expr {int($i-1)}]] - $text_y_offset)* $pdf_y_scaling }] [expr {[$pdf getStringWidth [$text get "$i.0" "$i.0 lineend"]]- $col1*$char_x}] [expr {$char_y}] -filled 1 -stroke 0
            set col1 0
          }
          if {($i >= $startline) && ($i<= $endline)} {
            $pdf rectangle [expr {$col1*$char_x}] [expr {([lindex $start_y_list [expr {int($i-1)}]] - $text_y_offset)* $pdf_y_scaling }] [expr {(($col2-$col1)*$char_x)}] [expr {$char_y}] -filled 1 -stroke 0
          }
        }
      } 
      ## add text lines
      $pdf setFillColor black
      for {set i $startline} {[$text compare $i <= $endline]} {set i [$text index "$i+1line"]} {
        $pdf setTextPosition 0 [expr {([lindex $start_y_list [expr {int($i-1)}]] - $text_y_offset)* $pdf_y_scaling + $pdf_y_top}]
        $pdf text [$text get $i "$i lineend"]
        if {[$text compare $i == end]} {break}
      }
      
      ## add inline canvases
      foreach {-- c ix} [$text dump -window $startline $endline+1c] {
        #sputs can $startline $ix $c [expr {([lindex $start_y_list [expr {int($ix-1)}]] - $text_y_offset)* $pdf_y_scaling + $pdf_y_top}]
        $pdf canvas $c -x 0 -y [expr {([lindex $start_y_list [expr {int($ix-1)}]] - $text_y_offset)* $pdf_y_scaling }] -height [expr {([lindex $start_y_list [expr {int($ix)}]] -[lindex $start_y_list [expr {int($ix-1)}]] )* $pdf_y_scaling}] -bbox [$c cget -scrollregion]
      }

      set startline [expr {$endline +1}]
      #while {[$text compare $startline < end] && [$text get $startline "$startline lineend"] eq {}} {
       # sputs blank line $startline
      #  set startline [expr {$startline +1}]
      #}
      set text_y_offset [expr {[lindex $start_y_list [expr {int($endline)}]]}]
      #set pdf_y [$pdf getFontMetric bboxt]
    }
  } elseif {$type eq "abi"} {
    ## add paginated abi items to pdf
    global info abi_info
    set c $window
    foreach {pdf_w pdf_h} [$pdf getDrawableArea] {}
    set print_width [expr {$pdf_w/72}]
    set print_height [expr {$pdf_h/72}]
    foreach {xmin ymin xmax ymax} [$c cget -scrollregion] {}
    set ymin [expr {($ymin <= 0) ? 0 : $ymin}]
    set w [winfo toplevel $c]
    set linespace 0.5
    set line_height_inches [expr {1.0*($print_height-$linespace*($info(print_abi_lines_per_page)-1))/$info(print_abi_lines_per_page)}]

    set ppi [expr {1.0* ($ymax-$ymin)/$line_height_inches}]
    set line_width_abi_pixels [expr {int($print_width * $ppi)}] 
    set total_lines [expr {int(ceil (1.0*($xmax- $xmin) / $line_width_abi_pixels))}]
    set total_pages [expr {int(ceil (1.0*$total_lines/$info(print_abi_lines_per_page)))}]
    set print_x0 0
    set Aline [$c coords [$c find withtag {trace && A}]]
    set Cline [$c coords [$c find withtag {trace && C}]]
    set Gline [$c coords [$c find withtag {trace && G}]] 
     set Tline [$c coords [$c find withtag {trace && T}]] 
    if {$abi_info($w,rev_com)} {
      set trace_i 1
      set Aline [lreverse $Aline]
      set Cline [lreverse $Cline]
      set Gline [lreverse $Gline] 
      set Tline [lreverse $Tline]
    } else {
      set trace_i 0
    }
    if {[winfo exists .c]} {destroy .c}
    set c1 [canvas .c]
    for {set page 0} {$page < $total_pages} {incr page} {
      #$c1 delete all
      canvas_delete_all $c1
      set print_y0 0
      for {set l 0} {($l<$info(print_abi_lines_per_page) && ($print_x0< $xmax) )} {incr l} {
        set print_x1 [expr {min($xmax, ($print_x0+$line_width_abi_pixels))}]
        set linewidth [expr {$print_x1 - $print_x0}]
        set print_y1 [expr {$print_y0+$line_height_inches*$ppi}]
        $c1 create rectangle 0 $print_y0 [expr {$print_x1-$print_x0}] $print_y1 -outline black
        set Acoords [list];set Ccoords [list];set Gcoords [list];set Tcoords [list];
        for {set trace_i $trace_i} {($trace_i < [llength $Aline]) && ([lindex $Aline $trace_i] < $print_x1)} {incr trace_i [expr {$abi_info($w,rev_com)?3:1}]} {
#concat over lappend here? could get an lrange of the coords and lset elements over ymin
          lappend Acoords [expr {[lindex $Aline $trace_i]-$print_x0}]
          lappend Ccoords [expr {[lindex $Cline $trace_i]-$print_x0}]
          lappend Gcoords [expr {[lindex $Gline $trace_i]-$print_x0}]
          lappend Tcoords [expr {[lindex $Tline $trace_i]-$print_x0}]
          incr trace_i [expr {$abi_info($w,rev_com)?-1:1}]
          lappend Acoords [expr {max($ymin,[lindex $Aline $trace_i]+$print_y0)}]
          lappend Ccoords [expr {max($ymin,[lindex $Cline $trace_i]+$print_y0)}]
          lappend Gcoords [expr {max($ymin,[lindex $Gline $trace_i]+$print_y0)}]
          lappend Tcoords [expr {max($ymin,[lindex $Tline $trace_i]+$print_y0)}]
        }
        $c1 create line {*}$Acoords -fill [$c itemcget [$c find withtag {trace && A}] -fill]
        $c1 create line {*}$Ccoords -fill [$c itemcget [$c find withtag {trace && C}] -fill]
        $c1 create line {*}$Gcoords -fill [$c itemcget [$c find withtag {trace && G}] -fill]
        $c1 create line {*}$Tcoords -fill [$c itemcget [$c find withtag {trace && T}] -fill]
        foreach element [$c find overlapping $print_x0 $ymin $print_x1 $ymax] {
          if {[$c type $element] eq "text"} {
            $c1 create text [expr {[lindex [$c coords $element] 0]-$print_x0}] [expr {[lindex [$c coords $element] 1]-$ymin+$print_y0}] -text [$c itemcget $element -text] -fill [$c itemcget $element -fill] -anchor n
          }
        }
        set print_x0 [expr {1 + $print_x1}]
        set print_y0 [expr {$print_y1 + $linespace * $ppi}]
      }
      $pdf startPage
#sputs $linewidth $ppi  $line_height_inches $pdf_w $pdf_h $print_width $print_height $line_width_abi_pixels
      $pdf canvas $c1 -x 0 -y 0 -width [expr {$pdf_w}] -sticky nw
    }
    destroy $c1
  } else {
    ## canvas item
    $pdf startPage
    foreach {pdf_w pdf_h} [$pdf getDrawableArea] {}
    $pdf canvas $window -x 0 -y 0 -width $pdf_w -height $pdf_h -sticky nw -bg 1 -fontmap [pdf_make_canvas_dict $window]
  }
}

##############
##
###############
## On mac glob search /Library/Fonts /Library/Fonts/Microsoft /System/Library/Fonts and ~/Library/Fonts for ttf files to match anything in the Text or canvas font to build a pdf ttfont dictionary
## On windows search $env(windir)/Fonts
proc pdf_make_font {tk_font {subset0 {}}} {
  global env
  set basefont [font actual [list $tk_font] -family]
  set basefont_use [regsub -all {[^A-Z,a-z]} $basefont ""]

  for {set f 0} {$f < 128} {incr f} {lappend subset $f}
  foreach ch $subset0 {
    if {$ch >=128} {
      lappend subset $ch
    }
  }
  if {[tk windowingsystem] == "win32"} {
    foreach bf [list $basefont [regsub -all { } $basefont ""] [regsub -all { } $basefont "_"]] {
      if {[set ttf_file [glob -nocomplain $env(windir)/Fonts/$bf.{ttf,ttc}]] != {}} {
        pdf4tcl::loadBaseTrueTypeFont BaseFont $ttf_file
        pdf4tcl::createFont BaseFont $basefont_use iso8859-1
        return $basefont_use
      } else {
        return ""
      }
    }
  } elseif {[tk windowingsystem] == "aqua"} {
    foreach bf [list [regsub -all { } $basefont " "] [regsub -all { } $basefont ""] [regsub -all { } $basefont "_"]] {
      foreach dir [list "/Library/Fonts/" "/Library/Fonts/Microsoft/" "/System/Library/Fonts/" "/System/Library/Fonts/Supplemental/"  [file join $env(HOME) "Library/Fonts/"]] {
        if {[catch {file join $env(HOME) "Library/Fonts/"} dir]} {continue}
        if {[set ttf_file [lindex [glob -nocomplain "$dir$bf.{ttf,ttc}"] 0]] != {} } {
          ## found base font file
          if {[catch {pdf4tcl::loadBaseTrueTypeFont "Base$basefont_use" $ttf_file}]} {
            return ""
          } else {
            if {[catch {pdf4tcl::createFontSpecEnc "Base$basefont_use" $basefont_use $subset} err]} {
              sputs "pdf error:$basefont $err"
              return ""
            } else {
              #sputs new_pdf_font $basefont_use $subset
              return $basefont_use 
            }
          }
        }
      }
    }
    return ""
  }
  return ""
}

##############
##
###############
proc pdf_make_canvas_dict {c} {
  set result [list]
  set missing [list]
  ## build subset of characters for each font family
  set subset [dict create]
  set font_list [list]
  foreach item [$c find all] {
    if {[$c type $item] eq "text"} {
      set font [$c itemcget $item -font]
      lappend font_list $font
      set font_family [font actual $font -family]
      if {$font_family eq ""} {continue}
      foreach char [split [$c itemcget $item -text] ""] {
        dict lappend subset $font_family [scan $char %c]
      }
    }
  }
  set family_dict [dict create]
  foreach font $font_list {
    set font_family [font actual $font -family]
    set font_size  [font actual $font -size]
    if {![dict exists $family_dict $font_family]} {
      if {[set pdf_font [pdf_make_font $font_family [lrange [lsort -integer -unique [dict get $subset $font_family]] 0 255]]] eq {}} {
        dict set family_dict $font_family "Helvetica"
      } else {
        dict set family_dict $font_family $pdf_font
      }
    }

    if {[font actual $font -weight] eq "bold"} {
      if {[font actual $font -slant] eq "italic"} {
        dict set result $font [list "Helvetica-BoldOblique" $font_size]
      } else {
        dict set result $font [list "Helvetica-Bold" $font_size]
      }
    } elseif {[font actual $font -slant] eq "italic"} {
      dict set result $font [list "Helvetica-Oblique" $font_size]
    } elseif {[dict get $family_dict $font_family] != ""} { 
      dict set result $font [list [dict get $family_dict $font_family] $font_size]
    } else {
      lappend missing $font_family
    }
  }

  if {$missing ne [list]} {
    #puts "pdf fonts not found:$missing"
  } 
   # sputs "pdf canvas dict: $result"
  return $result
}

##############
## LabArchive cloud storage interface
##############
###########
## basic access code- suplies security signature to all URLs
###########
proc labarchive_access {la_api_class la_api_method {querry_list {}}} {
  global info
  set la_akid wayne_davis_ape
  set la_akid_pass {56t$fvce1ifhenr89787$fghfjvndqapE3$87}
  set la_expires [clock milliseconds]
  set la_sig [base64::encode [binary format H* [::sha1::hmac $la_akid_pass "$la_akid$la_api_method$la_expires"]]]
  set url "https://$info(la_api)/api/$la_api_class/$la_api_method?[::http::formatQuery {*}$querry_list akid $la_akid expires $la_expires sig $la_sig]"
#sputs $url
  lassign [get_html $url] error html
  if {$error ne "ok" || $html eq {}} {
    return {}
  }
  return $html
}

###########
## proc to parse XML into dict via recursion- attributes are not passed through
###########
proc xml_parse {r} {
  if {[regexp {<\?xml [^>]*\?>(.*)} $r -- r]} {
    return [xml_parse $r]
  } elseif {[regexp {^([\n\s]*)<([^\s>]+?)\s([^>]*)/>(.*)} $r -- pre empty_tag attrs tail]} {
      return [list $empty_tag {} {*}[xml_parse $tail]]
  } elseif {[regexp {^([\n\s]*)<([^\s>]+)\s?([^>]*)>(.*?)</\2>(.*)$} $r -- pre tag attrs inner tail]} {
      return [list $tag [xml_parse $inner] {*}[xml_parse $tail]]
  } elseif {[regexp {^([\n\s]*)(.*)$} $r -- pre contents]} {
      return $contents
  } else {
    sputs not parsed- $r
    return
  }
}

###########
## Fill LabAcrchive Tree Directory Display
###########
proc labarchive_fill_treeview {t extension_list} {
  global info
  $t delete [$t children {}]
  set please_wait_item [$t insert {} 0 -text [mc "Please Wait..."] -values [list] -tags please_wait]
  update idletasks
  set r [labarchive_access search_tools most_recently_modified_attachment_by_extension [list uid $info(la_uid) entry_data true max_to_return 10000 extension $extension_list]]
  set d [xml_parse $r]

  if {[dict exists $d search-tools results total-returned] && [dict get $d search-tools results total-returned] > 0 && [dict exists $d search-tools entries]} {
    foreach {e entry_data} [dict get $d search-tools entries] {
      #sputs [dict get $entry_data notebook]  [dict get $entry_data tree-path] [dict get $entry_data attach-file-name]  [dict get $entry_data nbid] [dict get $entry_data eid]
      if {[dict exists $entry_data last-modified-verb] && [dict get $entry_data last-modified-verb] eq "deleted"} {
        continue
      }
      set attach_file_name [dict get $entry_data attach-file-name]
      set eid [dict get $entry_data eid]
      if {[dict exists $entry_data notebook]} {
        set nb [dict get $entry_data notebook]
        set nbid [dict get $entry_data nbid]
        set tree_path_ids [dict get $entry_data tree-path-ids]
        set tree_path [dict get $entry_data tree-path]
      } elseif {[dict exists $entry_data tree-path] && [dict get $entry_data tree-path] eq "Inbox"} {
        set nb "Inbox"
        set nbid 0
        set tree_path_ids {}
        set tree_path {}
      } else {
        set nb "Unknown"
        set nbid -1
        set tree_path_ids {}
        set tree_path {}
      }
      set nb_index {}
      foreach c [$t children {}] {
        if {[lindex [$t item $c -values] 0] eq $nbid} {
          set nb_index $c
          break
        }
      }
      if {$nb_index eq {}} {
        set nb_index [$t insert {} end -text $nb -values [list $nbid $nbid] -open 1 -tags NB]
      }

      set parent_index $nb_index
      foreach p [file split $tree_path]  pid [file split $tree_path_ids] {
        set path_index {}
        foreach c [$t children $parent_index] {
          if {[$t item $c -text] eq $p} {
            set path_index $c
            break
          }
        }
        if {$path_index eq {}} {
          set path_index [$t insert $parent_index end -text $p -values [list $pid $nbid] -open 1 -tags Path]
        }
        set parent_index $path_index
      }
      set file_index [$t insert $parent_index end -text $attach_file_name -values [list $nbid $eid] -tags Attachment]
    }
  }
  if {[info exists please_wait_item]} {
    $t delete $please_wait_item
  }
}

###### login/ change user
###### user_access_info
proc labarchive_login {w} {
  global info ok dialogblock user_email user_pwd
  if {$dialogblock == 1} {return}

  set s [new_dialog $w "Loging In To LabArchive..." "LOGIN"]
  bind $s <<Cancel>> "set ok -1"
  bind $s <<OK>> "set ok 1"
  set ok 0

  grid [label $s.uid_label -text [mc "User ID (email):"]] -row 0 -column 0 -sticky e
  grid [entry $s.uid -width 30 -textvariable user_email -selectforeground $info(text_select_fg_color) -selectbackground $info(text_select_bg_color) -foreground $info(text_fg_color) -background $info(text_bg_color) -font labelfont] -row 0 -column 1
  grid [label $s.pswd_label -text [mc "Password:"]] -row 1 -column 0 -sticky e
  grid [entry $s.pswd -width 30 -textvariable user_pwd -selectforeground $info(text_select_fg_color) -selectbackground $info(text_select_bg_color) -foreground $info(text_fg_color) -background $info(text_bg_color) -font labelfont] -row 1 -column 1
  if {![info exists info(la_show_password)]} {
    set info(la_show_password) 0
  }
  grid [checkbutton $s.pswd_show -text [mc "Show Password"] -onvalue 1 -offvalue 0 -variable info(la_show_password) -command "if {\$info(la_show_password)} {$s.pswd configure -show {}} else {$s.pswd configure -show *}"] -row 2 -columnspan 1 -column 1 -sticky we

  if {$info(la_show_password)} {
    $s.pswd configure -show {}
  } else {
    $s.pswd configure -show *
  }
  if {![info exists info(la_store_password)]} {
    set info(la_store_password) 0
  }
  grid [checkbutton $s.pswd_retain -text [mc "Store Password After Closing ApE"] -onvalue 1 -offvalue 0 -variable info(la_store_password)] -row 3 -columnspan 1 -column 1 -sticky we

  if {![info exists info(la_api)]} {
    set info(la_api) "api.labarchives.com"
  }
  grid [label $s.api_label -text [mc "LabArchives URL:"]] -row 4 -column 0 -sticky e
  grid [ttk::combobox $s.api -width 30 -textvariable info(la_api) -values [list "api.labarchives.com" "auapi.labarchives.com"]] -row 4 -column 1

  if {!$info(android)} {
    grid [frame $s.okframe] -row 5 -column 1 -sticky nswe
    grid [button $s.okframe.cancel -text [mc "Cancel"] -command "set ok -1"] -row 1 -column 0 -sticky nw -padx 10 -pady 3
    grid [button $s.okframe.ok -text [mc "OK"] -command "set ok 1" -default active] -row 1 -column 1 -sticky nw -padx 10 -pady 3
  }

  wm resizable [winfo toplevel $s] 0 0
  focus $s
  vwait ok

  if {$ok == 1} {
    set r [labarchive_access users user_access_info [list login_or_email $user_email password $user_pwd]]
    set d [xml_parse $r]
    if {![dict exists $d users id]} {
      sputs no LA ID found
      set la_uid {}
    } else {
      set la_uid [dict get $d users id] 
    }
    set info(la_uid) $la_uid
  }

  destroy $s
  set dialogblock 0
  bind . <<RaiseDialogs>> ""
  unset ok  user_email user_pwd
}


###########
#####  attachment_download
###########
proc labarchive_download_dialog {w} {
  global info ok dialogblock env

  if {![info exists info(la_uid)] || $info(la_uid) eq {} } {
    labarchive_login $w
  }
  if {![info exists info(la_uid)] || $info(la_uid) eq {} } {
    return
  }

  if {$dialogblock == 1} {return}
  set s [new_dialog $w  "Download Files From LabArchive..." "DOWNLOAD"]
  bind $s <<Cancel>> "set ok -1"
  bind $s <<OK>> "set ok 1"
  grid [set t [ttk::treeview $s.tv]] -row 0 -column 0 -sticky nswe
  grid columnconfigure $s 0 -weight 1
  grid rowconfigure $s 0 -weight 1
  $t configure -columns {NBID ID}
  $t configure -displaycolumns {}
  $t heading #0 -text [mc "Name"]
  $t column #0 -width 200 -minwidth 50 -stretch 1 -anchor w
  $t heading NBID -text NBID
  $t column NBID -width 60 -minwidth 50 -stretch 0 -anchor c
  $t heading ID -text ID
  $t column ID -width 150 -minwidth 50 -stretch 0 -anchor c
  $t tag configure NB -background gray70
  $t tag configure Path -background #FFFFCC

  bind $t <<TreeviewSelect>> {
    foreach la_c [%W selection] {
      if {[%W item $la_c -tags] ne "Attachment"} {
        %W selection remove $la_c
      }
    }
    unset -nocomplain la_c
  }

  if {![info exists info(la_extension_list)]} {
    set info(la_extension_list) "ape,gb,dna,str,seq,abi,ab1,scf"
  }
  grid [frame $s.extensionsframe] -row 2 -column 0 -sticky nswe
  grid [label $s.extensionsframe.ext_label -text [mc "Search For Extensions:"]] -row 0 -column 0 -sticky e
  grid [entry $s.extensionsframe.ext -width 30 -textvariable info(la_extension_list) -selectforeground $info(text_select_fg_color) -selectbackground $info(text_select_bg_color) -foreground $info(text_fg_color) -background $info(text_bg_color) -font labelfont -validate key ] -row 0 -column 1 -sticky ew
  grid [button $s.extensionsframe.refresh -width 10 -text [mc {Refresh List}] -font labelfont -command "labarchive_fill_treeview $s.tv \$info(la_extension_list)"] -row 0 -column 2
  grid columnconfigure $s.extensionsframe 1 -weight 1

  if {![info exists info(la_download_folder)] || ![file exists $info(la_download_folder)]|| ![file writable $info(la_download_folder)]} {
    set info(la_download_folder) $env(HOME)
  }
  grid [frame $s.downlaodframe] -row 3 -column 0 -sticky nswe
  grid [label $s.downlaodframe.folder_label -text [mc "Download to Folder:"]] -row 0 -column 0 -sticky e
  grid [entry $s.downlaodframe.folder -width 30 -textvariable info(la_download_folder) -selectforeground $info(text_select_fg_color) -selectbackground $info(text_select_bg_color) -foreground $info(text_fg_color) -background $info(text_bg_color) -font labelfont] -row 0 -column 1 -sticky ew
  grid [button $s.downlaodframe.changefolder -width 10 -text [mc {Change Folder}] -font labelfont -command {set la_temp [tk_chooseDirectory]; if {[file exists $la_temp]} {set info(la_download_folder) $la_temp}; unset la_temp}] -row 0 -column 2
  grid columnconfigure $s.downlaodframe 1 -weight 1


  grid [frame $s.okframe] -row 4 -column 0 -sticky nswe
  if {!$info(android)} {
    grid [button $s.okframe.cancel -text [mc "Cancel"] -command "set ok -1"] -row 1 -column 0 -sticky nw -padx 10 -pady 3
    grid [button $s.okframe.ok -text [mc "OK"] -command "set ok 1" -default active] -row 1 -column 1 -sticky nw -padx 10 -pady 3
  }
  grid [button $s.okframe.change_user -text [mc "Change User"] -command "set ok 2" -default active] -row 1 -column 2 -sticky nw -padx 10 -pady 3
  grid columnconfigure $s.okframe 1 -weight 1
  grid columnconfigure $s.okframe 0 -weight 1

  labarchive_fill_treeview $s.tv $info(la_extension_list)


  focus $s
  vwait ok

  if {$ok == 1} {
    # download files:
    foreach item [$s.tv selection] {
      if {[$s.tv item $item -tags] eq "Attachment"} {
        #sputs [$s.tv item $item -text] [lindex [$s.tv item $item -values] 1]
        set filename [$s.tv item $item -text]
        set eid [lindex [$s.tv item $item -values] 1]

        set file_data [labarchive_access entries entry_attachment [list uid $info(la_uid) eid $eid]]
        set data_file_ptr [open [file join $info(la_download_folder) $filename] w]
        fconfigure $data_file_ptr -translation binary
        puts $data_file_ptr $file_data
        close $data_file_ptr
      }
    }
  }

  destroy $s
  set dialogblock 0
  bind . <<RaiseDialogs>> ""
  if {$ok == 2} {
    unset ok
    set info(la_uid) {}
    labarchive_download_dialog $w
  }
  unset -nocomplain ok
}

###########
##### save files:
  ######### add_attachment
###########
proc labarchive_upload_dialog {w} {
  global info ok dialogblock abi_info

  if {![info exists info(la_uid)] || $info(la_uid) eq {} } {
    labarchive_login $w 
  }

  if {![info exists info(la_uid)] || $info(la_uid) eq {} } {
    return
  }

  if {$dialogblock == 1} {return}
  set s [new_dialog $w "Upload Files To LabArchive..." "UPLOAD"]
  bind $s <<Cancel>> "set ok -1"
  bind $s <<OK>> "set ok 1"
  wm resizable [winfo toplevel $s] 1 1


  set ok 0

  grid [set t [ttk::treeview $s.tv]] -row 0 -column 0 -sticky nswe
  grid columnconfigure $s 0 -weight 1
  grid rowconfigure $s 0 -weight 1
  $t configure -columns {window}
  $t configure -displaycolumns {}
  $t heading #0 -text [mc "Name"]
  $t column #0 -width 200 -minwidth 50 -stretch 1 -anchor w
  #$t heading NBID -text NBID
  #$t column NBID -width 60 -minwidth 50 -stretch 0 -anchor c
  ### fill treeview
  foreach win [winfo children .] {
    if {[string match "*_analysis*" $win]} {
      set linked $info($win,linked_windows)
      foreach item [$t children {}] {
        if {[lsearch -exact $linked [lindex [$t item $item -values] 0]] > -1} {
          $t insert $item 0 -text [wm title $win] -values [list $win] -open 1 -tags Analysis
        }
      }
    } elseif {[string match ".dna_window*" $win]} {
      if {$info($win,saved) && [file exists $info($win,filename)]} {
        $t insert {} 0 -text [wm title $win] -values [list $win] -open 1 -tags DNA
      }
    } elseif {[string match ".abi_window*" $win]} {
      if {[info exists abi_info($win,filename)] && [file exists $abi_info($win,filename)]} {
        $t insert {} 0 -text [wm title $win] -values [list $win] -open 1 -tags ABI
      }
    }
  }

  bind $t <<TreeviewSelect>> {
    foreach la_c [%W selection] {
      if {[%W item $la_c -tags] eq "Analysis" && ([lsearch -exact [%W selection] [%W parent $la_c]] == -1)} {
        %W selection add [%W parent $la_c]
      }
    }
    unset -nocomplain la_c
  }

  ## need to write drag and drop to re-order analysis windows within children, also allow abi to be added as an analysis window?
  if {!$info(android)} {
    grid [frame $s.okframe] -row 3 -column 0 -sticky nswe
    grid [button $s.okframe.cancel -text [mc "Cancel"] -command "set ok -1"] -row 1 -column 0 -sticky nw -padx 10 -pady 3
    grid [button $s.okframe.ok -text [mc "OK"] -command "set ok 1" -default active] -row 1 -column 1 -sticky nw -padx 10 -pady 3
  }

  wm resizable [winfo toplevel $s] 1 1
  focus $s
  vwait ok

  if {$ok == 1} {
    set c_dir [labarchive_generate_containers $s.tv]
    set la_akid wayne_davis_ape
    set la_akid_pass {56t$fvce1ifhenr89787$fghfjvndqapE3$87}
    set la_api_class entries
    set la_api_method add_attachment

    set zip_count 0
    set err_list [list]
    while {[file exists [set datafile [file join $c_dir "ApE_zip_$zip_count.zip"]]] && $zip_count < 1000} {
      set querry_list [list uid $info(la_uid) filename $datafile]
      set la_expires [clock milliseconds]
      set la_sig [base64::encode [binary format H* [::sha1::hmac $la_akid_pass "$la_akid$la_api_method$la_expires"]]]
      set url "https://$info(la_api)/api/$la_api_class/$la_api_method?[::http::formatQuery {*}$querry_list akid $la_akid expires $la_expires sig $la_sig]"
      if { $info(tls) eq "tls" } {
        ## version with direct tls channel access
        set data [open $datafile r]
        fconfigure $data -translation binary
        set x [::http::geturl $url -timeout 4000 -type "application/octet-stream" -querychannel $data]
        set html  [::http::data $x]
        ::http::cleanup $x
        #return $html
        close $data
      } else {
        ## need to use cURL here
        #sputs upload curl
        set f "@[file nativename $datafile]"
        if {[catch {exec curl -s -S $url -H "Content-Type: application/octet-stream"  --data-binary $f} html err]} {
          lappend err_list  [list $err $datafile]
          sputs $err $datafile
        } elseif {![regexp {<method>add_attachment</method>} $html]} {
          sputs  not uploaded\n$datafile\n $html
          lappend err_list  [list $err $datafile]
        } else {
          #sputs  "ok" $html
        }
      }
      incr zip_count
    }
    if {$err_list ne [list]} {
      tk_messageBox -title [mc "Labarchive upload errors..."] -message [mc {There were %1$s errors uploading files.} [llength $err_list]] -type ok 
    }
  }
  destroy $s
  set dialogblock 0
  bind . <<RaiseDialogs>> ""
  unset ok 
}


############
## generate LA container files
###########
proc labarchive_generate_containers {t} {
  global info abi_info toolbar_images
  set temp_dir [tempdir]
  set c_dir [file join $temp_dir "LA_container_files"]
  if {[file exists $c_dir]} {
    file delete -force $c_dir
  }
  file mkdir $c_dir
  set sel [$t selection]
  set zip_count 0

#update
  foreach w_item [$t children {}] {
    if {[lsearch -exact $sel $w_item] > -1} {
      set cont_dir [file join $c_dir "LA_container_temp"]
      if {[file exists $cont_dir]} {
        file delete -force $cont_dir
      }
      file mkdir $cont_dir
      set w [lindex [$t item $w_item -values] 0]
      set index_content {}
      set child_items [$t children $w_item] 
      if {[string match ".abi_window*" $w]} {
        set child_items [concat $w_item $child_items]
        if {[info exists abi_info($w,filename)] && [file exists $abi_info($w,filename)]} {
          file copy $abi_info($w,filename) $cont_dir
          set app_filename [file tail $abi_info($w,filename)]
        } else {
          sputs "error - abi file must be saved to make a manifest file"
          continue
        }
        set index_content $abi_info($w,basecall,edited)
      } elseif {[string match ".dna_window*" $w]} {
        if {$info($w,saved) && [file exists $info($w,filename)]} {
          file copy $info($w,filename) $cont_dir
          set app_filename [file tail $info($w,filename)]
        } else {
          sputs "error - file must be saved to make a manifest file"
          continue
        }
        set index_content [textarea_get $w.textarea 1.0 end]
        append index_content "\n[revcom [textarea_get $w.textarea 1.0 end]]"
         ##### to work on- needs to append for circular; possibly needs to do uppercase and lowercase versions if case sensitive searching
        foreach tag [$w.textarea tag names] {
          if {([regexp {f[0-9]+#} $tag]) && ([llength [$w.textarea tag ranges $tag]] > 1)} {
            append index_content "\n[lindex [$w.textarea tag bind $tag <<Metadata>>] 0]"
          }
        }
      }
      set index_file [open [file join $cont_dir "index.txt"] w]
      puts $index_file $index_content
      close $index_file
      set preview_file {}
      foreach ch_item $child_items {
        if {[lsearch -exact $sel $ch_item] > -1} {
          if {$preview_file eq {}} {
            set preview_file [file join $cont_dir "pdf_preview.pdf"]
            ::pdf4tcl::new pdf
            pdf configure -margin {36 36} -paper letter
          }
          set ch_w [lindex [$t item $ch_item -values] 0]
          if {[winfo exists $ch_w.textframe.text]} {
             add_window_to_pdf pdf $ch_w.textframe.text
           } elseif {[winfo exists $ch_w.canvas]} {
             add_window_to_pdf pdf $ch_w.canvas
           } elseif {[winfo exists $ch_w.c]} {
             add_window_to_pdf pdf $ch_w.c abi
           } else {
             sputs Warning: missing analyisis window: $ch_w
           }
        }
      }
      if {$preview_file eq {}} {
        set preview_file [$toolbar_images(monkey_icon) cget -file]
        file copy $preview_file $cont_dir
      } else {
        pdf write -file $preview_file
        pdf destroy
      }
      set preview_file [file tail $preview_file]
      set manifest_content "<?xml version=\"1.0\" encoding=\"utf-8\" ?>\n<la_manifest>\n  <entry_info >\n    <application_file name=\"$app_filename\"/>\n    <preview_file name=\"$preview_file\" />\n    <index_file name=\"index.txt\"/>\n  </entry_info>\n</la_manifest>"
      set manifest_file [open [file join $cont_dir "lamanifest.xml"] w]
      puts $manifest_file $manifest_content
      close $manifest_file
      ## zip $cont_dir
      while {[file exists [file join $c_dir "ApE_zip_$zip_count.zip"]] && $zip_count < 1000} {
        incr zip_count
      }
      set zip_file [file join $c_dir "ApE_zip_$zip_count.zip"]
      zipper::initialize [open $zip_file w]

      set dirs [list $cont_dir]
      while {[llength $dirs] > 0} {
        set d [lindex $dirs 0]
        set dirs [lrange $dirs 1 end]
        foreach f [lsort [glob -nocomplain [file join $d *]]] {
          if {[file isfile $f]} {
    	    regsub {^\./} $f {} f
            set fd [open $f]
	    fconfigure $fd -translation binary -encoding binary
	    zipper::addentry [file tail $f] [read $fd] [file mtime $f]
	    close $fd
          } elseif {[file isdir $f]} {
            lappend dirs $f
          }
        }
      }
      close [zipper::finalize]
    }
  }
  return $c_dir
}

##############
## Speak texts spacebar to start/stop arrows to slow or speed
##############
proc speak_dialog {w} {
  global info
  global ok dialogblock
  if {$dialogblock == 1} {return}
  set s [new_dialog $w "Speak Texts..."]
  bind $s <<Cancel>> "set ok -1"
  bind $s <<OK>> "set ok 1"
  grid [label $s.inst -text [mc "Use left arrow to slow,\n right to accelerate,\n space to start and stop."]] -row 1 -column 1 -columnspan 2
  grid [label $s.dellabel -text [mc "Speed (ms):"]] -row 2 -column 1
  grid [label $s.delentry -textvariable info(speak_delay)  -width 5 -justify right] -row 2 -column 2 -sticky w
  grid [button $s.speakbutton -text [mc "Start Speaking"] -command "if {!\[info exists info($w,speak_cancel)\]} {speak $w -1; $s.speakbutton configure -text {[mc {Stop Speaking}]};} else {speak $w stop; $s.speakbutton configure -text {[mc {Start Speaking}]}}
"] -row 3 -column 2
  bind $s <<StopSpeaking>>  "$s.speakbutton configure -text [mc {Start Speaking}]"
  bind $s <Key-space> "$s.speakbutton invoke"
  bind $s <Key-Left> {set info(speak_delay) [expr {$info(speak_delay) + 250}]}
  bind $s <Key-Right> {if {$info(speak_delay) > 500} {set info(speak_delay) [expr {$info(speak_delay) - 250}]}}
  grid [button $s.okbutton -text [mc Done] -default active -command "set ok 1"] -row 4 -column 2
  bind $s <Key-Return> "$s.okbutton invoke"
  vwait ok
  speak $w stop
  set dialogblock 0
  bind . <<RaiseDialogs>> ""
  destroy $s 
}

##############
## Speak texts
##############
proc speak {w i} {
  global info

  if {$i == "stop"} {
    catch {after cancel $info($w,speak_cancel)}
    array unset info "$w,speak_cancel"
    if {[winfo exists .dialog]} {event generate .dialog <<StopSpeaking>>}
    return
  }

  if {[regexp {.abi_window[0-9]+} $w] && ($i < [llength [$w.c find withtag basecall]])} {
    set char [$w.c itemcget [lindex [$w.c find withtag basecall] $i] -text]
    abi_select_region $w $i $i
  } elseif {[regexp {.dna_window[0-9]+} $w] && ![regexp {analysis} $w] && ([$w.textarea compare [bp2ix $w.textarea $i] < [end_ix $w.textarea]])} {
    if {($i == -1)} {
      if {([$w.textarea tag ranges sel] != "")} {
#selection used here - ok
        if {[llength [$w.textarea tag ranges sel]] > 2} {
          set i [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 2]]
        } else {
          set i [ix2bp $w.textarea [$w.textarea index sel.first]]
        }
      } else {
        set i [ix2bp $w.textarea [$w.textarea index insert]]
      }
    }
    set char [textarea_get $w.textarea [bp2ix $w.textarea $i] [bp2ix $w.textarea [expr {$i+1}]]]
    select_region $w [bp2ix $w.textarea $i] [bp2ix $w.textarea [expr {$i+1}]]
  } else {
    if {[end_ix $w.textarea] eq 1.0} {
      set info($w,speak_cancel) "empty text"
    }
    set char ""
  }

  if {$char != ""} {
    if  {[tk windowingsystem] == "aqua"} {
      if {$info(speak_use_words)} {
        set speech_char [string map {A alpha B bravo C charlie D delta G golf H hotel K kilo M mike N november R romeo S sierra T tango U uniform V victor W wiskey Y yankee} [string toupper $char]]
      } else {
        set speech_char  [string map {* N a ay A ay} $char]
      }
        #speech::speak   -voice $info(speak_voice)
      if {[catch {exec say -v $info(speak_voice) $speech_char} err]} {
          array unset info "$w,speak_cancel"
	  if {[winfo exists .dialog]} {event generate .dialog <<StopSpeaking>>}
          return
     }
    } elseif {[info commands snack::sound] != {}} {
       if {[catch {$sound(letters,[string map {* N} $char]) play} err]} {
	 array unset info "$w,speak_cancel"
	 if {[winfo exists .dialog]} {event generate .dialog <<StopSpeaking>>}
         return
       }
    } else {
      return
    }
    set info($w,speak_cancel) [after $info(speak_delay) "speak $w [expr {$i+1}]"]
  } else {
    array unset info "$w,speak_cancel"
    if {[winfo exists .dialog]} {event generate .dialog <<StopSpeaking>>}
  }
}

##############
## Load sound files referenced by a global sound array
##############
proc load_snack_sounds {} {
  global sounds info
  if {[info exists sounds] && ([array names sounds *leters,*] != {})} {
    return 1
  } else {
    set loaded 0
    foreach char [split ABCDGHKMNRSTUVWY ""] {
      if {[file exists [file join $info(Accdir) "lib" "audio_alphabet" $char.wav]]} {
        if {![catch {set sound(letters,$char) [snack::sound -load [file join $info(Accdir) "lib" "audio_alphabet" $char.wav]]} err]} {
           set loaded 1
        } else {
          sputs snack sound creation error:$err; return 0
        }
      }
    }
  }
  return $loaded
}

##############
## Text-based calculator
##############
proc tcl::mathfunc::pi {} {return 3.141592653589793238462643383}
proc tcl::mathfunc::e {} {return 2.718281828459}
proc tcl::mathfunc::dsin {x} {return [expr {sin(180.0/pi()*$x)}]}
proc tcl::mathfunc::dcos {x} {return [expr {cos(180.0/pi()*$x)}]}
proc tcl::mathfunc::dtan {x} {return [expr {tan(180.0/pi()*$x)}]}
proc tcl::mathfunc::dacos {x} {return [expr {180.0/pi()*acos($x)}]}
proc tcl::mathfunc::dasin {x} {return [expr {180.0/pi()*asin($x)}]}
proc tcl::mathfunc::datan {x} {return [expr {180.0/pi()*atan($x)}]}
proc tcl::mathfunc::datan2 {x y} {return [expr {180.0/pi()*atan2($x, $y)}]}
proc ::tcl::mathfunc::sign {x} {if {$x!=0} {return [expr {$x/abs($x)}]} else {return 0}}
proc calc {} {
  global modifier
  if {![winfo exists .calc]} {
    toplevel .calc
    wm resizable [winfo toplevel .calc] 1 0
    wm title .calc "Calculator: Enter a calculation"
    grid [entry .calc.e1 -validatecommand "calc_update %P" -validate key] -row 1 -column 1 -sticky nwe
    grid [label .calc.result ] -row 2 -column 1 -sticky nwe
    grid columnconfigure .calc 1 -weight 1
    bind .calc <$modifier-Key-c> "clipboard clear; if {\[.calc.e1 selection present\]} {clipboard_append \"\[tk::EntryGetSelection .calc.e1\]\"} else {clipboard_append \"\[.calc.result cget -text\]\"}"
    add_help_menubar .calc
  } else {
    raise .calc
  }
}

##############
## Update the calculator results
##############
# adds a decimal to numbers, so that all calculations are real
proc calc_update {text} {
  set pi [expr {acos(-1)}]
  set e [expr {exp(1)}]
  if {[winfo exists .calc.result]} {
    set dotlist [list]
    #regsub -all { } $result "" result
    foreach ilist [regexp -all -indices -inline {[0-9]+} $text] {
      foreach {a  b} $ilist {}
      if {([string index $text $a-1] ne ".") && ([string index $text $b+1] ne ".") && ([string toupper [string index $text $a-1]] ne "E") && ([string toupper [string range $text $a-2 $a-1]] ne "E-") && ([string toupper [string range $text $a-2 $a-1]] ne "E+") && ([string toupper [string range $text $a-2 $a-1]] ne "0X") && ([string toupper [string range $text  $b+1 $b+1]] ne "X")  && ([string range $text $a-2 $a-1] ne "<<") && ([string range $text $a-2 $a-1] ne ">>") && ([string range $text $a-1 $a-1] ne "^") && ([string range $text $a-1 $a-1] ne "|") && ([string range $text $a-1 $a-1] ne "&") && ([string range $text $b+1 $b+2] ne "<<") && ([string range $text  $b+1 $b+2] ne ">>") && ([string range $text  $b+1 $b+1] ne "^") && ([string range $text $b+1 $b+1] ne "|") && ([string range $text $b+1 $b+1] ne "&")} {
        lappend dotlist $b
      }
    }

    set i 0
    foreach b $dotlist {
      set text "[string range $text 0 [expr {$i+$b}]].[string range $text [expr {$i+$b+1}] end]"
      incr i
    }
    if {[catch {expr "$text"} result]} {
      .calc.result configure -text "------"
    } else {
      .calc.result configure -text [regsub {\.0$} $result ""]
    }
  }

return 1
}







####################
#### Molar calculations
####################
## todo:
## show equation
## +/- buttons
## ok: output recipe to printer/ clipboard
## ?: output to clipboard tab delimited
## ok: output QR to text
## ok: add description of (X) in molar ratio calculator
## ok:molar calculator-> mole/ng
## ok: bigger output text


##############
##
#############
proc mol_calc {} {
  global info mol_calc_info
  if {[winfo exists .mol_calc]} {
    raise .mol_calc
     return
  }

  array set mol_calc_info $info(calc_defaults)
  set a [toplevel .mol_calc]
  wm title .mol_calc [mc "Molecular Reaction Calculator"]
  add_help_menubar .mol_calc
  grid [ttk::notebook $a.n] -row 1 -column 1 -sticky nswe
  grid rowconfigure $a 1 -weight 1
  grid columnconfigure $a 1 -weight 1



#### Molar Ratio Reaction
  $a.n add [set t [ttk::frame $a.n.tab2]] -sticky nswe -text [mc "Molar Ratio Reaction"]

  grid [ttk::label $t.l1 -text [mc "Reaction"]] -row 1 -column 1 -sticky e
  grid [ttk::menubutton $t.reaction -menu $t.reaction.m -textvariable mol_calc_info(molar_reaction_name)] -row 1 -column 2 -sticky w
  menu $t.reaction.m
  foreach r_name [dict keys $info(calc_molar_raction_dict)] {
    $t.reaction.m add radiobutton -label $r_name -value $r_name -variable mol_calc_info(molar_reaction_name) -command "calc_molar_reaction_change_reaction $t"
  }
  $t.reaction.m add separator
 # $t.reaction.m add checkbutton -label [mc "Preserve Values Between Reactions"]  -variable mol_calc_info(molar_reaction_preserve_values) 
  $t.reaction.m add command -label [mc "Reset Values"] -command "calc_molar_reaction_clear $t"
  $t.reaction.m add separator
  $t.reaction.m add radiobutton -label [mc "Save New Reaction..."] -value [mc "New Reaction"] -variable mol_calc_info(molar_reaction_name) -command "calc_molar_reaction_new_reaction $t 0"
  $t.reaction.m add command -label [mc "Delete This Reaction..."] -command "calc_molar_reaction_new_reaction $t -1"

  grid [set f [ttk::frame $t.new_reaction]] -row 1 -column 3 -sticky nwe
  grid columnconfigure $f 2 -weight 1
  grid [ttk::entry $f.name  -textvariable mol_calc_info(molar_new_name)] -row 1 -column 2 -sticky we
  set mol_calc_info(molar_new_name) ""
  grid [ttk::button $f.save  -text [mc "Save"]  -command "calc_molar_reaction_new_reaction $t 1"] -row 1 -column 3 -sticky we

  grid columnconfigure $t 3 -weight 1
  grid [set f [ttk::frame $t.frags_frame]] -row 2 -column 1 -columnspan 3 -sticky nswe
  grid [ttk::label $f.l1 -text [mc "Fragment Name"]] -row 1 -column 1 -sticky w
  grid [ttk::label $f.l2 -text [mc "Size (kb)"]] -row 1 -column 2 -sticky w
  grid [ttk::label $f.l3 -text "ng/ul"] -row 1 -column 3 -sticky w
  grid [ttk::label $f.l4 -text [mc "ratio"]] -row 1 -column 4 -sticky w
  grid [ttk::label $f.l5_1 -textvariable mol_calc_info(molar_mol_label)] -row 1 -column 5 -sticky w
  grid [ttk::label $f.l5 -text [mc "volume (ul)"]] -row 1 -column 6 -sticky w
  grid columnconfigure $f 1 -weight 1
  for {set i 0} {$i < 10} {incr i} {
    grid [ttk::menubutton $f.mb_$i -width 0 -menu $f.mb_$i.m] -row [expr {$i+2}] -column 0 -sticky w
    menu $f.mb_$i.m 
    calc_molar_reaction_fill_menu  $f.mb_$i.m $i
    grid [ttk::label $f.name_label_$i -width 20 -textvariable mol_calc_info(frag_name,$i)] -row [expr {$i+2}] -column 1 -sticky we
    grid remove $f.name_label_$i
    grid [ttk::entry $f.name_$i -width 20 -textvariable mol_calc_info(frag_name,$i)] -row [expr {$i+2}] -column 1 -sticky we
    set mol_calc_info(frag_name,$i) {}

    grid [ttk::label $f.frag_size_label_$i -width 6 -textvariable mol_calc_info(frag_size,$i)] -row [expr {$i+2}] -column 2 -sticky w -padx 5
    grid remove $f.frag_size_label_$i
    grid [ttk::spinbox $f.frag_size_$i -width 6 -from 0 -to 100 -increment .1 -validate key -validatecommand "spinbox_validate %W %P" -command "calc_molar_reaction frag_size,$i" -textvariable mol_calc_info(frag_size,$i)] -row [expr {$i+2}] -column 2 -sticky w
    grid [ttk::spinbox $f.frag_conc_$i -width 4 -from 10 -to 3000 -increment 10 -validate key -validatecommand "spinbox_validate %W %P" -command "calc_molar_reaction frag_conc,$i" -textvariable mol_calc_info(frag_conc,$i)] -row [expr {$i+2}] -column 3 -sticky w
    grid [ttk::spinbox $f.frag_ratio_$i -width 3 -from 0 -to 50 -increment 1 -validate key -validatecommand "spinbox_validate %W %P" -command "calc_molar_reaction frag_ratio,$i" -textvariable mol_calc_info(frag_ratio,$i)] -row [expr {$i+2}] -column 4 -sticky w
    grid [ttk::label $f.u_$i -textvariable mol_calc_info(molar_mol,$i)] -row [expr {$i+2}]  -column 5 -sticky w
    grid [ttk::label $f.v_$i -textvariable mol_calc_info(molar_frag_volume,$i) -font boldlabelfont] -row [expr {$i+2}]  -column 6 -sticky w
    bind $f.mb_$i <<GelLaneDrop>> "calc_molar_reaction_gel_lane_drop %d $f $i "
    bind $f.name_label_$i <<GelLaneDrop>> "calc_molar_reaction_gel_lane_drop %d $f $i "
    bind $f.name_$i <<GelLaneDrop>> "calc_molar_reaction_gel_lane_drop %d $f $i "
  }
  grid [ttk::checkbutton $f.l6 -text [mc "Water"] -variable mol_calc_info(add_total_water) -command "calc_molar_reaction {}"] -row 12 -column 2 -columnspan 4 -sticky e
  set mol_calc_info(add_total_water) 1
  grid [ttk::label $f.l7 -textvariable mol_calc_info(total_water) -font boldlabelfont] -row 12 -column 6 -sticky w
  grid [ttk::label $f.l8 -text [mc "DNA Mix Intermediate Volume"]] -row 13 -column 2 -columnspan 4 -sticky e
  grid [ttk::label $f.l9 -textvariable mol_calc_info(DNA_intermediate_volume) -font boldlabelfont] -row 13 -column 6 -sticky w

  grid [ttk::separator $t.s1 -orient horizontal] -row 3 -column 1  -columnspan 3 -sticky nswe
  grid [set f [ttk::frame $t.volumes_frame]] -row 4 -column 1 -columnspan 3 -sticky nswe
  grid [ttk::label $f.l1 -text [mc "Reaction Volume (ul)"]] -row 1 -column 1 -sticky w
  grid [ttk::spinbox $f.reaction_volume -width 4 -from 1 -to 1000 -increment 1 -validate key -validatecommand "spinbox_validate %W %P" -command "calc_molar_reaction reaction_volume" -textvariable mol_calc_info(reaction_volume)] -row 1 -column 2 -sticky w
  grid [ttk::label $f.l2 -text [mc "DNA Mix Volume (ul)"]] -row 2 -column 1 -sticky w
  grid [ttk::label $f.l3 -textvariable mol_calc_info(total_dna_volume) -font boldlabelfont] -row 2 -column 2 -sticky w
  grid [ttk::label $f.l4 -text [mc "Enzyme+Buffer Mix Volume"]] -row 3 -column 1 -sticky w
  grid [ttk::label $f.l5 -textvariable mol_calc_info(total_enz_volume) -font boldlabelfont] -row 3 -column 2 -sticky w

  grid [ttk::separator $t.s2 -orient horizontal] -row 5 -column 1  -columnspan 3 -sticky nswe
  grid [set f [ttk::frame $t.conditions_frame]] -row 6 -column 1 -columnspan 3 -sticky nswe
  grid columnconfigure $f 4 -weight 1
  grid [ttk::label $f.l0 -text [mc "Reaction Conditions"]] -row 0 -column 1 -sticky w
  grid [ttk::label $f.l1 -text [mc "Final DNA amount/concentration"]] -row 1 -column 1 -sticky w
  grid [ttk::spinbox $f.dna_conc -width 3 -from 1 -to 1000 -increment 1 -validate key -validatecommand "spinbox_validate %W %P" -command "calc_molar_reaction final_DNA_conc" -textvariable mol_calc_info(final_DNA_conc)] -row 1 -column 2 -sticky w
  grid [ttk::menubutton $f.final_dna_units -menu $f.final_dna_units.m -textvariable mol_calc_info(final_DNA_units)] -row 1 -column 3 -sticky w
  menu $f.final_dna_units.m
  foreach m [list nM fmole ng ng/ul] {
    $f.final_dna_units.m add radiobutton -label $m -value $m -variable mol_calc_info(final_DNA_units) -command "calc_molar_reaction final_DNA_units"
  }
  grid [ttk::label $f.l1_1 -text "1 nM= 1 fmole/ul = 0.001 pmole/ul"] -row 1 -column 4 -columnspan 2 -sticky w 
  grid [ttk::label $f.l2 -text [mc "Minimum pipette volume (ul)"]] -row 2 -column 1 -sticky w
  grid [ttk::spinbox $f.pipette_vol -width 3 -from 0 -to 1 -increment .1 -validate key -validatecommand "spinbox_validate %W %P" -command "calc_molar_reaction minimum_pipette_volume" -textvariable mol_calc_info(minimum_pipette_volume)] -row 2 -column 2 -sticky w
  grid [ttk::label $f.l4 -text [mc "Enzyme Stock concentration (X)"]] -row 3 -column 1 -sticky w

  grid [ttk::menubutton $f.enz_stock_mb -menu $f.enz_stock_mb.m -textvariable mol_calc_info(enz_stock_label)] -row 3 -column 2 -columnspan 2 -sticky we
  menu $f.enz_stock_mb.m
    set mol_calc_info(enz_stock_label) ""
    set mol_calc_info(enz_conc_x) 10
    foreach {label value} [list "10x (1:9)" 10 "5x (1:4)" 5 "2x (1:1)" 2 "1.33x (3:1)" 1.333 "1.25x (4:1)" 1.25  "DNA Only" 1]  {
      $f.enz_stock_mb.m add radiobutton -label  $label -value $label -variable mol_calc_info(enz_stock_label) -command "set mol_calc_info(enz_conc_x) $value; grid remove $f.enz_stock;calc_molar_reaction enz_conc_x"
      if {$mol_calc_info(enz_conc_x) == $value} {
        set mol_calc_info(enz_stock_label) $label
      }
    }
    $f.enz_stock_mb.m add radiobutton -label [mc "Custom..."] -value "" -variable mol_calc_info(enz_stock_label) -command "set mol_calc_info(enz_conc_x) 10; grid configure $f.enz_stock;calc_molar_reaction enz_conc_x"

  grid [ttk::spinbox $f.enz_stock -width 3 -from 1 -to 100 -increment 1 -validate key -validatecommand "spinbox_validate %W %P" -command "calc_molar_reaction enz_conc_x" -textvariable mol_calc_info(enz_conc_x)] -row 3 -column 4 -sticky w
  if {$mol_calc_info(enz_stock_label) ne {}} {
    grid remove $f.enz_stock
  }
  #grid [ttk::label $f.l5 -text "10x= 1:9, 2x= 1:1, 1.333x=3:1 etc."] -row 3 -column 5 -columnspan 2 -sticky w
  grid [set f1 [ttk::frame $f.notesframe]] -row 4 -column 1 -columnspan 6 -sticky nwe
  grid columnconfigure $f1 2 -weight 1
  grid [ttk::label $f1.l6 -text [mc "Reaction Notes"]] -row 4 -column 1 -sticky w
  grid [ttk::entry $f1.com -xscrollcommand "optionscrollbar $f1.com_scroll" -textvariable mol_calc_info(molar_comment) ] -row 4 -column 2  -columnspan 4 -sticky we
  grid [scrollbar $f1.com_scroll -orient horizontal -command "$f1.com xview"] -row 5 -column 2  -columnspan 4 -sticky we

  grid [set f [ttk::frame $t.okframe]] -row 7 -column 1 -columnspan 6 -sticky nswe
  grid [ttk::button $f.copy -text [mc "Copy"] -command "calc_output 2 clipboard"] -row 1 -column 1 -sticky n
 # grid [ttk::button $f.qr -text [mc "QR"] -command "calc_output 2 qr"] -row 1 -column 2 -sticky n
  grid columnconfigure $f 1 -weight 1
  grid columnconfigure $f 2 -weight 1
  grid rowconfigure $t 8 -weight 1

  calc_molar_reaction_change_reaction $t
  
#### Master Mix Multiplier 
  $a.n add [set t [ttk::frame $a.n.tab3]] -sticky nswe -text [mc "Master Mix Multiplier"]
  grid [ttk::label $t.l1 -text [mc "Reaction"]] -row 1 -column 1 -sticky e
  grid [ttk::menubutton $t.reaction -menu $t.reaction.m -textvariable mol_calc_info(mm_reaction_name)] -row 1 -column 2 -sticky w
  menu $t.reaction.m
  foreach r_name [dict keys $info(calc_mm_raction_dict)] {
    $t.reaction.m add radiobutton -label $r_name -value $r_name -variable mol_calc_info(mm_reaction_name) -command "calc_mm_reaction_change_reaction $t"
  }
  $t.reaction.m add separator
  $t.reaction.m add radiobutton -label [mc "Save New Reaction..."] -value [mc "New Reaction"] -variable mol_calc_info(mm_reaction_name) -command "calc_mm_reaction_new_reaction $t 0"
  $t.reaction.m add command -label [mc "Delete This Reaction..."] -command "calc_mm_reaction_new_reaction $t -1"

  grid [set f [ttk::frame $t.new_reaction]] -row 1 -column 3 -sticky nwe
  grid columnconfigure $f 2 -weight 1
  grid [ttk::entry $f.name  -textvariable mol_calc_info(new_name)] -row 1 -column 2 -sticky we
  set mol_calc_info(new_name) ""
  grid [ttk::button $f.save  -text [mc "Save"]  -command "calc_mm_reaction_new_reaction $t 1"] -row 1 -column 3 -sticky we

  grid columnconfigure $t 3 -weight 1

  grid [set f [ttk::frame $t.reac]] -row 2 -column 1 -columnspan 3 -sticky nwe
  grid [ttk::label $f.l6 -text [mc "Single Reaction Volume"]] -row 2 -column 1 -sticky e
  grid [ttk::spinbox $f.reaction_vol -width 6 -from 1 -to 1000 -increment 1 -validate key -validatecommand "spinbox_validate %W %P" -command "calc_mm_reaction single_reaction_volume" -textvariable mol_calc_info(single_reaction_volume)] -row 2 -column 2 -columnspan 2 -sticky w
  grid [ttk::label $f.l2 -text [mc "# Reactions"]] -row 3 -column 1 -sticky e
  grid [ttk::spinbox $f.reactions -width 3 -from 1 -to 1000 -increment 1 -validate key -validatecommand "spinbox_validate %W %P" -command "calc_mm_reaction num_reactions" -textvariable mol_calc_info(num_reactions)] -row 3 -column 2 -sticky w
  grid [ttk::label $f.l3 -text [mc "plus"]] -row 4 -column 1 -sticky e
  grid [ttk::spinbox $f.add_perc -width 3 -from 0 -to 100 -increment 1 -validate key -validatecommand "spinbox_validate %W %P" -command "calc_mm_reaction add_perc" -textvariable mol_calc_info(add_perc)] -row 4 -column 2 -sticky w
  grid [ttk::menubutton $f.perc_ul -menu $f.perc_ul.m -textvariable mol_calc_info(perc_ul)] -row 4 -column 3 -sticky w
  menu $f.perc_ul.m
  $f.perc_ul.m add radiobutton -label "%" -variable mol_calc_info(perc_ul) -value "%" -command "calc_mm_reaction perc_ul"
  $f.perc_ul.m add radiobutton -label "ul" -variable mol_calc_info(perc_ul) -value "ul" -command "calc_mm_reaction perc_ul"

  grid [set f [ttk::frame $t.frags_frame]] -row 5 -column 1 -columnspan 3 -sticky nswe
  grid [ttk::label $f.l1 -text [mc "Component Name"]] -row 1 -column 1 -sticky w
  grid [ttk::label $f.l2 -text [mc "Volume/ Reaction"]] -row 1 -column 2 -sticky w
  grid [ttk::label $f.l3 -text [mc "Volume"]] -row 1 -column 3 -sticky w
  for {set i 0} {$i < 10} {incr i} {
    grid [ttk::entry $f.name_$i -width 20 -textvariable mol_calc_info(component_name,$i)] -row [expr {$i+2}] -column 1 -sticky w
    grid [ttk::spinbox $f.frag_vol_$i -width 4 -from 0 -to 1000 -increment 1 -validate key -validatecommand "spinbox_validate %W %P" -command "calc_mm_reaction frag_vol,$i" -textvariable mol_calc_info(frag_vol,$i)] -row [expr {$i+2}] -column 2 -sticky n
    grid [ttk::label $f.v_$i -textvariable mol_calc_info(mm_frag_volume,$i) -font boldlabelfont] -row [expr {$i+2}]  -column 3 -sticky w
  }
  grid [ttk::label $f.l4 -text [mc "Total Mix Volume"]] -row 13 -column 2 -sticky e
  grid [ttk::label $f.l5 -textvariable mol_calc_info(total_mm_volume) -font boldlabelfont] -row 13 -column 3 -sticky w

  grid [set f [ttk::frame $t.okframe]] -row 6 -column 1 -columnspan 3 -sticky nswe
  grid [ttk::button $f.copy -text [mc "Copy"] -command "calc_output 3 clipboard"] -row 1 -column 1 -sticky n
 # grid [ttk::button $f.qr -text [mc "QR"] -command "calc_output 3 qr"] -row 1 -column 2 -sticky n
  grid columnconfigure $f 1 -weight 1
  grid columnconfigure $f 2 -weight 1

  grid rowconfigure $t 7 -weight 1
  calc_mm_reaction_change_reaction $t

#### Molar Multiplier Calculator
  $a.n add [set t [ttk::frame $a.n.tab4]] -sticky nswe -text [mc "Molarity"]

  grid [ttk::spinbox $t.first -width 6 -from 1 -to 1000 -increment 1 -validate key -validatecommand "spinbox_validate %W %P" -command "calc_molarity $t molar_first" -textvariable mol_calc_info(molar_first)] -row 1 -column 1 -sticky w
  grid [ttk::menubutton $t.unit1 -menu $t.unit1.m -textvariable mol_calc_info(molar_unit1)] -row 1 -column 2 -sticky w
  menu $t.unit1.m
  foreach m [list g mg ug ng pg mole mmole umole nmole pmole] {
    $t.unit1.m add radiobutton -label $m -value $m -variable mol_calc_info(molar_unit1) -command "calc_molarity $t unit1"
  }
  $t.unit1.m add radiobutton -label [mc "%(wt/vol)"] -value "%(wt/vol)" -variable mol_calc_info(molar_unit1) -command "set mol_calc_info(molar_vol1) {}; calc_molarity $t unit1"


  grid [ttk::menubutton $t.vol1 -menu $t.vol1.m -textvariable mol_calc_info(molar_vol1)] -row 1 -column 3 -sticky w
  menu $t.vol1.m
  foreach m [list "" /L /mL /uL] {
    $t.vol1.m add radiobutton -label $m -value $m -variable mol_calc_info(molar_vol1) -command "calc_molarity $t molar_vol1"
  }

  grid [ttk::label $t.l1 -text "="] -row 1 -column 4 -sticky w

  grid [ttk::label $t.l2 -textvariable mol_calc_info(molar_second)] -row 1 -column 5 -sticky w
  grid [ttk::menubutton $t.unit2 -menu $t.unit2.m -textvariable mol_calc_info(molar_unit2)] -row 1 -column 6 -sticky w
  menu $t.unit2.m
  foreach m [list g mg ug ng pg mole mmole umole nmole pmole] {
    $t.unit2.m add radiobutton -label $m -value $m -variable mol_calc_info(molar_unit2) -command "calc_molarity $t unit2"
  }
  grid [ttk::menubutton $t.vol2 -menu $t.vol2.m -textvariable mol_calc_info(molar_vol2)] -row 1 -column 7 -sticky w
  menu $t.vol2.m
  foreach m [list /L /mL /uL] {
    $t.vol2.m add radiobutton -label $m -value $m -variable mol_calc_info(molar_vol2) -command "calc_molarity $t molar_vol2"
  }

  grid columnconfigure $t 8 -weight 1
  grid [set f [ttk::frame $t.mw_frame]] -row 2 -column 1 -columnspan 8 -sticky nswe
  grid [ttk::spinbox $f.mol_wt -width 6 -from 1 -to 1000 -increment 1 -validate key -validatecommand "spinbox_validate %W %P" -command "set mol_calc_info(lookup_text) {}; calc_molarity $t mol_wt" -textvariable mol_calc_info(mol_wt)] -row 2 -column 1 -sticky w
  grid [ttk::menubutton $f.unitmw -menu $f.unitmw.m -textvariable mol_calc_info(molar_unit_MW)] -row 2 -column 2 -sticky w
  menu $f.unitmw.m
  $f.unitmw.m add radiobutton -label g/mol -value g/mol -variable mol_calc_info(molar_unit_MW) -command "set mol_calc_info(lookup_text)] {}; set mol_calc_info(mol_wt) {}; calc_molarity $t unit_MW"
  foreach m [list  "nucleotides ssDNA" "base pairs dsDNA" "nucleotides RNA"] {
    $f.unitmw.m add radiobutton -label $m -value $m -variable mol_calc_info(molar_unit_MW) -command "set mol_calc_info(lookup_text)] {}; set mol_calc_info(mol_wt) 1; calc_molarity $t unit_MW"
  }
  grid [ttk::entry $f.nuc_sequence -validatecommand "calc_molarity_validate_seq %P  $t seq" -validate key ] -row 2 -column 3 -sticky w
  grid [ttk::combobox $f.compound_lookup -width 30 -textvariable mol_calc_info(lookup_text)] -row 2 -column 3 -sticky w
  bind $f.compound_lookup <Key> "after cancel {calc_molarity_cb_fill_autocomplete $t $f.compound_lookup}; after 750 {calc_molarity_cb_fill_autocomplete $t $f.compound_lookup}"
  bind $f.compound_lookup <<ComboboxSelected>> "calc_molarity_cb_check_autocomplete $t $f.compound_lookup"

## mol calculator- get autocomplete compound name, get mol weight and png of compoud name
## https://pubchem.ncbi.nlm.nih.gov/docs/autocomplete
## get_html https://pubchem.ncbi.nlm.nih.gov/rest/autocomplete/compound/tetrac/jsonp
## regexp  {"compound": \[(.*)\]} [get_html https://pubchem.ncbi.nlm.nih.gov/rest/autocomplete/compound/tetrac/jsonp] -- res
##  regsub -all {\s+\"|"} $res "" res2
## split $res2 ,
## https://pubchem.ncbi.nlm.nih.gov/docs/pug-rest
## get_html https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/tetracycline/property/MolecularWeight/TXT

##  can get an image of the compound like this:;
##  https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/tetracycline/PNG?image_size=100x100
##  set url  "https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/[::http::quoteString $mol_calc_info(lookup_text)]/PNG?image_size=150x150"

##     if {[set f [save_png_from_url $url] ne ""} {mol_png read $f} else {mol_png blank}
  catch {image delete mol_png}
  image create photo mol_png 
  grid [label $f.mol_png -image mol_png] -row 3 -column 3 -sticky wns
  grid rowconfigure $f 3 -weight 1




  grid [set f [ttk::frame $t.vol_frame]] -row 4 -column 1 -columnspan 8 -sticky nswe
  grid [ttk::spinbox $f.vol -width 6 -from 1 -to 1000 -increment 1 -validate key -validatecommand "spinbox_validate %W %P" -command "calc_molarity $t molar_vol" -textvariable mol_calc_info(molar_vol)] -row 1 -column 1 -sticky w
  grid [ttk::menubutton $f.unitv -menu $f.unitv.m -textvariable mol_calc_info(molar_unit_vol)] -row 1 -column 2 -sticky w
  menu $f.unitv.m
  foreach m [list L mL uL mole mmole umole nmole g mg ug ng] {
    $f.unitv.m add radiobutton -label $m -value $m -variable mol_calc_info(molar_unit_vol) -command "calc_molarity $t unit_vol"
  }
  grid [ttk::label $f.l1 -textvariable mol_calc_info(molar_g_per_l)] -row 1 -column 3 -sticky w
  after 10 "calc_molarity $t mol_wt"

  ### Recipe multiplier Calc
  grid [ttk::separator $t.s1 -orient horizontal] -row 5 -column 1  -columnspan 8 -sticky nswe
  grid [set f [ttk::frame $t.recipe_mult_frame]] -row 6 -column 1 -columnspan 8 -sticky nswe
  grid [ttk::label $f.istruct -wraplength 500]  -row 0 -column 1 -columnspan 3 -sticky w
  $f.istruct conf -text [mc "Copy a recipe in the form: 100mM CaCl2, 1M NaCl, 50 mM glucose. Set the desired volume. Click the calulate button. The result will be inserted into the clipboard"]
  grid [ttk::spinbox $f.vol -width 6 -from 1 -to 1000 -increment 1 -validate key -validatecommand "spinbox_validate %W %P" -textvariable mol_calc_info(recipe_mult_vol)] -row 1 -column 1 -sticky w
  grid [ttk::label $f.unitv -text "L"] -row 1 -column 2 -sticky w
  grid [ttk::button $f.recmultcalc -text [mc "Calculate"] -command "calc_molarity_recipe_mult"] -row 1 -column 3 -sticky w
  grid columnconfigure $f 3 -weight 1

  ### Stock dilution Calc
  #$a.n add [set t [ttk::frame $a.n.tab1]] -sticky nswe -text [mc "Stock Dilution"]
  grid [ttk::separator $t.s2 -orient horizontal] -row 7 -column 1  -columnspan 8 -sticky nswe

  grid [set f [ttk::frame $t.dil_frame]] -row 8 -column 1 -columnspan 8 -sticky nswe
  grid [ttk::label $f.l1 -text [mc "Stock Concentration"]] -row 1 -column 1 -sticky e
  grid [ttk::spinbox $f.stock -width 4 -from 0 -to 10000 -increment 1 -validate key -validatecommand "spinbox_validate %W %P" -command "calc_stock_dilution_update stock_conc" -textvariable mol_calc_info(stock_conc)] -row 1 -column 2 -sticky w
  grid [ttk::menubutton $f.stock_units -menu $f.stock_units.m -textvariable mol_calc_info(stock_units)] -row 1 -column 3 -sticky w
  menu $f.stock_units.m
  foreach m [list X M mM uM nM pM] {
    $f.stock_units.m add radiobutton -label $m -value $m -variable mol_calc_info(stock_units) -command "calc_stock_dilution_update stock_units"
  }

  grid [ttk::label $f.l2 -text [mc "Final Concentration"]] -row 2 -column 1 -sticky e
  grid [ttk::spinbox $f.final_conc -width 4 -from 0 -to 10000 -increment 1 -validate key -validatecommand "spinbox_validate %W %P" -command "calc_stock_dilution_update final_conc" -textvariable mol_calc_info(final_conc)] -row 2 -column 2 -sticky w
  grid [ttk::menubutton $f.final_conc_units -menu $f.final_conc_units.m -textvariable mol_calc_info(final_conc_units)] -row 2 -column 3 -sticky w
  menu $f.final_conc_units.m
  foreach m [list X M mM uM nM pM] {
    $f.final_conc_units.m add radiobutton -label $m -value $m -variable mol_calc_info(final_conc_units) -command "calc_stock_dilution_update final_conc_units"
  }

  grid [ttk::label $f.l3 -text [mc "Final Volume"]] -row 3 -column 1 -sticky e
  grid [ttk::spinbox $f.final_vol -width 4 -from 0 -to 10000 -increment 1 -validate key -validatecommand "spinbox_validate %W %P" -command "calc_stock_dilution_update final_volume" -textvariable mol_calc_info(final_volume)] -row 3 -column 2 -sticky w
  grid [ttk::menubutton $f.final_vol_units -menu $f.final_vol_units.m -textvariable mol_calc_info(final_vol_units)] -row 3 -column 3 -sticky w
  menu $f.final_vol_units.m
  foreach m [list L mL uL] {
    $f.final_vol_units.m add radiobutton -label $m -value $m -variable mol_calc_info(final_vol_units) -command "calc_stock_dilution_update final_vol_units"
  }

  grid [ttk::label $f.l4 -text [mc "Stock"]] -row 4 -column 1 -sticky e
  grid [ttk::label $f.stock_vol -textvariable mol_calc_info(stock_volume)  -font boldlabelfont] -row 4 -column 2 -sticky w
  ##grid [ttk::label $f.stock_vol_units  -textvariable mol_calc_info(stock_volume_units)] -row 4 -column 3 -sticky w

  grid [ttk::label $f.l5 -text [mc "Water"]] -row 5 -column 1 -sticky e
  grid [ttk::label $f.water_volume  -textvariable mol_calc_info(water_volume)  -font boldlabelfont] -row 5 -column 2 -sticky w
  ##grid [ttk::label $f.water_volume_units  -textvariable mol_calc_info(water_volume_units)] -row 5 -column 3 -sticky w

  grid [set f [ttk::frame $t.okframe]] -row 9 -column 1 -columnspan 8 -sticky nswe
  grid [ttk::button $f.copy -text [mc "Copy"] -command "calc_output 4 clipboard"] -row 1 -column 1 -sticky n
 # grid [ttk::button $f.qr -text [mc "QR"] -command "calc_output 4 qr"] -row 1 -column 2 -sticky n
  grid columnconfigure $f 1 -weight 1
  grid columnconfigure $f 2 -weight 1

  grid rowconfigure $t 10 -weight 1

  calc_stock_dilution_update start

}


###########
proc spinbox_validate {s p} {
  if {($p ne {} && $p ne {.}) &&  (![string is double $p] || $p < 0)} {
    return 0
  } else {
    after 10 [$s cget -command]
    return 1
  }
}

##############
##
#############
 #mol_calc_fill molar_ratio {{test1 500} {test2 700}}
proc calc_molar_reaction_fill {data_type data_list {reaction_regexp ""}} {
  global mol_calc_info info
  mol_calc
  set a .mol_calc
  if {$data_type ne {}} {
    switch $data_type {
      molar_ratio {
        set t $a.n.tab2
        set f $t.frags_frame
        $a.n select .mol_calc.n.tab2
        if {$reaction_regexp ne {}} {
          if {[set reac [lsearch -inline -nocase -regexp [dict keys $info(calc_molar_raction_dict)] $reaction_regexp]] ne {}} {
            set mol_calc_info(molar_reaction_name) $reac
            calc_molar_reaction_change_reaction $t
          }
        }
        for {set i 0} {$i < 10} {incr i} {
          calc_molar_reaction_fill_mr_row $i [lindex $data_list $i]
        }
      }
      master_mix {
        $a.n select .mol_calc.n.tab3
      }
      molarity {
        $a.n select .mol_calc.n.tab4
      }
    }
  }
}

#############
proc calc_molar_reaction_fill_mr_row { i data_list} {
  global mol_calc_info
  set a .mol_calc
   set t $a.n.tab2
   set f $t.frags_frame
  # grid remove $f.mb_$i
  # grid remove $f.name_$i 
  # grid remove $f.frag_size_$i 
 #  grid configure $f.name_label_$i
  # grid configure $f.frag_size_label_$i
   set mol_calc_info(frag_name,$i) [lindex $data_list 0]
   if {[catch {set mol_calc_info(frag_size,$i) [expr {[lindex $data_list 1]/ 1000.0}]}]} {
     set mol_calc_info(frag_size,$i) ""
  }
   calc_molar_reaction {}
}


#################
proc calc_molar_reaction_clear {t} {
  global mol_calc_info
  set f $t.frags_frame
  for {set i 0} {$i < 10} {incr i} {
    calc_molar_reaction_clear_row $f $i
  }
}

#################
proc calc_molar_reaction_clear_row {f i} {
  global mol_calc_info
    grid configure $f.mb_$i
    grid configure $f.name_$i 
    grid configure $f.frag_size_$i 
    grid remove $f.name_label_$i
    grid remove $f.frag_size_label_$i
    set mol_calc_info(frag_name,$i) {}
    set mol_calc_info(frag_size,$i) {}
    set mol_calc_info(frag_conc,$i) {}
    set mol_calc_info(frag_ratio,$i) {}
   calc_molar_reaction {}
}

#################
proc calc_molar_reaction_change_reaction {t} {
  global info mol_calc_info

  grid remove $t.new_reaction
  set reaction_name $mol_calc_info(molar_reaction_name)
  if {$reaction_name == "" || ![dict exists $info(calc_molar_raction_dict) $reaction_name]} {
    set reaction_data  [list [list frag1 0 0 1 frag2 0 0 1] 4 40 nM 0.5 10]
  } else {
    set reaction_data  [dict get $info(calc_molar_raction_dict) $reaction_name]
  }
  if {!$mol_calc_info(molar_reaction_preserve_values)} {
    for {set i 0} {$i <10} {incr i} {
        set mol_calc_info(frag_name,$i) [lindex $reaction_data 0 [expr {$i*4}]]
        set mol_calc_info(frag_size,$i) [lindex $reaction_data 0 [expr {$i*4+1}]]
        set mol_calc_info(frag_conc,$i) [lindex $reaction_data 0 [expr {$i*4+2}]]
        set mol_calc_info(frag_ratio,$i) [lindex $reaction_data 0 [expr {$i*4+3}]]
    }
  }
   set mol_calc_info(reaction_volume) [lindex $reaction_data 1]
   set mol_calc_info(final_DNA_conc) [lindex $reaction_data 2]
   set mol_calc_info(final_DNA_units) [lindex $reaction_data 3]
   set mol_calc_info(minimum_pipette_volume) [lindex $reaction_data 4]
   set mol_calc_info(enz_conc_x) [lindex $reaction_data 5]
   set mol_calc_info(enz_stock_label) ""
   grid configure $t.conditions_frame.enz_stock
   foreach {label value} [list "10x (1:9)" 10 "5x (1:4)" 5 "2x (1:1)" 2 "1.33x (3:1)" 1.333 "1.25x (4:1)" 1.25  "DNA Only" 1]  {
      if {$mol_calc_info(enz_conc_x) == $value} {
        set mol_calc_info(enz_stock_label) $label
        grid remove $t.conditions_frame.enz_stock
      }
    }

   set mol_calc_info(molar_comment) [lindex $reaction_data 6]

    $t.reaction.m delete 0 end
    foreach r_name [dict keys $info(calc_molar_raction_dict)] {
       $t.reaction.m add radiobutton -label $r_name -value $r_name -variable mol_calc_info(molar_reaction_name) -command "calc_molar_reaction_change_reaction $t"
    }
    $t.reaction.m add separator
   # $t.reaction.m add checkbutton -label [mc "Preserve Values Between Reactions"]  -variable mol_calc_info(molar_reaction_preserve_values) 
    $t.reaction.m add command -label [mc "Reset Values"] -command  "calc_molar_reaction_clear $t"
    $t.reaction.m add separator
    $t.reaction.m add radiobutton -label [mc "Save New Reaction..."] -value [mc "New Reaction"] -variable mol_calc_info(molar_reaction_name) -command "calc_molar_reaction_new_reaction $t 0"
    $t.reaction.m add command -label [mc "Delete This Reaction..."] -command "calc_molar_reaction_new_reaction $t -1"
    calc_molar_reaction ""
}

############
# set info(calc_molar_raction_dict) [list "HiFi" [list [list frag1 1 100 1 frag2 2 200 1] 4 40 nM 0.5 1.333 ""]  "Gibson"  [list [list frag1 3 300 3 frag2 4 400 1] 4 40 nM 0.5 2 ""]]
proc calc_molar_reaction_new_reaction {t v} {
  global info mol_calc_info
  switch $v {
    0 {
      grid configure $t.new_reaction
      $t.reaction.m delete 0 end
      foreach r_name [dict keys $info(calc_molar_raction_dict)] {
         $t.reaction.m add radiobutton -label $r_name -value $r_name -variable mol_calc_info(molar_reaction_name) -command "calc_molar_reaction_change_reaction $t"
      }
    }
    1 {
     set reaction_name [string trim $mol_calc_info(molar_new_name) " "]
     if {$reaction_name == ""} {
        tk_messageBox -message [mc "Please Name the Reaction"] -type ok
        return
      } elseif {[dict exists $info(calc_molar_raction_dict) $reaction_name]} {
        if {[tk_messageBox -message [mc "Overwrite the Reaction: %1s" $reaction_name] -type okcancel] eq "cancel"} {return}  
      }  
      set result [list]

      for {set i 0} {$i <10} {incr i} {
        if {[info exists mol_calc_info(frag_size,$i)] && [info exists  mol_calc_info(frag_conc,$i)] && [info exists mol_calc_info(frag_ratio,$i)] && ![catch {set p [expr {$mol_calc_info(frag_size,$i) * $mol_calc_info(frag_conc,$i) * $mol_calc_info(frag_ratio,$i)}]}] && $p > 0 } {
          lappend result $mol_calc_info(frag_name,$i) $mol_calc_info(frag_size,$i)  $mol_calc_info(frag_conc,$i) $mol_calc_info(frag_ratio,$i)
        }
      }

      dict set info(calc_molar_raction_dict) $mol_calc_info(molar_new_name) [list $result $mol_calc_info(reaction_volume) $mol_calc_info(final_DNA_conc) $mol_calc_info(final_DNA_units) $mol_calc_info(minimum_pipette_volume) $mol_calc_info(enz_conc_x) $mol_calc_info(molar_comment)]
      set mol_calc_info(molar_reaction_name) $mol_calc_info(molar_new_name)
      $t.reaction.m delete 0 end
      foreach r_name [dict keys $info(calc_molar_raction_dict)] {
         $t.reaction.m add radiobutton -label $r_name -value $r_name -variable mol_calc_info(molar_reaction_name) -command "calc_molar_reaction_change_reaction $t"
      }
      $t.reaction.m add separator
      $t.reaction.m add radiobutton -label [mc "Save New Reaction..."] -value [mc "New Reaction"] -variable mol_calc_info(molar_reaction_name) -command "calc_molar_reaction_new_reaction $t 0"
      $t.reaction.m add command -label [mc "Delete This Reaction..."] -command "calc_molar_reaction_new_reaction $t -1"
      grid remove $t.new_reaction
      calc_molar_reaction ""
    }
    -1 {
      set reaction_name $mol_calc_info(molar_reaction_name)
      if {$reaction_name == "" || ![dict exists $info(calc_molar_raction_dict) $reaction_name]} {
        set reaction_data  [list "" 0 ]
        set mol_calc_info(molar_reaction_name) ""
      } else {
        dict unset info(calc_molar_raction_dict) $reaction_name
        $t.reaction.m delete 0 end
        foreach r_name [dict keys $info(calc_molar_raction_dict)] {
           $t.reaction.m add radiobutton -label $r_name -value $r_name -variable mol_calc_info(molar_reaction_name) -command "calc_molar_reaction_change_reaction $t "
        }
        $t.reaction.m add separator
        $t.reaction.m add radiobutton -label [mc "Save New Reaction..."] -value [mc "New Reaction"] -variable mol_calc_info(molar_reaction_name) -command "calc_molar_reaction_new_reaction $t 0"
        $t.reaction.m add command -label [mc "Delete This Reaction..."] -command "calc_molar_reaction_new_reaction $t -1"
        set mol_calc_info(molar_reaction_name) [lindex [dict keys $info(calc_molar_raction_dict)] 0]
        calc_molar_reaction_change_reaction $t
      }
    }
  }

}



#################
proc calc_molar_reaction {s} {
  global info mol_calc_info
#calculate:


  set ratio_sum 0
  for {set i 0} {$i <10} {incr i} {
    if {![catch {set p0 [expr {$mol_calc_info(frag_size,$i) * $mol_calc_info(frag_conc,$i) }]}] && $p0 > 0 && (![info exists mol_calc_info(frag_ratio,$i)] || $mol_calc_info(frag_ratio,$i) =={})} {
      set mol_calc_info(frag_ratio,$i) 1
    }
    if {![catch {set p [expr {$mol_calc_info(frag_size,$i) * $mol_calc_info(frag_conc,$i) * $mol_calc_info(frag_ratio,$i)}]}] && $p > 0 } {
      set ratio_sum [expr {$ratio_sum + $mol_calc_info(frag_ratio,$i)}]
      set valid($i) 1
    } else {
      set valid($i) 0
      set mol_calc_info(molar_frag_volume,$i) ""
      set mol_calc_info(molar_mol_label) ""
      set mol_calc_info(molar_mol,$i) ""
    }
  }

  if {[catch {set p [expr {$mol_calc_info(final_DNA_conc) * $mol_calc_info(reaction_volume)}]}] || $p <=0 || $mol_calc_info(final_DNA_conc) < 0} {
    set ratio_sum 0
  }

  if {$ratio_sum ==0} {
    foreach var [list total_water  DNA_intermediate_volume  total_dna_volume  total_enz_volume] {
      set mol_calc_info($var) ""
    }
    return
  }
  

  if {$mol_calc_info(enz_conc_x) > 1} {
    set enz_conc_x $mol_calc_info(enz_conc_x)
  } else {
    set enz_conc_x 0
  }
  
  if {$enz_conc_x > 1} {
    set mol_calc_info(total_enz_volume) [expr { round(100.0*$mol_calc_info(reaction_volume) / $mol_calc_info(enz_conc_x))/100.0}]
    set mol_calc_info(total_dna_volume) [expr { round(100.0*$mol_calc_info(reaction_volume) * (1- 1.0/$mol_calc_info(enz_conc_x)))/100.0 }]
    set mol_calc_info(DNA_intermediate_volume) [expr { $mol_calc_info(total_dna_volume)}]
  } else {
    set mol_calc_info(total_enz_volume) 0
    set mol_calc_info(total_dna_volume) $mol_calc_info(reaction_volume)
    set mol_calc_info(DNA_intermediate_volume) [expr { $mol_calc_info(total_dna_volume)}]
  }

  set dna_sum 0
  set ng_sum 0
  for {set i 0} {$i <10} {incr i} {
    if {$valid($i)}  {
      switch $mol_calc_info(final_DNA_units) {
        uM {
          set dna_vol($i) [expr {1.0 *$mol_calc_info(final_DNA_conc)* $mol_calc_info(reaction_volume)  *  $mol_calc_info(frag_ratio,$i) / $ratio_sum   * ($mol_calc_info(frag_size,$i) * 617.96 + 36.04 )   / $mol_calc_info(frag_conc,$i) }]
        }
        nM {
          set dna_vol($i) [expr {1.0* $mol_calc_info(final_DNA_conc)/1000* $mol_calc_info(reaction_volume) *  $mol_calc_info(frag_ratio,$i) / $ratio_sum  * ($mol_calc_info(frag_size,$i) * 617.96 + 36.04 )   / $mol_calc_info(frag_conc,$i) }]
          set mol_calc_info(molar_mol,$i) [expr {1.0 * 1000 * $dna_vol($i) * $mol_calc_info(frag_conc,$i)/($mol_calc_info(frag_size,$i) * 617.96 + 36.04 ) }]
        }
        fmole {
          set dna_vol($i) [expr {1.0* $mol_calc_info(final_DNA_conc)/1000 *  $mol_calc_info(frag_ratio,$i) / $ratio_sum  * ($mol_calc_info(frag_size,$i) * 617.96 + 36.04 )   / $mol_calc_info(frag_conc,$i) }]
          set mol_calc_info(molar_mol,$i) [expr {1.0 * 1000 * $dna_vol($i) * $mol_calc_info(frag_conc,$i)/($mol_calc_info(frag_size,$i) * 617.96 + 36.04 ) }]
        }
        ng {
          set dna_vol($i) [expr {1.0*   $mol_calc_info(frag_ratio,$i) / $ratio_sum  * $mol_calc_info(frag_size,$i)  / $mol_calc_info(frag_conc,$i) }]
          set ng_sum [expr {$ng_sum + $dna_vol($i) *$mol_calc_info(frag_conc,$i) }]
        }
        ng/ul {
          set dna_vol($i) [expr {1.0*   $mol_calc_info(frag_ratio,$i) / $ratio_sum  * $mol_calc_info(frag_size,$i)  / $mol_calc_info(frag_conc,$i) }]
          set ng_sum [expr {$ng_sum + $dna_vol($i) *$mol_calc_info(frag_conc,$i) }]
        }
        default {
          set dna_vol($i) 0
        }
      }
      set dna_sum [expr {$dna_sum + $dna_vol($i) }]
      set mol_calc_info(molar_mol_label) "fmoles"
    } else {
      set mol_calc_info(molar_frag_volume,$i) ""
      set mol_calc_info(molar_mol,$i) ""
    }
  }

  ## adjust to total ng if ng/ul concentration (can be done with just sum of fragment sizes, but this seems more intuitive)
  if {$mol_calc_info(final_DNA_units) eq "ng/ul" || $mol_calc_info(final_DNA_units) eq "ng"} {
    set dna_sum 0
    for {set i 0} {$i <10} {incr i} {
      if {$valid($i)}  {
        if {$mol_calc_info(final_DNA_units) eq "ng"} {
          set dna_vol($i) [expr {$mol_calc_info(final_DNA_conc)/ $ng_sum * $dna_vol($i)}]
        } else {
          set dna_vol($i) [expr {$mol_calc_info(reaction_volume)* $mol_calc_info(final_DNA_conc)/ $ng_sum * $dna_vol($i)}]
        }
        set mol_calc_info(molar_mol,$i) [expr {$mol_calc_info(frag_conc,$i) * $dna_vol($i)}]
        set dna_sum [expr {$dna_sum + $dna_vol($i) }]
      }
    } 
      set mol_calc_info(molar_mol_label) "ng"
  }

  ## calculate total water to add here - can choose to not add water and get higher total DNA
  if {$mol_calc_info(add_total_water)} {
    if {$mol_calc_info(DNA_intermediate_volume) >= $dna_sum} {
      set mol_calc_info(total_water) [expr {$mol_calc_info(DNA_intermediate_volume) - $dna_sum}]
      set dna_conc_percent 100
    } else {
     ## concetrations are too low- 
      set mol_calc_info(total_water) 0
      set dna_conc_percent  [expr {int(100.0* $mol_calc_info(DNA_intermediate_volume) / $dna_sum)}]
     ## scale all the volumes to get the correct total without adding water
      set scale [expr {$mol_calc_info(DNA_intermediate_volume) / $dna_sum}]
      set dna_sum $mol_calc_info(DNA_intermediate_volume)
      for {set i 0} {$i <10} {incr i} {
        if {$valid($i)} {
          set dna_vol($i) [expr {$scale * $dna_vol($i)}]
          set mol_calc_info(molar_mol,$i) [expr {$scale * $mol_calc_info(molar_mol,$i)}]
        }
      }
    }
  } else {
    ## explicitly don't add the water and get over 100% desired conc
    set mol_calc_info(total_water) 0
    set dna_conc_percent  [expr {int(100.0* $mol_calc_info(DNA_intermediate_volume) / $dna_sum)}]
     ## scale all the volumes to get the correct total without adding water
    set scale [expr {$mol_calc_info(DNA_intermediate_volume) / $dna_sum}]
    set dna_sum $mol_calc_info(DNA_intermediate_volume)
    for {set i 0} {$i <10} {incr i} {
      if {$valid($i)} {
        set dna_vol($i) [expr {$scale * $dna_vol($i)}]
        set mol_calc_info(molar_mol,$i) [expr {$scale * $mol_calc_info(molar_mol,$i)}]
      }
    }
  }

  set min 10000
  for {set i 0} {$i <10} {incr i} {
    if {$valid($i)}  {
      set min [expr {min($min, $dna_vol($i))}]
    }
  }

  # if water is > 5% of DNA volume, consider it in the minimum pipette volume calculation
  if {$mol_calc_info(total_water) < $min && $dna_conc_percent == 100} {
    if {$mol_calc_info(total_water) >= [expr {0.05 * $dna_sum}]} {
      set min [expr {min($min, $mol_calc_info(total_water))}]
      #.mol_calc.n.tab2.frags_frame.l6 configure -foreground $info(label_fg_color)
      #.mol_calc.n.tab2.frags_frame.l7 configure -foreground $info(label_fg_color)
    } else {
      # if water is less than 5% of total, gray it out as irrelevant
      #.mol_calc.n.tab2.frags_frame.l6 configure -foreground $info(label_disabled_fg_color)
      #.mol_calc.n.tab2.frags_frame.l7 configure -foreground $info(label_disabled_fg_color)
      # if water is less than 5% of total, set it to 0, and calc 
      set mol_calc_info(total_water) 0
      set dna_conc_percent  [expr {int(100.0* $mol_calc_info(DNA_intermediate_volume) / $dna_sum)}]
    }
  }
  ## Adjust pipette volumes to minimum pipette volume, if necessary
  if {$min < $mol_calc_info(minimum_pipette_volume) && $min > 0} {
    for {set i 0} {$i <10} {incr i} {
      if {$valid($i)}  {
        #sputs $i $mol_calc_info(minimum_pipette_volume) / $min *  $dna_vol($i)
        set dna_vol($i) [expr {$mol_calc_info(minimum_pipette_volume) / $min * $dna_vol($i)}]
        set mol_calc_info(molar_mol,$i) [expr {$mol_calc_info(minimum_pipette_volume)/ $min * $mol_calc_info(molar_mol,$i)}]
      }
    }
    set mol_calc_info(DNA_intermediate_volume) [expr {$mol_calc_info(minimum_pipette_volume) / $min * $mol_calc_info(DNA_intermediate_volume)}]
    set mol_calc_info(total_water) [expr {$mol_calc_info(minimum_pipette_volume) / $min * $mol_calc_info(total_water)}]
  }

  ## round all DNA fmoles to 2 places and set volume label values
  for {set i 0} {$i <10} {incr i} {
    if { $mol_calc_info(molar_mol,$i) ne ""} {
        set mol_calc_info(molar_mol,$i) [format %.2f [expr {round(100 * $mol_calc_info(molar_mol,$i))/100.0}]]
    }
    if {$valid($i)}  {
      set mol_calc_info(molar_frag_volume,$i) [format %.2f [expr {round(100*$dna_vol($i))/100.0}]]
    } else {
      set mol_calc_info(molar_frag_volume,$i) ""
    }
  }

  if {[catch {set mol_calc_info(DNA_intermediate_volume) [format %.2f [expr {round(100 * $mol_calc_info(DNA_intermediate_volume))/100.0}]]}] || [catch {set mol_calc_info(total_water) [format %.2f [expr {round(100 * $mol_calc_info(total_water))/100.0}]]}] || $mol_calc_info(total_water) < 0} {
    set mol_calc_info(total_water) ""
    set mol_calc_info(DNA_intermediate_volume) ""
    set mol_calc_info(total_enz_volume) ""
    for {set i 0} {$i <10} {incr i} {
        set mol_calc_info(molar_mol,$i) ""
        set mol_calc_info(molar_frag_volume,$i) ""
    }
  }

  if {$dna_conc_percent < 100} {
    set mol_calc_info(total_dna_volume)  "$mol_calc_info(total_dna_volume) -Input DNA concentrations are too low ($dna_conc_percent %)"
    .mol_calc.n.tab2.conditions_frame.l1 configure -foreground red
  } else {
    if {$dna_conc_percent > 100} {
      set mol_calc_info(total_dna_volume)  "$mol_calc_info(total_dna_volume) ($dna_conc_percent %)"
    }
    .mol_calc.n.tab2.conditions_frame.l1 configure -foreground $info(text_fg_color)
  }
  #molar_frag_volume,$i
#total_water
#DNA_intermediate_volume
#total_dna_volume
#total_enz_volume

  calc_update_defaults
## show new reaction if modified
}


#################
proc calc_molar_reaction_gel_lane_drop {data f i} {
  global mol_calc_info
  set canvas [dict get $data canvas]
  set band [dict get $data band]
  set link_data [$canvas bind $band <<Link>>]
  if {$link_data == {}} {return}
  lassign $link_data window from_top to_top from_bottom to_bottom enz1 e1d enz2 e2d
sputs link $link_data
  calc_molar_reaction_fill_mr_row $i  [list "[file rootname [wm title $window]] $enz1-$enz2" [expr {($to_top - $from_top) % [ix2bp $window.textarea end]}]]
} 

#################
proc calc_molar_reaction_fill_menu {m i } {
  global mol_calc_info

  set j 0
  foreach window [dnawindows_list 1] {
    if {[ix2bp $window.textarea end] > 20} {
        $m add cascade -label [wm title $window] -menu $m.m$j
        menu $m.m$j -postcommand "calc_molar_reaction_post_w_menu $m.m$j $window $i"
        incr j
    }
  }
  $m add command -label [mc "Gel bands can be dropped here"] -command "" -state disabled
  set f [winfo parent [winfo parent $m]]
  $m add command -label [mc "Reset"] -command "calc_molar_reaction_clear_row $f $i"
}

#################
proc calc_molar_reaction_post_w_menu {m window i} {
  global mol_calc_info
  $m delete 0 end
  set len [ix2bp $window.textarea end]
  $m add command -label [mc "All"] -command "calc_molar_reaction_fill_mr_row $i \[list \"[file rootname [wm title $window]]\" [expr {$len}]\] "
  if {[$window.textarea tag ranges sel] ne {}} {
    set sel_start [ix2bp $window.textarea [$window.textarea index sel.first]] 
    set sel_end [ix2bp $window.textarea [$window.textarea index sel.last]]
    $m add command -label [mc "Selection (%s - %s)" $sel_start $sel_end] -command "calc_molar_reaction_fill_mr_row $i \[list \"[file rootname [wm title $window]] ($sel_start- $sel_end)\" [expr {$sel_end- $sel_start}]\] "
    $m add command -label [mc "Excluding Selection (%s - %s)" $sel_end $sel_start ] -command "calc_molar_reaction_fill_mr_row $i \[list \"[file rootname [wm title $window]] ($sel_end - $sel_start)\" [expr {$len-$sel_end+ $sel_start}]\] "
  }
}

#################
proc calc_mm_reaction_change_reaction {t} {
  global info mol_calc_info

  grid remove $t.new_reaction
  set reaction_name $mol_calc_info(mm_reaction_name)
  if {$reaction_name == "" || ![dict exists $info(calc_mm_raction_dict) $reaction_name]} {
    set reaction_data  [list "" 0 ]
  } else {
    set reaction_data  [dict get $info(calc_mm_raction_dict) $reaction_name]
  }
  set sum 0
  for {set i 0} {$i <10} {incr i} {
    set mol_calc_info(component_name,$i) [lindex $reaction_data [expr {$i*2}]]
    set mol_calc_info(frag_vol,$i) [lindex $reaction_data [expr {$i*2+1}]]
    if {$mol_calc_info(frag_vol,$i) != "" && [string is double $mol_calc_info(frag_vol,$i)]} {
      catch {set sum [expr {$sum + $mol_calc_info(frag_vol,$i)}]}
    }
  }
  set mol_calc_info(single_reaction_volume) $sum
  $t.reaction.m delete 0 end
  foreach r_name [dict keys $info(calc_mm_raction_dict)] {
     $t.reaction.m add radiobutton -label $r_name -value $r_name -variable mol_calc_info(mm_reaction_name) -command "calc_mm_reaction_change_reaction $t"
  }
  $t.reaction.m add separator
  $t.reaction.m add radiobutton -label [mc "Save New Reaction..."] -value [mc "New Reaction"] -variable mol_calc_info(mm_reaction_name) -command "calc_mm_reaction_new_reaction $t 0"
  $t.reaction.m add command -label [mc "Delete This Reaction..."] -command "calc_mm_reaction_new_reaction $t -1"

  calc_mm_reaction ""
}



############
proc calc_mm_reaction_new_reaction {t v} {
  global info mol_calc_info
  switch $v {
    0 {
      grid configure $t.new_reaction
      $t.reaction.m delete 0 end
      foreach r_name [dict keys $info(calc_mm_raction_dict)] {
         $t.reaction.m add radiobutton -label $r_name -value $r_name -variable mol_calc_info(mm_reaction_name) -command "calc_mm_reaction_change_reaction $t"
      }
    }
    1 {
     set reaction_name [string trim $mol_calc_info(new_name) " "]
     if {$reaction_name == ""} {
        tk_messageBox -message [mc "Please Name the Reaction"] -type ok
        return
      } elseif {[dict exists $info(calc_mm_raction_dict) $reaction_name]} {
        if {[tk_messageBox -message [mc "Overwrite the Reaction: %1s" $reaction_name] -type okcancel] eq "cancel"} {return}  
      }  
      set result [list]
      set sum 0
      for {set i 0} {$i <10} {incr i} {
        if {[info exists mol_calc_info(frag_vol,$i)] && $mol_calc_info(frag_vol,$i) !="" && [string is double $mol_calc_info(frag_vol,$i)]} {
          lappend result $mol_calc_info(component_name,$i) $mol_calc_info(frag_vol,$i)
          catch {set sum [expr {$sum + $mol_calc_info(frag_vol,$i)}]}
        }
      }
      set mol_calc_info(single_reaction_volume) $sum
      dict set info(calc_mm_raction_dict) $mol_calc_info(new_name) $result
      set mol_calc_info(mm_reaction_name) $mol_calc_info(new_name)
      $t.reaction.m delete 0 end
      foreach r_name [dict keys $info(calc_mm_raction_dict)] {
         $t.reaction.m add radiobutton -label $r_name -value $r_name -variable mol_calc_info(mm_reaction_name) -command "calc_mm_reaction_change_reaction $t"
      }
      $t.reaction.m add separator
      $t.reaction.m add radiobutton -label [mc "Save New Reaction..."] -value [mc "New Reaction"] -variable mol_calc_info(mm_reaction_name) -command "calc_mm_reaction_new_reaction $t 0"
      $t.reaction.m add command -label [mc "Delete This Reaction..."] -command "calc_mm_reaction_new_reaction $t -1"
      grid remove $t.new_reaction
      calc_mm_reaction ""
    }
    -1 {
      set reaction_name $mol_calc_info(mm_reaction_name)
      if {$reaction_name == "" || ![dict exists $info(calc_mm_raction_dict) $reaction_name]} {
        set reaction_data  [list "" 0 ]
        set mol_calc_info(mm_reaction_name) ""
      } else {
        dict unset info(calc_mm_raction_dict) $reaction_name
        $t.reaction.m delete 0 end
        foreach r_name [dict keys $info(calc_mm_raction_dict)] {
           $t.reaction.m add radiobutton -label $r_name -value $r_name -variable mol_calc_info(mm_reaction_name) -command "calc_mm_reaction_change_reaction $t"
        }
        $t.reaction.m add separator
        $t.reaction.m add radiobutton -label [mc "Save New Reaction..."] -value [mc "New Reaction"] -variable mol_calc_info(mm_reaction_name) -command "calc_mm_reaction_new_reaction $t 0"
        $t.reaction.m add command -label [mc "Delete This Reaction..."] -command "calc_mm_reaction_new_reaction $t -1"
        set mol_calc_info(mm_reaction_name) [lindex [dict keys $info(calc_mm_raction_dict)] 0]
        calc_mm_reaction_change_reaction $t
      }
    }
  }

}



###########
proc calc_mm_reaction {s} {
  global mol_calc_info

 # if {$mol_calc_info(single_reaction_volume) <= 0 || $mol_calc_info(num_reactions) <= 0} {return}
#calculate:
  set sum 0
  for {set i 0} {$i <10} {incr i} {
    if {[info exists mol_calc_info(frag_vol,$i)] && $mol_calc_info(frag_vol,$i) !="" && [string is double $mol_calc_info(frag_vol,$i)]} {
     catch {set sum [expr {$sum + $mol_calc_info(frag_vol,$i)}]}
    }
  }

  if {[regexp {frag_vol*} $s] } {
    set mol_calc_info(single_reaction_volume) [expr {round(100.0 * $sum) /100.0}]
  }
#frag_volume,$i (based on single_reaction_volume)
  set sum2 0
  for {set i 0} {$i <10} {incr i} {
    if {[info exists mol_calc_info(frag_vol,$i)] && $mol_calc_info(frag_vol,$i) ne {} && $mol_calc_info(single_reaction_volume) ne {} && $mol_calc_info(single_reaction_volume)  >0 && $mol_calc_info(num_reactions) ne {}  && $mol_calc_info(num_reactions) > 0   &&  [string is double $mol_calc_info(frag_vol,$i)] && $sum >0} {
      if {$s eq "single_reaction_volume"} {
        set mol_calc_info(frag_vol,$i) [expr {round(100.0 * $mol_calc_info(frag_vol,$i) * $mol_calc_info(single_reaction_volume) / $sum) / 100.0}]
      }
      if {$mol_calc_info(add_perc) ne "" && $mol_calc_info(perc_ul) in [list "%" "ul"] } {
        if {$mol_calc_info(perc_ul) eq "%"} {
          set mol_calc_info(mm_frag_volume,$i) [expr {round($mol_calc_info(frag_vol,$i) * $mol_calc_info(num_reactions) * (1.0+$mol_calc_info(add_perc)/100.0)*100) /100.0}]
        } else {
          set mol_calc_info(mm_frag_volume,$i) [expr {round($mol_calc_info(frag_vol,$i) * $mol_calc_info(num_reactions) * (1.0+ $mol_calc_info(add_perc)/($mol_calc_info(single_reaction_volume)* $mol_calc_info(num_reactions))) *100) /100.0}]
        }
      } else {
        set mol_calc_info(mm_frag_volume,$i) [expr {round($mol_calc_info(frag_vol,$i) * $mol_calc_info(num_reactions) * (1.0+0/100.0)*100) /100.0}]
     }
      set sum2 [expr {$sum2 + $mol_calc_info(mm_frag_volume,$i)}]
    } else {
        set mol_calc_info(mm_frag_volume,$i) ""
    }
  }
#total_mm_volume
  set mol_calc_info(total_mm_volume) [expr {round(100*$sum2)/100.0}]
  calc_update_defaults

## change to new reaction if components are edited
}

###########
proc calc_molarity_validate_seq {new_value t s} {
  after 10 "calc_molarity $t $s"
  return true
}


###########
proc calc_molarity_cb_fill_autocomplete {t cb} {
  global mol_calc_info
  if {![winfo exists $t.mw_frame.mol_wt] || ![info exists mol_calc_info(lookup_text)]} {return}
  if {$mol_calc_info(lookup_text) eq {}} {
    set mol_calc_info(mol_wt) 0
    catch {mol_png blank; mol_png configure -height 1}
    $t.mw_frame.mol_wt state !disabled
    calc_molarity $t mol_wt
    return
  }
  set url  "https://pubchem.ncbi.nlm.nih.gov/rest/autocomplete/compound/[::http::quoteString $mol_calc_info(lookup_text)]/jsonp"
  lassign [get_html $url] err html
  set vals [list]
  set len [string length $mol_calc_info(lookup_text)]
  set found 0
  if {$err eq "ok" && [regexp  {"compound": \[\n(.*)\n\s+\]} $html -- res]} {
    foreach {-- name} [regexp -inline -all {\"([^\"]+)\"} $res] {
      lappend vals $name
      if {!$found && [string tolower [string range $name 0 $len-1]] eq [string tolower $mol_calc_info(lookup_text)]} {
        set found 1
        set mol_calc_info(lookup_text) $name
        $cb selection clear
        $cb selection range $len end
      }
    }
  } 
  $cb conf -values $vals
  calc_molarity_cb_check_autocomplete $t $cb
}

###########
proc calc_molarity_cb_check_autocomplete {t cb} {
  global mol_calc_info
  if {![winfo exists $t.mw_frame.mol_wt]} {return}
update idletasks
  set url  "https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/[::http::quoteString $mol_calc_info(lookup_text)]/property/MolecularWeight/TXT"
  lassign [get_html $url] err html
  if {$err eq "ok" && [string is double $html]} {
    #sputs mol  wt $html
    set mol_calc_info(mol_wt) $html
    $t.mw_frame.mol_wt state disabled
    calc_molarity $t mol_wt
    set url "https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/[::http::quoteString $mol_calc_info(lookup_text)]/PNG?record_type=2d&image_size=small"
    catch {mol_png blank; mol_png configure -height 0}
    if {[set f [save_png_from_url $url]] eq "" || [catch {mol_png read $f}]} {
      mol_png configure -height 1
    }
  } else {
    set mol_calc_info(mol_wt) 0
    catch {mol_png blank; mol_png configure -height 1}
    $t.mw_frame.mol_wt state !disabled
  }
}

###########
proc calc_molarity {t s} {
  global mol_calc_info

#molar_first
#molar_unit1
#molar_vol1
#molar_unit2
#molar_vol2 $t.vol2

#calc:molar_second

  if {$mol_calc_info(molar_unit_MW) in [list "nucleotides ssDNA"  "base pairs dsDNA" "nucleotides RNA"]} {
    grid configure $t.mw_frame.nuc_sequence
    grid remove $t.mw_frame.compound_lookup
    grid remove $t.mw_frame.mol_png
  } else {
    grid configure $t.mw_frame.compound_lookup
    grid configure $t.mw_frame.mol_png
    grid remove $t.mw_frame.nuc_sequence
  }
  if {($mol_calc_info(molar_unit1) in [list g mg ug ng pg] &&  $mol_calc_info(molar_unit2) in [list mole mmole umole nmole pmole]) || ($mol_calc_info(molar_unit2) in [list g mg ug ng pg] &&  $mol_calc_info(molar_unit1) in [list mole mmole umole nmole pmole]) || ($mol_calc_info(molar_unit1) in [list "%(wt/vol)"] && $mol_calc_info(molar_unit2) in [list mole mmole umole nmole pmole])} {
	grid configure $t.mw_frame
  } else {
	grid remove $t.mw_frame
  }

  set vol_conv1 1
  set vol_conv2 1
  if {($mol_calc_info(molar_vol1) in [list /L /mL /uL])} {
    grid configure $t.vol2
    grid configure $t.vol_frame
    set vol_conv1 [string map [list /L 1 /mL 1e3 /uL 1e6] $mol_calc_info(molar_vol1)]
    set vol_conv2 [string map [list  /L 1 /mL 1e3 /uL 1e6] $mol_calc_info(molar_vol2)]
  } elseif {($mol_calc_info(molar_unit1) in [list "%(wt/vol)"] )} {
    grid configure $t.vol2
    grid configure $t.vol_frame
    set vol_conv1 1e1
    set vol_conv2 [string map [list  /L 1 /mL 1e3 /uL 1e6] $mol_calc_info(molar_vol2)]
  } else {
    grid remove $t.vol2
    grid remove $t.vol_frame
  }

  if {$mol_calc_info(molar_unit_MW) in [list "nucleotides ssDNA"  "base pairs dsDNA" "nucleotides RNA"]} {
    grid configure $t.mw_frame.nuc_sequence
    grid remove $t.mw_frame.compound_lookup
    set seq [$t.mw_frame.nuc_sequence get]
    if {$mol_calc_info(molar_unit_MW) in [list "nucleotides RNA"]} {
      set seq [string map {T U t u} $seq]
    } else {
      set seq [string map {U T u t} $seq]
    }
    regsub -all {[^ACGTUacgtu]} $seq "" seq
    $t.mw_frame.mol_wt state !disabled
    $t.mw_frame.nuc_sequence configure -validate none
    $t.mw_frame.nuc_sequence delete 0 end
    $t.mw_frame.nuc_sequence insert 0 $seq
    $t.mw_frame.nuc_sequence configure -validate key
    if {$seq eq ""} {
    } else {
      set mol_calc_info(mol_wt) [string length $seq]
      $t.mw_frame.mol_wt state disabled
    }
  } else {
    grid remove $t.mw_frame.nuc_sequence
    grid configure $t.mw_frame.compound_lookup
  }

  ## check for blank fields
  if {[catch {expr {$mol_calc_info(molar_first) * $mol_calc_info(mol_wt) * $mol_calc_info(molar_vol)} }] || $mol_calc_info(mol_wt) < 1} {
    set mol_calc_info(molar_second) ""
    set mol_calc_info(molar_g_per_l) ""
    return
  }

  switch $mol_calc_info(molar_unit_MW) {
    "nucleotides ssDNA" {
      if {$seq ne ""} {
        #dA: 313.23 dT: 304.21 dG: 329.23 dC: 289.20 + 18.02 g/mol is added for the 1 -OH and 1 -H added back to the ends.
        set a_count [string length [string map -nocase {c "" g "" t "" n "" b "" d "" h "" k "" m "" r "" v "" w "" y "" * ""} $seq]]
        set c_count [string length [string map -nocase {a "" g "" t "" n "" b "" d "" h "" k "" m "" r "" v "" w "" y "" * ""} $seq]]
        set g_count [string length [string map -nocase {a "" c "" t "" n "" b "" d "" h "" k "" m "" r "" v "" w "" y "" * ""} $seq]]
        set t_count [string length [string map -nocase {a "" c "" g "" n "" b "" d "" h "" k "" m "" r "" v "" w "" y "" * ""} $seq]]
        set molecular_weight [expr {1.0 * $a_count * 313.23 + $c_count * 289.20 + $g_count * 329.23 + $t_count * 304.21 + 18.02}]
      } else {
        set molecular_weight [expr {1.0 * $mol_calc_info(mol_wt) * 308.97 + 18.02}]
       }
    }
    "base pairs dsDNA" {
      if {$seq ne ""} {
        #dA/dT: 617.44 dG/dC: 618.22 + 36.04 g/mol is added for the 2 -OH and 2 -H added back to the ends.
        set at_count [string length [string map -nocase {c "" g ""  n "" b "" d "" h "" k "" m "" r "" v "" w "" y "" * ""} $seq]]
        set gc_count [string length [string map -nocase {a "" t "" n "" b "" d "" h "" k "" m "" r "" v "" w "" y "" * ""} $seq]]
        set molecular_weight [expr {1.0 * $at_count * 617.44 + $gc_count * 618.22  + 36.04}]
      } else {
         set molecular_weight [expr {1.0 * $mol_calc_info(mol_wt) * 617.96 + 36.04 }]
       }
    }
    "nucleotides RNA" {
      if {$seq ne ""} {
        #A: 329.2 U: 306.2 dG: 345.2 dC: 305.2 + 18.02 g/mol is added for the 1 -OH and 1 -H added back to the ends.
        set a_count [string length [string map -nocase {c "" g "" u "" n "" b "" d "" h "" k "" m "" r "" v "" w "" y "" * ""} $seq]]
        set c_count [string length [string map -nocase {a "" g "" u "" n "" b "" d "" h "" k "" m "" r "" v "" w "" y "" * ""} $seq]]
        set g_count [string length [string map -nocase {a "" c "" u "" n "" b "" d "" h "" k "" m "" r "" v "" w "" y "" * ""} $seq]]
        set u_count [string length [string map -nocase {a "" c "" g "" n "" b "" d "" h "" k "" m "" r "" v "" w "" y "" * ""} $seq]]
        set molecular_weight [expr {1.0 * $a_count * 329.2 + $c_count * 305.2 + $g_count * 345.2 + $u_count * 306.2 + 18.02}]
      } else {
        set molecular_weight [expr {1.0 * $mol_calc_info(mol_wt) * 321.47 + 18.02}]
       }
    }
    default {
      set molecular_weight [expr {1.0 * $mol_calc_info(mol_wt)}]
     }
  }

  set unit_conv1 1
  set unit_conv1 [string map [list %(wt/vol) 1 g 1 mg 1e-3 ug 1e-6 ng 1e-9 pg 1e-12 mole 1 mmole 1e-3 umole 1e-6 nmole 1e-9 pmole 1e-12] $mol_calc_info(molar_unit1)]
  set unit_conv2 1
  set unit_conv2 [string map [list g 1 mg 1e-3 ug 1e-6 ng 1e-9 pg 1e-12 mole 1 mmole 1e-3 umole 1e-6 nmole 1e-9 pmole 1e-12] $mol_calc_info(molar_unit2)]

  if {$mol_calc_info(molar_unit1) eq "%(wt/vol)" } {
    if {$mol_calc_info(molar_unit2) in [list mole mmole umole nmole pmole]} {
      set mol2 [expr {1.0 * $mol_calc_info(molar_first) / $molecular_weight * $unit_conv1 / $unit_conv2 * $vol_conv1 / $vol_conv2}]
    } else {
      set mol2 [expr {1.0 * $mol_calc_info(molar_first) * $unit_conv1 / $unit_conv2 * $vol_conv1 / $vol_conv2}]
    }
  } elseif {($mol_calc_info(molar_unit1) in [list g mg ug ng pg] &&  $mol_calc_info(molar_unit2) in [list mole mmole umole nmole pmole])} {
    set mol2 [expr {1.0 * $mol_calc_info(molar_first) / $molecular_weight * $unit_conv1 / $unit_conv2 * $vol_conv1 / $vol_conv2}]
  } elseif  {($mol_calc_info(molar_unit2) in [list g mg ug ng pg] &&  $mol_calc_info(molar_unit1) in [list mole mmole umole nmole pmole])} {
    set mol2 [expr {1.0 * $mol_calc_info(molar_first) * $molecular_weight * $unit_conv1 / $unit_conv2 * $vol_conv1 / $vol_conv2}]
  } else {
    set mol2 [expr {1.0 * $mol_calc_info(molar_first) * $unit_conv1 / $unit_conv2 * $vol_conv1 / $vol_conv2}]
  }


  if {0} {
    set sig_dig [expr {round(log($mol2)/log(10))}] 
    set fmt "%.[expr {abs($sig_dig-2)}]g"
    set mol2 [expr {1.0*round($mol2*10**abs($sig_dig-2)) /10**abs($sig_dig-2)}]
  } else {
    set fmt "%.3g"
   # set mol2 [expr {round($mol2*100) /100.0}]
  }

  set mol_calc_info(molar_second) [format $fmt $mol2]



  ## set menu $t.vol_frame.unitv.m to units of molar_unit2
  set f $t.vol_frame

  ## don't change the units- calculate the other two units for any given unit
  if {0} {
  $f.unitv.m delete 0 end
  if {$mol_calc_info(molar_unit2) in [list g mg ug ng pg]} {
    foreach m [list L mL uL g mg ug ng] {
      $f.unitv.m add radiobutton -label $m -value $m -variable mol_calc_info(molar_unit_vol) -command "calc_molarity $t unit_vol"
    }
    if {$mol_calc_info(molar_unit_vol) ni [list L mL uL g mg ug ng]} {
      set mol_calc_info(molar_unit_vol) mL
    }
  } else {
    foreach m [list L mL uL mole mmole umole nmole pmole] {
      $f.unitv.m add radiobutton -label $m -value $m -variable mol_calc_info(molar_unit_vol) -command "calc_molarity $t unit_vol"
   }
    if {$mol_calc_info(molar_unit_vol) ni [list L mL uL mole mmole umole nmole pmole]} {
      set mol_calc_info(molar_unit_vol) mL
    }
  }
  }
#calculate:
  set unit_conv3 [string map [list  L 1 mL 1e3 uL 1e6 g 1 mg 1e3 ug 1e6 ng 1e9 pg 1e12 mole 1 mmole 1e3 umole 1e6 nmole 1e9 pmole 1e12] $mol_calc_info(molar_unit_vol)]
  set key 0
  set calc_value [expr {$mol_calc_info(molar_first)* $unit_conv1}]

  if {$mol_calc_info(molar_unit1) in [list g mg ug ng pg "%(wt/vol)"] || $mol_calc_info(molar_unit2) in [list g mg ug ng pg]} {
    incr key 4
  }
  if {$mol_calc_info(molar_unit1) in [list mole mmole umole nmole pmole] || $mol_calc_info(molar_unit2) in [list mole mmole umole nmole pmole]} {
    incr key 2
  }
  if {$mol_calc_info(molar_unit1) in [list mole mmole umole nmole pmole] && $mol_calc_info(molar_unit2) in [list g mg ug ng pg]} {
    set calc_value [expr {$calc_value * $molecular_weight}]
  } 
  if {$mol_calc_info(molar_vol1) ne {} || $mol_calc_info(molar_unit1) in [list "%(wt/vol)"]} {
    incr key 1
    set calc_value [expr {$calc_value* $vol_conv1}]
  }
  switch $key {
    3 {
       # calc_value in moles/L
      if {$mol_calc_info(molar_unit_vol) in [list L mL uL nL]} {
        set mol_calc_info(molar_g_per_l) " =  [calc_set_units [expr {1.0 * $calc_value /($mol_calc_info(molar_vol)/$unit_conv3) }] mole] "
      } elseif {$mol_calc_info(molar_vol) in [list g mg ug ng]} {
        set mol_calc_info(molar_g_per_l) " "
      } elseif {$mol_calc_info(molar_vol) in [list mole mmole umole nmole]} {
        set mol_calc_info(molar_g_per_l) " =  [calc_set_units [expr {1.0 /  ($mol_calc_info(molar_vol)/$unit_conv3) / $calc_value}] L] "
      }
    }
    5 {
       # calc_value in g/L, no mol wt
      if {$mol_calc_info(molar_unit_vol) in [list L mL uL nL]} {
        set mol_calc_info(molar_g_per_l) " =  [calc_set_units [expr {1.0 * $calc_value *($mol_calc_info(molar_vol)/$unit_conv3) }] g] "
      } elseif {$mol_calc_info(molar_unit_vol) in [list g mg ug ng]} {
        set mol_calc_info(molar_g_per_l) " = [calc_set_units [expr {1.0 *  ($mol_calc_info(molar_vol)/$unit_conv3) / $calc_value}] L]"
      } elseif {$mol_calc_info(molar_unit_vol) in [list mole mmole umole nmole]} {
        set mol_calc_info(molar_g_per_l) "   "
      }
    }
    7 {
       # calc_value in g/L, with mol wt
      if {$mol_calc_info(molar_unit_vol) in [list L mL uL nL]} {
        set mol_calc_info(molar_g_per_l) " =  [calc_set_units [expr {1.0 * $calc_value *($mol_calc_info(molar_vol)/$unit_conv3) }] g] , [calc_set_units [expr {1.0 * $calc_value *($mol_calc_info(molar_vol)/$unit_conv3)/ $molecular_weight }] mole] "
      } elseif {$mol_calc_info(molar_unit_vol) in [list g mg ug ng]} {
        set mol_calc_info(molar_g_per_l) " = [calc_set_units [expr {1.0 *  ($mol_calc_info(molar_vol)/$unit_conv3) / $calc_value}] L], [calc_set_units [expr {1.0 * ($mol_calc_info(molar_vol)/$unit_conv3) / $molecular_weight }] mole]"
      } elseif {$mol_calc_info(molar_unit_vol) in [list mole mmole umole nmole]} {
        set mol_calc_info(molar_g_per_l) " = [calc_set_units [expr {1.0 *  ($mol_calc_info(molar_vol)/$unit_conv3)*$molecular_weight / $calc_value}] L], [calc_set_units [expr {1.0 *  ($mol_calc_info(molar_vol)/$unit_conv3) * $molecular_weight }] g]"
      }
    }
  }
#molar_g_per_l
  calc_update_defaults
}


###########
proc calc_set_units {value units} {
   set l [expr {floor(log($value)/log(10))}]
  if {$l < -9} {
    return "[format %.3g [expr {$value * 1e12}]] p$units"
  } elseif {$l < -6} {
    return "[format %.3g [expr {$value * 1e9}]] n$units"
  } elseif {$l < -3} {
    return "[format %.3g [expr {$value *1e6}]] u$units"
  } elseif {$l < 0} {
    return "[format %.3g [expr {$value *1e3}]] m$units"
  } else {
    return "[format %.3g [expr {$value }]] $units"
  }
}

###########
proc calc_molarity_recipe_mult {} {
  global mol_calc_info tcl_platform
  set result [list]
  if {[catch {clipboard get} clip_data]} {sputs error clip_data $clip_data;return}
  if {[regexp {\n} $clip_data]} {
    set clip_list [split $clip_data "\n"]
  } elseif {[regexp {;} $clip_data]} {
    set clip_list [split $clip_data ";"]
  } else {
    set clip_list [split $clip_data ","]
  }
  foreach line $clip_list {
    if {[regexp  {\s*([0-9.]+)\s*((?:[mun]?g/[mun]?[lL])|(?:[mun]?M))\s+(.*)} $line -- amt unit chem] || [regexp  {(.*)[[:space:]]+([0-9.]+)\s*((?:[mun]?g/[mun]?[lL])|(?:[mun]?M))\s*} $line -- chem amt unit] || [regexp  {\s*([0-9.]+)\s*(\%\s*\(wt?/v\))\s+(.*)} $line -- amt unit chem] || [regexp  {(.*)[[:space:]]+([0-9.]+)\s*(\%\s*\(wt?/v\))\s*} $line -- chem amt unit]} {
      regsub -all {[^A-Za-z0-9\s]} $chem "" chem
      set chem [string trim $chem " "]
      if {$unit in [list M mM uM nM]} {
        set url  "https://pubchem.ncbi.nlm.nih.gov/rest/pug/compound/name/[::http::quoteString $chem]/property/MolecularWeight/TXT"
        lassign [get_html $url] err html
        if {[regexp {(^[0-9\.]+)\n} $html -- first_number]} {
          set html $first_number
        }
        if {$err eq "ok" && [string is double $html]} {
          set mult [string map [list M 1 mM .001 uM 1e-6 nM 1e-9] $unit]
          set amt [expr {$amt * $html *$mult}]
          lappend result "$line [format %.2g [expr {$amt * $mol_calc_info(recipe_mult_vol)}]]g"
        } else {
          lappend result "#no compund recognized# $line"
        }
      } elseif {[string index $unit 0] eq "%"} { 
        ## % wt/vol
        lappend result "$line [format %.2g [expr {$amt *10 * $mol_calc_info(recipe_mult_vol)}]]g"
      } elseif {[regexp {([mun]?g)/([mun]?[lL])} $unit -- gunit lunit]} {
        set gmult [string map [list g 1 mg .001 ug 1e-6 ng 1e-9] $gunit]
        set lmult [string map [list l 1 ml 1000 ul 1e6 nl 1e9 L 1 mL 1000 uL 1e6 nL 1e9] $lunit]
        set amt [expr {$amt * $gmult *$lmult}]
        lappend result "$line [format %.2g [expr {$amt * $mol_calc_info(recipe_mult_vol)}]]g"
      }
    }
  }
  #sputs [join $result \n]
   clipboard clear 
    clipboard_append -displayof .mol_calc  [join $result \n]
    if {($tcl_platform(platform) == "unix") && ([tk windowingsystem] != "aqua")} {
      selection own -selection CUT_BUFFER0 .mol_calc
      selection own -selection CLIPBOARD .mol_calc
    }
}


###########
proc calc_update_defaults {} {
  global mol_calc_info info  

  foreach key $info(calc_defaults) {
    if {[info exists mol_calc_info($key)]} {
      dict set info(calc_defaults) $key $mol_calc_info($key)
    }
  }
}

#################
proc calc_stock_dilution_update {s {p "nn"}} {
  global mol_calc_info
  if {[catch {expr {$mol_calc_info(final_volume) *$mol_calc_info(final_conc) * $mol_calc_info(stock_conc)}}] || $mol_calc_info(stock_conc) ==0} {
    set mol_calc_info(stock_volume) ""
    set mol_calc_info(water_volume) ""
    return
  }
  if {$p != "nn"} {
    if {![string is double $p] || $p==""} {
      return 0
    }
    if {[info exists mol_calc_info($s)]} {
      set mol_calc_info($s) $p
    }
  }
  if {$s eq "stock_units"} {
    if {$mol_calc_info(stock_units) eq "X"} {
      set mol_calc_info(final_conc_units) "X"
    } elseif {$mol_calc_info(final_conc_units) eq "X"} {
      set mol_calc_info(final_conc_units) $mol_calc_info(stock_units)
    }
  }
  if {$s eq "final_conc_units"} {
    if {$mol_calc_info(final_conc_units) eq "X"} {
      set mol_calc_info(stock_units) "X"
    } elseif {$mol_calc_info(stock_units) eq "X"} {
      set mol_calc_info(stock_units) $mol_calc_info(final_conc_units)
    }
  }

  set unit_diff [expr {10.0** (3* ([lsearch [list M mM uM nM pM X] $mol_calc_info(stock_units)] - [lsearch [list M mM uM nM pM X] $mol_calc_info(final_conc_units)]) )}]

#calculate

   set stock_volume [expr {$mol_calc_info(final_volume) * $mol_calc_info(final_conc) *  $unit_diff /$mol_calc_info(stock_conc)}]
   set stock_adj_vol_units $mol_calc_info(final_vol_units)
   set adj_stock_volume $stock_volume
   while {$adj_stock_volume < 1 && $stock_adj_vol_units ne "uL"} {
     set adj_stock_volume [expr {1000.0 * $adj_stock_volume}]
     if {$stock_adj_vol_units eq "L"} {
       set stock_adj_vol_units "mL"
     } elseif {$stock_adj_vol_units eq "mL"} {
       set stock_adj_vol_units "uL"
     }
   }
   set adj_stock_volume [expr {round($adj_stock_volume * 100.0) / 100.0}]
   set mol_calc_info(stock_volume) "$adj_stock_volume $stock_adj_vol_units"

   set water_volume [expr {($mol_calc_info(final_volume) - $stock_volume)}]
   set water_adj_vol_units $mol_calc_info(final_vol_units)
   set adj_water_volume $water_volume
   while {$adj_water_volume < 1 && $water_adj_vol_units ne "uL"} {
     set adj_water_volume [expr {1000.0 * $adj_water_volume}]
     if {$water_adj_vol_units eq "L"} {
       set water_adj_vol_units "mL"
     } elseif {$water_adj_vol_units eq "mL"} {
       set water_adj_vol_units "uL"
     }
   }
   set adj_water_volume [expr {round (100.0 * $adj_water_volume) / 100.0}]


   if {$water_volume < 0} {
      set mol_calc_info(stock_volume) "Error"
      set mol_calc_info(water_volume) ""
   } else {
     set mol_calc_info(water_volume) "$adj_water_volume $water_adj_vol_units"
   }
#stock_volume (+stock_volume_units )
#water_volume (+water_volume_units)
  calc_update_defaults
}

##############
## Output the calulator to the clipboard or a qr code
##############
proc calc_output {tab mode} {
  global mol_calc_info tcl_platform
  set result ""

  if {$mode eq "clipboard"} {
    switch $tab {
      2 {
        append result "Reaction: $mol_calc_info(molar_reaction_name)\n"
        append result "Fragment Name\tSize (kb)\tng/ul\tratio\tVolume\n"
        for {set i 0} {$i < 10} {incr i} {
          if {$mol_calc_info(molar_frag_volume,$i) ne {}} {
            append result "$mol_calc_info(frag_name,$i)\t$mol_calc_info(frag_size,$i)\t$mol_calc_info(frag_conc,$i)\t$mol_calc_info(frag_ratio,$i)\t$mol_calc_info(molar_frag_volume,$i) ul\n"
          }
        }
        append result "Water: $mol_calc_info(total_water) ul\n\n"
        append result "DNA mix: $mol_calc_info(total_dna_volume) ul\n"
        append result "Enzyme+Buffer mix: $mol_calc_info(total_enz_volume) ul\n"
        append result "Notes: $mol_calc_info(molar_comment)"
      }
      3 {
        append result "Reaction: $mol_calc_info(mm_reaction_name)\n"
        append result "Single Reaction Volume: $mol_calc_info(single_reaction_volume)\n"
        append result "Reaction Number: $mol_calc_info(num_reactions)\n"
        for {set i 0} {$i < 10} {incr i} {
          if {$mol_calc_info(mm_frag_volume,$i) ne {}} {
            append result "$mol_calc_info(component_name,$i)\t$mol_calc_info(mm_frag_volume,$i)\n"
          }
       }
      }
      4 {
        append result "\[Stock\]: $mol_calc_info(stock_conc) $mol_calc_info(stock_units)\n"
        append result "Final: $mol_calc_info(final_volume) $mol_calc_info(final_vol_units) of $mol_calc_info(final_conc) $mol_calc_info(final_conc_units)\n"
        append result "Add : $mol_calc_info(stock_volume) of stock\n"
        append result "To : $mol_calc_info(water_volume) water.\n"
      }
    }
    clipboard clear 
    clipboard_append -displayof .mol_calc  $result
    if {($tcl_platform(platform) == "unix") && ([tk windowingsystem] != "aqua")} {
      selection own -selection CUT_BUFFER0 .mol_calc
      selection own -selection CLIPBOARD .mol_calc
    }
    set info(clipboard_text) {}
    set info(clipboard_tags) {}
  } elseif {$mode eq "qr"} {
    switch $tab {
      2 {
        set result ""
        set max_line 30
       #max length - 230 chars?
        while {$result eq {} || ([string length $result] > 220 && $max_line > 5)} {
          set result ""
          for {set i 0} {$i < 10} {incr i} {
            if {$mol_calc_info(molar_frag_volume,$i) ne {}} {
              append result "[string range $mol_calc_info(frag_name,$i) 0 $max_line]  $mol_calc_info(molar_frag_volume,$i)\n"
            }
          }
          if {$mol_calc_info(total_water) != 0} { 
            append result "H2O: $mol_calc_info(total_water)\n"
          }
          append result "\n"
          append result "DNA: $mol_calc_info(total_dna_volume)\n"
          append result "EnzBuff: $mol_calc_info(total_enz_volume)"
          incr max_line -1

        }
        ## add the data URI
        #set result "data:text/plain;$result"
        set c .mol_calc.n.tab2.c
        catch {[canvas $c -bg white]}
        grid configure $c -column 1 -row 1 -columnspan 3 -rowspan 2 -sticky nswe
      }
      3 {
        set result "data:,"
        append result "Reaction Vol $mol_calc_info(single_reaction_volume)\n"
        for {set i 0} {$i < 10} {incr i} {
          if {$mol_calc_info(mm_frag_volume,$i) ne {}} {
            append result "[string range mol_calc_info(component_name,$i) 0 20] $mol_calc_info(mm_frag_volume,$i)\n"
          }
       }
        set c .mol_calc.n.tab3.c
        catch {set c [canvas $c -bg white]}
        grid configure $c -column 1 -row 1 -columnspan 3 -rowspan 5 -sticky nswe
      }
      4 {
        set result "data:,"
        append result "\[Stock\]: $mol_calc_info(stock_conc) $mol_calc_info(stock_units)\n"
        append result "Final: $mol_calc_info(final_volume) $mol_calc_info(final_vol_units) of $mol_calc_info(final_conc) $mol_calc_info(final_conc_units)\n"
        append result "Add: $mol_calc_info(stock_volume) of stock\n"
        append result "To: $mol_calc_info(water_volume) water."
        set c .mol_calc.n.tab4.c
        catch {set c [canvas $c -bg white]}
        grid configure $c -column 1 -row 1 -columnspan 8 -rowspan 5 -sticky nswe
      }
    }
    #$c delete all
    canvas_delete_all $c
    bind $c <Any-Button> "destroy $c"
    #sputs $result
    #max length - 230 chars?
# toplevel .t
# set c [canvas .t.c -bg white]
# grid $c -row 1 -column 1 -sticky nswe
# grid columnconfigure .t 1 -weight 1
# grid rowconfigure .t 1 -weight 1
    set qr_data [qrcode::make $result -eclevel L]
    set q_length [llength $qr_data]
    update idletasks
    set box_size [expr {min([winfo width $c], [winfo height $c]) / $q_length}]
    set margin [expr {(min([winfo width $c], [winfo height $c]) - $box_size *$q_length) /2 }]
    set y $margin
    foreach row $qr_data {
      set x $margin
      foreach pixel $row {
        if {$pixel} {
          $c create rectangle $x $y [expr {$x+$box_size}] [expr {$y+$box_size}] -fill black -outline {}
        }
        incr x $box_size
      }
      incr y $box_size
    }
  }
}

##############
## qr code generator
##############
proc qr_test {qr_input} {
 toplevel .t
 set c [canvas .t.c -bg white -height 500 -width 500]
 grid $c -row 1 -column 1 -sticky nswe
 grid columnconfigure .t 1 -weight 1
 grid rowconfigure .t 1 -weight 1
  update idletasks
  set qr_data [qrcode::make $qr_input -eclevel H]
  set q_length [llength $qr_data]
  set box_size [expr {min([winfo width $c], [winfo height $c]) / $q_length}]
  set margin [expr {(min([winfo width $c], [winfo height $c]) - $box_size *$q_length) /2 }]
  set y $margin
  foreach row $qr_data {
    set x $margin
    foreach pixel $row {
      if {$pixel} {
        $c create oval $x $y [expr {$x+$box_size}] [expr {$y+$box_size}] -fill black -outline {}
      }
      incr x $box_size
    }
    incr y $box_size
  }
  
  set result ""
  foreach {row0 row1} $qr_data {
    set r ""
    foreach a $row0 b $row1 {
      if {$a} {
        if {$b eq "" || !$b} {
          append r \u2580
        } else {
          append r \u2588
        }
      } else {
        if {$b eq "" || !$b} {
          append r " "
        } else {
          append r \u2584
        }
      }
    }
    append result $r \n
  }
}

##############
## show all sites that can be generated keeping the same translation
##############
proc silent_sites {w selected_enzymes} {
  global info
  global enzinfo
  global enzymes
  global modstring modifier

  set seq_len [ix2bp $w.textarea end]

  if {[$w.textarea tag ranges sel] == ""} {
    set start 0
    set end [ix2bp $w.textarea end]
    set DNA [textarea_get $w.textarea [bp2ix $w.textarea $start] [bp2ix $w.textarea $end]]
  } elseif {[llength [$w.textarea tag ranges sel]] == 2} {
    set  start [ix2bp $w.textarea [$w.textarea index sel.first]]
    set end [ix2bp $w.textarea [$w.textarea index sel.last]]
    set DNA [textarea_get $w.textarea [bp2ix $w.textarea $start] [bp2ix $w.textarea $end]]
  } else {
    set  start [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 2]]
    set end [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 1]]
    set DNA "[textarea_get $w.textarea [bp2ix $w.textarea $start] end][textarea_get $w.textarea 1.0 [bp2ix $w.textarea $end]]"
  }
#selection used here - ok
  if {$selected_enzymes == [list]} {
    tk_messageBox -message [mc "No enzymes selected, searching all enzymes."] -type ok -icon info -default ok
    set selected_enzymes $enzymes
  } else {
    tk_messageBox -message [mc "Searching %s selected enzymes." [llength $selected_enzymes]] -type ok -icon info -default ok
  }

  if {[array names enzinfo 3ftrxl*] == [list]} {
    foreach enzyme $enzymes {
      set enzinfo(3ftrxl,$enzyme) [degen_transl $enzinfo(flatpat,$enzyme)]
    }
  }

  findenzymes $w


  incr start
  incr end
  set AA [translate $DNA]
  set templist [list]

  foreach enzyme $selected_enzymes {
    foreach trxl $enzinfo(3ftrxl,$enzyme) frame [list 2 1 0] {
      foreach pair [regexp -indices -all -inline $trxl $AA] {
#sputs $enzyme $info($w,$enzyme) [expr {$start+3*[lindex $pair 0]+$frame}] [lsearch $info($w,$enzyme) [expr {$start+3*[lindex $pair 0]+$frame}]]
        if {[lsearch $info($w,$enzyme) [expr {$start+3*[lindex $pair 0]+$frame}]] == -1} {
          lappend templist [list $enzyme $frame [expr {$start+3*[lindex $pair 0]+$frame}] [string range $DNA [expr {3*[lindex $pair 0]}] [expr {2+3*[lindex $pair 1]}]]]
        }
      }
    }
  }

  set a [new_analysis_window $w "Silent Sites" silent_sites]
  create_textframe $a 40
  $a.textframe.text configure -tabs {3.5c right 3.5c left}

  catch {$a.textframe.text insert end "[clock format [clock seconds] -format $info(clock_format)]\n"}
  $a.textframe.text insert end "[wm title $w] \n"
  $a.textframe.text insert end "[mc From] $start [mc to] [expr {$end-1}]\. \n"
  $a.textframe.text insert end "Silent Sites\n\n"

  set templist [lsort -integer -index 2 $templist]
  foreach site $templist {
  #site: name of enzyme, frame, start index of enzyme, DNA sequence
    #pad the RE sequence with N and find the minimal change to give the same translation (stored in new_seq)
    set original_seq [lindex $site 3]
    set re_seq "[string repeat "N" [lindex $site 1]]$enzinfo(flatpat,[lindex $site 0])"
    set re_seq "$re_seq[string repeat "N" [expr {(3-[string length $re_seq]%3)%3}]]"
    set new_seq_list [coordinate_translation $original_seq $re_seq]

    #output to text window
    set ls_tag "ls[expr {seq_len_mod([lindex $site 2]-[lindex $site 1], $seq_len)}]_1"
    $a.textframe.text insert end "\t[expr {seq_len_mod([lindex $site 2]-[lindex $site 1], $seq_len)}]\t" {} "[regexp -inline -all {(?:...)} [lindex $site 3]]" [list dnatag $ls_tag] "\n"
    foreach new_seq $new_seq_list {
      #$a.textframe.text insert end "\t\t[regexp -inline -all {(?:...)} $new_seq]\n"
      $a.textframe.text insert end "\t\t"
      for {set i1 0} {$i1 < [string length $new_seq]} {incr i1} {
        if {[expr {$i1 %3}] == 0 && $i1 > 0} {
          $a.textframe.text insert end " "
        }
        if {[string toupper [string index $new_seq $i1]] == [string toupper [string index [lindex $site 3] $i1]]} {
          $a.textframe.text insert end [string toupper [string index $new_seq $i1]]
        } else {
          $a.textframe.text insert end [string toupper [string index $new_seq $i1]] [list highlight]
        }
      }
      $a.textframe.text insert end "\n"
    }
    $a.textframe.text insert end "\t[lindex $site 0]\t[join [regexp -inline -all {(?:...)} "[string repeat " " [lindex $site 1]]$enzinfo(flatpat,[lindex $site 0])   "] " "]\n"
    $a.textframe.text insert end "\t\t [translate [lindex $site 3] 1 1 3]\n\n"
  }

  if {$templist == ""} {
    $a.textframe.text insert end "No sites Found"
  }

  #bindings
  $a.textframe.text tag configure highlight -font bolddnafont  -foreground red
  $a.textframe.text tag bind dnatag <Double-Button-1> "alignlink2 $a.textframe.text $w \[$a.textframe.text index @%x,%y\] goto 1; break"
  $a.textframe.text tag bind dnatag <Button-1> "alignlink2 $a.textframe.text $w \[$a.textframe.text index @%x,%y\] goto 0; break"
  $a.textframe.text tag bind dnatag <Shift-Button-1> "alignlink2 $a.textframe.text $w \[$a.textframe.text index @%x,%y\] select 0; break"
  $a.textframe.text tag bind dnatag <Shift-Double-Button-1> "alignlink2 $a.textframe.text $w \[$a.textframe.text index @%x,%y\] select 1; break"
  lappend info($w,linked_events) [list $a.textframe.text dnatag <Double-Button-1>]
  lappend info($w,linked_events) [list $a.textframe.text dnatag <Button-1>]
  lappend info($w,linked_events) [list $a.textframe.text dnatag <Shift-Button-1>]
  lappend info($w,linked_events) [list $a.textframe.text dnatag <Shift-Double-Button-1>]
  $a.textframe.text tag bind dnatag <Any-Leave> {%W tag remove highlite 1.0 end}
  $a.textframe.text tag bind dnatag <Any-Motion> {%W tag remove highlite 1.0 end; %W tag add highlite current}
  $a.textframe.text tag configure highlite -background red

  #bind $a <MouseWheel> "$a.textframe.text yview scroll \[expr {int(1.0 * %D/-\$info(mousewheelunits))}\] units"
  set outputmenu [add_output_menu $a.textframe.text "Text" text $w]
  bind $a <Button-1> "focus $a.textframe.text" 
  bindtags $a.textframe.text [list $a.textframe.text AnalysisText $a . all]
  wm deiconify $a
  if {[info exists info(last_analysis_xy)]} {
    wm geometry [winfo toplevel $a] [textbox_geometry $a.textframe.text {*}$info(last_analysis_xy)]
  } else {
    scan [wm geometry [winfo toplevel $a]] "%dx%d+%d+%d" w h x y
    wm geometry [winfo toplevel $a] [textbox_geometry $a.textframe.text $x $y]
  }
  $a.textframe.text configure -state disabled
  window_on_screen $a
  focus $a.textframe.text
} 

##############
## Utility function of Silent sites- coordinate the original seq and enzyme sequence to give the smallest change that has the same translation
##############
proc coordinate_translation {original_seq re_seq} {
  set result ""
  set original_seq [string toupper $original_seq]
  foreach orig_codon [regexp -inline -all {(?:...)} $original_seq] re_codon [regexp -inline -all {(?:...)} $re_seq] {
    if {[regexp {[^ACGT]} $re_codon] == 0} {
       set i $re_codon
    } elseif {$re_codon == "NNN"} {
      set i $orig_codon
    } else {
      set i ""
      foreach orig_char [split $orig_codon ""] re_char [split $re_codon ""] {
        set possible_list [string map {A A B CGT C C D AGT G G H ACT K GT M AC N ACGT R AG S GC T T V ACG W AT Y CT}  $re_char]
         if {[string match "*[string toupper $orig_char]*" $possible_list]} {
           set i "$i$orig_char"
         } else {
           set i "$i$re_char"
         }
      }
    }
    if {[translate $i] == [translate $orig_codon]} {
      #we've found a codon that is compatible between original and re by simple substitution
      set result "$result$i"
    } else {
      #need to find codon from re only (re has at least one degenerate base)
      set codon_list [string map {R {CGN CGV CGD CGB CGH CGW CGS CGR CGY CGK CGM CGA CGC CGG CGT AGR AGA AGG} S {TCN TCV TCD TCB TCH TCW TCS TCR TCY TCK TCM TCA TCC TCG TCT AGY AGC AGT}  L {CTN CTV CTD CTB CTH CTW CTS CTR CTY CTK CTM CTA CTC CTG CTT TTR TTA TTG} G {GGN GGV GGD GGB GGH GGW GGS GGR GGY GGK GGM GGA GGC GGG GGT} V {GTN GTV GTD GTB GTH GTW GTS GTR GTY GTK GTM GTA GTC GTG GTT} P {CCN CCV CCD CCB CCH CCW CCS CCR CCY CCK CCM CCA CCC CCG CCT} T {ACN ACV ACD ACB ACH ACW ACS ACR ACY ACK ACM ACA ACC ACG ACT} A {GCN GCV GCD GCB GCH GCW GCS GCR GCY GCK GCM GCA GCC GCG GCT}  I {ATH ATW ATY ATM ATA ATC ATT} F {TTY TTC TTC} Y {TAY TAC TAT} C {TGY TGC TGT} H {CAY CAC CAT} N {AAY AAC AAT} D {GAY GAC GAT} * {TAR TAA TAG TGG} Q {CAR CAA CAG} K {AAR AAA AAG} E {GAR GAA GAG} W {TGG}  M {ATG} } [translate $orig_codon]]
      set search_pattern [string map {B [BYSKCGT] D [DRWKAGT] H [HMWYACT] K [KGT] M [MAC] N [NBDHVKMRYWSACGT] R [RAG] S [SGC] V [VMSRACG] W [WAT] Y [YCT]}  $re_codon]
      set i [regexp -inline $search_pattern $codon_list]
#sputs coordinate_translation $orig_codon [translate $orig_codon] $re_codon $i
      if {($i != "")} {
        if {[regexp {[^ACGT]} $i]} {
         #resubstitute any degenerate codes that are in the new codon
          set j ""
          foreach orig_char [split $orig_codon ""] re_char [split $i ""] {
            set possible_list [string map {A A B CGT C C D AGT G G H ACT K GT M AC N ACGT R AG S GC T T V ACG W AT Y CT}  $re_char]
             if {[string match "*[string toupper $orig_char]*" $possible_list]} {
               set j "$j$orig_char"
             } else {
                set j "$j$re_char"
             }
          }
          set result "$result$j"
          #if {$i != $j} {sputs coordinate_translation  $i $j}
        } else {
          set result "$result$i"
        }
      } else {
        #match algorithm has gone wrong- shouldn't get to here
        set result [join [list $result "xxx"] ""]
      }
    }
  }
  if {[regexp {[^ACGT]} $result] == 0} {
    set result_list [list $result]
  } else {
    set result_list [list ""]
    foreach char [split $result ""] {
      set templist [list]
      foreach new_char [split [string map {A A B CGT C C D AGT G G H ACT K GT M AC N ACGT R AG S GC T T V ACG W AT Y CT} $char] ""] {
        foreach str $result_list {
          lappend templist "$str$new_char"
        }
      }
      set result_list $templist
    }
  }
  return $result_list
}

##############
## Find diagnostic site Dialog
##############
proc add_daignostic_site_dialog {w} {
  global info ok
  global  enzinfo enzymes
  global enzymes dialogblock
  if {$dialogblock == 1} {return}
  set dialog [new_dialog $w "Find Diagnostic Sites..." "ANALYZE"]
  bind $dialog <<Cancel>> "set ok -1"
  bind $dialog <<OK>> "set ok 1"



  grid [frame $dialog.f3 -relief ridge -borderwidth 3] -row 1 -column 0  -sticky nwe
  grid [label $dialog.f3.label1 -text [mc "Enzymes:"] ] -row 0 -column 0 -sticky w
  grid [radiobutton $dialog.f3.selenz -text [mc "Selected Enzymes"] -value "selected" -variable info(enz_make_diag_enz) -selectcolor white] -row 0 -column 2 -sticky w
  grid [radiobutton $dialog.f3.absenz -text [mc "Absent Enzymes"] -value "absent" -variable info(enz_make_diag_enz) -selectcolor white] -row 0 -column 3 -sticky w


  grid [frame $dialog.f4 -relief ridge -borderwidth 3] -row 2 -column 0  -sticky nwe
  grid [label $dialog.f4.label1 -text [mc "Mismatches:"]] -row 0 -column 0 -sticky w
  grid [radiobutton $dialog.f4.mm1 -text [mc "1"] -value 1 -variable info(enz_make_diag_mm) -selectcolor white] -row 0 -column 1 -sticky w
  grid [radiobutton $dialog.f4.mm2 -text [mc "2"] -value 2 -variable info(enz_make_diag_mm) -selectcolor white] -row 0 -column 2 -sticky w
  grid [radiobutton $dialog.f4.mm3 -text [mc "3"] -value 3 -variable info(enz_make_diag_mm) -selectcolor white] -row 0 -column 3 -sticky w


  if {0} {
  set analyze_selection $info(analyze_selection)
  grid [frame $dialog.f4 -relief ridge -borderwidth 3] -row 2 -column 0  -sticky nwe
  grid [label $dialog.f4.label1 -text [mc "DNA:"]] -row 0 -column 0 -sticky w
  grid [radiobutton $dialog.f4.selall -text [mc "All"] -value "all" -variable analyze_selection -selectcolor white] -row 0 -column 1 -sticky w
  grid [radiobutton $dialog.f4.selonly -text [mc "Selected DNA only"] -value "selection" -variable analyze_selection -selectcolor white] -row 0 -column 2 -sticky w
  }

  if {!$info(android)} {
    grid [button $dialog.ok -command {set ok 1} -text [mc "OK"]  -default active] -row 3 -column 0 -sticky n -padx 10 -pady 3
    bind $dialog <Key-Return> "set ok 1"
    grid columnconfigure $dialog 0 -weight 1
  }

  update idletasks
  regexp {([0-9]*)x([0-9]*)\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry [winfo toplevel $dialog] ] wgeom winw winh winx winy
  if {[expr {$winx+$winw}] > [winfo screenwidth .]} {set winx [expr {[winfo screenwidth .]-$winw}]}
  if {$winx < 0} {set winx 0}
  if {[expr {$winy+$winh}] > [winfo screenheight .]} {set winy [expr {[winfo screenheight .]-$winh}]}
  if {$winy < 0} {set winy 0}
  wm geometry [winfo toplevel $dialog] "+$winx+$winy"
  wm resizable [winfo toplevel $dialog] 0 0
  focus $dialog
  #grab $dialog
  vwait ok

  set dialogblock 0


  ## Do output
 ####
  if {$ok == 1} {
    $dialog.ok configure -text [mc "Stop"]
    set ok 0
    do_diagnostic_site $w
  }
  destroy $dialog
  bind . <<RaiseDialogs>> ""
  unset ok 

}

################
## Utility function of Do Make Diagnostic site
################
proc do_diagnostic_site {w} {
  global info ok
  global  enzinfo enzymes
  global enzymes dialogblock
  if {[$w.textarea tag ranges sel] == ""} {
    set start 0
    set end [ix2bp $w.textarea end]
    set DNA [textarea_get $w.textarea [bp2ix $w.textarea $start] [bp2ix $w.textarea $end]]
  } elseif {[llength [$w.textarea tag ranges sel]] == 2} {
    set  start [ix2bp $w.textarea [$w.textarea index sel.first]]
    set end [ix2bp $w.textarea [$w.textarea index sel.last]]
    set DNA [textarea_get $w.textarea [bp2ix $w.textarea $start] [bp2ix $w.textarea $end]]
  } else {
    set  start [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 2]]
    set end [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 1]]
    set DNA "[textarea_get $w.textarea [bp2ix $w.textarea $start] end][textarea_get $w.textarea 1.0 [bp2ix $w.textarea $end]]"
  }
 
    #selection used here - ok
  set text_list [split [string toupper $DNA] ""]
  set found [list]
  findenzymes $w
  ## Find sites and sequences
  switch $info(enz_make_diag_enz) {
    "selected" {
      set enz_list $info(enz_currently_selected)
    }
    "absent" {
      set enz_list [enz_site_usage_filter $w $enzymes "==0" "all"]
    }
  }
  set update_counter 0
  set ok 0
 
  foreach enz $enz_list {
   # if {![expr {$update_counter %2}]} {update}
    # skip metylation requiring enzymes
    if {$enz in [list AbaSI AoxI BisI BlsI DpnI FspEI GlaI GluI KroI LpnPI MalI MspJI MteI PcsI PkrI SgeI]} {continue}
    set flatpat $enzinfo(flatpat,$enz)
    foreach pat [expr {$flatpat eq [revcom $flatpat] ? [list $flatpat]:[list $flatpat [revcom $flatpat]]}] {
      set pat_list [string map {B BYSKCGT D DRWKAGT H HMWYACT K KGT M MAC N NBDHVKMRYWSACGT R RAG S SGC V VMSRACG W WAT Y YCT b byskcgt d drwkagt h hmwyact k kgt m mac n nbdhvkmrywsacgt r rag s sgc v vmsracg w wat y yct} [split $pat ""]]

      for {set i 0} {$i <= [expr {[llength $text_list] - [llength $pat_list]}]} {incr i} {
        set mm 0
        foreach s1 $pat_list c2 [lrange $text_list $i [expr {$i+[llength $pat_list]-1}]] {
          if {[string first $c2 $s1] == -1} {
            incr mm
            if {$mm > $info(enz_make_diag_mm)} break
          }
        }
        if {$mm <= $info(enz_make_diag_mm) && $mm > 0} {
          lappend found [list $i $enz $pat $mm]
        }
      }
    }
    incr update_counter 
    if {$ok} {break}
  }



  set a [new_analysis_window $w "Diagnostic Sites" diagnostic_sites]
  create_textframe $a 40
  $a.textframe.text configure -tabs {3.5c right 3.5c left}

  catch {$a.textframe.text insert end "[clock format [clock seconds] -format $info(clock_format)]\n"}
  $a.textframe.text insert end "[wm title $w] \n"
  $a.textframe.text insert end "[mc From] $start [mc to] [expr {$end-1}]\. \n"
  $a.textframe.text insert end "Diagnostic Sites\n\n"
  if {$ok} {
    $a.textframe.text insert end "Interrupted!\n\n"
  }



      #output to text window
  foreach f [lsort -integer -index 0 -increasing $found] {
    foreach {i e pat mm} $f {}
    $a.textframe.text insert end "\t[expr {$i+$start+1}]\t" {} "[string range $DNA $i [expr {$i -1 + [string length $pat]}]]"  [list dnatag "ls[expr {$i+$start+1}]_1"]  "\n\t\t"
    for {set i1 0} {$i1 < [string length $pat]} {incr i1} {
      if {[string toupper [string index $DNA [expr {$i1+$i}]]] in [split [string map {B BYSKCGT D DRWKAGT H HMWYACT K KGT M MAC N NBDHVKMRYWSACGT R RAG S SGC V VMSRACG W WAT Y YCT} [string toupper [string index $pat $i1]]] ""]} {
        $a.textframe.text insert end [string index $DNA [expr {$i1+$i}]]
      } else {
        $a.textframe.text insert end [string index $pat $i1] [list highlight]
      }
    }
    $a.textframe.text insert end "\n"

    $a.textframe.text insert end "\t$e\t$pat\n\n"
  }


  if {$found == ""} {
    $a.textframe.text insert end "No sites Found"
  }

    #bindings
    $a.textframe.text tag configure highlight -font bolddnafont  -foreground red
    $a.textframe.text tag bind dnatag <Double-Button-1> "alignlink2 $a.textframe.text $w \[$a.textframe.text index @%x,%y\] goto 1; break"
    $a.textframe.text tag bind dnatag <Button-1> "alignlink2 $a.textframe.text $w \[$a.textframe.text index @%x,%y\] goto 0; break"
    $a.textframe.text tag bind dnatag <Shift-Button-1> "alignlink2 $a.textframe.text $w \[$a.textframe.text index @%x,%y\] select 0; break"
    $a.textframe.text tag bind dnatag <Shift-Double-Button-1> "alignlink2 $a.textframe.text $w \[$a.textframe.text index @%x,%y\] select 1; break"
    lappend info($w,linked_events) [list $a.textframe.text dnatag <Double-Button-1>]
    lappend info($w,linked_events) [list $a.textframe.text dnatag <Button-1>]
    lappend info($w,linked_events) [list $a.textframe.text dnatag <Shift-Button-1>]
    lappend info($w,linked_events) [list $a.textframe.text dnatag <Shift-Double-Button-1>]
    $a.textframe.text tag bind dnatag <Any-Leave> {%W tag remove highlite 1.0 end}
    $a.textframe.text tag bind dnatag <Any-Motion> {%W tag remove highlite 1.0 end; %W tag add highlite current}
    $a.textframe.text tag configure highlite -background red

    #bind $a <MouseWheel> "$a.textframe.text yview scroll \[expr {int(1.0 * %D/-\$info(mousewheelunits))}\] units"
    set outputmenu [add_output_menu $a.textframe.text "Text" text $w]
    bind $a <Button-1> "focus $a.textframe.text" 
    bindtags $a.textframe.text [list $a.textframe.text AnalysisText $a . all]
    wm deiconify $a
    if {[info exists info(last_analysis_xy)]} {
      wm geometry [winfo toplevel $a] [textbox_geometry $a.textframe.text {*}$info(last_analysis_xy)]
    } else {
      scan [wm geometry [winfo toplevel $a]] "%dx%d+%d+%d" w h x y
      wm geometry [winfo toplevel $a] [textbox_geometry $a.textframe.text $x $y]
    }
    $a.textframe.text configure -state disabled
    window_on_screen $a
    focus $a.textframe.text
}


##############
## Make an orf map
##############
proc orf_map {w region} {
  global enzymes
  global info
  global modstring
  global modifier

  set fwd_s_s_color pink
  set fwd_m_s_color  #87ccff
  set rev_s_s_color orange
  set rev_m_s_color #94cd97


  set seq_len [ix2bp $w.textarea end]
  if {[$w.textarea tag ranges sel] == ""} {set region "all"}
  if {$region == "all"} {
    set start 0
    set total_length $seq_len
    set end $total_length
    set text [textarea_get $w.textarea [bp2ix $w.textarea $start] [bp2ix $w.textarea $end]]
  } elseif {[llength [$w.textarea tag ranges sel]] == 2} {
    set start [ix2bp $w.textarea [$w.textarea index sel.first]]
    set end [ix2bp $w.textarea [$w.textarea index sel.last]]
    set total_length [expr {$end - $start+1}]
    set text [textarea_get $w.textarea [bp2ix $w.textarea $start] [bp2ix $w.textarea $end]]
  } else {
    set start [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 2]]
    set end [ix2bp $w.textarea [lindex [$w.textarea tag ranges sel] 1]]
    set total_length [expr {$end + $seq_len - $start + 1}]
    set text "[textarea_get $w.textarea [bp2ix $w.textarea $start] end][textarea_get $w.textarea 1.0 [bp2ix $w.textarea $end]]"
    set end [expr {$end + $seq_len}]
  }
#selection used here - ok
  if {$total_length == 0} return

  incr start


  regsub -all {[Uu]} $text "T" text

  foreach frame [list 0 1 2] {
    set metlist($frame) [list]
    set stoplist($frame) [list]
    set temlist($frame) [list]
    set potslist($frame) [list]
  }

  foreach met [regexp -inline -all -nocase -indices {ATG} $text] {
    lappend metlist([expr {[lindex $met 0] % 3}]) [list met [lindex $met 0]]
  }
  foreach stop [regexp -inline -all -nocase -indices {TAG|TAA|TGA} $text] {
    lappend stoplist([expr {[lindex $stop 0] %3}]) [list stop [lindex $stop 0]]
  }
  foreach tem [regexp -inline -all -nocase -indices {CAT} $text] {
    lappend temlist([expr {[lindex $tem 0] % 3}]) [list tem [lindex $tem 0]]
  }
  foreach pots [regexp -inline -all -nocase -indices {CTA|TTA|TCA} $text] {
    lappend potslist([expr {[lindex $pots 0] % 3}]) [list pots [lindex $pots 0]]
  }

  set a [new_analysis_window $w "ORF Map" orf_map]  

  grid [canvas $a.c -yscrollcommand "optionscrollbar $a.sy" -xscrollcommand "optionscrollbar $a.sx" -width 700 -height 450 -background $info(graphic_bg_color)] -row 0 -column 0 -sticky nswe
  grid [scrollbar $a.sy -orient vertical -command "$a.c yview"] -row 0 -column 1 -sticky nswe
  grid [scrollbar $a.sx -orient horizontal -command "$a.c xview"] -row 1 -column 0 -sticky nwe
  grid [frame $a.f] -row 2 -column 0 -sticky nw
  grid [label $a.f.l -text [mc "Minimum ORF length"]] -row 0 -column 0 -sticky nw
  grid [menubutton $a.f.mb -textvariable info($a,orf_min)] -row 0 -column 1 -sticky nw
  $a.f.mb configure -menu [menu $a.f.mb.menu]
  foreach j [list 0 30 60 90 180 300 600 900 1200 1500] {
    $a.f.mb.menu add radiobutton -label "$j" -variable info($a,orf_min) -value $j -command "orf_map_update_colors $a $j"
  }

  grid [checkbutton $a.f.show_leg -text [mc "Legend"] -variable info($a,orf_show_legend) -onvalue 1 -offvalue 0 -command "if {\$info($a,orf_show_legend)} {event generate $a <<ShowLegend>>} else {event generate $a <<HideLegend>>}"] -row 0 -column 2 -sticky nw

  grid rowconfigure $a 0 -weight 1
  grid columnconfigure $a 0 -weight 1
  grid columnconfigure $a 1 -minsize 17

  set scale [expr {1.0/5}]
  set tick_incr 100
  if {$total_length <= 1000} {
    set scale [expr {1.0/2}]
    set tick_incr 10
    if {$total_length <= 100} {
      set scale [expr {2.0}]
      set tick_incr 1
    }
  }

  ## add legend
  set font "$info(graphicfontfamily) 13"
  set leg_space [font metrics $font -linespace]
  set leg_height [expr {4 * $leg_space +10}]
  set leg_width [font measure $font "Forward start to stop"]
  set leg_right 55
  set leg_top 100
  set leg_left [expr {$leg_right - $leg_width -45}]
  $a.c create rectangle $leg_left $leg_top [expr {$leg_left + $leg_width +35}] [expr {$leg_top + $leg_height}]  -fill {} -outline $info(graphic_fg_color)  -tags legend
  set leg_y [expr {$leg_top+2}]
  foreach text {"Forward stop to stop" "Forward start to stop" "Reverse stop to stop" "Reverse start to stop"} color [list $fwd_s_s_color $fwd_m_s_color $rev_s_s_color $rev_m_s_color] {
    $a.c create rectangle [expr {$leg_left +5}] $leg_y [expr {$leg_left +20}] [expr {$leg_y +15}] -fill $color -outline $info(graphic_fg_color)  -tags legend
    $a.c create text [expr {$leg_left +22}] $leg_y -text $text -anchor nw  -fill $info(graphic_fg_color) -tags legend
    incr leg_y [expr {$leg_space+2}]
  }

  ##make the outer box and horizontal lines
  set x_right [expr {50+$total_length*$scale}]
  $a.c create rectangle 50 100 $x_right 400 -outline $info(graphic_fg_color) 
  foreach y [list 150 200 250 300 350] {
    $a.c create line 50 $y $x_right $y  -fill $info(graphic_fg_color)
  }
  $a.c create text 50 405 -text "$info($w,filename)" -anchor nw   -fill $info(graphic_fg_color)
  $a.c create text 50 417 -text [mc "ORF Map from %s to %s" $start  [expr {seq_len_mod($end, $seq_len)}]] -anchor nw -fill $info(graphic_fg_color)

  ##make the top row tick marks
  set x [expr {$start-(($start-1) % $tick_incr)-1+$tick_incr}]
  while {$x <= $end} {
    set x_pos [expr {50+($x-$start)*$scale}]
    if {[expr {$x %(5*$tick_incr)}] == 0} {
      $a.c create line $x_pos 90 $x_pos 100  -fill $info(graphic_fg_color)
      if {[expr {$x % (10*$tick_incr)}] == 0} {
        $a.c create text $x_pos 87 -text [expr {seq_len_mod($x, $seq_len)}] -anchor s  -fill $info(graphic_fg_color)
      }
    } else {
      $a.c create line $x_pos 95 $x_pos 100  -fill $info(graphic_fg_color)
    }
    incr x $tick_incr
  }

  ##now put in the met and stops
  foreach frame [list 0 1 2] {
    set fwd [lsort -decreasing -integer -index 1 [concat $metlist($frame) $stoplist($frame)]]
    for {set i -1} {$i < [llength $fwd]} {incr i} {
      if {$i >= 0} {
        set item [lindex $fwd $i]
      } else {
        set item [list "stop" [expr {$end-$start+1}]]
      }
      set x_pos [expr {50+[lindex $item 1]*$scale}]
      if {[lindex $item 0] eq "met"} {
        $a.c create line $x_pos [expr {125+50*$frame}] $x_pos [expr {150+50*$frame}]  -fill $info(graphic_fg_color)
      } else {
        $a.c create line $x_pos [expr {100+50*$frame}] $x_pos [expr {150+50*$frame}]   -fill $info(graphic_fg_color)
        for {set j [expr {$i+1}]} {$j < [llength $fwd] && [lindex $fwd $j 0] eq "met"} {incr j} {}
        if {$j < [llength $fwd]} {
          set e [$a.c create rectangle $x_pos [expr {100+50*$frame}] [expr {50+[lindex $fwd $j 1]*$scale}] [expr {125+50*$frame}] -tags [list fwd_stop_orf orf] -outline {} -fill $fwd_s_s_color -activefill red -disabledfill $info(graphic_bg_color) ]
          $a.c bind $e <<Link>> [list [expr {[lindex $item 1] - [lindex $fwd $j 1]}] [expr {3+($start-1) +[lindex $fwd $j 1]}] [expr {3+($start-1) +[lindex $item 1]}]]
        } elseif {$j == [llength $fwd]} {
          set e [$a.c create rectangle $x_pos [expr {100+50*$frame}] [expr {50+0*$scale}] [expr {125+50*$frame}] -tags [list fwd_stop_orf orf] -outline {} -fill $fwd_s_s_color -activefill red -disabledfill $info(graphic_bg_color)]
          $a.c bind $e <<Link>> [list [expr {[lindex $item 1]+3+($start-1)%3- $frame}] [expr {($start-1) -($start-1)%3+ $frame}] [expr {3+($start-1)+[lindex $item 1]}]]
        }
        incr j -1
        if {[lindex $fwd $j 0] eq "met" } {
          set e [$a.c create rectangle $x_pos [expr {125+50*$frame}] [expr {50+[lindex $fwd $j 1]*$scale}] [expr {150+50*$frame}] -tags [list orf fwd_met_orf] -outline {} -fill $fwd_m_s_color -activefill red -disabledfill $info(graphic_bg_color) ]
          $a.c bind $e <<Link>> [list [expr {[lindex $item 1] - [lindex $fwd $j 1]}] [expr {($start-1) +[lindex $fwd $j 1]}] [expr {($start-1) +3+[lindex $item 1]}]     ]
        }
      }
    }

    set rev [lsort -integer -index 1 [concat $temlist($frame) $potslist($frame)]]
    for {set i -1} {$i < [llength $rev]} {incr i} {
      if {$i >= 0} {
        set item [lindex $rev $i]
      } else {
        set item [list "pots" [expr {0}]]
      }

      set x_pos [expr {50+[lindex $item 1]*$scale}]
      if {[lindex $item 0] == "tem"} {
        $a.c create line $x_pos [expr {250+50*$frame}] $x_pos [expr {275+50*$frame}]  -fill $info(graphic_fg_color)
      } else {
        $a.c create line $x_pos [expr {250+50*$frame}] $x_pos [expr {300+50*$frame}]  -fill $info(graphic_fg_color)
        for {set j [expr {$i+1}]} {$j < [llength $rev] && [lindex $rev $j 0] eq "tem"} {incr j} {}
        if {$j < [llength $rev]} {
          set e [$a.c create rectangle $x_pos [expr {275+50*$frame}] [expr {50+[lindex $rev $j 1]*$scale}] [expr {300+50*$frame}] -tags [list orf rev_stop_orf] -outline {} -fill $rev_s_s_color -activefill red -disabledfill $info(graphic_bg_color) ]
          $a.c bind $e <<Link>> [list [expr {[lindex $rev $j 1] - [lindex $item 1]}] [expr {($start-1) +[lindex $item 1]}] [expr {($start-1) +[lindex $rev $j 1]}]]
        } elseif {$j == [llength $rev]} {
          set e [$a.c create rectangle $x_pos [expr {275+50*$frame}] [expr {50+($end-$start+1)*$scale}] [expr {300+50*$frame}] -tags [list rev_stop_orf orf] -outline {} -fill $rev_s_s_color -activefill red -disabledfill $info(graphic_bg_color)]
          $a.c bind $e <<Link>> [list [expr {$end -($end%3)+ $frame +1 - $start - [lindex $item 1]}] [expr {($start-1)+[lindex $item 1]}]  [expr {$end -($end%3)+ $frame}]]
        }
        incr j -1
        if {[lindex $rev $j 0] eq "tem" } {
          set e [$a.c create rectangle $x_pos [expr {250+50*$frame}] [expr {50+[lindex $rev $j 1]*$scale}] [expr {275+50*$frame}] -tags [list orf rev_met_orf] -outline {} -fill $rev_m_s_color -activefill red -disabledfill $info(graphic_bg_color)] 
          $a.c bind $e <<Link>> [list [expr {[lindex $rev $j 1] - [lindex $item 1]}] [expr {($start-1) +[lindex $item 1]}] [expr {($start-1) + 3 +[lindex $rev $j 1]}]]
        }
      }
    }
  }



  $a.c lower orf 
  $a.c bind orf <Button-1> "orf_map_link $a $w"

  lappend info($w,linked_events) [list $a.c orf <Button-1>]

  foreach {x0 y0 x1 y1} [$a.c bbox all] {}
 # bind $a <<ShowLegend>> "$a.c configure -scrollregion \{[$a.c bbox all]\};  $a.c xview moveto $leg_left"
 # bind $a <<HideLegend>> "$a.c configure -scrollregion \[list 50 $y0 \[expr {max($x1 , 40 + \[winfo width $a.c\])}\] $y1\]"

  bind $a <<ShowLegend>> "$a.c itemconfigure legend -state normal ; $a.c configure -scrollregion \[$a.c bbox all\];  $a.c xview moveto $leg_left"
  bind $a <<HideLegend>> "$a.c itemconfigure legend -state hidden ; $a.c configure -scrollregion \[$a.c bbox all\];  $a.c xview moveto 50"

  
  set info($a,orf_show_legend) 1
  if {$info($a,orf_show_legend)} {
    $a.c configure -scrollregion [list $x0 $y0 $x1 $y1] -height [expr {$y1-$y0}]
    $a.c xview moveto $leg_left
  } else {
    $a.c configure -scrollregion [list 50 $y0 $x1 $y1] -height [expr {$y1-$y0}]
  }

  set outputmenu [add_output_menu $a.c "Image" image $w]
  set info($a,scale) 100
  set info($a,new_scale) 100
  set info($a,orf_min) $info(find_orf_min)
  orf_map_update_colors $a $info($a,orf_min)

  bind $a.c <Shift-MouseWheel> {%W xview scroll [expr {int(1.0 * %D/-$info(mousewheelunits))}] units}
  bind $a <Shift-MouseWheel> {[winfo toplevel %W].c xview scroll [expr {int(1.0 *%D/-$info(mousewheelunits))}] units}

  bind $a <Destroy> "array unset info $a,*"
  bind $a <Button-1> "focus $a.c" 
  wm deiconify $a

  if {[info exists info(last_analysis_xy)]} {
    #wm geometry [winfo toplevel $a] [expr {min ($x1 - $x0 + 30, ([winfo vrootwidth $a]-100))}]x[expr {min ($y1 - $y0 + 25 + [winfo height $a.f.mb], ([winfo vrootheight $a]-150))}]+[lindex $info(last_analysis_xy) 0]+[lindex $info(last_analysis_xy) 1]
    wm geometry [winfo toplevel $a] +[lindex $info(last_analysis_xy) 0]+[lindex $info(last_analysis_xy) 1]
  } else {
   # wm geometry [winfo toplevel $a] [expr {min ($x1 - $x0 + 30, ([winfo vrootwidth $a]-100))}]x[expr {min ($y1 - $y0 + 25 + [winfo height $a.f.mb, ([winfo vrootheight $a]-150))}]
  }
  window_on_screen $a
  focus $a.c
}

##############
## ORF map process button press links
##############
proc orf_map_update_colors {a size} {
  foreach e [$a.c find withtag orf] {
    set link_list [$a.c bind $e <<Link>>]
    if {$link_list ne {}} {
      if {[lindex $link_list 0] > $size} {
        $a.c itemconfigure $e -state normal
      } else { 
        $a.c itemconfigure $e -state disabled
      }
    }
  }
}

##############
## ORF map process button press links
##############
proc orf_map_link {a w} {
  set e [$a.c find withtag current]
   set link_list [$a.c bind $e <<Link>>]
  if {$link_list ne {}} {
    select_region $w [bp2ix $w.textarea [lindex $link_list 1]] [bp2ix $w.textarea [lindex $link_list 2]]
  } else {
    sputs orf [$a.c bind [$a.c find withtag current]]
  }
}

##############
## Translation analysis window
##############
## Translate CDS, needs to check for RevCom
proc translation_window {w} {
  global info
  global modifier
  global modstring
  global ok dialogblock translate_source translate_source_text
  if {$dialogblock == 1} {return}
  set dialog [new_dialog $w "Translate..." "TRANSLATE"]

  bind $dialog <<Cancel>> "set ok -1"
  bind $dialog <<OK>> "set ok 1"
  set ok 0
  grid [frame $dialog.f0 -relief ridge -borderwidth 3] -row 0 -column 0 -sticky nwe
  grid [label $dialog.f0.label -text [mc "Translate:"]] -row 0 -column 0 -sticky w
  grid [menubutton $dialog.f0.type -menu $dialog.f0.type.menu -textvariable translate_source_text -font labelfont -width 15 -indicatoron 1] -row 0 -column 1 -sticky we
  menu $dialog.f0.type.menu
  $dialog.f0.type.menu add radiobutton -label [mc All] -variable translate_source -value all -command "set translate_source_text [mc All]; $dialog.f3.dcopyhigh configure -state normal; $dialog.f1.revcom configure -state normal"
  set translate_source_text [mc All]
  set translate_source all
  if {[$w.textarea tag ranges sel] != ""} {
    $dialog.f0.type.menu add radiobutton -label [mc Selection] -variable translate_source -value sel -command "set translate_source_text [mc Selection]; $dialog.f3.dcopyhigh configure -state normal; $dialog.f1.revcom configure -state normal"
    set translate_source_text [mc Selection]
    set translate_source sel
  }
  set tag_list [get_tags_exact $w.textarea [list 1.0 end]]
  foreach {tag data} $tag_list {
    if {[regexp {f[0-9]+#} $tag]} {
      set metadata_index [lsearch -exact [lindex $data 2] <<Metadata>>]
      set type [lindex [lindex [lindex $data 3] $metadata_index] 2]
      if {[string toupper $type] == "CDS"} {
        set name [lindex [lindex [lindex $data 3] $metadata_index] 0]
        $dialog.f0.type.menu add radiobutton -label $name -variable translate_source -value $tag -command "set translate_source_text \{$name\}; $dialog.f3.dcopyhigh configure -state disabled; $dialog.f1.revcom configure -state disabled"
      }
    }
  }
  grid [frame $dialog.f1 -relief ridge -borderwidth 3] -row 1 -column 0 -sticky nwe
  grid [label $dialog.f1.label -text [mc "Code:"]] -row 0 -column 0 -sticky w
  grid [radiobutton $dialog.f1.1let -text [mc "1 Letter"] -variable info(translation_window_code) -value 1  -selectcolor white -activebackground $info(bg_color)] -row 0 -column 1 -sticky w
  grid [radiobutton $dialog.f1.3let -text [mc "3 Letter"] -variable info(translation_window_code) -value 3 -selectcolor white -activebackground $info(bg_color)] -row 0 -column 2 -sticky w
  grid [checkbutton $dialog.f1.spacing -text [mc "Codon Spacing"] -variable info(translation_window_spacing) -onvalue 1 -offvalue 0 -selectcolor white -activebackground $info(bg_color)] -row 1 -column 0 -columnspan 2 -sticky w
  grid [checkbutton $dialog.f1.revcom -text [mc "Reverse Complement"] -variable info(translation_window_revcom) -onvalue 1 -offvalue 0 -selectcolor white -activebackground $info(bg_color)] -row 1 -column 2 -sticky w

  grid [frame $dialog.f2 -relief ridge -borderwidth 3] -row 2 -column 0  -sticky nwe
  grid [label $dialog.f2.label1 -text [mc "Line Width:"]] -row 0 -column 0 -sticky w
  grid [entry $dialog.f2.width -width 4 -textvariable info(translation_window_width) -validate key -vcmd "check_char %S"] -row 0 -column 1 -columnspan 3 -sticky w
  grid [label $dialog.f2.label2 -text [mc "Line Numbers:"]] -row 1 -column 0 -sticky w
  grid [radiobutton $dialog.f2.lnone -text [mc "None"] -variable info(translation_window_line_numbers) -value none -selectcolor white -activebackground $info(bg_color)] -row 1 -column 1 -sticky w
  grid [radiobutton $dialog.f2.lleft -text [mc "Left"] -variable info(translation_window_line_numbers) -value left -selectcolor white -activebackground $info(bg_color)] -row 1 -column 2 -sticky w
  grid [radiobutton $dialog.f2.lright -text [mc "Right"] -variable info(translation_window_line_numbers) -value right -selectcolor white -activebackground $info(bg_color)] -row 1 -column 3 -sticky w
  grid [radiobutton $dialog.f2.lboth -text [mc "Both"] -variable info(translation_window_line_numbers) -value both -selectcolor white -activebackground $info(bg_color)] -row 1 -column 4 -sticky w

  grid [frame $dialog.f3 -relief ridge -borderwidth 3] -row 3 -column 0  -sticky nwe
  #grid [checkbutton $dialog.f3.revcom -text [mc "Index Line"] -variable info(translation_window_index_line) -onvalue 1 -offvalue 0 -selectcolor white -activebackground $info(bg_color)] -row 1 -column 0 -columnspan 2 -sticky w
  grid [label $dialog.f3.label1 -text [mc "DNA:"]] -row 2 -column 0 -sticky w
  grid [radiobutton $dialog.f3.dnone -text [mc "None"] -variable info(translation_window_dna_line) -value none -selectcolor white -activebackground $info(bg_color)] -row 2 -column 1 -sticky w
  grid [radiobutton $dialog.f3.dabove -text [mc "Above"] -variable info(translation_window_dna_line) -value above -selectcolor white -activebackground $info(bg_color)] -row 2 -column 2 -sticky w
  grid [radiobutton $dialog.f3.dbelow -text [mc "Below"] -variable info(translation_window_dna_line) -value below -selectcolor white -activebackground $info(bg_color)] -row 2 -column 3 -sticky w
  grid [checkbutton $dialog.f3.dcopyhigh -text [mc "Copy Highlight"] -variable info(translation_window_copy_highlight) -onvalue 1 -offvalue 0 -selectcolor white -activebackground $info(bg_color)] -row 3 -column 0 -sticky w 

  if {!$info(android)} {
    grid [button $dialog.ok -command {set ok 1} -text [mc "OK"] -default active] -row 4 -column 0 -sticky n -padx 10 -pady 3
    bind $dialog <Key-Return> "set ok 1"
  }
  update idletasks
  regexp {([0-9]*)x([0-9]*)\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry [winfo toplevel $dialog] ] wgeom winw winh winx winy
  if {[expr {$winx+$winw}] > [winfo screenwidth .]} {set winx [expr {[winfo screenwidth .]-$winw}]}
  if {$winx < 0} {set winx 0}
  if {[expr {$winy+$winh}] > [winfo screenheight .]} {set winy [expr {[winfo screenheight .]-$winh}]}
  if {$winy < 0} {set winy 0}
  wm geometry [winfo toplevel $dialog]  "+$winx+$winy"

  vwait ok
  set dialogblock 0
  destroy $dialog
  bind . <<RaiseDialogs>> ""
  if {$ok != 1} {return}
  unset ok



  if {$translate_source == "all" || $translate_source == "sel"} {
    if {$translate_source == "all" || [$w.textarea tag ranges sel] == ""} {
      set start 0
      set end [ix2bp $w.textarea end]
    } else {
#selection used here 
      set  start [ix2bp $w.textarea [$w.textarea index sel.first]]
      set end [ix2bp $w.textarea [$w.textarea index sel.last]]
    }
    set dna [textarea_get $w.textarea [bp2ix $w.textarea $start] [bp2ix $w.textarea $end]]
    incr start
    if {$info(translation_window_revcom)} {
      set dna [revcom $dna]
      set start [expr {$start+([string length $dna] % 3)}]
    } else {
      set end [expr {$end-([string length $dna] % 3)}]
    }
  } else {
    set tag $translate_source
    set metadata [$w.textarea tag bind $tag <<Metadata>>]
    set dir [lindex $metadata 3]
    set dna [get_cds $w $tag]
    if {$dir} {set dna [revcom $dna]}
    set start 1
    set end [string length $dna]
  }
 

  regexp {(^[^*]*)\*?(.*)} [translate $dna 1 1 0] temp mwaa mwxs
  set dna [regexp -inline {(?:...)*} $dna]
  set spacing 0

  if {$info(translation_window_spacing)} {
    if {($info(translation_window_code) == 1) && ($info(translation_window_dna_line) != "none")} {
      set spacing 3
    } else {
      set spacing 1
    }
  } elseif {($info(translation_window_code) == 1) && ($info(translation_window_dna_line) != "none")} {
    set spacing 2
  }

  set protein [translate $dna $info(translation_window_code) 1 $spacing]

  if {$info(translation_window_spacing)} {
    set dna "[regexp -all -inline {(?:...)} $dna] "
    set protein "$protein "
  }
  if {($info(translation_window_code) == 1) && ($info(translation_window_dna_line) != "none")} {
    set protein " $protein"
  }
  if {($info(translation_window_code) == 1) && ($info(translation_window_dna_line) != "none")} {
    set protein "$protein "
  }

  if {($info(translation_window_code) == 1)} {
    incr spacing 1
  } else {
    incr spacing 3
  }

  set a [new_analysis_window $w [mc "Translation"] transation]
  create_textframe $a 120
  catch {$a.textframe.text insert end "[clock format [clock seconds] -format $info(clock_format)]\n"}
  $a.textframe.text insert end "[wm title $w] \n"
  $a.textframe.text insert end "$info($w,filename) \n"
  if {$translate_source == "all" || $translate_source == "sel"} {
    if {$info(translation_window_revcom)} {
      $a.textframe.text insert end [mc "From %1\$s to %2\$s.\n" $end $start]
    } else {
      $a.textframe.text insert end [mc "From %1\$s to %2\$s.\n" $start $end] 
    }
  } else {
    $a.textframe.text insert end "[lindex $metadata 0] \n"
  }
  $a.textframe.text insert end "[mc Translation] "

  set mw [expr "[string map -nocase {X +0.0 G +57.05 A +71.09 S +87.08 T +101.11 C +103.15 V +99.14 L +113.16 I +113.16 M +131.19 P +97.12 F +147.18 Y +163.18 W +186.21 D +115.09 E +129.12 N +114.11 Q +128.14 H +137.14 K +128.17 R +156.19 * +0.0} $mwaa]+18.02"]
  set mw [expr {round($mw *100)/100.0}]
  $a.textframe.text insert end [mc "%1\$s a.a. MW=%2\$s\n" [string length $mwaa] $mw]
  if {$mwxs!=""} {
    $a.textframe.text insert end [mc "???(%s extra codons after stop)\n" [string length $mwxs]]
  } else {
    $a.textframe.text insert end "\n"
  }
  set translation_window_width $info(translation_window_width)
  if {$info(translation_window_width) == ""} {set translation_window_width 200000}
  
  for {set x 0} {[expr {$x*($spacing)}]< [string length $protein]} {incr x $translation_window_width} {
    set width $translation_window_width
    set pline [string range $protein [expr {$x*($spacing)}] [expr {($width+$x)*($spacing)-1}]]
    set dline [string range $dna [expr {$x*($spacing)}] [expr {($width+$x)*($spacing)-1}]]
    set linestart [expr {$info(translation_window_revcom)?($end-3*$x):($start+3*$x)}]
    if {[string length $dline] == [expr {$width*$spacing}]} {
      set lineend [expr {$info(translation_window_revcom)?($end-3*($x+$width)+1):($start+3*($x+$width)-1)}]
    } else {
      set lineend [expr {$info(translation_window_revcom)?$start:$end}]
    }
    if {$info(translation_window_dna_line) == "above"} { 
      if {($info(translation_window_line_numbers) == "left") ||($info(translation_window_line_numbers) == "both")} {
        $a.textframe.text insert end "[format {%7u } $linestart]"
      }
      set dlinestartindex [$a.textframe.text index "end -1char"]
      $a.textframe.text insert end "$dline" [list linktag "ls$linestart\_[expr {$info(translation_window_revcom)?-1:1}]"]
      if {($translate_source == "all" || $translate_source == "sel") && $info(translation_window_copy_highlight)} {
        copy_tags $w.textarea [list [bp2ix $w.textarea [expr {$linestart-1}]] [bp2ix $w.textarea [expr {$lineend-1}]]] $a.textframe.text $dlinestartindex [expr {$info(translation_window_revcom)?"reverse":"forward"}] ""
      }
      if {($info(translation_window_line_numbers) == "right") ||($info(translation_window_line_numbers) == "both")} {
        $a.textframe.text insert end "[format { %-7u} $lineend]\n"
      } else {
        $a.textframe.text insert end "\n"
      }
    }

    if {($info(translation_window_line_numbers) == "left") ||($info(translation_window_line_numbers) == "both")} {
      $a.textframe.text insert end "[format {%7u } [expr {$x+1}]]"
    }
    $a.textframe.text insert end "$pline" [list linktag "ls$linestart\_[expr {$info(translation_window_revcom)?(($info(translation_window_code)==1)?-3:-1):(($info(translation_window_code)==1)?3:1)}]"]
    if {($info(translation_window_line_numbers) == "right") ||($info(translation_window_line_numbers) == "both")} {
      $a.textframe.text insert end "[format { %-7u} [expr {$x+[string length $pline]/$spacing}]]\n"
    } else {
      $a.textframe.text insert end "\n"
    }

    if {$info(translation_window_dna_line) == "below"} { 
      if {($info(translation_window_line_numbers) == "left") ||($info(translation_window_line_numbers) == "both")} {
        $a.textframe.text insert end "[format {%7u } $linestart]"
      }
      set dlinestartindex [$a.textframe.text index "end -1char"]
      $a.textframe.text insert end "$dline" [list linktag "ls$linestart\_[expr {$info(translation_window_revcom)?-1:1}]"]
      if {($translate_source == "all" || $translate_source == "sel") && $info(translation_window_copy_highlight)} {
        copy_tags $w.textarea [list [bp2ix $w.textarea [expr {$linestart-1}]] [bp2ix $w.textarea [expr {$lineend-1}]]] $a.textframe.text $dlinestartindex [expr {$info(translation_window_revcom)?"reverse":"forward"}] ""
      }
      if {($info(translation_window_line_numbers) == "right") ||($info(translation_window_line_numbers) == "both")} {
        $a.textframe.text insert end "[format { %-7u} $lineend]\n"
      } else {
        $a.textframe.text insert end "\n"
      }
    }
    if {($info(translation_window_dna_line) != "none") || ($info(translation_window_index_line))} {
      $a.textframe.text insert end "\n"
    }
  }

  if {($translate_source == "all" || $translate_source == "sel")} {
    if { $info(translation_window_copy_highlight)} {
      foreach tag [$w.textarea tag names] {
        if {[lsearch -exact [$a.textframe.text tag names] $tag] > -1} {
           $a.textframe.text tag raise $tag
         }
      }
    }    
    $a.textframe.text tag bind linktag <Double-Button-1> "alignlink2 $a.textframe.text $w \[$a.textframe.text index @%x,%y\] goto 1; break"
    $a.textframe.text tag bind linktag <Shift-Double-Button-1> "alignlink2 $a.textframe.text $w \[$a.textframe.text index @%x,%y\] select 1; break"
    $a.textframe.text tag bind linktag <Button-1> "alignlink2 $a.textframe.text $w \[$a.textframe.text index @%x,%y\] goto 0; break"
    $a.textframe.text tag bind linktag <Shift-Button-1> "alignlink2 $a.textframe.text $w \[$a.textframe.text index @%x,%y\] select 0; break"
    $a.textframe.text tag bind linktag <Any-Leave> {%W tag remove highlite 1.0 end}
    $a.textframe.text tag bind linktag <Any-Motion> {%W tag remove highlite 1.0 end; %W tag add highlite current}
    $a.textframe.text tag configure highlite -background red
    lappend info($w,linked_events) [list $a.textframe.text linktag <Double-Button-1>]
    lappend info($w,linked_events) [list $a.textframe.text linktag <Button-1>]
    lappend info($w,linked_events) [list $a.textframe.text linktag <Shift-Button-1>]
    lappend info($w,linked_events) [list $a.textframe.text linktag <Shift-Double-Button-1>]
  }

  #bind $a <MouseWheel> {[winfo toplevel %W].textframe.text yview scroll [expr {int(1.0 * %D/-$info(mousewheelunits))}] units}
  set outputmenu [add_output_menu $a.textframe.text "Text" text $w]
  bind $a <Button-1> "focus $a.textframe.text" 
  bindtags $a.textframe.text [list $a.textframe.text AnalysisText $a . all]
  wm deiconify $a
  $a.textframe.text configure -state disabled
  if {[info exists info(last_analysis_xy)]} {
    wm geometry [winfo toplevel $a] [textbox_geometry $a.textframe.text {*}$info(last_analysis_xy)]
  } else {
    scan [wm geometry [winfo toplevel $a]] "%dx%d+%d+%d" w h x y
    wm geometry [winfo toplevel $a] [textbox_geometry $a.textframe.text $x $y]
  }
  window_on_screen $a
  focus $a.textframe.text
}

##############
## save a canvas as encapsulated postscript or enhanced metafile
##############
proc canvas_save {c {type ""}} {
  global tcl_platform ps_fontmap info

  if {[set coords [$c bbox all]] != [list]} {
    set filetypes { {"Portable Document Format" {.pdf}} {"Scalable Vector Graphics" {.svg}} {"PowerPoint Slide" {.pptx}} {"Encapsulated Postscript" {.eps}} } 
    if {$tcl_platform(platform) == "windows"} {
     # lappend filetypes {"Enhanced Metafile" {.emf}}
    }

    set filename [tk_getSaveFile -defaultextension ".pdf" -title [mc "Save Image"] -filetypes $filetypes -parent [winfo toplevel $c]]

    if {$filename == ""} {return}
    if {[file extension $filename] == ""} {
      switch $type {
        eps {set filename "$filename\.eps"}
        emf {set filename "$filename\.emf"}
        svg {set filename "$filename\.svg"}
        pdf {set filename "$filename\.pdf"}
        pptx {set filename "$filename\.pptx"}
        default {set filename "$filename\.eps"}
      }
    }
    switch [file extension $filename] {
      .eps {set type ".eps"}
      .emf {set type ".emf"}
      .svg {set type ".svg"}
      .pdf {set type ".pdf"}
      .pptx {set type ".pptx"}
      default {set type ".eps"}
    }

 
    if {$info(antialias_show)} {
      set aa [list]
      foreach a [$c find withtag aa] {
        if {[$c itemcget $a -state] eq "" || [$c itemcget $a -state] eq "normal"} {
          lappend aa $a
          $c itemconfigure $a -state "hidden"
        }
      }
    }
    
    switch $type {
      .eps {
        set x1 [lindex $coords 0]
        set y1 [lindex $coords 1]
        set x2 [lindex $coords 2]
        set y2 [lindex $coords 3]
        array unset ps_fontmap *
        get_canv_fontmap $c ps_fontmap
        $c postscript -file $filename -fontmap ps_fontmap -height [expr ($y2-$y1)] -width [expr ($x2-$x1)] -x $x1 -y $y1
      } 
      .emf {      
## this is too ugly- fix before restoring
        if {([lsearch -exact [package names] "wmf"] > -1)} {
          set hDCname [wmf open]
          set hDC [hdc addr $hDCname]
          canvas_to_hdc $c $hDC 0
          set emf_file [wmf close $hDCname]
          wmf copy $emf_file -file $filename
          wmf delete $emf_file
        }
      }
      .svg {
        set file [open $filename w]
        puts $file [canvas_to_svg $c]
        close $file
      }
      .pdf {
        ::pdf4tcl::new pdf
        pdf configure -margin {36 36} -paper letter
        add_window_to_pdf pdf $c
        pdf write -file  $filename
        pdf destroy
      }
      .pptx {
	global info
        set temp_dir [tempdir]
        if {[file exists [file join $info(Accdir) blank_ppt_file]]} {
          if {[catch {file delete -force [file join $temp_dir blank_ppt_file]}]} {return}
          file copy [file join $info(Accdir) blank_ppt_file] [file join $temp_dir blank_ppt_file]
          set file [open [file join $temp_dir blank_ppt_file ppt slides slide1.xml] w]
          set bg_color_xml ""
          if {[winfo rgb $c [$c cget -bg]] != [winfo rgb $c white]  } {
            set bg_color [color_to_xmlrgb [$c cget -bg]] 
             set bg_color_xml  "<p:bg><p:bgPr><a:solidFill><a:srgbClr val=\"$bg_color\"/></a:solidFill></p:bgPr></p:bg>"
          }
          puts $file "<?xml version=\"1.0\" encoding=\"UTF-8\" standalone=\"yes\"?><p:sld xmlns:a=\"http://schemas.openxmlformats.org/drawingml/2006/main\" xmlns:r=\"http://schemas.openxmlformats.org/officeDocument/2006/relationships\" xmlns:p=\"http://schemas.openxmlformats.org/presentationml/2006/main\"><p:cSld>$bg_color_xml<p:spTree><p:nvGrpSpPr><p:cNvPr id=\"1\" name=\"\"/><p:cNvGrpSpPr/><p:nvPr/></p:nvGrpSpPr><p:grpSpPr><a:xfrm><a:off x=\"0\" y=\"0\"/><a:ext cx=\"0\" cy=\"0\"/><a:chOff x=\"0\" y=\"0\"/><a:chExt cx=\"0\" cy=\"0\"/></a:xfrm></p:grpSpPr>[canvas_to_xml $c]</p:spTree><p:extLst><p:ext uri=\"{BB962C8B-B14F-4D97-AF65-F5344CB8AC3E}\"><p14:creationId xmlns:p14=\"http://schemas.microsoft.com/office/powerpoint/2010/main\" val=\"3505383029\"/></p:ext></p:extLst></p:cSld><p:clrMapOvr><a:masterClrMapping/></p:clrMapOvr></p:sld>"
          close $file
          zip::mkzip $filename -directory [file join $temp_dir blank_ppt_file]
        }
      }
    } 
    if {$info(antialias_show)} {
      foreach a $aa {
        $c itemconfigure $a -state "normal"
       }
    }
  }
}

##############
## export a sequence text area
##############
proc textarea_export {t {type "pdf"}} {
 global tcl_platform ps_fontmap info

    set filetypes { {"Portable Document Format" {.pdf}} } 
    
    if {$tcl_platform(platform) == "windows"} {
     # lappend filetypes {"Enhanced Metafile" {.emf}}
    }

    set filename [tk_getSaveFile -defaultextension ".pdf" -title [mc "Export Sequence Text"] -filetypes $filetypes -parent [winfo toplevel $t]]

    if {$filename == ""} {return}
    if {[file extension $filename] == ""} {
      switch $type {
        eps {set filename "$filename\.eps"}
        emf {set filename "$filename\.emf"}
        svg {set filename "$filename\.svg"}
        pdf {set filename "$filename\.pdf"}
        pptx {set filename "$filename\.pptx"}
        default {set filename "$filename\.eps"}
      }
    }
    switch [file extension $filename] {
      .eps {set type ".eps"}
      .emf {set type ".emf"}
      .svg {set type ".svg"}
      .pdf {set type ".pdf"}
      .pptx {set type ".pptx"}
      default {set type ".pdf"}
    }

 
    
    switch $type {
      .pdf {
        ::pdf4tcl::new pdf
        pdf configure -margin {36 36} -paper letter
        add_window_to_pdf pdf $t textarea
        pdf write -file  $filename
        pdf destroy
      }

    } 



}


##############
## get a postscript fontmap for a canvas
##############
proc get_canv_fontmap {c fontmap} {
  global $fontmap tk_fonts ps_fonts
  set fontlist [list]
  set scale [tk scaling]
  array unset $fontmap *
  foreach i [$c find all] {
    if {[$c type $i] == "text"} {
      set font [$c itemcget $i -font]
      if {[lsearch -exact $fontlist $font] == -1} {
        set family [string tolower [font actual "$font" -family]]
        set weight [font actual "$font" -weight]
        set size [font actual "$font" -size]
        if {[lsearch -exact $tk_fonts "$family\_$weight"] > -1} {
          set ps_font [lindex $ps_fonts [lsearch -exact $tk_fonts "$family\_$weight"]]
        } elseif {[font metrics $font -fixed]} {
          set ps_font Courier  
        } else {
          set ps_font Helvetica
        }
        set "$fontmap\($font)" [list $ps_font [expr {round(1.0*$size*$scale)}]]
      }
    }
  }
}

##############
## print a canvas- windows uses printer extension, aqua uses maccarbonprint extension, UNIX uses postscript
##############
# to put a pdf onto the clipboard in OSX
# exec osascript -e {set the clipboard to (the POSIX file "/Users/noeckel/plot.pdf")}
proc print_canvas {c {dialog_parent ""}} {
  global tcl_platform ps_fontmap info
  if {[set sc [$c bbox all]] != [list]} {
    foreach {x1 y1 x2 y2} $sc {}
  } else {
    return
  }
  if {$dialog_parent eq ""} {
    if {[winfo ismapped $c]} {
      set dialog_parent $c
    } else {
      tk_messageBox -message [mc "Bad window parent: %s" $c] -icon error 
      return
    }
  }
  if {($tcl_platform(platform) == "windows")} {
    if {[set print_parameters [windows_print_dialog]] != ""} {
      foreach {hDC page_width page_height pm_left pm_top pm_right pm_bottom ppi_x ppi_y first_page last_page copies spool_copies print_flag} $print_parameters {}
      set pages [expr {($copies<$spool_copies)?$spool_copies:$copies}]
      ###need to scale the output to fit on page
      set window_x [expr {$x2-$x1}]
      set window_y [expr {$y2-$y1}]
      set printer_x [expr {($page_width - $pm_left - $pm_right) * $ppi_x / 1000.0}]
      set printer_y [expr {($page_height - $pm_top - $pm_bottom) * $ppi_y / 1000.0}]
      set factor_x [ expr $window_x / $printer_x ]
      set factor_y [ expr $window_y / $printer_y ]
      if { $factor_x < $factor_y } {
        set lo $window_y
        set ph $printer_y
      } else {
        set lo $window_x
        set ph $printer_x
      }
      printer job start
      for {set i 0} {$i < $pages} {incr i} {
        printer page start
        gdi map $hDC -logical $lo -physical $ph -offset [list [expr {int(($pm_left* $ppi_x / 1000)-(1.0*$x1/$lo*$ph))}] [expr {int(($pm_top* $ppi_x / 1000)-(1.0*$y1/$lo*$ph))}]]
        canvas_to_hdc $c $hDC 1
        printer page end
      }
      printer job end
      printer close
    }
  } elseif {[tk windowingsystem] == "aqua" && ([lsearch -glob [info loaded] "*libcocoaprint*"] > -1 || [info commands ::tk::print::_print] ne {})} {
      set preview_file [file join [tempdir] "[file rootname [wm title [winfo toplevel $c]]].pdf"]
      ::pdf4tcl::new pdf
      pdf configure -margin {36 36} -paper letter
      add_window_to_pdf pdf $c
      pdf write -file $preview_file
      pdf destroy
      if {[lsearch -glob [info loaded] "*libcocoaprint*"] > -1} {
        cocoaprint::print $preview_file [winfo toplevel $c]
      } elseif {[info commands ::tk::print::_print] ne {}} {
        ::tk::print::_print $preview_file
      } 
      #after 5000 "file delete $preview_file"
  } elseif {$tcl_platform(os) == "Linux" || $tcl_platform(os) == "Darwin"} {
    if {0} {
      #####non-aqua unix printing
      if {[llength [set print_parameters [unix_print_dialog [winfo toplevel $c]]]] > 3} {
        puts $print_parameters
        foreach {printer page_width page_height pm_left pm_top pm_right pm_bottom ppi_x ppi_y copies orient scale} $print_parameters {}
        array unset ps_fontmap *
        get_canv_fontmap $c ps_fontmap
        #exec lpr -P $printer << [$c postscript -height [expr ($y2-$y1)] -width [expr ($x2-$x1)] -x $x1 -y $y1]
        if {$orient=="landscape"} {
          exec lpr -P $printer << [$c postscript -height [expr ($y2-$y1)] -width [expr ($x2-$x1)] -x $x1 -y $y1 -pagex "$pm_top\i" -pagey "[expr {$pm_left}]\i" -pageanchor nw -rotate 1]
        } else {
          exec lpr -P $printer << [$c postscript -height [expr ($y2-$y1)] -width [expr ($x2-$x1)] -fontmap ps_fontmap -x $x1 -y $y1 -pagex "$pm_left\i" -pagey "[expr {$page_height-$pm_top}]\i" -pageanchor nw]
        }
        #if {[tk_messageBox -title [mc "Printing..."] -message [mc "Printing will occur on your default printer:\n %s" [exec lpstat -d]] -type okcancel -default ok -parent [winfo toplevel $c]] == "ok"} {
        #  exec lpr << [$c postscript -height [expr ($y2-$y1)] -width [expr ($x2-$x1)] -x $x1 -y $y1]
        #}
      }
    } else {
      if {[llength [set print_parameters [unix_print_dialog [winfo toplevel $c]]]] > 3} {
        #puts $print_parameters
        foreach {printer page_width page_height pm_left pm_top pm_right pm_bottom ppi_x ppi_y copies orient scale} $print_parameters {}
        ::pdf4tcl::new pdf
        pdf configure -margin {36 36} -paper letter -landscape [expr {$orient=="landscape"?1:0}]
        add_window_to_pdf pdf $c
        set preview_file [file join [tempdir] "[file rootname [wm title [winfo toplevel $c]]].pdf"]
        pdf write -file $preview_file
        pdf destroy
        if {$orient=="landscape"} {
          exec lpr -P $printer -o landscape $preview_file
        } else {
          exec lpr -P $printer $preview_file
        }
      }
    }
  } else {
    warning_dialog "Printing isn't available from non-windows or -unix"
    canvas_save $c
  }
}


##############
## print a sequence window- windows uses printer extension, aqua uses maccarbonprint extension, UNIX uses postscript
##############
proc print_textarea {t} {
  global ps_fontmap tcl_platform info
  if {[tk windowingsystem] == "win32"} {
    enz_text_map $w -1
  } elseif {[tk windowingsystem] == "aqua" && ([lsearch -glob [info loaded] "*libcocoaprint*"] > -1 || [info commands ::tk::print::_print] ne {})} {
    if {1} {
      set preview_file [file join [tempdir] "[file rootname [wm title [winfo toplevel $t]]].pdf"]
      ::pdf4tcl::new pdf
      pdf configure -margin {36 36} -paper letter
      add_window_to_pdf pdf $t textarea
      pdf write -file $preview_file
      pdf destroy
      if {[lsearch -glob [info loaded] "*libcocoaprint*"] > -1} {
        cocoaprint::print $preview_file [winfo toplevel $t]
      } elseif {[info commands ::tk::print::_print] ne {}} {
        ::tk::print::_print $preview_file
      }
      #sputs print file $preview_file
      #after 5000 "file delete $preview_file"
    }
  } elseif {$tcl_platform(os) == "Linux" || $tcl_platform(os) == "Darwin"} {
    if {[llength [set print_parameters [unix_print_dialog [winfo toplevel $t]]]] > 3} {
      #puts $print_parameters
      foreach {printer page_width page_height pm_left pm_top pm_right pm_bottom ppi_x ppi_y copies orient scale} $print_parameters {}
      ::pdf4tcl::new pdf
      pdf configure -margin {36 36} -paper letter -landscape [expr {$orient=="landscape"?1:0}]
      add_window_to_pdf pdf $t textarea
      set preview_file [file join [tempdir] "[file rootname [wm title [winfo toplevel $t]]].pdf"]
      pdf write -file $preview_file
      pdf destroy
      if {$orient=="landscape"} {
        exec lpr -P $printer -o landscape $preview_file
      } else {
        exec lpr -P $printer $preview_file
      }
    }
  } else {
    warning_dialog "Printing isn't available from non-windows or -unix"
  }
}

##############
## print a text window- windows uses printer extension, aqua uses maccarbonprint extension, UNIX uses postscript
##############
proc print_text {t} {
  global ps_fontmap tcl_platform info
  if {[tk windowingsystem] == "win32"} {
    print_text_win32 $t
  } elseif {[tk windowingsystem] == "aqua" && ([lsearch -glob [info loaded] "*libcocoaprint*"] > -1 || [info commands ::tk::print::_print] ne {})} {
    if {1} {
      set preview_file [file join [tempdir] "[file rootname [wm title [winfo toplevel $t]]].pdf"]
      ::pdf4tcl::new pdf
      pdf configure -margin {36 36} -paper letter
      add_window_to_pdf pdf $t
      pdf write -file $preview_file
      pdf destroy
      if {[lsearch -glob [info loaded] "*libcocoaprint*"] > -1} {
        cocoaprint::print $preview_file [winfo toplevel $t]
      } elseif {[info commands ::tk::print::_print] ne {}} {
        ::tk::print::_print $preview_file
      }
      #sputs print file $preview_file
      #after 5000 "file delete $preview_file"
    }
  } elseif {$tcl_platform(os) == "Linux" || $tcl_platform(os) == "Darwin"} {
    if {[llength [set print_parameters [unix_print_dialog [winfo toplevel $t]]]] > 3} {
      #puts $print_parameters
      foreach {printer page_width page_height pm_left pm_top pm_right pm_bottom ppi_x ppi_y copies orient scale} $print_parameters {}
      ::pdf4tcl::new pdf
      pdf configure -margin {36 36} -paper letter -landscape [expr {$orient=="landscape"?1:0}]
      add_window_to_pdf pdf $t
      set preview_file [file join [tempdir] "[file rootname [wm title [winfo toplevel $t]]].pdf"]
      pdf write -file $preview_file
      pdf destroy
      if {$orient=="landscape"} {
        exec lpr -P $printer -o landscape $preview_file
      } else {
        exec lpr -P $printer $preview_file
      }
    }
  } else {
    warning_dialog "Printing isn't available from non-windows or -unix"
  }
}

##############
## print a text window- windows uses printer extension
##############
proc print_text_win32 {t} {
  global ps_fontmap info
  #get the default font of the widget
  set print_font_size [font actual [$t cget -font] -size]
  set print_font [list [font actual [$t cget -font] -family] [font actual [$t cget -font] -size]]
  set char_x [expr {[font measure $print_font W]}]

  #find the widest line
  set max_chars_per_line 0
  for {set i 1} {[$t compare $i.0 < end]} {incr i} {
    if {[set lineend [regsub {[0-9]*\.} [$t index $i.0lineend] ""]] > $max_chars_per_line} {
      set max_chars_per_line $lineend
    }
  }

  #get list of text tags with colored background for color printing
  set bg_formatted_tags [list]
  if {$info(print_formatted)} {
    foreach tag [$t tag names] {
      if {([$t tag cget $tag -background] != "") && ($tag ne "sel")} {
        lappend bg_formatted_tags $tag
      }
    }
  }
    set page_width 8500
    set page_height 11000
    set pm_left 1000
    set pm_right 1000
    set pm_top 1000
    set pm_bottom 1000
    set ppi_x 1000
    set ppi_y 1000
    set attr_list [printer attr]
    foreach attr $attr_list {
      switch -exact [lindex $attr 0] {
        "page dimensions" {
          set page_width [lindex [lindex $attr 1] 0]
          set page_height [lindex [lindex $attr 1] 1]
        }
        "page margins" {
          set pm_left [lindex [lindex $attr 1] 0]
          set pm_top [lindex [lindex $attr 1] 1]
          set pm_right [lindex [lindex $attr 1] 2]
          set pm_bottom [lindex [lindex $attr 1] 3]
        }
        "pixels per inch" {
          set ppi_x [lindex [lindex $attr 1] 0]
          set ppi_y [lindex [lindex $attr 1] 1]
        }
      }
    }

    #shrink the font size until it fits within the horizontal margins
    set print_width [expr {int(($page_width-$pm_left-$pm_right)/1000.0)}]
    set line_width [expr {int($max_chars_per_line*$char_x/([tk scaling]*72.0))}]
    while {($line_width > $print_width) && ($print_font_size > 5)} {
      incr print_font_size -1
      set print_font [list [font actual [$t cget -font] -family] $print_font_size]
      set char_x [expr {[font measure $print_font W]}]
      set line_width [expr {int($max_chars_per_line*$char_x/([tk scaling]*72.0))}]
    }

    #define the character height
    set char_y [expr {int([font metrics $print_font -linespace])}]
    set char_mid_y [expr {int([font metrics $print_font -linespace]/2)}]


    #count the lines/page so we can determine how many pages we will print (this might be wrong if the page orientation is changed in the dialog)
    set lines_per_page [expr {int((($page_height-$pm_top-$pm_bottom)/1000.0)/($char_y/([tk scaling]*72)))}]
    set total_pages [expr {int(ceil(([$t index end]-1)/$lines_per_page))}]

    if {[set print_parameters [windows_print_dialog [list 1 $total_pages]]] != ""} {
      #START PRINTING here
      foreach {hDC page_width page_height pm_left pm_top pm_right pm_bottom ppi_x ppi_y first_page last_page copies spool_copies print_flag} $print_parameters {}

      #reset the lines/page and total pages after getting possibly new printer margin info
      set print_width [expr {int(($page_width-$pm_left-$pm_right)/1000.0)}]
      set line_width [expr {int($max_chars_per_line*$char_x/([tk scaling]*72.0))}]
      while {($line_width > $print_width) && ($print_font_size > 5)} {
        incr print_font_size -1
        set print_font [list [font actual [$t cget -font] -family] $print_font_size]
        set char_x [expr {[font measure $print_font W]}]
        set line_width [expr {int($max_chars_per_line*$char_x/([tk scaling]*72.0))}]
      }
      set lines_per_page [expr {int((($page_height-$pm_top-$pm_bottom)/1000)/($char_y/([tk scaling]*72)))}]
      set total_pages [expr {int(ceil(([$t index end]-1)/$lines_per_page))}]
      switch $print_flag {
        all {
          set first_line 1
          set last_line [expr {int([$t index end]-1)}]
        }
        selection {
          if {[$t tag ranges sel] != ""} {
#selection used here 
            set first_line [expr {int([$t index sel.first\linestart])}]
            set last_line [expr {int([$t index sel.last\linestart])}]
          } else {
            set first_line 1
            set last_line [expr {int([$t index end]-1)}]
          }
        }
        pagenums {
            set first_line [expr {int((($first_page-1)*$lines_per_page)+1.0)}]
            set last_line [expr {int(($last_page)*$lines_per_page*1.0)}]
        }
      } 
      printer job -hdc $hDC start
      toplevel .printer_notifier
      #wm attributes .printer_notifier -topmost 1
      set dialogblock 1
      set bind_store [bind . <<RaiseDialogs>>]
      bind . <<RaiseDialogs>> "wm deiconify .printer_notifier; raise .printer_notifier"
      wm overrideredirect .printer_notifier 1
      wm title .printer_notifier "Printing..."
      regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry [winfo toplevel $t]] wgeom winx winy
      wm geometry .printer_notifier "+[expr (($winx<0)?0:$winx)+100]+[expr (($winy<0)?0:$winy)+100]"
      pack [frame .printer_notifier.frame -relief ridge -bd 3 -width 200]      
      pack [label .printer_notifier.frame.message -text "" -width 50 -height 4]
      for {set copies_spooled 1} {$copies_spooled <= $spool_copies} {incr copies_spooled} {
        for {set next_line $first_line} {$next_line <= $last_line} {set next_line [expr {$next_line+$lines_per_page}]} {
          if {[expr {$next_line+$lines_per_page-1}] > $last_line} {
            set last_page_line $last_line
          } else {
            set last_page_line [expr {$next_line+$lines_per_page-1}]
          }
          set line_top_y 0
          set line_mid_y $char_mid_y
          set line_bottom_y [expr {$char_y-1}]
          for {set copies_printed 1} {$copies_printed <= $copies} {incr copies_printed} {
            if {$copies == 1} {
              if {$spool_copies == 1} {
                .printer_notifier.frame.message configure -text "Printing page [expr {$next_line/$lines_per_page+1}] of [expr {int(1.0*$last_line/$lines_per_page+0.5)}]."
              } else {
                .printer_notifier.frame.message configure -text "Printing page [expr {$next_line/$lines_per_page+1}] of [expr {int(1.0*$last_line/$lines_per_page+0.5)}], copy $copies_spooled of $spool_copies."
              } 
            } else {
                .printer_notifier.frame.message configure -text "Printing page [expr {$next_line/$lines_per_page+1}] of [expr {int(1.0*$last_line/$lines_per_page+0.5)}], copy $copies_printed of $copies."
            }
            update
            printer page -hdc $hDC start
            gdi map $hDC -logical [expr {(([tk scaling]*72))}] -physical $ppi_x -offset [list [expr {int(($pm_left* $ppi_x / 1000))}] [expr {int(($pm_top* $ppi_x / 1000))}]]
            for {set current_line $next_line} {$current_line <= $last_page_line} {incr current_line} {
              if {$info(print_formatted)} {
                foreach colorblock [get_text_line_props $t $current_line $bg_formatted_tags] {
                  foreach {color start end} $colorblock {
                    gdi rectangle $hDC [expr {$start*$char_x}] $line_top_y [expr {($end*$char_x)}] [expr {$line_bottom_y}] -fill $color -outline $color 
                  }
                }
                for {set i 0} {[$t compare $current_line.$i < $current_line.0\lineend]} {incr i} {
                  #foreach {font bg} [get_text_chraracter_props $t $current_line.$i] {
                  #  if {$bg != {}} {
                  #    gdi rectangle $hDC [expr {$i*$char_x}] $line_top_y [expr {(($i+1)*$char_x)}] [expr {$line_bottom_y}] -fill $bg -outline $bg 
                  #  }
                  #  if {$font == {}} {
                  #    set font $print_font
                  #  }
                  #}
                  set font $print_font
                  gdi text $hDC [expr {($i*$char_x+$char_x/2)}] $line_mid_y -text [$t get $current_line.$i] -font $font -anchor center -justify left
                }
              } else {
                gdi text $hDC 0 $line_mid_y -text [$t get $current_line.0 $current_line.0\lineend] -font $print_font -anchor w -justify left
              }

              incr line_top_y $char_y
              incr line_mid_y $char_y
              incr line_bottom_y $char_y
            }
            printer page -hdc $hDC end
          }
        }
      }
      printer job -hdc $hDC end
      printer close -hdc $hDC
      destroy .printer_notifier
      set dialogblock 0
      bind . <<RaiseDialogs>> $bind_store
    }
}

############
## Return font and bg color for an index of a text window 
############
proc get_text_chraracter_props {text index} {
  set font {}
  set char_bg {}
  foreach tag [$text tag names $index] {
    if {($tag ne "dnatag") && ($tag ne "sel")} {
      #if {$font == {}} {set font [$text tag cget $tag -font]}
      set bg [$text tag cget $tag -background]
      if {$bg != {}} {
        set char_bg $bg
      }
    }
  }
  return [list $font $char_bg]
}

############
## Return list of colors and indices with that color for a row of a text window 
############
proc get_text_line_props {text line tags} {
  set result [list]
  foreach tag $tags {
    set i $line.0
    while {([set indexes [$text tag nextrange $tag $i $line.end]] != "")} {
      set i [lindex $indexes 1]
      lappend result [list [$text tag cget $tag -background] [regsub {[0-9]*\.} [lindex $indexes 0] ""] [regsub {[0-9]*\.} $i ""]]
    }
  }
  return $result
}

##############
## display printer dialog in windows
## return $hDC $page_width $page_height $pm_left $pm_top $pm_right $pm_bottom $ppi_x $ppi_y $copies
## return {} and close printer if no print connection is established
##############
proc windows_print_dialog {{pagerange {1 1}}} {
  if  {([lsearch -exact [package names] "printer"] > -1)} {
    set minimum_page [lindex $pagerange 0]
    set maximum_page [lindex $pagerange 1]
    printer attr -set [list [list "first page" $minimum_page] [list "last page" $maximum_page] [list "maximum page" $maximum_page] [list "minimum page" $minimum_page]]
    set hDC [printer dialog select]
    if { [lindex $hDC 1] == 0 } {
    # User has canceled printing
      catch {printer close}
	return {}
    }
    set hDC [lindex $hDC 0]
    if {[string match "?" $hDC] || [string match 0x0 $hDC]} {
      catch {printer close}
      tk_messageBox -title [mc "Printer problem"] -message [mc "Problem opening printer: printer context cannot be established"] -type ok
      return {}
    }
    set page_width 8500
    set page_height 1100
    set pm_left 1000
    set pm_top 1000
    set pm_right 1000
    set pm_bottom 1000
    set ppi_x 1000
    set ppi_y 1000
    set first_page 1
    set last_page 1
    set spool_copies 1
    set copies 1
    set print_flag "all"
    set attr_list [printer attr]
    foreach attr $attr_list {
      switch -exact [lindex $attr 0] {
        "page dimensions" {
          set page_width [lindex [lindex $attr 1] 0]
          set page_height [lindex [lindex $attr 1] 1]
        }
        "page margins" {
          set pm_left [lindex [lindex $attr 1] 0]
          set pm_top [lindex [lindex $attr 1] 1]
          set pm_right [lindex [lindex $attr 1] 2]
          set pm_bottom [lindex [lindex $attr 1] 3]
        }
        "pixels per inch" {
          set ppi_x [lindex [lindex $attr 1] 0]
          set ppi_y [lindex [lindex $attr 1] 1]
        }
        "first page" {
          set first_page [lindex $attr 1]
        }
        "last page" {
          set last_page [lindex $attr 1]
          if {$last_page > $maximum_page} {
            set last_page $maximum_page
          }
        }
        "copiesToSpool" {
          set spool_copies [lindex $attr 1]
        }
        "copies" {
          set copies [lindex $attr 1]
        }
        "print flag" {
          set print_flag [lindex $attr 1]
        }
      }
    }
    return [list $hDC $page_width $page_height $pm_left $pm_top $pm_right $pm_bottom $ppi_x $ppi_y $first_page $last_page $copies $spool_copies $print_flag]
  } else {
    tk_messageBox -title [mc "Printer problem"] -message [mc "Problem opening printer: printer dll is not loaded"] -type ok
    return {}
  }
}

##############
## display printer dialog in MacCarbon (Aqua)
## return $printerObject $type $page_width $page_height $ppi_x $ppi_y $copies
## return {} and close printer if no print connection is established
##############
proc aqua_print_dialog {w {pagerange {1 1}}} {
  global info

#sputs $w $pagerange $info(aqua_page_setup)
  if {[set printlist [eval {::maccarbonprint::print -parent $w -pagerange $pagerange -copies 1} $info(aqua_page_setup)]] != {}} {
    set type [lindex $printlist 0]
    set printObj [lindex $printlist 1]
    array set optsArr [::maccarbonprint::printconfigure $printObj]
    #sputs dialog-printconfigure
    #foreach o [array names optsArr] {
    #  sputs $o $optsArr($o)
    #}

    foreach {pageX pageY pagewidth pageheight} $optsArr(-adjustedpagerect) {}

    if {[llength [set resol $optsArr(-resolution)]]==1} {
      set ppi_x $resol
      set ppi_y $resol
    } else {
      foreach {ppi_x ppi_y} $resol {}
    }

    if {[set last_page $optsArr(-lastpage)] > [lindex $pagerange 1]} {
      set last_page [lindex $pagerange 1]
    }

    return [list $printObj $type $pagewidth $pageheight $ppi_x $ppi_y $optsArr(-copies) $optsArr(-firstpage) $last_page]
  } else {
    return ""
  }
}

##############
## display printer setup dialog in Aqua
##############
proc page_setup_dialog {w} {
  global info
  if  {([lsearch -glob [info loaded] "*MacCarbonPrint.dylib*"] > -1)} {
    set pf [eval {::maccarbonprint::pagesetup -parent $w} $info(aqua_page_setup)]
    if {$pf != ""} {
      set info(aqua_page_setup) [list -pageformat $pf]
    }
  } elseif {([lsearch -exact [package names] "printer"] > -1)} {
    printer dialog page_setup
  }
}

##############
## display printer dialog in unix
## return $printer $page_width $page_height $pm_left $pm_top $pm_right $pm_bottom $ppi_x $ppi_y $copies
## return {} and close printer if no print connection is established
##############
proc unix_print_dialog {w} {
  global ok dialogblock info tcl_platform
  global printer orient scale copies
  if {$tcl_platform(platform) != "unix"} {
    set prlist [list printer1 printer2 printer3]
    set defaultprinter printer2
  } else {
    if {([catch {set lplist [exec lpstat -a]}]) || ($lplist == "")} {return "no_lplist"}
    set lplist [split $lplist \n]
    foreach lp $lplist {
      #puts $lp
      #   need to make a dictionary of lp name and info:     if {[regexp {printer-info='([^'])'} [exec lpoptions -p $lp] -- lpr_name]}

      if {![regexp "not accepting" $lp]} {
        lappend prlist [regexp -inline {[^ ]*} $lp]
      }
    }
    if {([catch {set defaultprinter [exec lpstat -d]}]) || ([regexp "no system default" $defaultprinter])}  {return "no_default"}
    set defaultprinter [regexp -inline {[^ ]*$} $defaultprinter]
  }

  if {$dialogblock == 1} {return "dialogblock"}
  set dialogblock 1
  set a [toplevel .dialog]
  wm title $a [mc "Printer..."]
  wm protocol $a WM_DELETE_WINDOW "set ok -1"
  set oldbind [bind . <<RaiseDialogs>>]
  bind . <<RaiseDialogs>> "wm deiconify $a; raise $a"
  regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $w] wgeom winx winy
  wm geometry [winfo toplevel $a] "+[expr (($winx<0)?0:$winx)+3]+[expr (($winy<0)?0:$winy)+50]"
  if {[tk windowingsystem] != "aqua"} {
    wm transient $a $w
  } else {
    ::tk::unsupported::MacWindowStyle style $a document {closeBox}
  }
  set ok 0
  set page_width 8.500
  set page_height 11.00
  set pm_left 1.0
  set pm_top 1.0
  set pm_right 1.0
  set pm_bottom 1.0
  set ppi_x 1000
  set ppi_y 1000
  set copies 1
  set orient portrait
  set scale 100
  set printer $defaultprinter


  grid [frame $a.frame1 -relief flat] -row 0 -column 0 -sticky nswe
  grid [label $a.frame1.label1 -text [mc "Printer:"]] -row 0 -column 0 -sticky e
  set printer_menu [tk_optionMenu $a.frame1.printer printer {*}$prlist]
  grid $a.frame1.printer -row 0 -column 1 -sticky nw -columnspan 2
  grid [label $a.frame1.label2 -text [mc "Orientation:"]] -row 1 -column 0 -sticky e
  set orientmenu [tk_optionMenu $a.frame1.orient orient portrait landscape]
  grid $a.frame1.orient -row 1 -column 1 -sticky nw -columnspan 2
  #grid [label $a.frame1.label3 -text [mc "Scale:"]] -row 2 -column 0 -sticky e
  #set scalemenu [tk_optionMenu $a.frame1.scale scale 10 20 30 40 50 60 70 80 90 100]
  #grid $a.frame1.scale -row 2 -column 1 -sticky nw
  #grid [label $a.frame1.label4 -text "%"] -row 2 -column 2 -sticky w
  #grid [label $a.frame1.label5 -text [mc "Copies:"]] -row 3 -column 0 -sticky e
  #grid [entry $a.frame1.copies -textvariable copies -width 2 -validate key -validatecommand "string is integer %P"] -row 3 -column 1 -sticky nw -columnspan 2


  grid [frame $a.frame2 -relief flat] -row 1 -column 0 -sticky nswe
  grid [button .dialog.frame2.ok -text [mc "OK"] -command "set ok 1" -default active] -row 0 -column 0 -padx 10 -pady 3 -sticky we
  bind .dialog <Key-Return> "set ok 1"
  grid [button .dialog.frame2.cancel -text [mc "Cancel"] -command "set ok -1"] -row 0 -column 1 -padx 5 -sticky we
  grid rowconfigure .dialog 0 -weight 1
  grid rowconfigure .dialog 1 -weight 0
  grid rowconfigure .dialog 2 -weight 0
  grid columnconfigure .dialog 0 -weight 1



  vwait ok
  set dialogblock 0
  destroy .dialog
  bind . <<RaiseDialogs>> $oldbind
  if {$ok == 1} {
    if {[catch {set optionlist [exec lpoptions -p $printer -l]}]} {
      set optionlist ""
    } else {
      foreach attr [split $optionlist \n] {
        set attr [split $attr :]
        switch -regexp [lindex $attr 0] {
          "Resolution" {
            regexp {\*([0-9]*)x([0-9]*)} [lindex $attr 1] i ppi_x ppi_y
           }
        }
      }
    }
    set scale [expr {$scale/100.0}]
    #sputs "printer $printer optionlist:$optionlist"
    set result [list $printer $page_width $page_height $pm_left $pm_top $pm_right $pm_bottom $ppi_x $ppi_y $copies $orient $scale]
    unset printer orient scale copies
    return $result
  } else {
    return "cancel"
  }
}

##############
## save or copy to clipboard a canvas to wmf or emf format
##############
## this is too ugly- fix before restoring
proc canvas_to_metafile {operation c {type both}} {
  global info
  set hDCname [wmf open]
  set hDC [hdc addr $hDCname]

  if {$info(antialias_show)} {
    set aa [list]
    foreach a [$c find withtag aa] {
      if {[$c itemcget $a -state] eq ""} {
        lappend aa $a
        $c itemconfigure $a -state "hidden"
      }
    }
  }

  canvas_to_hdc $c $hDC 0

  if {$info(antialias_show)} {
    foreach a $aa {
      $c itemconfigure $a -state ""
     }
  }

  set emf_file [wmf close $hDCname ]
  if {$operation == "copy"} {
    wmf copy $emf_file -type $type
  } else {
    set filename [tk_getSaveFile -defaultextension ".emf" -title [mc "Save Enhanced Metafile..."] -parent [winfo toplevel $c]]
    if {$filename != ""} {
      wmf copy $emf_file -file $filename
    }
  }
  wmf delete $emf_file
}

##############
## print a canvas to an hDC (device context handle) for windows printing and metafile output
##############
## this is too ugly- fix before restoring
proc canvas_to_hdc {c hdc {bug_workaround 1}} {
  foreach item [$c find all] {
    if {[$c itemcget $item -state] == "hidden"} {
      continue
    }
    set coords [$c coords $item]

    switch [$c type $item] {
      arc {
        if {!$bug_workaround} {
          set cmd  "gdi arc $hdc $coords -extent [$c itemcget $item -extent] -outline {[$c itemcget $item -outline]} -start [$c itemcget $item -start] -style [$c itemcget $item -style]"
          if {[set width  [$c itemcget $item -width]] > 1} {set cmd "$cmd -width $width"}
          #sputs $cmd
        } else {
          #this is for bug in the gdi implementation- it might not be needed in wmf copies
          set x0 [expr {([lindex $coords 0]+[lindex $coords 2])/2.0}]
          set y0 [expr {([lindex $coords 1]+[lindex $coords 3])/2.0}]
          set xr [expr {[lindex $coords 2]-$x0}]
          set yr [expr {[lindex $coords 3]-$y0}]
          set start_angle [$c itemcget $item -start]
          set stop_angle [expr {[$c itemcget $item -extent]+$start_angle}]
          if {$stop_angle < $start_angle} {
            set a $start_angle
            set start_angle $stop_angle
            set stop_angle $a
          }
          set deg2rad [expr {3.14159/180}]
          set start_angle [expr {$deg2rad*$start_angle}]
          set stop_angle [expr {$deg2rad*$stop_angle}]
          set incr [expr {$deg2rad*2.5}]
          set coords [list [expr {$x0+cos($start_angle)*$xr}] [expr {$y0-sin($start_angle)*$yr}]]
          for {set a $start_angle} {$a <$stop_angle} {set a [expr {$a+$incr}]} {
            lappend coords [expr {$x0+cos($a)*$xr}] [expr {$y0-sin($a)*$yr}]
          }
          lappend coords [expr {$x0+cos($stop_angle)*$xr}] [expr {$y0-sin($stop_angle)*$yr}]
          set cmd  "gdi line $hdc $coords -fill {[$c itemcget $item -outline]}"
          if {[set width  [$c itemcget $item -width]] > 1} {
            set cmd "$cmd -width $width"
          }
        }
      } 
      bitmap {
        #sputs "No handler for item type: Bitmap"
      }
      image {
        #sputs "No handler for item type: Image"
      }
      line {
        set cmd  "gdi line $hdc $coords -fill {[$c itemcget $item -fill]}"
        if {[set width  [$c itemcget $item -width]] > 1} {set cmd "$cmd -width $width"}
      }
      oval {
        set cmd "gdi oval $hdc $coords -outline [$c itemcget $item -outline]"
        if {[set width  [$c itemcget $item -width]] > 1} {set cmd "$cmd -width $width"}
        #sputs $cmd
      }
      polygon {
        set cmd "gdi polygon $hdc $coords -width [$c itemcget $item -width]"
        if {[set outline [$c itemcget $item -outline]] != ""} {set cmd "$cmd  -outline {$outline}"}
      }
      rectangle {
        set cmd "gdi rectangle $hdc $coords -outline {[$c itemcget $item -outline]}"
        if {[set width  [$c itemcget $item -width]] > 1} {set cmd "$cmd -width $width"}
      }
      text {
        if {[$c itemcget $item -text] != ""} {
          set font [$c itemcget $item -font]
          #set font [list [font configure $font -family]  -[font configure $font -size]]
          set font [list [font actual $font -family] [expr {int([font actual $font -size]*[tk scaling])}] [font actual $font -weight] [font actual $font -slant]]
          set bbox [$c bbox $item]
          #set width [expr {[lindex $bbox 2] - [lindex $bbox 0]+2}]
          set width [font measure $font [$c itemcget $item -text]]
          set cmd "gdi text $hdc $coords -text [list [$c itemcget $item -text]] \
		-anchor [$c itemcget $item -anchor] -font [list $font] \
		-width $width -justify [$c itemcget $item -justify]"
        } else {
          set cmd ""
        }
      }
      window {
        #sputs "No handler for item type: Window"
      }
      default {
        #sputs "No handler for item type:[$c type $item]"
      }
    }

    if {([set fill [$c itemcget $item -fill]] != "") && ($cmd !="")} {set cmd "$cmd -fill $fill"}
    eval $cmd
  }
}

##############
## print a canvas to a printer window for Aqua printing
##############
proc canvas_to_carbonprint {c win scale} {
  foreach item [$c find all] {
    if {[$c itemcget $item -state] == "hidden"} {
      continue
    }
    switch [$c type $item] {
      text {
        if {[$c itemcget $item -text] != ""} {
          set font [$c itemcget $item -font]
          set font [list [font actual $font -family] [expr {int([font actual $font -size]*[tk scaling]*$scale)}] [font actual $font -weight] [font actual $font -slant]]
          set bbox [$c bbox $item]
          set width [font measure $font [$c itemcget $item -text]]
          $win create text {*}[$c coords $item] -text [list [$c itemcget $item -text]] -anchor [$c itemcget $item -anchor] -font [list $font] -justify [$c itemcget $item -justify] -fill [$c itemcget $item -fill]
        }
      }
      arc {
        set opts {}
        foreach option [$c itemconfigure $item] {
          foreach {key blank blank2 def val} $option {}
          if {![string equal $def $val]} {
            lappend opts $key $val
          }
        }
        $win create [$c type $item] {*}[$c coords $item] {*}$opts
      }
      window {
        #sputs "No handler for item type: Window"
      }
      default {
        set opts {}
        foreach option [$c itemconfigure $item] {
          foreach {key blank blank2 def val} $option {}
          if {![string equal $def $val]} {
            lappend opts $key $val
          }
        }
        $win create [$c type $item] {*}[$c coords $item] {*}$opts
      }
    }
  }
}

##############
## generate a canvas from a text box
##############
proc text_to_canvas {t startline endline} {
 set bg_formatted_tags [list]
  foreach tag [$t tag names] {
    if {([$t tag cget $tag -background] != "") && ($tag ne "sel")} {
      lappend bg_formatted_tags $tag
    }
  }
  if {$endline eq "end"} {set endline [expr {int([$t index end])-1}]}
  set text_font [$t cget -font]
  set char_x [font measure $text_font A]
  set char_y [font metrics $text_font -linespace]
  set char_y_descent [font metrics $text_font -descent]
  set linewidth [$t cget -width]

  set start_y_list [list 0]
  set next_y 0
  for {set i $startline} {$i <= $endline} {incr i} {
    incr next_y [$t count -ypixels [expr {1.0*$i}] [expr {1.0 * ($i+1)}]]
    lappend start_y_list $next_y
  }

  if {[winfo exists .c]} {destroy .c}
  set c [canvas .c]
  foreach tag $bg_formatted_tags {
    set color [$t tag cget $tag -background]
    foreach {row1 col1 row2 col2} [split [$t tag ranges $tag] ". "] {
      for {set i $row1} {$i < $row2} {incr i} {
        if {($i < $startline)} {set col1 0; continue}
        if {($i > $endline)} break
        #$c create rectangle [expr {$col1*$char_x}] [expr {($i-$startline)*$char_y-$char_y_descent}] [expr {($linewidth*$char_x)}] [expr {($i-$startline+1)*$char_y-$char_y_descent}] -fill $color -outline $color
        $c create rectangle [expr {$col1*$char_x}] [lindex $start_y_list [expr {$i-$startline}]] [expr {($linewidth*$char_x)}] [lindex $start_y_list [expr {$i-$startline+1}]] -fill $color -outline $color
        set col1 0
      }
      if {($i >= $startline) && ($i<= $endline)} {
        #$c create rectangle [expr {$col1*$char_x}] [expr {($i-$startline)*$char_y-$char_y_descent}] [expr {($col2*$char_x)}] [expr {($i-$startline+1)*$char_y-$char_y_descent}] -fill $color -outline $color
        $c create rectangle [expr {$col1*$char_x}] [lindex $start_y_list [expr {$i-$startline}]] [expr {($col2*$char_x)}] [lindex $start_y_list [expr {$i-$startline+1}]] -fill $color -outline $color
      }
    } 
  }
  for {set i $startline} {$i <= $endline} {incr i} {
    for {set j 0} {$j< $linewidth} {incr j} {
      #$c create text [expr {$j*$char_x}] [expr {($i-$startline)*$char_y-3}] -text [$t get $i.$j] -anchor nw -font $text_font
      $c create text [expr {$j*$char_x}] [lindex $start_y_list [expr {$i-$startline}]] -text [$t get $i.$j] -anchor nw -font $text_font
    }
  }
  return $c
}


##############
## save text analysis as text
##############
proc text_save {t {filename {}}} {
global info
  while { (![file isdirectory $info(default_dnadir)])} {
    set info(default_dnadir) [file dirname $info(default_dnadir)]
    if {[file dirname $info(default_dnadir)] == $info(default_dnadir)} {
      set info(default_dnadir) [valid_default_dir]
    }
  }
  if {$filename == ""} {
    set filename [tk_getSaveFile -title [mc "Save As Text File"] -initialdir $info(default_dnadir) -defaultextension ".rtf" -filetypes {{"Rich Text Format" {.rtf}} {"Scalable Vector Graphics" {.svg}} {"Portable Document Format" {.pdf}} {"Plain Text" {.txt}}} ]
  }
  while {($filename != "") && ([catch {set text_file [open $filename w]}])} {
    catch {close $text_file}
    tk_messageBox -title [mc "Text File not Writable"] -message [mc "The file %s is not writable. It may be locked." $filename] -type ok -icon warning -default ok
    set filename [tk_getSaveFile -title [mc "Save As Text File"] -initialdir $info(default_dnadir) -defaultextension ".rtf" -filetypes {{"Rich Text Format" {.rtf}} {"Scalable Vector Graphics" {.svg}} {"Portable Document Format" {.pdf}} {"Plain Text" {.txt}}} ]
  }
  if {$filename != ""} {
    ###save the text file
    if {[file extension $filename] eq ".rtf"} {
      puts -nonewline $text_file [text_to_rtf $t 1]
    } elseif {[file extension $filename] eq ".svg"} {
      set lastline [$t index end]
      if {[regexp {[0-9]+} $lastline lastline]} {
        puts -nonewline $text_file [text_to_svg0 $t 1 $lastline]
      }
    } elseif {[file extension $filename] eq ".pdf"} {
      catch {close $text_file}
      ::pdf4tcl::new pdf
      pdf configure -margin {36 36} -paper letter
      add_window_to_pdf pdf $t
      pdf write -file $filename
      pdf destroy
    }  else {
      set i 1
      while {$i < [$t index end]} {
        puts $text_file [$t get $i.0 $i.0lineend]
        incr i
      }
    }
    catch {close $text_file}
  }
}

##############
## convert named color to svg rgb value
##############
proc color_to_svgrgb {color} {
    if {$color == ""} {return none}
    foreach {r g b} [winfo rgb . $color] {}
    format #%02x%02x%02x [expr {$r/256}] [expr {$g/256}] [expr {$b/256}]
}

##############
## convert named color to xml rgb value
##############
proc color_to_xmlrgb {color} {
    if {$color == ""} {return none}
    foreach {r g b} [winfo rgb . $color] {}
  string toupper [format %02x%02x%02x [expr {$r/256}] [expr {$g/256}] [expr {$b/256}]]
}

proc color_to_keysvgrgb {color} {
    if {$color == ""} {return none}
    foreach {r g b} [winfo rgb . $color] {}
    return "[expr {$r/65536.0}] [expr {$g/65536.0}] [expr {$b/65536.0}]"
}

##############
## print a canvas to an svg string
##############
proc canvas_to_svg {c} {
  foreach {x0 y0 x1 y1} [$c bbox all] {}
  set deg2rad [expr {3.14159/180}]
  set result "<svg id=\"svgbox\" width=\"[expr {$x1-$x0}]px\" height=\"[expr {$y1-$y0}]px\" xmlns=\"http://www.w3.org/2000/svg\" version=\"1.1\" preserveAspectRatio=\"xMidYMid meet\" viewBox=\"[lindex [$c bbox all] 0] [lindex [$c bbox all] 1] [expr {[lindex [$c bbox all] 2] - [lindex [$c bbox all] 0]}] [expr {[lindex [$c bbox all] 3] - [lindex [$c bbox all] 1]}]\">\n"
  foreach item [$c find all] {
    if {[$c itemcget $item -state] == "hidden"} {
      continue
    }
    set coords [$c coords $item]

    switch [$c type $item] {
      arc {
        set x0 [expr {([lindex $coords 0]+[lindex $coords 2])/2.0}]
        set y0 [expr {([lindex $coords 1]+[lindex $coords 3])/2.0}]
        set xr [expr {[lindex $coords 2]-$x0}]
        set yr [expr {[lindex $coords 3]-$y0}]
        set start_angle [$c itemcget $item -start]
        set stop_angle [expr {[$c itemcget $item -extent]+$start_angle}]
        if {$stop_angle < $start_angle} {
          set a $start_angle
          set start_angle $stop_angle
          set stop_angle $a
        }

        set start_angle [expr {$deg2rad*$start_angle}]
        set stop_angle [expr {$deg2rad*$stop_angle}]

        set mcoords "[expr {$x0+cos($start_angle)*$xr}],[expr {$y0-sin($start_angle)*$yr}]"
        set ecoords "[expr {$x0+cos($stop_angle)*$xr}],[expr {$y0-sin($stop_angle)*$yr}]"
        if {[$c itemcget $item -style] eq "arc"} {
          set cmd "<path d=\"M $mcoords A $xr,$yr 0 [expr {(abs([$c itemcget $item -extent])>180)?1:0}] 0 $ecoords\" stroke-width=\"[$c itemcget $item -width]\" stroke=\"[color_to_svgrgb [$c itemcget $item -outline]]\" fill=\"none\"/>\n"
        } elseif {[$c itemcget $item -style] eq "chord"} {
          set cmd "<path d=\"M $mcoords A $xr,$yr 0 [expr {(abs([$c itemcget $item -extent])>180)?1:0}] 0 $ecoords Z\" stroke-width=\"[$c itemcget $item -width]\" stroke=\"[color_to_svgrgb [$c itemcget $item -outline]]\" fill=\"[color_to_svgrgb [$c itemcget $item -fill]]\"/>\n"
        } else {
          set cmd "<path d=\"M $x0,$y0 L $mcoords A $xr,$yr 0 [expr {(abs([$c itemcget $item -extent])>180)?1:0}] 0 $ecoords Z\" stroke-width=\"[$c itemcget $item -width]\" stroke=\"[color_to_svgrgb [$c itemcget $item -outline]]\" fill=\"[color_to_svgrgb [$c itemcget $item -fill]]\"/>\n"
        }
      } 
      bitmap {
        #sputs "No handler for item type: Bitmap"
        set cmd ""
      }
      image {
        #sputs "No handler for item type: Image"
        set cmd ""
      }
      line {
        if {[llength $coords] == 4} {
          set cmd "<line x1=\"[lindex $coords 0]\" y1=\"[lindex $coords 1]\" x2=\"[lindex $coords 2]\" y2=\"[lindex $coords 3]\" stroke-width=\"[$c itemcget $item -width]\" stroke=\"[color_to_svgrgb [$c itemcget $item -fill]]\"/>\n"
        } else {
          ## need to add -smooth raw and smooth true/bezier
          set cmd "<polyline points=\"$coords\" stroke-width=\"[$c itemcget $item -width]\" stroke=\"[color_to_svgrgb [$c itemcget $item -fill]]\" fill=\"none\"/>\n"
        }
      }
      oval {
          set cmd "<ellipse cx=\"[expr {([lindex $coords 2]+[lindex $coords 0])/2.0}]\" cy=\"[expr {([lindex $coords 3]+[lindex $coords 1])/2.0}]\" rx=\"[expr {([lindex $coords 2]-[lindex $coords 0])/2.0}]\" ry=\"[expr {([lindex $coords 3]-[lindex $coords 1])/2.0}]\" stroke-width=\"[$c itemcget $item -width]\" stroke=\"[color_to_svgrgb [$c itemcget $item -outline]]\" fill=\"[color_to_svgrgb [$c itemcget $item -fill]]\"/>\n"
      }
      polygon {
        set smooth [$c itemcget $item -smooth]
        if {$coords == ""} {
            set cmd ""
        } elseif {$smooth eq "raw"} {
          set path_text "M [expr {[lindex $coords 0]}] [expr {[lindex $coords 1]}] "
          foreach {xpt0 ypt0 xpt1 ypt1 xpt2 ypt2} [lrange $coords 2 end] {
            if {$ypt2 eq {}} {break}
            append path_text "C [expr {$xpt0}] [expr {$ypt0}], [expr {$xpt1}] [expr {$ypt1}], [expr {$xpt2}] [expr {$ypt2}] "
          }
          append path_text "z"
          set cmd "<path d=\"$path_text\" stroke-width=\"[$c itemcget $item -width]\" stroke=\"[color_to_svgrgb [$c itemcget $item -outline]]\" fill=\"[color_to_svgrgb [$c itemcget $item -fill]]\"/>\n"
        } elseif  {([string is boolean $smooth] && $smooth)} {
          set path_text "M [expr {([lindex $coords 0]+[lindex $coords 2])/2}] [expr {([lindex $coords 1]+[lindex $coords 3])/2}] "
          set xpt0 [lindex $coords 2]
          set ypt0 [lindex $coords 3]
          set coords [list {*}[lrange $coords 4 end] {*}[lrange $coords 0 3]]
          foreach {xpt1 ypt1} $coords {
            if {$ypt1 eq {}} {break}
            append path_text "Q [expr {$xpt0}] [expr {$ypt0}], [expr {($xpt1+$xpt0)/2}] [expr {($ypt1+$ypt0)/2}] "
            set xpt0 $xpt1
            set ypt0 $ypt1
          }
          append path_text "z"
          set cmd "<path d=\"$path_text\" stroke-width=\"[$c itemcget $item -width]\" stroke=\"[color_to_svgrgb [$c itemcget $item -outline]]\" fill=\"[color_to_svgrgb [$c itemcget $item -fill]]\"/>\n"
        } else {
          set cmd "<polygon points=\"$coords\" stroke-width=\"[$c itemcget $item -width]\" stroke=\"[color_to_svgrgb [$c itemcget $item -outline]]\" fill=\"[color_to_svgrgb [$c itemcget $item -fill]]\"/>\n"
        }
      }
      rectangle {
          set cmd "<rect x=\"[lindex $coords 0]\" y=\"[lindex $coords 1]\" width=\"[expr {[lindex $coords 2]-[lindex $coords 0]}]\" height=\"[expr {[lindex $coords 3]-[lindex $coords 1]}]\" stroke-width=\"[$c itemcget $item -width]\" stroke=\"[color_to_svgrgb [$c itemcget $item -outline]]\" fill=\"[color_to_svgrgb [$c itemcget $item -fill]]\"/>\n"
      }
      text {
        set font [$c itemcget $item -font]
        if {[$c itemcget $item -text] != "" && [set bbox [$c bbox $item]] !={}} {
          if {[set angle [$c itemcget $item -angle]] == 0} {
            ## unrotated text
            set char_y [expr {round([tk scaling]*[font metrics $font -ascent]*10)/10.0}]
            set txt [string map {> &#62; < &#60; \" &#34; & &#38;} [$c itemcget $item -text]]
            if { [font actual $font -underline]} {
              set svg_text_underline "text-decoration=\"underline\""
            } else {
              set svg_text_underline ""
            }
            set cmd "<text x=\"[expr {1+[lindex $bbox 0]}]\" y=\"[expr {[lindex $bbox 1]+$char_y}]\" $svg_text_underline font-weight=\"[font actual $font -weight]\" font-style=\"[font actual $font -slant]\" font-family=\"[font actual $font -family]\" font-size=\"[expr {round([tk scaling]*[font actual $font -size]*10)/10.0}]\" fill=\"[color_to_svgrgb [$c itemcget $item -fill]]\" >"
            if {[llength [split $txt \n]] == 1} {
              append cmd $txt
            } else {
              set iline 1
              append cmd [lindex [split $txt \n] 0]
              foreach line [lrange [split $txt \n] 1 end] {
                if {$line eq ""} {
                  incr iline
                } else {
                  append cmd "<tspan x=\"[lindex $bbox 0]\" dy=\"[expr {$char_y * $iline}]\" >$line</tspan>\n"
                  set iline 1
                }
              }
            }
          } else {
            ## rotated text --rotates relative to center of bbox, then moves baseline by angle
            set txt [string map {> &#62; < &#60; \" &#34; & &#38;} [$c itemcget $item -text]]
            set char_y [expr {0.25*round([tk scaling]*[font metrics $font -linespace]*10)/10.0}]
            #needs to use char_y to shift x and y so that the svg the baseline is correct
            #foreach {charx chary} [$c coords $item] {}
	    foreach {x0 y0 x1 y1} $bbox {}
	    set charx [expr {($x0 + $x1) /2.0}]
	    set chary [expr {($y0 + $y1) /2.0}]
            set chary [expr {$chary+ $char_y*cos($angle * pi()/180)}]
            set charx [expr {$charx+ $char_y*sin($angle * pi()/180)}]
            set cmd "<text x=\"$charx\" y=\"$chary\" font-weight=\"[font actual $font -weight]\" font-style=\"[font actual $font -slant]\" font-family=\"[font actual $font -family]\" font-size=\"[expr {round([tk scaling]*[font actual $font -size]*10)/10.0}]\" fill=\"[color_to_svgrgb [$c itemcget $item -fill]]\" style=\"text-anchor: middle\" transform=\"rotate([expr {-1*$angle}], $charx, $chary)\">"
            append cmd $txt
          }
          append cmd "</text>\n"
        } else {
          set cmd ""
        }
      }
      window {
        #sputs "No handler for item type: Window"
        set cmd ""
      }
      default {
        #sputs "No handler for item type:[$c type $item]"
        set cmd ""
      }
    }
    append result $cmd
  }
  append result "</svg>\n"
  return $result
}

##############
## print a canvas to an rtf string
##############
proc canvas_to_rtf {c} {
  foreach {x0 y0 x1 y1} [$c bbox all] {}
  set result ""
  set deg2rad [expr {3.14159/180}]
  set shape_id 1000
  set z_height 0
  set colortable "colortbl;"
  set colortable_index 1
  set colortable_list [list]
  set fonttable ""
  set fonttable_index 1
  set fonttable_list [list]
  set x_offset [expr {-1* [lindex [$c cget -scrollregion] 0]}]
  set y_offset [expr {-1* [lindex [$c cget -scrollregion] 1]}]
  foreach item [$c find all] {
    if {[$c itemcget $item -state] == "hidden"} {
      continue
    }

    set coords [$c coords $item]

    switch [$c type $item] {
      arc {
        ###filled arcs are not supported
        set arc_width [expr {[$c itemcget $item -width]}]
        set x0 [expr {int(([lindex $coords 0]-$arc_width/2.0 + $x_offset)*20)}]
        set y0 [expr {int(([lindex $coords 1]-$arc_width/2.0  + $y_offset) * 20)}]
        set x1 [expr {int(([lindex $coords 2]+$arc_width/2.0  + $x_offset) * 20)}]
        set y1 [expr {int(([lindex $coords 3]+$arc_width/2.0  + $y_offset) * 20)}]
        set start_angle [expr {int((270-([$c itemcget $item -start]+[$c itemcget $item -extent]/2.0))*65536)}]
        set extent_angle [expr {int((180-abs([$c itemcget $item -extent]))/2*65536)}]

        set internal_radius [expr {int((1-(40.0*$arc_width/($x1-$x0)))*10800)}]
        set outline_color [$c itemcget $item -outline]
        if {$outline_color ne ""} {
          foreach {red green blue} [winfo rgb . $outline_color] {}
          set outline_color [expr {(($blue>>8)<<16)+(($green>>8)<<8)+(($red>>8))}]
        }
        set cmd "{\\shp{\\*\\shpinst\\shpleft$x0\\shptop$y0\\shpright$x1\\shpbottom$y1\\shpfhdr0\\shpbxcolumn\\shpbxignore\\shpbypara\\shpbyignore\\shpwr4\\shpwrk0\\shpfblwtxt0\\shpz$z_height\\shplid$shape_id{\\sp{\\sn shapeType}{\\sv 95}}{\\sp{\\sn rotation}{\\sv $start_angle}}{\\sp{\\sn adjustValue}{\\sv $extent_angle}}{\\sp{\\sn adjust2Value}{\\sv $internal_radius}}{\\sp{\\sn fillColor}{\\sv $outline_color}}{\\sp{\\sn fUseShapeAnchor}{\\sv 0}}{\\sp{\\sn fFilled}{\\sv 1}}{\\sp{\\sn fNoFillHitTest}{\\sv 1}}{\\sp{\\sn lineColor}{\\sv 4626167}}{\\sp{\\sn lineWidth}{\\sv 00}}{\\sp{\\sn fLine}{\\sv 0}}}{\\shprslt}}"
        incr shape_id
        incr z_height
      } 
      bitmap {
        #sputs "No handler for item type: Bitmap"
        set cmd ""
      }
      image {
        #sputs "No handler for item type: Image"
        set cmd ""
      }
      line {
        set line_color [$c itemcget $item -fill]
        if {$line_color ne ""} {
          foreach {red green blue} [winfo rgb . $line_color] {}
          set line_color [expr {(($blue>>8)<<16)+(($green>>8)<<8)+(($red>>8))}]
        }
        set line_width [expr {int([$c itemcget $item -width]  * 12700)}]
        if {[llength $coords] == 4} {
          set x0 [expr {int(([lindex $coords 0] + $x_offset) * 20)}]
          set y0 [expr {int(([lindex $coords 1] + $y_offset) * 20)}]
          set x1 [expr {int(([lindex $coords 2] + $x_offset) * 20)}]
          set y1 [expr {int(([lindex $coords 3] + $y_offset) * 20)}]
         
          set cmd "{\\shp{\\*\\shpinst\\shpleft$x0\\shptop$y0\\shpright$x1\\shpbottom$y1\\shpfhdr0\\shpbxcolumn\\shpbxignore\\shpbypara\\shpbyignore\\shpwr4\\shpwrk0\\shpfblwtxt0\\shpz$z_height\\shplid$shape_id{\\sp{\\sn shapeType}{\\sv 20}}
{\\sp{\\sn lineColor}{\\sv $line_color}}{\\sp{\\sn lineWidth}{\\sv $line_width}}{\\sp{\\sn fArrowheadsOK}{\\sv 1}}{\\sp{\\sn fLine}{\\sv 1}}{\\sp{\\sn lineType}{\\sv 0}}{\\sp{\\sn fUseShapeAnchor}{\\sv 0}}{\\sp{\\sn fFilled}{\\sv 0}}{\\sp{\\sn fNoFillHitTest}{\\sv 1}}}{\\shprslt}}"
          incr shape_id
          incr z_height
        } else {
          set xmin [lindex $coords 0]
          set xmax [lindex $coords 0]
          set ymin [lindex $coords 1]
          set ymax [lindex $coords 1]
          foreach {xcoord ycoord} $coords {
            set xmax [expr {max($xmax,$xcoord)}]
            set xmin [expr {min($xmin,$xcoord)}]
            set ymax [expr {max($ymax,$ycoord)}]
            set ymin [expr {min($ymin,$ycoord)}]
          }
          set line_vert [list 8 [expr {[llength $coords]/2}]]
          foreach {xcoord ycoord} $coords {
            lappend line_vert "([expr {int(20*($xcoord-$xmin))}],[expr {int(20*($ycoord-$ymin))}])"
          }
           set line_vert [join $line_vert ";"]
           #pSegmentInfo= 16384;44032+(;1;44032)*(pts-1)+;32768
           set pSegmentInfo "2;[expr {[llength $coords]+1}];16384;44032[string repeat {;1;44032} [expr {[llength $coords]/2-1}]];32768"
          set cmd "{\\shp{\\*\\shpinst\\shpleft[expr {int(20*($xmin+ $x_offset))}]\\shptop[expr {int(20*($ymin+ $y_offset))}]\\shpright[expr {int(20*($xmax+ $x_offset))}]\\shpbottom[expr {int(20*($ymax+ $y_offset))}]\\shpfhdr0\\shpbxcolumn\\shpbxignore\\shpbypara\\shpbyignore\\shpwr4\\shpwrk0\\shpfblwtxt0\\shpz$z_height\\shplid$shape_id{\\sp{\\sn shapeType}{\\sv 0}}{\\sp{\\sn geoRight}{\\sv [expr {int(20*($xmax-$xmin))}]}}
{\\sp{\\sn geoBottom}{\\sv [expr {int(20*($ymax-$ymin))}]}}{\\sp{\\sn shapePath}{\\sv 4}}{\\sp{\\sn fFillOK}{\\sv 1}}{\\sp{\\sn pVerticies}{\\sv $line_vert}}{\\sp{\\sn pSegmentInfo}{\\sv $pSegmentInfo}}
{\\sp{\\sn lineColor}{\\sv $line_color}}{\\sp{\\sn lineWidth}{\\sv $line_width}}{\\sp{\\sn fArrowheadsOK}{\\sv 1}}{\\sp{\\sn fLine}{\\sv 1}}{\\sp{\\sn lineType}{\\sv 0}}{\\sp{\\sn fUseShapeAnchor}{\\sv 0}}{\\sp{\\sn fFilled}{\\sv 0}}{\\sp{\\sn fNoFillHitTest}{\\sv 1}}}{\\shprslt}}"
          incr shape_id
          incr z_height
        }
      }
      oval1 {
        ## uses donut item- not used
        set line_width [expr {[$c itemcget $item -width]}]
        set x0 [expr {int(([lindex $coords 0]-$line_width/2.0 + $x_offset)*20)}]
        set y0 [expr {int(([lindex $coords 1]-$line_width/2.0  + $y_offset) * 20)}]
        set x1 [expr {int(([lindex $coords 2]+$line_width/2.0  + $x_offset) * 20)}]
        set y1 [expr {int(([lindex $coords 3]+$line_width/2.0  + $y_offset) * 20)}]

        set internal_radius [expr {int(40.0*$line_width)}]
        set outline_color [$c itemcget $item -outline]
        if {$outline_color ne ""} {
          foreach {red green blue} [winfo rgb . $outline_color] {}
          set outline_color [expr {(($blue>>8)<<16)+(($green>>8)<<8)+(($red>>8))}]
        }
        set cmd "{\\shp{\\*\\shpinst\\shpleft$x0\\shptop$y0\\shpright$x1\\shpbottom$y1\\shpfhdr0\\shpbxcolumn\\shpbxignore\\shpbypara\\shpbyignore\\shpwr4\\shpwrk0\\shpfblwtxt0\\shpz$z_height\\shplid$shape_id{\\sp{\\sn shapeType}{\\sv 23}}
{\\sp{\\sn adjustValue}{\\sv $internal_radius}}{\\sp{\\sn fillColor}{\\sv $outline_color}}{\\sp{\\sn fUseShapeAnchor}{\\sv 0}}{\\sp{\\sn fFilled}{\\sv 1}}{\\sp{\\sn fNoFillHitTest}{\\sv 1}}{\\sp{\\sn lineColor}{\\sv 4626167}}{\\sp{\\sn lineWidth}{\\sv 00}}{\\sp{\\sn fLine}{\\sv 0}}}{\\shprslt}}"
        incr shape_id
        incr z_height
      }
      oval {
        set line_width [expr {int([$c itemcget $item -width]  * 12700)}]
        set x0 [expr {int(([lindex $coords 0] + $x_offset)*20)}]
        set y0 [expr {int(([lindex $coords 1] + $y_offset) * 20)}]
        set x1 [expr {int(([lindex $coords 2] + $x_offset) * 20)}]
        set y1 [expr {int(([lindex $coords 3] + $y_offset) * 20)}]
        set fill_color [$c itemcget $item -fill]
        if {$fill_color ne ""} {
          foreach {red green blue} [winfo rgb . $fill_color] {}
          set fill_color [expr {(($blue>>8)<<16)+(($green>>8)<<8)+(($red>>8))}]
        } else {set fill_color 0}
        set outline_color [$c itemcget $item -outline]
        if {$outline_color ne ""} {
          foreach {red green blue} [winfo rgb . $outline_color] {}
          set outline_color [expr {(($blue>>8)<<16)+(($green>>8)<<8)+(($red>>8))}]
        } else {set outline_color 0}
        set cmd "{\\shp{\\*\\shpinst\\shpleft$x0\\shptop$y0\\shpright$x1\\shpbottom$y1\\shpfhdr0\\shpbxcolumn\\shpbxignore\\shpbypara\\shpbyignore\\shpwr4\\shpwrk0\\shpfblwtxt0\\shpz$z_height\\shplid$shape_id{\\sp{\\sn shapeType}{\\sv 3}}
{\\sp{\\sn fillColor}{\\sv $outline_color}}{\\sp{\\sn fUseShapeAnchor}{\\sv 0}}{\\sp{\\sn fFilled}{\\sv [expr {([$c itemcget $item -fill] ne "")?1:0}]}}{\\sp{\\sn fillColor}{\\sv $fill_color}}{\\sp{\\sn fNoFillHitTest}{\\sv 1}}{\\sp{\\sn lineColor}{\\sv $outline_color}}{\\sp{\\sn lineWidth}{\\sv $line_width}}{\\sp{\\sn fLine}{\\sv [expr {([$c itemcget $item -outline] ne 0)?1:0}]}}}{\\shprslt}}"
        incr shape_id
        incr z_height
      }
      polygon {
        if {$coords == {}} {continue}
        set fill_color [$c itemcget $item -fill]
        if {$fill_color ne ""} {
          foreach {red green blue} [winfo rgb . $fill_color] {}
          set fill_color [expr {(($blue>>8)<<16)+(($green>>8)<<8)+(($red>>8))}]
        }
        set line_color [$c itemcget $item -outline]
        if {$line_color ne ""} {
          foreach {red green blue} [winfo rgb . $line_color] {}
          set line_color [expr {(($blue>>8)<<16)+(($green>>8)<<8)+(($red>>8))}]
        }
        set line_width [expr {int([$c itemcget $item -width]  * 12700)}]
        set xmin [lindex $coords 0]
        set xmax [lindex $coords 0]
        set ymin [lindex $coords 1]
        set ymax [lindex $coords 1]
        foreach {xcoord ycoord} $coords {
          set xmax [expr {max($xmax,$xcoord)}]
          set xmin [expr {min($xmin,$xcoord)}]
          set ymax [expr {max($ymax,$ycoord)}]
          set ymin [expr {min($ymin,$ycoord)}]
        }
        set line_vert [list 8 [expr {([llength $coords]+2)/2}]] 
        foreach {xcoord ycoord} $coords {
          lappend line_vert "([expr {int(20*($xcoord-$xmin))}],[expr {int(20*($ycoord-$ymin))}])"
        }
        lappend line_vert "([expr {int(20*([lindex $coords 0]-$xmin))}],[expr {int(20*([lindex $coords 1]-$ymin))}])"
        set line_vert [join $line_vert ";"]
         #pSegmentInfo= 16384;44032+(;1;44032)*(pts)+;24577;32768
         set pSegmentInfo "2;[expr {[llength $coords]+4}];16384;44032[string repeat {;1;44032} [expr {[llength $coords]/2}]];24577;32768"
        set cmd "{\\shp{\\*\\shpinst\\shpleft[expr {int(20*($xmin+ $x_offset))}]\\shptop[expr {int(20*($ymin+ $y_offset))}]\\shpright[expr {int(20*($xmax+ $x_offset))}]\\shpbottom[expr {int(20*($ymax+ $y_offset))}]\\shpfhdr0\\shpbxcolumn\\shpbxignore\\shpbypara\\shpbyignore\\shpwr4\\shpwrk0\\shpfblwtxt0\\shpz$z_height\\shplid$shape_id{\\sp{\\sn shapeType}{\\sv 0}}{\\sp{\\sn geoRight}{\\sv [expr {int(20*($xmax-$xmin))}]}}
{\\sp{\\sn geoBottom}{\\sv [expr {int(20*($ymax-$ymin))}]}}{\\sp{\\sn shapePath}{\\sv 4}}{\\sp{\\sn fFillOK}{\\sv 1}}{\\sp{\\sn pVerticies}{\\sv $line_vert}}{\\sp{\\sn pSegmentInfo}{\\sv $pSegmentInfo}}{\\sp{\\sn fillColor}{\\sv $fill_color}}
{\\sp{\\sn lineColor}{\\sv $line_color}}{\\sp{\\sn lineWidth}{\\sv $line_width}}{\\sp{\\sn fArrowheadsOK}{\\sv 1}}{\\sp{\\sn fLine}{\\sv 1}}{\\sp{\\sn lineType}{\\sv 0}}{\\sp{\\sn fUseShapeAnchor}{\\sv 0}}{\\sp{\\sn fFilled}{\\sv 1}}{\\sp{\\sn fNoFillHitTest}{\\sv 1}}}{\\shprslt}}"
          incr shape_id
          incr z_height
      }
      rectangle {
        set line_width [expr {int([$c itemcget $item -width]*12700)}]
        set x0 [expr {int(([lindex $coords 0]+ $x_offset)*20)}]
        set y0 [expr {int(([lindex $coords 1] + $y_offset) * 20)}]
        set x1 [expr {int(([lindex $coords 2] + $x_offset) * 20)}]
        set y1 [expr {int(([lindex $coords 3] + $y_offset) * 20)}]
        set outline_color [$c itemcget $item -outline]
        if {$outline_color ne ""} {
          foreach {red green blue} [winfo rgb . $outline_color] {}
          set outline_color [expr {(($blue>>8)<<16)+(($green>>8)<<8)+(($red>>8))}]
        }
        set fill_color [$c itemcget $item -fill]
        if {$fill_color ne ""} {
          foreach {red green blue} [winfo rgb . $fill_color] {}
          set fill_color [expr {(($blue>>8)<<16)+(($green>>8)<<8)+(($red>>8))}]
        }
        set cmd "{\\shp{\\*\\shpinst\\shpleft$x0\\shptop$y0\\shpright$x1\\shpbottom$y1\\shpfhdr0\\shpbxcolumn\\shpbxignore\\shpbypara\\shpbyignore\\shpwr4\\shpwrk0\\shpfblwtxt0\\shpz$z_height\\shplid$shape_id{\\sp{\\sn shapeType}{\\sv 1}}{\\sp{\\sn fillColor}{\\sv $fill_color}}{\\sp{\\sn fUseShapeAnchor}{\\sv 0}}{\\sp{\\sn fFilled}{\\sv [expr {($fill_color ne "")?1:0}]}}{\\sp{\\sn fNoFillHitTest}{\\sv 1}}{\\sp{\\sn lineColor}{\\sv $outline_color}}{\\sp{\\sn lineWidth}{\\sv $line_width}}{\\sp{\\sn fLine}{\\sv [expr {($outline_color ne "")?1:0}]}}}{\\shprslt}}"
        incr shape_id
        incr z_height
      }
      text {
        if {[$c itemcget $item -text] != ""} {
          set font [$c itemcget $item -font]
          if {[set angle [$c itemcget $item -angle]] == 0} {
            ## unrotated text
            set bbox [$c bbox $item]
            set x0 [expr {int(([lindex $bbox 0] + $x_offset)*20)}]
            set y0 [expr {int(([lindex $bbox 1] + $y_offset) * 20)}]
            set x1 [expr {int(([lindex $bbox 2] + $x_offset) * 20)}]
            set y1 [expr {int(([lindex $bbox 3] + $y_offset) * 20)}]
            if {[string first "w" [$c itemcget $item -anchor]] > -1}  {
              incr x1 100
            } elseif {[string first "e" [$c itemcget $item -anchor]] > -1} {
              incr x0 -100
            } else {
              incr x1 50
              incr x0 -50
            }
            set text [$c itemcget $item -text]
            set color [$c itemcget $item -fill]
            set fontsize [expr {int(round([tk scaling]*[font actual $font -size]*10)/5)}]
            foreach {r g b} [winfo rgb . $color] {}
            if {[set color_index [lsearch -exact $colortable_list $color]] == -1} {
              append colortable "\\red[expr {$r>>8}]\\green[expr {$g>>8}]\\blue[expr {$b>>8}];"
              lappend colortable_list $color
              set color_index $colortable_index
              incr colortable_index
            } else {
              incr color_index
            }
            set font_family [font actual $font -family]
            if {[set font_index [lsearch -exact $fonttable_list $font_family]] == -1} {
              append fonttable "{\\f$fonttable_index $font_family;}"
              lappend fonttable_list $font_family
              set font_index $fonttable_index
              incr fonttable_index
            } else {
              incr font_index
            }
            if {[llength [split $text \n]] == 1} {
              set cmd "{\\shp{\\*\\shpinst\\shpleft$x0\\shptop$y0\\shpright$x1\\shpbottom$y1\\shpfhdr0\\shpbxcolumn\\shpbxignore\\shpbypara\\shpbyignore\\shpwr4\\shpwrk0\\shpfblwtxt0\\shpz$z_height\\shplid$shape_id{\\sp{\\sn shapeType}{\\sv 202}}{\\sp{\\sn fFilled}{\\sv 0}}{\\sp{\\sn dyTextTop}{\\sv 0}}{\\sp{\\sn dyTextBottom}{\\sv 0}}{\\sp{\\sn dxTextLeft}{\\sv 0}}{\\sp{\\sn dxTextRight}{\\sv 0}}{\\sp{\\sn fNoFillHitTest}{\\sv 1}}{\\sp{\\sn fLine}{\\sv 0}}{\\sp{\\sn fEditedWrap}{\\sv 0}}{\\sp{\\sn fLayoutInCell}{\\sv 1}}{\\shptxt{\\f$font_index\\fs$fontsize\\cf$color_index $text}}}{\\shprslt}}"
              incr shape_id
              incr z_height
            } else {
              set iline 1
              append cmd ""
              foreach line [lrange [split $txt \n] 1 end] {
                if {$line eq ""} {
                  incr iline
                } else {
                  append cmd ""
                  set iline 1
                }
              }
            }
          } else {
            ## rotated text --assumes -anchor center
            set txt [string map {> &#62; < &#60; \" &#34; & &#38;} [$c itemcget $item -text]]
            set char_y [expr {0.25*round([tk scaling]*[font metrics $font -linespace]*10)/10.0}]
            #needs to use char_y to shift x and y so that the svg the baseline is correct
            foreach {charx chary} [$c coords $item] {}
            set chary [expr {$chary+ $char_y*cos($angle * pi()/180)}]
            set charx [expr {$charx+ $char_y*sin($angle * pi()/180)}]
            set cmd ""
            append cmd ""
          }
          append cmd ""
        } else {
          set cmd ""
        }
      }
      window {
        #sputs "No handler for item type: Window"
        set cmd ""
      }
      default {
        #sputs "No handler for item type:[$c type $item]"
        set cmd ""
      }
    }
    append result $cmd
  }
  return "{\\rtf1\\ansi{\\fonttbl{\\f0\\fmodern Courier;}$fonttable}{\\$colortable}\\f0\\pard
$result\\par}"
}



###########
## from tcl wiki, zip a directory into a gzip file, modified. Used to save a directory as a zipped pptx file (skipping .DS_Store files)
###########
 namespace eval zip {}
 # zip::timet_to_dos
 #
 #        Convert a unix timestamp into a DOS timestamp for ZIP times.
 #
 #   DOS timestamps are 32 bits split into bit regions as follows:
 #                  24                16                 8                 0
 #   +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
 #   |Y|Y|Y|Y|Y|Y|Y|m| |m|m|m|d|d|d|d|d| |h|h|h|h|h|m|m|m| |m|m|m|s|s|s|s|s|
 #   +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+ +-+-+-+-+-+-+-+-+
 #
 proc zip::timet_to_dos {time_t} {
     set s [clock format $time_t -format {%Y %m %e %k %M %S}]
     scan $s {%d %d %d %d %d %d} year month day hour min sec
     expr {(($year-1980) << 25) | ($month << 21) | ($day << 16) 
           | ($hour << 11) | ($min << 5) | ($sec >> 1)}
 }
 
 # zip::pop --
 #
 #        Pop an element from a list
 #
 proc zip::pop {varname {nth 0}} {
     upvar $varname args
     set r [lindex $args $nth]
     set args [lreplace $args $nth $nth]
     return $r
 }
 
 # zip::walk --
 #
 #        Walk a directory tree rooted at 'path'. 
 #
proc zip::walk {base {path {}}} {
     set result {}
     set files [glob -nocomplain -tails -types f -directory $base [file join $path *]]
     lappend files {*}[glob -nocomplain -tails -types f -directory $base [file join $path .*]]
     foreach file $files {
       lappend result $file
     }
     foreach dir [glob -nocomplain -tails -types d -directory $base [file join $path *]] {
         set subdir [walk $base  $dir]
         if {[llength $subdir]>0} {
             set result [concat $result [list $dir] $subdir]
         } else {
             set result [concat $result [list $dir]]
         }
     }
     return $result
 }
 
 # zip::mkzipfile --
 #
 #        Add a single file to a zip archive. The zipchan channel should
 #        already be open and binary. You may provide a comment for the
 #        file The return value is the central directory record that
 #        will need to be used when finalizing the zip archive.
 #
 # FIX ME: should  handle the current offset for non-seekable channels
 #
 proc zip::mkzipfile {zipchan base path {comment ""}} {
     set fullpath [file join $base $path]
     set mtime [timet_to_dos [file mtime $fullpath]]
     set utfpath [encoding convertto utf-8 $path]
     set utfcomment [encoding convertto utf-8 $comment]
     set flags [expr {(1<<11)}] ;# utf-8 comment and path
     set method 0               ;# store 0, deflate 8
     set attr 0                 ;# text or binary (default binary)
     set version 20             ;# minumum version req'd to extract
     set extra ""
     set crc 0
     set size 0
     set csize 0
     set data ""
     set seekable [expr {[tell $zipchan] != -1}]
     if {[file isdirectory $fullpath]} {
         set attrex 0x41ff0010  ;# 0o040777 (drwxrwxrwx)
         append path /
         set utfpath [encoding convertto utf-8 $path]
     } elseif {[file executable $fullpath]} {
         set attrex 0x81ff0080  ;# 0o100777 (-rwxrwxrwx)
     } else {
         set attrex 0x81b60020  ;# 0o100666 (-rw-rw-rw-)
         if {[file extension $fullpath] in {".tcl" ".txt" ".c"}} {
             set attr 1         ;# text
         }
     }
 
     if {[file isfile $fullpath]} {
         set size [file size $fullpath]
         if {!$seekable} {set flags [expr {$flags | (1 << 3)}]}
     }
 
     set offset [tell $zipchan]
     set local [binary format a4sssiiiiss PK\03\04 \
                    $version $flags $method $mtime $crc $csize $size \
                    [string length $utfpath] [string length $extra]]
     append local $utfpath $extra
     puts -nonewline $zipchan $local
 
     if {[file isfile $fullpath]} {
         # If the file is under 2MB then zip in one chunk, otherwize we use
         # streaming to avoid requiring excess memory. This helps to prevent
         # storing re-compressed data that may be larger than the source when
         # handling PNG or JPEG or nested ZIP files.
         if {$size < 0x00200000} {
             set fin [open $fullpath rb]
             set data [read $fin]
             set crc [zlib crc32 $data]
             set cdata [zlib deflate $data]
             if {[string length $cdata] < $size} {
                 set method 8
                 set data $cdata
             }
             close $fin
             set csize [string length $data]
             puts -nonewline $zipchan $data
         } else {
             set method 8
             set fin [open $fullpath rb]
             set zlib [zlib stream deflate]
             while {![eof $fin]} {
                 set data [read $fin 4096]
                 set crc [zlib crc32 $data $crc]
                 $zlib put $data
                 if {[string length [set zdata [$zlib get]]]} {
                     incr csize [string length $zdata]
                     puts -nonewline $zipchan $zdata
                 }
             }
             close $fin
             $zlib finalize
             set zdata [$zlib get]
             incr csize [string length $zdata]
             puts -nonewline $zipchan $zdata
             $zlib close
         }
     
         if {$seekable} {
             # update the header if the output is seekable
             set local [binary format a4sssiiii PK\03\04 \
                            $version $flags $method $mtime $crc $csize $size]
             set current [tell $zipchan]
             seek $zipchan $offset
             puts -nonewline $zipchan $local
             seek $zipchan $current
         } else {
             # Write a data descriptor record
             set ddesc [binary format a4iii PK\7\8 $crc $csize $size]
             puts -nonewline $zipchan $ddesc
         }
     }
 
     set hdr [binary format a4ssssiiiisssssii PK\01\02 0x0317 \
                  $version $flags $method $mtime $crc $csize $size \
                  [string length $utfpath] [string length $extra]\
                  [string length $utfcomment] 0 $attr $attrex $offset]
     append hdr $utfpath $extra $utfcomment
     return $hdr
 }
 
 # zip::mkzip --
 #
 #        Create a zip archive in 'filename'. If a file already exists it will be
 #        overwritten by a new file. If '-directory' is used, the new zip archive
 #        will be rooted in the provided directory.
 #        -runtime can be used to specify a prefix file. For instance, 
 #        zip myzip -runtime unzipsfx.exe -directory subdir
 #        will create a self-extracting zip archive from the subdir/ folder.
 #        The -comment parameter specifies an optional comment for the archive.
 #
 #        eg: zip my.zip -directory Subdir -runtime unzipsfx.exe *.txt
 # 
 proc zip::mkzip {filename args} {
     array set opts {
         -comment "" -directory ""
     }
     
     while {[string match -* [set option [lindex $args 0]]]} {
         switch -exact -- $option {
             -comment { set opts(-comment) [encoding convertto utf-8 [pop args 1]] }
             -directory {set opts(-directory) [file normalize [pop args 1]] }
             -- { pop args ; break }
             default {
                 break
             }
         }
         pop args
     }
 
     set zf [open $filename wb]
     
     set count 0
     set cd ""

     if {$opts(-directory) ne ""} {
         set paths [walk $opts(-directory)]
     } else {
         set paths [glob -nocomplain {*}$args]
     }
     foreach path $paths {
         if {[file tail $path] eq ".DS_Store"} {continue}
         append cd [mkzipfile $zf $opts(-directory) $path]
         incr count
     }
     set cdoffset [tell $zf]
     set endrec [binary format a4ssssiis PK\05\06 0 0 \
                     $count $count [string length $cd] $cdoffset\
                     [string length $opts(-comment)]]
     append endrec $opts(-comment)
     puts -nonewline $zf $cd
     puts -nonewline $zf $endrec
     close $zf

     return
  }


##############
## print a canvas to open xml (drawingML)
## used in pptx files
##############
proc canvas_to_xml {c} {
  foreach {x0 y0 x1 y1} [$c bbox all] {}
    set result ""
    set emuperpixel [expr {int(12700/ [tk scaling])}]
  set i 1
  if {[$c cget -scrollregion]  ne {}} {
    lassign [$c cget -scrollregion] canvx0 canvy0 canvx1 canvy1
  } else {
    lassign [$c bbox all] canvx0 canvy0 canvx1 canvy1
  }
  foreach var {canvx0 canvy0 canvx1 canvy1} {set $var [expr {int($emuperpixel * [set $var])}]}
    
    foreach item [$c find all] {
    if {[$c itemcget $item -state] == "hidden"} {
      continue
    }
    foreach {bbx0 bby0 bbx1 bby1} [$c bbox $item] {}
    foreach var {bbx0 bby0 bbx1 bby1} {set $var [expr {int($emuperpixel * [set $var])}]}
    set cx [expr {$bbx1 - $bbx0}]
    set cy [expr {$bby1 - $bby0}]

    switch [$c type $item] {
	arc {
	   # continue
        if {[set outline_color [color_to_xmlrgb [$c itemcget $item -outline]]] eq "none"} continue
	set start_angle [expr {round([$c itemcget $item -start]* -60000) % (360 * 60000)}]
	if {[$c itemcget $item -extent] != 0} {
	    set extent_angle [expr {round([$c itemcget $item -extent]* -60000)}]
	} else {
	    set extent_angle 20000
	}
        set stop_angle [expr {($start_angle + $extent_angle) % (360 * 60000)}]
        set line_width [expr {round([$c itemcget $item -width])  * 12700}]
        foreach {bbx0 bby0 bbx1 bby1} [$c coords $item] {}
        foreach var {bbx0 bby0 bbx1 bby1} {set $var [expr {round($emuperpixel * [set $var])}]}
        set cx [expr {$bbx1 - $bbx0}]
        set cy [expr {$bby1 - $bby0}]
        set cmd "<p:sp><p:nvSpPr><p:cNvPr id=\"$i\" name=\"\"></p:cNvPr><p:cNvSpPr/><p:nvPr/></p:nvSpPr><p:spPr><a:xfrm><a:off x=\"[expr {$bbx0 - $canvx0}]\" y=\"[expr {$bby0 - $canvy0}]\"/><a:ext cx=\"$cx\" cy=\"$cy\"/></a:xfrm><a:prstGeom prst=\"arc\"><a:avLst><a:gd name=\"adj1\" fmla=\"val $start_angle\"/><a:gd name=\"adj2\" fmla=\"val $stop_angle\"/></a:avLst></a:prstGeom><a:ln w=\"$line_width\"><a:solidFill><a:srgbClr val=\"$outline_color\"/></a:solidFill></a:ln></p:spPr></p:sp>\n"
      }
	line {
	   # continue
        if {[set outline_color [color_to_xmlrgb [$c itemcget $item -fill]]] eq "none"} continue
        set line_width [expr {round([$c itemcget $item -width]  *12700)}]
        set first_pt 1
        set path_text ""
	set coords [$c coords $item]
	set minx [lindex $coords 0]
	set miny [lindex $coords 1]
	set maxx [lindex $coords 0]
	set maxy [lindex $coords 1]
        foreach {xpt ypt} $coords {
	  set minx [expr {min($minx,$xpt)}]
	  set miny [expr {min($miny,$ypt)}]
	  set maxx [expr {max($maxx,$xpt)}]
	  set maxy [expr {max($maxy,$ypt)}]
        }
        ## need to add -smooth raw and smooth true/bezier
        foreach {xpt ypt} $coords {
          if {$first_pt} {
            append path_text "<a:moveTo><a:pt x=\"[expr {round($emuperpixel * ($xpt-$minx))}]\" y=\"[expr {round($emuperpixel * ($ypt-$miny))}]\"/></a:moveTo>"
            set first_pt 0
          } else {
            append path_text "<a:lnTo><a:pt x=\"[expr {round($emuperpixel * ($xpt-$minx))}]\" y=\"[expr {round($emuperpixel * ($ypt-$miny))}]\"/></a:lnTo>"
          }
        }
	    set cmd "<p:sp><p:nvSpPr><p:cNvPr id=\"$i\" name=\"\"></p:cNvPr><p:cNvSpPr/><p:nvPr/></p:nvSpPr><p:spPr><a:xfrm><a:off x=\"[expr {round($emuperpixel * ($minx)) - $canvx0}]\" y=\"[expr {round($emuperpixel * ($miny)) - $canvy0}]\"/><a:ext cx=\"[expr {round($emuperpixel* ($maxx-$minx+2*[$c itemcget $item -width]))}]\" cy=\"[expr {round($emuperpixel* ($maxy-$miny+2*[$c itemcget $item -width]))}]\"/></a:xfrm><a:custGeom><a:pathLst><a:path w=\"[expr {round($emuperpixel* ($maxx-$minx+2*[$c itemcget $item -width]))}]\" h=\"[expr {round($emuperpixel* ($maxy-$miny+2*[$c itemcget $item -width]))}]\">$path_text</a:path></a:pathLst></a:custGeom><a:noFill/><a:ln w=\"$line_width\"><a:solidFill><a:srgbClr val=\"$outline_color\"/></a:solidFill></a:ln></p:spPr></p:sp>\n"
      }
      oval {
        set outline_color [color_to_xmlrgb [$c itemcget $item -outline]]
        set fill_color [color_to_xmlrgb [$c itemcget $item -fill]]
        if {$outline_color eq "none" && $fill_color eq "none"} continue
        if {$outline_color eq "none"} {
          set outline_text "<a:noFill/>"
        } else {
          set outline_text "<a:solidFill><a:srgbClr val=\"$outline_color\"/></a:solidFill>"
        }
        if {$fill_color eq "none"} {
          set fill_text "<a:noFill/>"
        } else {
          set fill_text "<a:solidFill><a:srgbClr val=\"$fill_color\"/></a:solidFill>"
        }
        set line_width [expr {round([$c itemcget $item -width] * 12700)}]
	foreach {bbx0 bby0 bbx1 bby1} [$c coords $item] {}
        foreach var {bbx0 bby0 bbx1 bby1} {set $var [expr {round($emuperpixel * [set $var])}]}
        set cx [expr {$bbx1 - $bbx0}]
        set cy [expr {$bby1 - $bby0}]
        set cmd "<p:sp><p:nvSpPr><p:cNvPr id=\"$i\" name=\"\"></p:cNvPr><p:cNvSpPr/><p:nvPr/></p:nvSpPr><p:spPr><a:xfrm><a:off x=\"[expr {$bbx0 - $canvx0}]\" y=\"[expr {$bby0 - $canvy0}]\"/><a:ext cx=\"$cx\" cy=\"$cy\"/></a:xfrm><a:prstGeom prst=\"ellipse\"><a:avLst/></a:prstGeom>$fill_text<a:ln w=\"$line_width\">$outline_text</a:ln></p:spPr></p:sp>\n"
      }
	polygon {
	  #  continue
          if {$coords == ""} {
            continue
          } 
        set outline_color [color_to_xmlrgb [$c itemcget $item -outline]]
        set fill_color [color_to_xmlrgb [$c itemcget $item -fill]]
	    if {$outline_color eq "none" && $fill_color eq "none"} {#sputs no fill $item;continue}
        if {[$c coords $item] == ""} continue
        if {$outline_color eq "none"} {
          set outline_text "<a:noFill/>"
        } else {
          set outline_text "<a:solidFill><a:srgbClr val=\"$outline_color\"/></a:solidFill>"
        }
        if {$fill_color eq "none"} {
          set fill_text "<a:noFill/>"
        } else {
          set fill_text "<a:solidFill><a:srgbClr val=\"$fill_color\"/></a:solidFill>"
        }
        set line_width [expr {round([$c itemcget $item -width] *  12700)}]
        set first_pt 1
        set path_text ""
 	set coords [$c coords $item]
	set minx [lindex $coords 0]
	set miny [lindex $coords 1]
	set maxx [lindex $coords 0]
	set maxy [lindex $coords 1]
        foreach {xpt ypt} $coords {
	  set minx [expr {min($minx,$xpt)}]
	  set miny [expr {min($miny,$ypt)}]
	  set maxx [expr {max($maxx,$xpt)}]
	  set maxy [expr {max($maxy,$ypt)}]
        }
        set smooth [$c itemcget $item -smooth]
        if {$smooth eq "raw"} {
          append path_text "<a:moveTo><a:pt x=\"[expr {round($emuperpixel * ([lindex $coords 0]-$minx))}]\" y=\"[expr {round($emuperpixel * ([lindex $coords 1]-$miny))}]\"/></a:moveTo>"
          foreach {xpt0 ypt0 xpt1 ypt1 xpt2 ypt2} [lrange $coords 2 end] {
            if {$ypt2 eq {}} {break}
            append path_text "<a:cubicBezTo><a:pt x=\"[expr {round($emuperpixel * ($xpt0-$minx))}]\" y=\"[expr {round($emuperpixel * ($ypt0-$miny))}]\"/><a:pt x=\"[expr {round($emuperpixel * ($xpt1-$minx))}]\" y=\"[expr {round($emuperpixel * ($ypt1-$miny))}]\"/><a:pt x=\"[expr {round($emuperpixel * ($xpt2-$minx))}]\" y=\"[expr {round($emuperpixel * ($ypt2-$miny))}]\"/></a:cubicBezTo>"
          }
        } elseif {([string is boolean $smooth] && $smooth)} {
          append path_text "<a:moveTo><a:pt x=\"[expr {round($emuperpixel * (([lindex $coords 0]+[lindex $coords 2])/2 -$minx))}]\" y=\"[expr {round($emuperpixel * (([lindex $coords 1]+[lindex $coords 3])/2 -$miny))}]\"/></a:moveTo>"
          set xpt0 [lindex $coords 2]
          set ypt0 [lindex $coords 3]
          set coords [list {*}[lrange $coords 4 end] {*}[lrange $coords 0 3]]
          foreach {xpt1 ypt1} $coords {
            if {$ypt1 eq {}} {break}
            append path_text "<a:quadBezTo><a:pt x=\"[expr {round($emuperpixel * ($xpt0-$minx))}]\" y=\"[expr {round($emuperpixel * ($ypt0-$miny))}]\"/><a:pt x=\"[expr {round($emuperpixel * (($xpt1+$xpt0)/2-$minx))}]\" y=\"[expr {round($emuperpixel * (($ypt1+$ypt0)/2-$miny))}]\"/></a:quadBezTo>"
            set xpt0 $xpt1
            set ypt0 $ypt1
          }
        } else {
          foreach {xpt ypt} $coords {
            if {$first_pt} {
              append path_text "<a:moveTo><a:pt x=\"[expr {round($emuperpixel * ($xpt-$minx))}]\" y=\"[expr {round($emuperpixel * ($ypt-$miny))}]\"/></a:moveTo>"
              set first_pt 0
            } else {
              append path_text "<a:lnTo><a:pt x=\"[expr {round($emuperpixel * ($xpt-$minx))}]\" y=\"[expr {round($emuperpixel * ($ypt-$miny))}]\"/></a:lnTo>"
            }
          }
        }
	set cmd "<p:sp><p:nvSpPr><p:cNvPr id=\"$i\" name=\"\"></p:cNvPr><p:cNvSpPr/><p:nvPr/></p:nvSpPr><p:spPr><a:xfrm><a:off x=\"[expr {round($emuperpixel * $minx) - $canvx0}]\" y=\"[expr {round($emuperpixel * $miny) - $canvy0}]\"/><a:ext cx=\"[expr {round($emuperpixel* ($maxx-$minx+2*[$c itemcget $item -width]))}]\" cy=\"[expr {round($emuperpixel* ($maxy-$miny+2*[$c itemcget $item -width]))}]\"/></a:xfrm><a:custGeom><a:pathLst><a:path w=\"$cx\" h=\"$cy\">$path_text<a:close/></a:path></a:pathLst></a:custGeom>$fill_text<a:ln w=\"$line_width\">$outline_text</a:ln></p:spPr></p:sp>\n"
        }
	rectangle {
	   # continue
        set outline_color [color_to_xmlrgb [$c itemcget $item -outline]]
        set fill_color [color_to_xmlrgb [$c itemcget $item -fill]]
        if {$outline_color eq "none" && $fill_color eq "none"} continue
        if {$outline_color eq "none"} {
          set outline_text "<a:noFill/>"
        } else {
          set outline_text "<a:solidFill><a:srgbClr val=\"$outline_color\"/></a:solidFill>"
        }
        if {$fill_color eq "none"} {
          set fill_text "<a:noFill/>"
        } else {
          set fill_text "<a:solidFill><a:srgbClr val=\"$fill_color\"/></a:solidFill>"
        }
        set line_width [expr {round([$c itemcget $item -width] * 12700)}]
        set cmd "<p:sp><p:nvSpPr><p:cNvPr id=\"$i\" name=\"\"></p:cNvPr><p:cNvSpPr/><p:nvPr/></p:nvSpPr><p:spPr><a:xfrm><a:off x=\"[expr {$bbx0 - $canvx0}]\" y=\"[expr {$bby0 - $canvy0}]\"/><a:ext cx=\"$cx\" cy=\"$cy\"/></a:xfrm><a:prstGeom prst=\"rect\"><a:avLst/></a:prstGeom>$fill_text<a:ln w=\"$line_width\">$outline_text</a:ln></p:spPr></p:sp>\n"
      }
	text {
	    #continue
        if {[$c itemcget $item -text] != "" && [set bbox [$c bbox $item]] !={}} {
          if {[set angle [$c itemcget $item -angle]] == 0} {
            set rot ""
          } else {
            set rot " rot=\"[expr {round($angle* -60000) % (360 * 60000)}]\""
          }
          set text [$c itemcget $item -text] 
          set font [$c itemcget $item -font]
          set font_size [expr {round(100*[font actual $font -size])}]
          set font_family [font actual $font -family]
          set font_color [color_to_xmlrgb [$c itemcget $item -fill]]
          set font_bold [expr {[font actual $font -weight] eq "bold"}]
          set font_italic [expr {[font actual $font -slant] eq "italic"}]
          set font_underline [expr {[font actual $font -underline]? "sng" : "none"}]
	  if {[$c itemcget $item -width] ==0} {
	    set wrap_text  "wrap=\"none\""
	  } else {
	    set wrap_text  "wrap=\"square\""
	  }
	   if {[$c itemcget $item -justify] eq "center"} {
	    set align_text  "algn=\"ctr\""
	  } elseif {[$c itemcget $item -justify] eq "right"} {
	    set align_text  "algn=\"r\""
	  } else {
	    set align_text ""
	  }
          set cmd "<p:sp><p:nvSpPr><p:cNvPr id=\"$i\" name=\"\"></p:cNvPr><p:cNvSpPr/><p:nvPr/></p:nvSpPr><p:spPr><a:xfrm$rot><a:off x=\"[expr {($bbx0-int(.0*$cx)) - $canvx0}]\" y=\"[expr {($bby0) - $canvy0}]\"/><a:ext cx=\"[expr {int(1.1*$cx)}]\" cy=\"$cy\"/></a:xfrm><a:prstGeom prst=\"rect\"><a:avLst/></a:prstGeom><a:noFill/></p:spPr><p:txBody><a:bodyPr $wrap_text rtlCol=\"0\" bIns=\"0\" tIns=\"0\" lIns=\"0\" rIns=\"0\"><a:spAutoFit/></a:bodyPr><a:lstStyle/><a:p><a:pPr $align_text/><a:r><a:rPr lan=\"en-US\" dirty=\"0\" sz=\"$font_size\" b=\"$font_bold\" i=\"$font_italic\" u=\"$font_underline\"  smtClean=\"0\"><a:solidFill><a:srgbClr val=\"$font_color\"/></a:solidFill><a:latin typeface=\"$font_family\"/></a:rPr><a:t>$text</a:t></a:r></a:p></p:txBody></p:sp>\n"
        } else {
          set cmd ""
        }
      } 
      bitmap {
        #sputs "No handler for item type: Bitmap"
        set cmd ""
      }
      image {
        #sputs "No handler for item type: Image"
        set cmd ""
      }
      window {
        #sputs "No handler for item type: Window"
        set cmd ""
      }
      default {
        #sputs "No handler for item type:[$c type $item]"
        set cmd ""
      }
    }
    append result $cmd
    incr i
  }
  append result "\n"
  return $result
}


##############
## print a canvas to a keynote simplified svg string
##############
## NOT USED
proc canvas_to_keysvg {c} {
  ##arc and oval items, figure out group transformations, move all to +200 200, move text items to anchors
  set result ""
  set deg2rad [expr {3.14159/180}]

  foreach item [$c find all] {

    if {[$c itemcget $item -state] == "hidden"} continue
    set coords [$c coords $item]
    switch [$c type $item] {
      arc {
        set x0 [expr {([lindex $coords 0]+[lindex $coords 2])/2.0}]
        set y0 [expr {([lindex $coords 1]+[lindex $coords 3])/2.0}]
        set xr [expr {[lindex $coords 2]-$x0}]
        set yr [expr {[lindex $coords 3]-$y0}]
        set start_angle [$c itemcget $item -start]
        set stop_angle [expr {[$c itemcget $item -extent]+$start_angle}]
        if {$stop_angle < $start_angle} {
          set a $start_angle
          set start_angle $stop_angle
          set stop_angle $a
        }

        set start_angle [expr {$deg2rad*$start_angle}]
        set stop_angle [expr {$deg2rad*$stop_angle}]

        set mcoords "[expr {$x0+cos($start_angle)*$xr}],[expr {$y0-sin($start_angle)*$yr}]"
        set ecoords "[expr {$x0+cos($stop_angle)*$xr}],[expr {$y0-sin($stop_angle)*$yr}]"

        set cmd "<path d=\"M $mcoords A$xr,$yr 0 [expr {(abs([$c itemcget $item -extent])>180)?1:0}] 0 $ecoords\" stroke-width=\"[$c itemcget $item -width]\" stroke=\"[color_to_keysvgrgb [$c itemcget $item -outline]]\" fill=\"[color_to_keysvgrgb [$c itemcget $item -fill]]\"/>\n"
set cmd ""
      } 
      bitmap {
        #sputs "No handler for item type: Bitmap"
        set cmd ""
      }
      image {
        #sputs "No handler for item type: Image"
        set cmd ""
      }
      line {
        if {[llength $coords] == 4} {
          set cmd "<line head=\"[lindex $coords 0] [lindex $coords 1]\" tail=\"[lindex $coords 2] [lindex $coords 3]\" stroke-width=\"[$c itemcget $item -width]\" stroke-color=\"[color_to_keysvgrgb [$c itemcget $item -fill]] 1\"> <styles> <dash-style pattern=\"solid\"/> </styles> </line>\n"
        } else {
          set coordstring "M [lindex $coords 0] [lindex $coords 1]"
          foreach {a b} [lrange $coords 2 end] {
            append coordstring  " L $a $b"
          }
          set cmd "<shape path=\"$coordstring\" stroke-width=\"[$c itemcget $item -width]\" stroke-color =\"[color_to_keysvgrgb [$c itemcget $item -fill]] 1\"> <styles> <fill-style fill-type=/"none/"/> <dash-style pattern=/"none/"/> </styles> </shape> \n"
        }
      }
      oval {
          set cmd "<ellipse cx=\"[expr {([lindex $coords 2]+[lindex $coords 0])/2.0}]\" cy=\"[expr {([lindex $coords 3]+[lindex $coords 1])/2.0}]\" rx=\"[expr {([lindex $coords 2]-[lindex $coords 0])/2.0}]\" ry=\"[expr {([lindex $coords 3]-[lindex $coords 1])/2.0}]\" stroke-width=\"[$c itemcget $item -width]\" stroke=\"[color_to_keysvgrgb [$c itemcget $item -outline]]\" fill=\"[color_to_keysvgrgb [$c itemcget $item -fill]]\"/>\n"
set cmd ""
      }
      polygon {
        if {[llength $coords] ==0} {set cmd ""; continue}
          set coordstring "M [lindex $coords 0] [lindex $coords 1]"
          foreach {a b} [lrange $coords 2 end] {
            append coordstring  " L $a $b"
          }
          append coordstring " Z"
          set cmd "<shape path=\"$coordstring\" "
          if {[$c itemcget $item -outline] != ""} {
            append cmd "stroke-width=\"[$c itemcget $item -width]\" stroke-color =\"[color_to_keysvgrgb [$c itemcget $item -outline]] 1\">  <styles> <fill-style fill-type=\"color\"  fill-color=\"[color_to_keysvgrgb [$c itemcget $item -fill]] 1\"/> <dash-style pattern=\"solid\"/> </styles> </shape> \n"
           } else {
             append cmd ">  <styles> <fill-style fill-type=\"color\"  fill-color=\"[color_to_keysvgrgb [$c itemcget $item -fill]] 1\"/> <dash-style pattern=\"none\"/> </styles> </shape> \n"
           }
      }
      rectangle {
          set coords [list [lindex $coords 0] [lindex $coords 1] [lindex $coords 2] [lindex $coords 1] [lindex $coords 2] [lindex $coords 3] [lindex $coords 0] [lindex $coords 3]]
          set coordstring "M [lindex $coords 0] [lindex $coords 1]"
          foreach {a b} [lrange $coords 2 end] {
            append coordstring  " L $a $b"
          }
          append coordstring " Z"
          set cmd "<shape path=\"$coordstring\"" 
          if {[$c itemcget $item -outline] != ""} {
            append cmd "stroke-width=\"[$c itemcget $item -width]\" stroke-color =\"[color_to_keysvgrgb [$c itemcget $item -outline]] 1\">  <styles> <fill-style fill-type=\"color\"  fill-color=\"[color_to_keysvgrgb [$c itemcget $item -fill]] 1\"/> <dash-style pattern=\"solid\"/> </styles> </shape> \n"
           } else {
             append cmd ">  <styles> <fill-style fill-type=\"color\"  fill-color=\"[color_to_keysvgrgb [$c itemcget $item -fill]] 1\"/> <dash-style pattern=\"none\"/> </styles> </shape> \n"
           }

      }
      text {
        if {[$c itemcget $item -text] != ""} {
          set font [$c itemcget $item -font]
          set bbox [$c bbox $item]
          set cmd "<textbox size=\"[expr {[lindex $bbox 2]-[lindex $bbox 0]+10}] 1\" transformation=\"1 0.00000 0.00000 1 [lindex $bbox 0] [lindex $bbox 1]\">  <content font-name=\"[font actual $font -family]\" font-size=\"[expr {[tk scaling]*[font actual $font -size]}]\" font-color=\"[color_to_keysvgrgb [$c itemcget $item -fill]] 1\">[$c itemcget $item -text]</content> </textbox>\n"
        } else {
          set cmd {}
        }
      }
      window {
        #sputs "No handler for item type: Window"
        set cmd {}
      }
      default {
        #sputs "No handler for item type:[$c type $item]"
        set cmd {}
      }
    }
    append result $cmd
  }
  append result "\n"
  return $result
}

##############
## Process background errors, putting up a console window
##############
proc bgerror {message} {
global errorInfo tcl_platform info
  if {($tcl_platform(platform) == "windows") || ([tk windowingsystem] == "aqua") || $info(android)} {
    puts $message
    puts $errorInfo
    after 500 console show
  } else {
    puts "ApE_error: $message"
    puts "ApE_error: $errorInfo"
  }
}

##############
## scanner for feature_scan- replaces old regexp search 
##############
proc feature_find_mm {start fea text {slower 0}} {

  
  if {!$slower && ![regexp {/[1-9]} $fea]} {
    set regexpfwd "([string toupper $fea])"
    ## take out mm and dividers
    regsub -all {/[0-9]*} $regexpfwd "" regexpfwd
    regsub -all {\s} $regexpfwd "" regexpfwd
    regsub -all {[a-z]+} $regexpfwd ")&(" regexpfwd
    regsub -all {[nN]} $regexpfwd "." regexpfwd
    #remove duplicate + and #
    regsub -all {\++} $regexpfwd "+" regexpfwd
    regsub -all {[\+\#][\+\#]+} $regexpfwd "#" regexpfwd
    #remove leading and trailing # and +
    regsub -all {^\+} $regexpfwd "" regexpfwd
    regsub -all {^\#} $regexpfwd "" regexpfwd
    regsub -all {\+$} $regexpfwd "" regexpfwd
    regsub -all {\#$} $regexpfwd "" regexpfwd
    #convert # and + to .*?
    regsub -all {\+} $regexpfwd ").*?(" regexpfwd
    regsub -all {\#} $regexpfwd ".*?" regexpfwd
    #remove empty parens
    regsub -all {\(\)} $regexpfwd "" regexpfwd
    #substitute degenerate codes
    set regexpfwd [regsubpattern $regexpfwd]
    return [regexp -inline -indices -start $start $regexpfwd $text]
  }
  set dhash [dict create a 8 A 8 c 4 C 4 g 2 G 2 t 1 T 1 n 15 N 15 * 15 b 7 B 7 d 11 D 11 h 13 H 13 k 3 K 3 m 12 M 12 r 10 R 10 s 6 S 6 v 14 V 14 w 9 W 9 y 5 Y 5]

  set cont 1
  foreach s_pat [split $fea "/"] {
    if {$s_pat eq "+"} {
      set cont 1
      continue
    } elseif {$s_pat eq "#"} {
      set cont 2
      continue
    }
    if {[scan $s_pat "%d%s" max_mm s_pat] != 2} {
      set max_mm 0
    }
    set found 0
  
    set endix [expr {[string length $text] - [string length $s_pat]}]

    set mm 0
    for {set i $start} {$i <= [expr {$cont?$endix:$start}]} {incr i} {
      for {set j 0} {$j < [string length $s_pat]} {incr j} {
        if {[expr {(~[dict get $dhash [string index $text [expr {$i+$j}]]] | [dict get $dhash [string index $s_pat $j]])}] != -1} {
          incr mm
          if {$mm > $max_mm} break
        }
      }
      if {$mm <= $max_mm} {
        if {$cont == 2} {
          lappend foundlist [list $start $i]
        }
        foreach exon [regexp -inline -indices -all {[A-Z]+} $s_pat] {
          lappend foundlist [list [expr {$i+[lindex $exon 0]}] [expr {$i+[lindex $exon 1]}]]
        }
        set found 1
        set start [expr {$i+[string length $s_pat]}]
        break
      }
      set mm 0
    }
    if {$found == 0} break
    set cont 0
  }
  if {$found == 0} {
    return {}
  } else {
    return [linsert $foundlist 0 [list [lindex $foundlist 0 0] [lindex $foundlist end 1]]]
  }
}

##############
## scans a dna window textbox and adds feature tags and metainfo 
##############
#<<Metadata>>:(0)name, (1) format info, (2) type, (3)fwd/rev, (4) annotations_string annotations_string (qualifiers data), (5) groups list
#<<Revcolors>>: binding used for the color if the sequence is reversed
#library list: (0)name (1)regexp_fwd(flanked by paren) (2)regexp_rev (3)preseq (4)postseq (5)plain_text_def (6)type (7)fwd_color (8)rev_color (9)graphic_format (10)dna/prot search (11)annotations_string  (qualifiers data) (12)groups list

##################
####### Use this for now- the find with mm (feature_scan0) is not doing introns
##################

proc feature_scan {w} {
  global fea_info
  global info dialogblock temp_translation
  global f_scan_i
  if {$dialogblock == 1 || [file_lock_check $w 0]} {return}
  set dialogblock 1
  $w configure -cursor watch
  $w.textarea configure -cursor watch
  regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $w] wgeom winx winy
 
  set f_scan_i 0 
  if {$info(use_tile)} {
    grid [label $w.pleasewait -width 50 -bg yellow -text [mc "Searching for Features, Please wait..."]] -row 2 -column 0  -columnspan 3  -sticky new
    grid [ttk::progressbar $w.pleasewait_prog -maximum [llength $fea_info(library)] -variable f_scan_i -orient horizontal -mode determinate] -row 3 -column 1  -sticky new
  } else {
    grid [label $w.pleasewait -width 50 -bg yellow -text [mc "Searching for Features, Please wait..."]] -row 2 -column 0  -columnspan 3  -sticky new
  }

  set temp_text [string toupper [textarea_get $w.textarea 1.0 end]]
  set text_end [expr {[string length $temp_text]-1}]
  set circular [expr {$info($w,circular)== "circular"}]
  if {$circular} {
    set temp_text "$temp_text$temp_text"
  }


  foreach feature $fea_info(library) {
    incr f_scan_i

    if {![expr {$f_scan_i % 10}]} {
      update idletasks
    }
#sputs feature $feature
#update idletasks
    foreach direction [list 1 2]  {
      set start 0
      if {[lindex $feature $direction] == ""} continue
      while {[set found_list [feature_scan_search $start $feature $direction $temp_text $circular]] != ""} {
        set start [lindex $found_list end]
        if {$start > $text_end} {break}
        set found_list [lindex $found_list 0]
        if {$found_list == [list] || [expr {[lindex [lindex $found_list 0] 1] - [lindex [lindex $found_list 0] 0]} > $text_end]} {continue}
        set tagname "f$fea_info($w,count)#"
        set fntagname "fn$fea_info($w,count)#"
        incr fea_info($w,count)
        ##add feature fn(feature_number)# to indicate a split feature
        ## add f mark instead, to indicate split feature
        if {[llength $found_list] > 2} {
          set first [lindex [lindex $found_list 0] 0]
          set last [lindex [lindex $found_list 0] 1]
          if {$last <= $text_end} {
            textarea_tag_create $w.textarea $fntagname
            textarea_tag_add $w.textarea $fntagname [bp2ix $w.textarea $first] [bp2ix $w.textarea [expr {1 + $last}]]
          } else {
            textarea_tag_create $w.textarea $fntagname
            textarea_tag_add $w.textarea $fntagname [bp2ix $w.textarea $first] [end_ix $w.textarea]
            textarea_tag_add $w.textarea $fntagname 1.0 [bp2ix $w.textarea [expr {$last-$text_end}]]
          }
        }
        textarea_tag_create $w.textarea $tagname
        foreach region [lrange $found_list 1 end] {

          if {[lindex $region 1] <= $text_end} {
            textarea_tag_add $w.textarea $tagname [bp2ix $w.textarea [lindex $region 0]] [bp2ix $w.textarea [expr {1+[lindex $region 1]}]]
          } else {
            if {[lindex $region 0] <= $text_end} {
              textarea_tag_add $w.textarea $tagname [bp2ix $w.textarea [lindex $region 0]] [end_ix $w.textarea]
              textarea_tag_add $w.textarea $tagname 1.0 [bp2ix $w.textarea [expr {[lindex $region 1]-$text_end}]]
            } else {
              textarea_tag_add $w.textarea $tagname [bp2ix $w.textarea [expr {[lindex $region 0]-$text_end-1}]] [bp2ix $w.textarea [expr {[lindex $region 1]-$text_end}]]
            }
          }
        }
        set color [lindex $feature 7]
        set revcolor [lindex $feature 8]
        textarea_tag_bind $w.textarea $tagname <<Revcolors>> [list $color $revcolor]
        ##metadata here
        set g_format [lindex $feature 9]
        if {$g_format == "" || $g_format== 0 || $g_format == 1} {
          set g_format $info(feature_default_gformat)
        }
        #<<Metadata>>:(0)name, (1)format_info, (2)type, (3)fwd/rev, (4)annotations_string (qualifiers data)
        set qualifier_data [lindex $feature 11]
        if {[lindex $feature 6] eq "primer_bind" && ![dict exists $qualifier_data "PCR_conditions"]} {
          lappend qualifier_data "PCR_conditions" "primer sequence:[lindex $feature 5]"
        } 
        set metadata [list [lindex $feature 0] $g_format [lindex $feature 6] [expr {$direction-1}] $qualifier_data]
        textarea_tag_bind $w.textarea $tagname <<Metadata>> $metadata
        textarea_tag_configure $w.textarea $tagname -background [lindex $feature [expr {$direction + 6}]]
        ###check for dup tags and delete the old tag
        set tag_start_index [lindex [$w.textarea tag ranges $tagname] 0]
        if {$tag_start_index eq {}} {continue}
        set tag_ranges [$w.textarea tag ranges $tagname]
        foreach pos_dup_tag [$w.textarea tag names $tag_start_index] {
          if {$pos_dup_tag == $tagname} continue
          if {([$w.textarea tag ranges $pos_dup_tag] == $tag_ranges) && ([lindex [$w.textarea tag bind $pos_dup_tag <<Metadata>>] 0] == [lindex $metadata 0])} {
            textarea_tag_delete $w.textarea $pos_dup_tag
          }
        }
      }
    }
  }
#sputs featurescan0; update idletasks
  register_undo_separator $w "Feature Scan"
  features_to_tree_view $w
#sputs featurescan1; update idletasks
  #destroy .wait 
  #bind . <<RaiseDialogs>> ""
  set dialogblock 0
  destroy $w.pleasewait
  if {[info exists temp_translation]} {
    array unset temp_translation
  }
  if {[winfo exists $w.pleasewait_prog]} {destroy $w.pleasewait_prog}
  $w configure -cursor arrow
  $w.textarea configure -cursor xterm
  update idletasks
}

##############
##
##############
proc feature_scan_search {start feature direction text circular} {
  global temp_translation
  ## use lindex 10 (previously italic) to search type (0=dna 1=protein_with_introns 2= protein_no_introns)
  if {[lindex $feature 10] == 0} {
    ############ DNA feature
   ## TODO: try using the recursive search like the protein search does
     set found_list [regexp -inline -indices -start $start [string toupper [lindex $feature $direction]] $text]
     if {$found_list == {}} {return [list]}
    set start [lindex $found_list 0 0]
    incr start
    set next_start [expr {1 + [lindex $found_list 0 0]}]
    ##end extension scan
    if {$direction == 1} {
      set preseq [lindex $feature 3]
      set postseq [lindex $feature 4]
    } else {
      set preseq [revcom_regexp [lindex $feature 4]]
      set postseq [revcom_regexp [lindex $feature 3]]
    }
    set dhash [dict create a 8 A 8 c 4 C 4 g 2 G 2 t 1 T 1 n 15 N 15 * 15 b 7 B 7 d 11 D 11 h 13 H 13 k 3 K 3 m 12 M 12 r 10 R 10 s 6 S 6 v 14 V 14 w 9 W 9 y 5 Y 5]

    if {$preseq ne ""} {
      set i [expr {[lindex $found_list 0 0]}]
      if {($i <= 0) && $circular} {
        set i [expr {[string length $text]}]
      }
      set j [expr {[string length $preseq]}]
      set k 0
      while {($j > 0) && ([string index $text [expr {$i-1}]] ne "") && ([string index $preseq [expr {$j-1}]] ne "") && ([expr {(~[dict get $dhash [string index $text [expr {$i-1}]]] | [dict get $dhash [string index $preseq [expr {$j-1}]]])}] == -1)} {
        incr i -1
        incr j -1
        incr k
        if {($i <= 0)} {
           if {($circular)} {
            set i [expr {[string length $text]/2}]
          } else {
            break
          }
        }
      }
      ##add the extension
      if {$i > $start} {
         #wrapped around
        set temp_list [list]
        foreach r $found_list {
          lappend temp_list [list [expr {[lindex $r 0]+[string length $text]/2}] [expr {[lindex $r 1]+[string length $text]/2}]]
        }
        set found_list $temp_list
      }
      set found_list [lreplace $found_list 0 1 [list $i [lindex [lindex $found_list 0] 1]] [list $i [lindex [lindex $found_list 1] 1]]] 
    }
    if {$postseq != ""} {
      set last [lindex [lindex $found_list 0] 1]
      set postf [string toupper [string range $text [expr {$last + 1}] [expr {$last + [string length $postseq]}]]]
      set i 0
      while {($i < [string length $postf]) && ($i < [string length $postseq]) && ([expr {(~[dict get $dhash [string index $postf $i] ] | [dict get $dhash [string index $postseq $i]])}] == -1)} { incr i} 
      ##add the extension
      set found_list [lreplace $found_list 0 0 [list [lindex [lindex $found_list 0] 0] [expr {[lindex [lindex [K $found_list [set found_list {}]] 0] 1]+$i}]]]
      set found_list [lreplace $found_list end end [list [lindex [lindex $found_list end] 0] [expr {[lindex [lindex [K $found_list [set found_list {}]] end] 1]+$i}]]]
    }
    ## need to return the feature location as well as the place to start searching next round- presequence could send the feature start to before the last start index, giving infinite loop
    return [list $found_list $next_start]
  } elseif {[lindex $feature 10] in [list 1 2]} {
    ############ protein feature 
    # type: 1 = protein_with_intron, 2 = protein_no_intron
    if {![array exists temp_translation]} {
      set temp_translation(1,0) [translate $text 1 1 0]
      set temp_translation(1,1) [translate [string range $text 1 end] 1 1 0]
      set temp_translation(1,2) [translate [string range $text 2 end] 1 1 0]
      set temp_translation(2,0) [translate $text 1 0 0]
      set temp_translation(2,1) [translate [string range $text 1 end] 1 0 0]
      set temp_translation(2,2) [translate [string range $text 2 end] 1 0 0]
    }
    #feature 1 and 2 are lists of aa- 1 is forward, 2 is lreverse
    set aa_regexp_list [lindex $feature $direction]
    set found_list [list]
    while {[set protein_index_list  [feature_scan_protein [expr {$start==0?0:($start+1)/3}] $aa_regexp_list $direction $circular [lindex $feature 10]]] ne {}} {
      ## TODO: add in any preseq or post-seq here- set the next_start to 1+ fist base index *before* any presequence adjustments
      ## then convert aa to dna indexes
      set next_start [expr {$start+1}]
      set found_list [feature_scan_aa_to_dna $protein_index_list $text $direction $circular]
      if {$found_list ne {}} {
        set next_start [expr {3 + [lindex $found_list 0 0]}]
        ## found a match- add preseq and postseq here
        set preseq [lindex $feature 3]
        set postseq [lindex $feature 4]
        if {$direction ==2} {
         ##reverse match
          if {$preseq != ""} {
            if {[regexp {\-[0-9]+} $preseq]} {
              ## remove preseq count match from right side
              set remain [expr {-3*$preseq}]
              while {$remain > 0 && [llength $found_list] > 1} {
                if {[expr {[lindex $found_list end 1] - [lindex $found_list end 0]+1}] > $remain} {
                  lset found_list end 1 [expr {[lindex $found_list end 1]-$remain }]
                  set remain 0
                } else {
                  set remain [expr {$remain - ([lindex $found_list end 1] - [lindex $found_list end 0]+1)}]
                  set found_list [lrange $found_list 0 end-1]
                }
                lset found_list 0 1 [lindex $found_list end 1]
              }
            } elseif  {[lindex $preseq end] eq "&"} {
              ## look for matching "&" preseq on right side- work here to not require in frame gap
              set pre_first [expr {[lindex $found_list end end]+1}]
              if {$circular} {
                set offset [expr {[string length $text] /2}]
                set pre_aa [translate [revcom [string range "$text$text" $pre_first [expr {($pre_first + $offset) - ($pre_first + $offset)%3}]]]]
              } else {
                set pre_aa [translate [revcom [string range "$text$text" $pre_first [expr {[string length $text] -1 - ([string length $text]- $pre_first)%3}]]]]
              }
              set pre_aa [string range $pre_aa [expr {1+ [string last "*" $pre_aa]}] end]
              set preseq [lrange $preseq 0 end-1]
              set pre_len [llength $preseq]
              set preseq_s [join $preseq ""]
              set ix [expr {[string length $pre_aa] - $pre_len}]
              while {$ix >-1 && (![string match $preseq_s [string range $pre_aa $ix [expr {$ix+$pre_len-1}]]]) } {incr ix -1}
              if {[string match $preseq_s [string range $pre_aa $ix [expr {$ix+$pre_len-1}]]]} {
                set new_ix [expr {[lindex $found_list 0 1] +([string length $pre_aa] -$ix)*3}]
                lset found_list 0 1  $new_ix
                lset found_list end 1 $new_ix
              }
            } else {
              ## look for matching extension preseq on right side
              set pre_len [llength $preseq]
              set pre_first [expr {[lindex $found_list end end]+1}]
              set pre_last [expr {$pre_first + 3*$pre_len-1}]
              set pre_aa [translate [revcom [string range "$text[string repeat n [expr {1+$pre_last-[string length $text]}]]" $pre_first $pre_last]]]
              set ix 0
              while {$ix < [llength $preseq] && ([string match [lindex $preseq end-$ix] [string index $pre_aa end-$ix]]) } {incr ix}
              set new_ix [expr {[lindex $found_list 0 1] +$ix*3}]
              lset found_list 0 1  $new_ix
              lset found_list end 1 $new_ix
            }
          }
          if {$postseq != ""} {
            if {[regexp {\-[0-9]+} $postseq]} {
              ## remove  postseq count match from left side
              set remain [expr {-3*$postseq}]
              while {$remain > 0 && [llength $found_list] > 1} {
                if {[expr {[lindex $found_list 1 1] - [lindex $found_list 1 0]+1}] > $remain} {
                  lset found_list 1 0 [expr {[lindex $found_list 1 0]+$remain }]
                  set remain 0
                } else {
                  set remain [expr {$remain - ([lindex $found_list 1 1] - [lindex $found_list 1 0]+1)}]
                  set found_list [lreplace $found_list 1 1]
                }
                lset found_list 0 0 [lindex $found_list 1 0]
              }
              if {$circular} {
                set offset [expr {[string length $text] /2}]
                if {[lindex $found_list 0 0] >= $offset} {
                 # set next_start [expr { $offset-1}]
                  set fl2 [list]
                  foreach h $found_list {
                    foreach {h1 h2} $h {
                      lappend fl2 [list [expr {$h1 - $offset}] [expr {$h2 - $offset}]]
                    }
                  }
                  set found_list $fl2
                }
              }
            } elseif  {[regexp {(.*)\&} $postseq - new_postseq]} {
              ## look for matching "&" postseq on left side - work here to not require in frame gap
              set post_last [expr {[lindex $found_list 0 0]-1}]
              if {$circular} {
                set offset [expr {[string length $text] /2}]
                set post_aa [translate [revcom [string range "$text$text" [expr {$post_last + (1 + $offset)%3}]  [expr {$post_last + $offset}] ]]]
              } else {
                set post_aa [translate [revcom [string range "$text$text" [expr {($post_last+1)%3}] $post_last ]]]
              }
              set post_aa [string range $post_aa 0 [expr { [string first "*" $post_aa] -1}]]
              set postseq [lrange $postseq 1 end]
              set post_len [llength $postseq]
              set postseq_s [join $postseq ""]
              set ix 0
              while {$ix < [expr {[string length $post_aa] - $post_len}] && (![string match $postseq_s [string range $post_aa $ix [expr {$ix+$post_len-1}]]]) } {incr ix}
              if {[string match $postseq_s [string range $post_aa $ix [expr {$ix+$post_len-1}]]]} {
                set i [expr {[lindex $found_list 0 0] -($ix+$post_len)*3}]
                lset found_list 0 0 $i
                lset found_list 1 0 $i
                if {$i < 0} {
                  if {$circular} {
                    set offset [expr {[string length $text] /2}]
                    set fl2 [list]
                    foreach h $found_list {
                      foreach {h1 h2} $h {
                        lappend fl2 [list [expr {$h1 + $offset}] [expr {$h2 + $offset}]]
                      }
                    }
                    set found_list $fl2
                  } else {
                    set i [expr {$i % 3}]
                    lset found_list 0 0 $i
                    lset found_list 1 0 $i
                  }
                }
              }
            } else {
              ## look for matching extension postseq on left side
              set post_len [llength $postseq]
              set post_last [expr {[lindex $found_list 0 0]-1}]
              set post_first [expr {$post_last - 3*$post_len +1 }]
              if {$circular} {
                set text2 "[string range $text end-[expr {-$post_first-1 }] end][string range $text $post_first $post_last]"
              } else {
                set text2 "[string repeat N [expr {-$post_first }]][string range $text $post_first $post_last]"
              }
              set post_aa [translate [revcom $text2 ]]
              set ix 0
              while {$ix < [llength $postseq] && ([string match [lindex $postseq $ix] [string index $post_aa $ix]]) } {incr ix}
              set i [expr {[lindex $found_list 0 0] -$ix*3}]
              lset found_list 0 0 $i
              lset found_list 1 0 $i
              if {$i < 0} {
                if {$circular} {
                  set offset [expr {[string length $text] /2}]
                  set fl2 [list]
                  foreach h $found_list {
                    foreach {h1 h2} $h {
                      lappend fl2 [list [expr {$h1 + $offset}] [expr {$h2 + $offset}]]
                    }
                  }
                  set found_list $fl2
                } else {
                  set i [expr {$i % 3}]
                  lset found_list 0 0 $i
                  lset found_list 1 0 $i
                }
              }
            }
          }
        } else {
         ##forward match
          if {$postseq != ""} {
            if {[regexp {\-[0-9]+} $postseq]} {
              ## remove postseq count match from right side
              set remain [expr {-3*$postseq}]
              while {$remain > 0 && [llength $found_list] > 1} {
                if {[expr {[lindex $found_list end 1] - [lindex $found_list end 0]+1}] > $remain} {
                  lset found_list end 1 [expr {[lindex $found_list end 1]-$remain }]
                  set remain 0
                } else {
                  set remain [expr {$remain - ([lindex $found_list end 1] - [lindex $found_list end 0]+1)}]
                  set found_list [lrange $found_list 0 end-1]
                }
                lset found_list 0 1 [lindex $found_list end 1]
              }
            } elseif  {[lindex $postseq end] eq "&"} {
              ## look for matching "&" postseq on right side- work here to not require in frame gap
              set post_first [expr {[lindex $found_list end end]+1}]
              if {$circular} {
                set offset [expr {[string length $text] /2}]
                set post_aa [translate [string range "$text$text" $post_first [expr {($post_first + $offset) - ($post_first + $offset)%3}]]]
              } else {
                set post_aa [translate  [string range "$text$text" $post_first [expr {[string length $text] -1 - ([string length $text]- $post_first)%3}]]]
              }
              set post_aa [string range $post_aa 0 [expr { [string first "*" $post_aa] -1}]]
              set postseq [lrange $postseq 1 end]
              set post_len [llength $postseq]
              set postseq_s [join $postseq ""]
              set ix 0
              while {$ix < [expr {[string length $post_aa] - $post_len}] && (![string match $postseq_s [string range $post_aa $ix [expr {$ix+$post_len-1}]]]) } {incr ix}
              if {[string match $postseq_s [string range $post_aa $ix [expr {$ix+$post_len-1}]]]} {
                set new_ix [expr {[lindex $found_list 0 1] + ($ix+$post_len) *3}]
                lset found_list 0 1  $new_ix
                lset found_list end 1 $new_ix
              }
            } else {
              ## look for matching extension postseq on the right side
              set post_len [llength $postseq]
              set post_first [expr {[lindex $found_list end end]+1}]
              set post_last [expr {$post_first + 3*$post_len-1}]
              set post_aa [translate [string range $text $post_first $post_last]]
              set ix 0
              while {$ix < [llength $postseq] && ([string match [lindex $postseq $ix] [string index $post_aa $ix]]) } { incr ix}
              set new_ix [expr {[lindex $found_list 0 1] + $ix*3}]
              lset found_list 0 1 $new_ix
              lset found_list end 1 $new_ix
            }
          }
          if {$preseq != ""} {
            if {[regexp {\-[0-9]+} $preseq]} {
              ## remove  preseq count match from left side
              set remain [expr {-3*$preseq}]
              while {$remain > 0 && [llength $found_list] > 1} {
                if {[expr {[lindex $found_list 1 1] - [lindex $found_list 1 0]+1}] > $remain} {
                  lset found_list 1 0 [expr {[lindex $found_list 1 0]+$remain }]
                  set remain 0
                } else {
                  set remain [expr {$remain - ([lindex $found_list 1 1] - [lindex $found_list 1 0]+1)}]
                  set found_list [lreplace $found_list 1 1]
                }
                lset found_list 0 0 [lindex $found_list 1 0]
              }
              if {$circular} {
                set offset [expr {[string length $text] /2}]
                if {[lindex $found_list 0 0] >= $offset} {
                  set fl2 [list]
                 # set next_start [expr { $offset-1}]
                  foreach h $found_list {
                    foreach {h1 h2} $h {
                      lappend fl2 [list [expr {$h1 - $offset}] [expr {$h2 - $offset}]]
                    }
                  }
                  set found_list $fl2
                }
              }
            } elseif  {[lindex $preseq end] eq "&"} {
              ## look for matching "&" preseq on left side- work here to not require in frame gap
              set pre_last [expr {[lindex $found_list 0 0]-1}]
              if {$circular} {
                set offset [expr {[string length $text] /2}]
                set pre_aa [translate  [string range "$text$text" [expr {$pre_last + (1 + $offset)%3}]  [expr {$pre_last + $offset}] ]]
              } else {
                set pre_aa [translate [string range "$text$text" [expr {($pre_last+1)%3}] $pre_last ]]
              }
              set pre_aa [string range $pre_aa [expr {1+ [string last "*" $pre_aa]}] end]
              set preseq [lrange $preseq 0 end-1]
              set pre_len [llength $preseq]
              set preseq_s [join $preseq ""]
              set ix [expr {[string length $pre_aa] - $pre_len}]
              while {$ix >-1 && (![string match $preseq_s [string range $pre_aa $ix [expr {$ix+$pre_len-1}]]]) } {incr ix -1}
              if {[string match $preseq_s [string range $pre_aa $ix [expr {$ix+$pre_len-1}]]]} {
                set i [expr {[lindex $found_list 0 0] -([string length $pre_aa] -$ix)*3}]
                lset found_list 0 0 $i
                lset found_list 1 0 $i
                if {$i < 0} {
                  if {$circular} {
                    set offset [expr {[string length $text] /2}]
                    set fl2 [list]
                    foreach h $found_list {
                      foreach {h1 h2} $h {
                        lappend fl2 [list [expr {$h1 + $offset}] [expr {$h2 + $offset}]]
                      }
                    }
                    set found_list $fl2
                  } else {
                    set i [expr {$i % 3}]
                    lset found_list 0 0 $i
                    lset found_list 1 0 $i
                  }
                }
              }
            } else {
              ## look for matching extension preseq on left side
              set pre_len [llength $preseq]
              set pre_last [expr {[lindex $found_list 0 0]-1}]
              set pre_first [expr {$pre_last - 3*$pre_len +1 }]
              if {$circular} {
                set text2 "[string range $text end-[expr {-$pre_first-1 }] end][string range $text $pre_first $pre_last]"
              } else {
                set text2 "[string repeat N [expr {-$pre_first }]][string range $text $pre_first $pre_last]"
              }
              set pre_aa [translate $text2 ]
              set ix 0
              while {$ix < [llength $preseq] && ([string match [lindex $preseq end-$ix] [string index $pre_aa end-$ix]]) } {incr ix; #sputs g [lindex $preseq end-$ix] [string index $pre_aa end-$ix]}
              set i [expr {[lindex $found_list 0 0] -$ix*3}]
              lset found_list 0 0 $i
              lset found_list 1 0 $i
              if {$i < 0} {
                set offset [expr {[string length $text] /2}]
                if {$circular} {
                  set fl2 [list]
                  foreach h $found_list {
                    foreach {h1 h2} $h {
                      lappend fl2 [list [expr {$h1 + $offset}] [expr {$h2 + $offset}]]
                    }
                  }
                  set found_list $fl2
                } else {
                  set i [expr {$i % 3}]
                  lset found_list 0 0 $i
                  lset found_list 1 0 $i
                }
              }
            }
          }
        }
        return [list  $found_list $next_start]
      } else {
        set start $next_start
        incr start 6
      }
    } 
    return [list]
  } else {
    sputs unknown feature type [lindex $feature 10]
    return [list]
  }
}

######
## return list of [list start_index last_index frame] [list of gap aa's] 
proc feature_scan_protein {start aa_regexp_list direction circular {type 1}} {
  global temp_translation
# type: 1 = protein_with_intron, 2 = protein_no_intron
  if {$type == 2} {return [feature_scan_protein_no_introns $start $aa_regexp_list $direction $circular]}
# search for first 5 aa, check any matches for cDNA, if not, check for extension, then skip 1 aa, then call recursively. Return [list [list frame index0 index1] aa [list frame index0 index1].....]
# for *EVERY* match extend, then call recursively. Return earliest full result
  set min 0
  foreach aa $aa_regexp_list {
    if {$aa ne "?" && $aa ne {[ACDEFGHIKLMNPQRSTVWY]}} {
      incr min
      if {$min > 4} {break}
    }
  } 
  if {$min >= 5} {
    set first_aa_regexp [join [lrange $aa_regexp_list 0 [expr {$min-1}]] ""]
    regsub -all {\*} $first_aa_regexp {\\*} first_aa_regexp
    regsub -all {\?} $first_aa_regexp {\.} first_aa_regexp
    set found_list [list]
    foreach i {0 1 2} {
      foreach a [regexp -all -inline -indices -start $start $first_aa_regexp $temp_translation($direction,$i)] {
        lappend found_list [list {*}$a $i]
      }
    }
    if {$found_list eq {}} {
      return [list]
    }
    if {$circular && [llength $found_list] > 1} {
      ## take out found elements past the end of a circular fragment that are duplicates
      set new_found_list [list]
      foreach f $found_list {
        foreach {a1 a2 frame}  $f {}
        set c  [expr {$a1 - ([string length $temp_translation($direction,$frame)] +1) /2}]
        if {$c <=0 || [lsearch -index 0 $found_list $c] == -1} {
          lappend new_found_list $f
        }
      }
      set found_list $new_found_list
    }
    set result [list]

    set found_list [lsort -integer -increasing -index 0 $found_list]
    foreach found $found_list {

      set firstindex [lindex $found 0]
      set lastindex [expr {1+[lindex $found 1]}]
      set frame  [lindex $found 2]
      if {[string match [join $aa_regexp_list ""] [string range $temp_translation($direction,$frame) $firstindex [expr {$firstindex+[llength $aa_regexp_list] - 1}] ] ]} {
        lappend result [list [list $firstindex [expr {$firstindex+[llength $aa_regexp_list] - 1}] $frame]  ]
      } else {
        for {set i $min} {$i < [llength $aa_regexp_list] && [string match [lindex $aa_regexp_list [expr {$i}]] [string index $temp_translation($direction,$frame) [expr {$firstindex + $i}]]]} {incr i} {
        }
        if {$i < [llength $aa_regexp_list]} {
          ## didn't find complete- lookfor an intron-spanning match, add gap aa's here
          if {[set rest_of_match [feature_scan_protein [expr {$firstindex + $i}] [lrange $aa_regexp_list [expr {$i+1}] end]  $direction $circular $type]] ne {}} {
              lappend result [list [list $firstindex [expr {$firstindex + $i -1}] $frame] [lrange $aa_regexp_list [expr {$i-3}] [expr {$i}]] {*}$rest_of_match]
          }
        } else {
           lappend result [list [list $firstindex [expr {$firstindex + $i}] $frame]]
        }
      }
    }
  } else {
      ## re list too short
    set result ""
  }
  return [lindex $result 0]
}
#regexp  {^((?:[A-Z]|\[[A-Z]+\]){5})(.*)} $protein_seq -- first_aa_regexp last_aa_regexp

###################
## do a raw regexp, which allows [AA]? atoms, but prohibits intron scanning
###################
proc feature_scan_protein_no_introns {start aa_regexp_list direction circular} {
  global temp_translation

  set first_aa_regexp [join $aa_regexp_list ""]
  set found_list [list]
  foreach i {0 1 2} {
    foreach a [regexp -all -inline -indices -start $start $first_aa_regexp $temp_translation($direction,$i)] {
      lappend found_list [list {*}$a $i]
    }
  }
  if {$found_list eq {}} {
    return [list]
  }

  if {$circular && [llength $found_list] > 1} {
    ## take out found elements past the end of a circular fragment that are duplicates
    set new_found_list [list]
    foreach f $found_list {
      foreach {a1 a2 frame}  $f {}
      set c  [expr {$a1 - ([string length $temp_translation($direction,$frame)] +1) /2}]
      if {$c <=0 || [lsearch -index 0 $found_list $c] == -1} {
        lappend new_found_list $f
      }
    }
    set found_list $new_found_list
  }

  set found_list [lsort -integer -increasing -index 0 $found_list]
  set found [lindex $found_list 0]
  set firstindex [lindex $found 0]
  set frame  [lindex $found 2]
  set $i [llength $aa_regexp_list]
  set result [list [list $firstindex [expr {$firstindex + $i}] $frame]]
  return $result
}


###################
#pWD619 {706 771 2} {V T K G} {788 858 1} {Y K V K} {877 931 1} {D F K T} {950 1029 1} 
# send to proc to convert aa indexes to dna indexes and to find gy...ag introns (keep in mind that the intron might have to push more than 3 bp forward if the 5' end of the intron matches an aa)
proc feature_scan_aa_to_dna {protein_index_list text direction circular} {
  set result [list]
  #sputs feature_scan_aa_to_dna $protein_index_list
  set dir_b [expr {$direction==1?1:0}]
  if {1} {
    ## forward
    if {[llength $protein_index_list] == 1} {
      set start_index [lindex $protein_index_list 0 0]
      set end_index [lindex $protein_index_list 0 1]
      set frame [lindex $protein_index_list 0 2]
      return [list [list [expr {3* $start_index + $frame}] [expr {3* $end_index + $frame +2}]] [list [expr {3* $start_index + $frame}] [expr {3* $end_index + $frame+2}]]]
    } else {

      set frame0 [lindex $protein_index_list 0 2]   
      set frameN [lindex $protein_index_list end 2]  
      set feature_start [expr {3* [lindex $protein_index_list 0 0] + $frame0}]  
      set feature_end [expr {3* [lindex $protein_index_list end 1] + $frameN +2}]  
      set result [list [list $feature_start $feature_end]]
      set exon0_start_index $feature_start 
      for {set i 0} {[expr {2 *$i+2}] < [llength $protein_index_list]} {incr i} {
        set frame0 [lindex $protein_index_list [expr {$i * 2}] 2]   
        set exon0_end_index [expr {3 * [lindex $protein_index_list [expr {$i * 2}] 1] + $frame0 +2}]
        set frame1 [lindex $protein_index_list [expr {$i * 2+2}] 2]   
        set exon1_start_index [expr {3 * [lindex $protein_index_list [expr {$i * 2+2}] 0] + $frame1}]  
        if {$circular && [expr {$exon1_start_index - $exon0_start_index}] >=  [expr {[string length $text]/2}]} {return [list]}
#sputs feature_start $feature_start feature_end $feature_end exon0_start_index $exon0_start_index exon0_end_index $exon0_end_index exon1_start_index $exon1_start_index dir_b $dir_b
        set missing_aa_list [lindex $protein_index_list [expr {$i * 2+1}]] 
        for {set j 0} {$j < 12} {incr j} {
          set aa_seq [translate "[string range $text [expr {$exon0_end_index-3*($j/3)+1}] [expr {$exon0_end_index-3*($j/3)+2-$j%3}]][string range $text [expr {$exon1_start_index-3*($j/3)-1-$j%3}] [expr {$exon1_start_index-3*($j/3)-1}]]" 1 $dir_b 0]
          if {![string match [lindex $missing_aa_list end-[expr {$j/3}]] $aa_seq]} {
            if {[expr {$j%3}] ==2} {
               #sputs bad protein feature intron $i $j [lindex $missing_aa_list end-[expr {$j/3}]] $aa_seq
               return [list]
             } else {
               continue
             }
          }
          if {$direction == 1} {
            set intron_start [string range $text [expr {$exon0_end_index-3*($j/3)+3-$j%3}] [expr {$exon0_end_index-3*($j/3)+4-$j%3}]]
            if {$intron_start ne "GT" && $intron_start ne "GC"} {continue}
            set intron_end  [string range $text [expr {$exon1_start_index-3*($j/3)-3-$j%3}] [expr {$exon1_start_index-3*($j/3)-2-$j%3}]]
            if {$intron_end ne "AG" } {continue}
            break
          } else {
            ## reverse intron
            set intron_start [string range $text [expr {$exon0_end_index-3*($j/3)+3-$j%3}] [expr {$exon0_end_index-3*($j/3)+4-$j%3}]]
            if {$intron_start ne "CT"} {continue}
            set intron_end  [string range $text [expr {$exon1_start_index-3*($j/3)-3-$j%3}] [expr {$exon1_start_index-3*($j/3)-2-$j%3}]]
            if {$intron_end ne "AC" && $intron_end ne "GC" } {continue}
            break
          }
        }
        if {$j == 12} {
          #sputs bad protein feature $j
          return [list]
        } else {
          lappend result [list $exon0_start_index [expr {$exon0_end_index-3*($j/3)+2-$j%3}]]
          set exon0_start_index [expr {$exon1_start_index-3*($j/3)-1-$j%3}]
        }
      }
      lappend result [list $exon0_start_index $feature_end]
    }
  }
  return $result
}

##############
## scans a dna window textbox and adds feature tags and metainfo 
##############
#<<Metadata>>:(0)name, (1) format info, (2) type, (3)fwd/rev, (4) annotations_string (qualifiers data), (5) groups list
#<<Revcolors>>: binding used for the color if the sequence is reversed
#library list: (0)name (1)regexp_fwd(flanked by paren) (2)regexp_rev (3)preseq (4)postseq (5)plain_text_def (6)type (7)fwd_color (8)rev_color (9)graphic_format (10)dna/prot search (11)annotations_string (qualifiers data) (12)groups list
## uses mm scan, but doesn't handle introns- either as lowercase OR as wildcards
proc feature_scan0 {w} {
  global fea_info
  global info dialogblock
  global f_scan_i

#####
global time_list
set time0 [ clock milli]
set time_list [list]
######

  if {$dialogblock == 1} {return}
  set dialogblock 1
  $w configure -cursor watch
  $w.textarea configure -cursor watch
  regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $w] wgeom winx winy
 
  set f_scan_i 0 
  if {$info(use_tile)} {
    grid [label $w.pleasewait -width 50 -bg yellow -text [mc "Searching for Features, Please wait..."]] -row 2 -column 0  -columnspan 3  -sticky new
    grid [ttk::progressbar $w.pleasewait_prog -maximum [llength $fea_info(library)] -variable f_scan_i -orient horizontal -mode determinate] -row 3 -column 1  -sticky new
  } else {
    grid [label $w.pleasewait -width 50 -bg yellow -text [mc "Searching for Features, Please wait..."]] -row 2 -column 0  -columnspan 3  -sticky new
  }

  set temp_text [string toupper [textarea_get $w.textarea 1.0 [end_ix $w.textarea]]]
  set text_end [expr {[string length $temp_text]-1}]
  if {$info($w,circular)== "circular"} {
    set temp_text "$temp_text$temp_text"
  }

   set do_slower_find 0
   if {[regexp -nocase {[^acgt]} $temp_text]} {
     set do_slower_find 1
     sputs doing slow feature find
   }


  foreach feature $fea_info(library) {
    incr f_scan_i
######
#if {$f_scan_i >= 100} {break}
#######
    if {[expr {$f_scan_i % 10}] == 0} {
      update idletasks
    }
    foreach direction [list 1 2]  {
      set start 0
      if {[lindex $feature $direction] == ""} continue
      while {[set found_list [feature_find_mm $start [lindex $feature $direction] $temp_text $do_slower_find]] != ""} {
        ##when adding features, set saved to 0 (keep links to analysis windows though)

        set start [lindex [lindex $found_list 0] 0]
        if {$start > $text_end} {break}

        ###regexp prefers the earliest starting feature, even if there is a shorter match. for features that have low information exons before a "+" this can lead to finding hundreds of copies of the feature. By reverse complementing the found region, then searching that for the revcom search pattern, a shorter match can be found. start then needs to be incremented to that new start position.
        ###compare the last found base in the forward direction to the last found base in the reverse (looking only in the region of text within the found area).
        if {([llength $found_list] > 2) && ([set rc_found [feature_find_mm 0 [lindex $feature [expr {$direction==1?2:1}]] [revcom [string range $temp_text $start [lindex [lindex $found_list 0] end]]]  $do_slower_find]] != "")} {
          if {[set rc_dif [expr {[lindex [lindex $found_list 0] end] - [lindex [lindex $rc_found 0] end]}]] > $start} {
             #sputs feature find: $found_list $rc_found , $rc_dif,  $start
             set start $rc_dif
             continue 
          }
        }

        incr start
        set tagname "f$fea_info($w,count)#"
        ##end extension scan
        if {$direction == 1} {
          set preseq [lindex $feature 3]
          set postseq [lindex $feature 4]
        } else {
          set preseq [revcom_regexp [lindex $feature 4]]
          set postseq [revcom_regexp [lindex $feature 3]]
        }
        if {$preseq != ""} {
          set i [expr {[lindex [lindex $found_list 0] 0]}]
          if {($i <= 0) && ($info($w,circular)== "circular")} {
            set i [expr {1+$text_end}]
          }
          set j [expr {[string length $preseq]}]
          set k 0
          while {([string match -nocase [string index $preseq [expr {$j-1}]] [string index $temp_text [expr {$i-1}]]]) || ([string index $preseq $j] == "N")} {
            incr i -1
            incr j -1
            incr k
            if {($i <= 0)} {
              if {($info($w,circular)== "circular")} {
                set i [expr {1+$text_end}]
              } else {
                break
              }
            }
          }

          ##add the extension
          if {$i > $start} {
            #wrapped around
            set temp_list [list]
            foreach r $found_list {
              lappend temp_list [list [expr {[lindex $r 0]+$text_end+1}] [expr {[lindex $r 1]+$text_end+1}]]
            }
            set found_list $temp_list
          }
          set found_list [lreplace $found_list 0 1 [list $i [lindex [lindex $found_list 0] 1]] [list $i [lindex [lindex $found_list 1] 1]]] 
        }

        if {$postseq != ""} {
          set last [lindex [lindex $found_list 0] 1]
          set postf [string toupper [string range $temp_text [expr {$last + 1}] [expr {$last + [string length $postseq]}]]]
          set i 0
          while {($i < [string length $postseq]) && (([string index $postseq $i] == [string index $postf $i]) || ([string index $postseq $i] == "N"))} {incr i} 
          ##add the extension
          set found_list [lreplace $found_list 0 0 [list [lindex [lindex $found_list 0] 0] [expr {[lindex [lindex [K $found_list [set found_list {}]] 0] 1]+$i}]]]
          set found_list [lreplace $found_list end end [list [lindex [lindex $found_list end] 0] [expr {[lindex [lindex [K $found_list [set found_list {}]] end] 1]+$i}]]]
        }

        ##add feature fn(feature_number)# to indicate a split feature
     ## use get_feature_exons_indexes - add f mark instaed to indicate a split feature
        if {[llength $found_list] > 2} {
          set first [lindex [lindex $found_list 0] 0]
          set last [lindex [lindex $found_list 0] 1]
          if {$last <= $text_end} {
            textarea_tag_add $w.textarea "fn$fea_info($w,count)#" [bp2ix $w.textarea $first] [bp2ix $w.textarea [expr {1 + $last}]]
          } else {
            textarea_tag_add $w.textarea "fn$fea_info($w,count)#" [bp2ix $w.textarea $first] [end_ix $w.textarea]
            textarea_tag_add $w.textarea "fn$fea_info($w,count)#" 1.0 [bp2ix $w.textarea [expr {$last-$text_end}]]
          }
        }

        incr fea_info($w,count)
        foreach region [lrange $found_list 1 end] {
#sputs "$tagname [bp2ix $w.textarea [lindex $region 0]] [bp2ix $w.textarea [expr {1+[lindex $region 1]}]]"
#update
          if {[lindex $region 1] <= $text_end} {
            textarea_tag_add $w.textarea $tagname [bp2ix $w.textarea [lindex $region 0]] [bp2ix $w.textarea [expr {1+[lindex $region 1]}]]
          } else {
            if {[lindex $region 0] <= $text_end} {
              textarea_tag_add $w.textarea $tagname [bp2ix $w.textarea [lindex $region 0]] [end_ix $w.textarea]
              textarea_tag_add $w.textarea $tagname 1.0 [bp2ix $w.textarea [expr {[lindex $region 1]-$text_end}]]
            } else {
              textarea_tag_add $w.textarea $tagname [bp2ix $w.textarea [expr {[lindex $region 0]-$text_end-1}]] [bp2ix $w.textarea [expr {[lindex $region 1]-$text_end}]]
            }
          }
        }
        set color [lindex $feature 7]
        set revcolor [lindex $feature 8]

        textarea_tag_bind $w.textarea $tagname <<Revcolors>> [list $color $revcolor]
##metadata here
        set g_format [lindex $feature 9]
        if {$g_format == "" || $g_format== 0 || $g_format == 1} {
          set g_format $info(feature_default_gformat)
        }
        #<<Metadata>>:(0)name, (1)format_info, (2)type, (3)fwd/rev, (4)annotations_string (qualifiers data)
        set metadata [list [lindex $feature 0] $g_format [lindex $feature 6] [expr {$direction-1}] [lindex $feature 11]]
        textarea_tag_bind $w.textarea $tagname <<Metadata>> $metadata
        textarea_tag_configure $w.textarea $tagname -background [lindex $feature [expr {$direction + 6}]]

        ###check for dup tags and delete the old tag
        set tag_start_index [lindex [$w.textarea tag ranges $tagname] 0]
        set tag_ranges [$w.textarea tag ranges $tagname]
        foreach pos_dup_tag [$w.textarea tag names $tag_start_index] {
          if {$pos_dup_tag == $tagname} continue
          if {([$w.textarea tag ranges $pos_dup_tag] == $tag_ranges) && ([lindex [$w.textarea tag bind $pos_dup_tag <<Metadata>>] 0] == [lindex $metadata 0])} {
            textarea_tag_delete $w.textarea $pos_dup_tag
          }
        }
      }
    }
  }

  register_undo_separator $w "Feature Scan"
  features_to_tree_view $w
  #destroy .wait 
  #bind . <<RaiseDialogs>> ""
  set dialogblock 0
  destroy $w.pleasewait
  if {[winfo exists $w.pleasewait_prog]} {destroy $w.pleasewait_prog}
  $w configure -cursor arrow
  $w.textarea configure -cursor xterm
  update idletasks
}

##############
## remove unused feature tags, split features that are broken
##############
proc feature_cleanup {text} {
  set deleted [list]
  foreach text_tag [$text tag names] {
    if {([regexp {fn?[0-9]+#} $text_tag]) && ([$text tag ranges $text_tag] == {})} {
      $text tag delete $text_tag 
      lappend deleted $text_tag
    }
  }
  features_to_tree_view [winfo toplevel $text]
  return 
}
proc feature_cleanup {text} {
}

##############
## returns all features with elements between c1 and c2 as a list of feature names and tag names 
##############
proc feature_find {w {c1 -1} {c2 -1}} {
  if {$c1 == -1} {
    set i1 1.0
  } else {
    set i1 [bp2ix $w.textarea $c1]
  }
  if {$c2 == -1} {
    set i2 [end_ix $w.textarea]
  } else {
    set i2 [bp2ix $w.textarea $c2]
  }

  set result [list]
  if {$c2 < $c1} {
    # split through origin
    foreach text_tag [$w.textarea tag names] {
      if {[regexp {f([0-9]+)#} $text_tag -- f_number]} {
        set fn_tag "fn$f_number\#"
        if {[$w.textarea tag ranges "fn$f_number\#"] == {}} {
          set fn_tag $text_tag
        }
		if {(([lsearch -exact [$w.textarea tag names 1.0] $fn_tag] != -1) || ([lsearch -exact [$w.textarea tag names $i1] $fn_tag] != -1) || ([$w.textarea tag nextrange $fn_tag 1.0 $i2+1char] != {}) || ([$w.textarea tag nextrange $fn_tag $i1 end] != {}))} {
		  set metadata [$w.textarea tag bind $text_tag <<Metadata>>]
		  set name [lindex $metadata 0]
		  lappend result $name $fn_tag
		}
	  }
    }
  } else {
    foreach text_tag [$w.textarea tag names] {
      if {[regexp {f([0-9]+)#} $text_tag -- f_number]} {
        set fn_tag "fn$f_number\#"
        if {[$w.textarea tag ranges "fn$f_number\#"] == {}} {
          set fn_tag $text_tag
        }
		if {(([lsearch -exact [$w.textarea tag names $i1] $fn_tag] != -1) || ([$w.textarea tag nextrange $fn_tag $i1 $i2+1char] != {}))} {
		  set metadata [$w.textarea tag bind $text_tag <<Metadata>>]
		  set name [lindex $metadata 0]
		  lappend result $name $fn_tag
		}
      }
    }
  }
  return $result
}

##############
## returns coordinates of fea between c1 and c2
##############
proc feature_coords {w fea {c1 -1} {c2 -1}} {
  if {$c1 == -1} {
    set c1 0
  } 
  if {$c2 == -1} {
    set c2 [ix2bp $w.textarea end]
  }
  set result [list]
  foreach {x1 x2} [$w.textarea tag ranges $fea] {
    set x1 [ix2bp $w.textarea  $x1]
    set x2 [ix2bp $w.textarea  $x2]
    incr x2 -1
    if {$x1 >= $c1} {
      if {$x1 <= $c2} {
        if {$x2 <= $c2} {
          lappend result [list $x1 $x2]
        } else {
          lappend result [list $x1 $c2]
        }
      }
    } else {
      if {$x2 >= $c1} {
        if {$x2 <= $c2} {
          lappend result [list $c1 $x2]
        } else {
          lappend result [list $c1 $c2]
        }
      } 
    }
  }
  set fntag_ranges [$w.textarea tag ranges [regsub f $fea fn]]
  if {$fntag_ranges == ""} {set fntag_ranges [$w.textarea tag ranges $fea]}
  if {[llength $fntag_ranges]> 2} {
    set start [ix2bp $w.textarea [lindex $fntag_ranges 2]]
    set pos 0
    while {([lindex [lindex $result $pos] 0] < $start) && ($pos < [llength $result])} {incr pos}
    set result [concat [lrange $result $pos end] [lrange $result 0 [expr {$pos-1}]]]
  }
  return $result
}

##############
## returns list of start and end index (list of four for spanning the origin)
##############
proc feature_tag_start_end_ix {w tag} {
  if {[set ranges [$w.textarea tag ranges $tag]] == {}} {
    return [list 1.0 1.0]
  }
  set fntag [regsub f $tag fn]
  if {[set fnranges [$w.textarea tag ranges $fntag]] == {}} {
    set fnranges $ranges
  }

  if {[llength $fnranges] > 2} {
    return [list [lindex $fnranges 2] [lindex $fnranges 3] [lindex $fnranges 0] [lindex $fnranges 1]]
  } else {
    return [list [lindex $fnranges 0] [lindex $fnranges 1]]
  }
}

##############
## returns Feature coordinates as a string format: aaa..bbb,xxx..yyy
##############
proc feature_coords_text {w fea} {
  set loc [list]
  foreach {x1 x2} [$w.textarea tag ranges $fea] {
    set x1 [ix2bp $w.textarea $x1]
    incr x1
    set x2 [ix2bp $w.textarea $x2]
    lappend loc "$x1..$x2"
  }
  if {[lsearch -exact [$w.textarea tag names] [regsub f $fea fn]] > -1} {
    #check that a split tag isn't split acros the origin
    set fntag [regsub f $fea fn]
    set fn_tagrange [$w.textarea tag ranges $fntag]
    if {[llength $fn_tagrange] > 2} {
      set tagstart [expr {1+[ix2bp $w.textarea [lindex $fn_tagrange 2]]}]
      set i 0
      foreach pair $loc {
        if {[regexp ^$tagstart.. $pair]} break
        incr i
      }
      set loc [concat [lrange $loc $i end] [lrange $loc 0 [expr {$i-1}]]]
    }
  } elseif {[llength $loc] > 1} {
    #tag is split across the origin
    set loc [concat [lindex $loc 1] [lindex $loc 0]]
  }

  return [join $loc ,]
}

##############
## deletes all feature tags in a textbox
##############
proc feature_clear {w} {
  global info
  if {[tk_messageBox -message [mc "Clear all features from the file?"] -type okcancel -icon warning -default cancel] == "ok"} {
    foreach text_tag [$w.textarea tag names] {
      if {[regexp {f[0-9]+#} $text_tag]} {
          textarea_tag_delete $w.textarea $text_tag
      }
    }
    register_undo_separator $w "Clear Features"
    features_to_tree_view $w
  }
  raise $w
  focus $w
  focus $w.textarea
}

##############
## Utility for dealing with selections in listboxes
##############
proc listbox_multiple {w el} {
  if {[$w selection includes $el]} {
    $w selection clear $el
  } else {
    $w selection set $el
  }
}

##############
## Configure display properties of features in a window
##############
proc configure_features {w} {
  global info 
  global ok modifier
  global mem deleted dialogblock
  if {$dialogblock == 1} {return}
  set dialogblock 1
  toplevel .dialog
  wm title .dialog [mc "Edit Features..."]
  wm protocol .dialog WM_DELETE_WINDOW "set ok -1"
  bind .dialog <KeyPress-Escape>  "set ok -1"
  bind . <<RaiseDialogs>> "wm deiconify .dialog; raise .dialog"
  bind .dialog <FocusIn> "event generate . <<RaiseDialogs>>"
  bind .dialog <Map> "event generate . <<RaiseDialogs>>"
  bind .dialog <Activate> "event generate . <<RaiseDialogs>>"

  regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $w] wgeom winx winy
  wm geometry .dialog "+[expr (($winx<0)?0:$winx)+3]+[expr (($winy<0)?0:$winy)+50]"
  if {[tk windowingsystem] != "aqua"} {
    wm transient .dialog $w
  } else {
    #::tk::unsupported::MacWindowStyle style .dialog document {closeBox resizable}
    ::tk::unsupported::MacWindowStyle style .dialog document {closeBox horizontalZoom verticalZoom}
  }
  set ok 0

  grid [frame .dialog.frame1 -relief flat] -row 0 -column 0 -sticky nswe
  grid [listbox .dialog.frame1.list -width 60 -yscrollcommand "optionscrollbar .dialog.frame1.scroll" -selectmode extended -activestyle none -background white] -row 0 -column 0 -sticky nswe
  grid [scrollbar .dialog.frame1.scroll -command ".dialog.frame1.list yview"] -row 0 -column 1 -sticky nse
  grid rowconfigure .dialog.frame1 0 -weight 1
  grid columnconfigure .dialog.frame1 0 -weight 1
  grid columnconfigure .dialog.frame1 1 -weight 0
  grid [frame .dialog.frame2 -relief ridge -borderwidth 2] -row 1 -column 0 -sticky swe
  grid [button .dialog.frame2.raise -text [mc "Raise"] -command "event generate .dialog <<raise>>"] -row 0 -column 0 -sticky we
  grid [button .dialog.frame2.lower -text [mc "Lower"] -command "event generate .dialog <<lower>>"] -row 0 -column 1 -sticky we
  grid [button .dialog.frame2.delete -text [mc "Delete"] -command "event generate .dialog <<delete>>"] -row 0 -column 2 -sticky we
  bind .dialog <KeyPress-BackSpace> "event generate .dialog <<delete>>; break"
  grid [button .dialog.frame2.rename -text [mc "Edit "] -command "event generate .dialog.frame1.list <<edit>> -x -1 -y -1"] -row 0 -column 3 -sticky we
  grid [button .dialog.frame2.hide -text [mc "Hide"] -command "event generate .dialog.frame1.list <<hide>>"] -row 0 -column 4 -sticky we
  grid [button .dialog.frame2.show -text [mc "Show"] -command "event generate .dialog.frame1.list <<show>>"] -row 0 -column 5 -sticky we

  grid [frame .dialog.frame3 -relief raised] -row 2 -column 0 -sticky swe
  grid [button .dialog.frame3.ok -text [mc "OK"] -command "set ok 1" -default active] -row 0 -column 0 -padx 5 -pady 3 -sticky we
  bind .dialog <Key-Return> "set ok 1"
  grid [button .dialog.frame3.cancel -text [mc "Cancel"] -command "set ok -1"] -row 0 -column 1 -padx 5 -pady 3 -sticky we
  grid rowconfigure .dialog 0 -weight 1
  grid rowconfigure .dialog 1 -weight 0
  grid rowconfigure .dialog 2 -weight 0
  grid columnconfigure .dialog 0 -weight 1

  #bind .dialog.frame1.list <$modifier-Button-1> {listbox_multiple %W [%W index @%x,%y];break}
  bind .dialog.frame1.list <Double-Button-1> "event generate .dialog.frame1.list <<edit>> -x %x -y %y"
  #bind .dialog.frame1.list <Button-1> {bell; .dialog.frame1.list selection clear 0 end; .dialog.frame1.list selection set [%W index @%x,%y]}

  set i [expr {[llength [set features [feature_find $w]]]/2-1}]
  foreach {name tag} $features {
    .dialog.frame1.list insert 0 $name
    regsub "fn" $tag "f" tag
    .dialog.frame1.list itemconfigure 0 -background [$w.textarea tag cget $tag -background]
    if {[$w.textarea tag cget $tag -background] == ""} {
      .dialog.frame1.list itemconfigure 0 -foreground gray50
    }
    set mem($i) $tag
    incr i -1
  }
  set deleted [list]
  .dialog.frame1.list selection set 0
  .dialog.frame1.list selection anchor 0

  regexp {([0-9]*)x([0-9]*)\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry .dialog] wgeom winw winh winx winy
  if {[expr {$winx+$winw}] > [winfo screenwidth .]} {set winx [expr {[winfo screenwidth .]-$winw}]}
  if {$winx < 0} {set winx 0}
  if {[expr {$winy+$winh}] > [winfo screenheight .]} {set winy [expr {[winfo screenheight .]-$winh}]}
  if {$winy < 0} {set winy 0}
  wm geometry .dialog "+$winx+$winy"
  focus .dialog.frame1.list

  bind .dialog.frame1.list <<edit>> "
    if {%y == -1} {
      set sel_index \[lindex \[%W curselection\] 0\]
    } else {
      set sel_index \[%W index @%x,%y\]
    }
    if {\$sel_index != {}} {
      if {\[edit_feature_dialog .dialog $w \$mem(\$sel_index) 0 1\] eq \"ok\"} {
        .dialog.frame1.list delete \$sel_index
        .dialog.frame1.list insert \$sel_index \[lindex \[$w.textarea tag bind \$mem(\$sel_index) <<Metadata>>\] 0\]
        .dialog.frame1.list itemconfigure \$sel_index -background \[$w.textarea tag cget \$mem(\$sel_index) -background\]
        .dialog.frame1.list selection set \$sel_index \$sel_index
      }
    }
  "
  bind .dialog <<raise>> {
    foreach i [.dialog.frame1.list curselection] {
      if {$i > 0} {
        set nstore [.dialog.frame1.list get $i]
        set cstore [.dialog.frame1.list itemcget $i -background]
        .dialog.frame1.list delete $i
        set tstore $mem($i)
        set mem($i) $mem([expr {$i-1}])
        incr i -1
        .dialog.frame1.list insert $i $nstore
        .dialog.frame1.list itemconfigure $i -background $cstore       
        set mem($i) $tstore
        .dialog.frame1.list selection set $i
      }
    }
    if {[.dialog.frame1.list curselection] != {}} {
      .dialog.frame1.list see [lindex [.dialog.frame1.list curselection] 0]
    }
  } 

  bind .dialog <<lower>> {
    for {set j [expr {[llength [.dialog.frame1.list curselection]]-1}]} {$j > -1} {incr j -1} {
      set i [lindex [.dialog.frame1.list curselection] $j]
      if {$i < [expr {[.dialog.frame1.list index end] -1}]} {
        set nstore [.dialog.frame1.list get $i]
        set cstore [.dialog.frame1.list itemcget $i -background]
        .dialog.frame1.list delete $i
        set tstore $mem($i)
        set mem($i) $mem([expr {$i+1}])
        incr i 1
        .dialog.frame1.list insert $i $nstore
        .dialog.frame1.list itemconfigure $i -background $cstore       
        set mem($i) $tstore
        .dialog.frame1.list selection set $i
      }
    }
    if {[.dialog.frame1.list curselection] != {}} {
      .dialog.frame1.list see [lindex [.dialog.frame1.list curselection] end]
    }
  }

  bind .dialog <<delete>> {
    set last_sel_index [lindex [.dialog.frame1.list curselection] end]
    set first_sel_index [lindex [.dialog.frame1.list curselection] 0]
    for {set j [expr {[llength [.dialog.frame1.list curselection]]-1}]} {$j > -1} {incr j -1} {
      set i [lindex [.dialog.frame1.list curselection] $j]
      .dialog.frame1.list delete $i

      lappend deleted $mem($i)
      while {$i <= [expr {[.dialog.frame1.list index end] - 1}]} {
        set mem($i) $mem([expr {$i+1}])
        incr i
      }
      array unset mem $i 
    }
#sputs $last_sel_index [.dialog.frame1.list index end]
    while {$last_sel_index >= [.dialog.frame1.list index end]} {incr last_sel_index -1}
#sputs $last_sel_index [.dialog.frame1.list index end]
    if {$last_sel_index > -1} {
      .dialog.frame1.list selection set [expr {$first_sel_index}]
      .dialog.frame1.list selection anchor [expr {$first_sel_index}]
    }
    #.dialog.frame1.list selection clear 0 end
  } 

  bind .dialog <<hide>> "
    foreach i \[.dialog.frame1.list curselection\] {
      .dialog.frame1.list itemconfigure \$i -background \"\" -foreground gray50

      textarea_tag_configure $w.textarea \$mem(\$i) -background \"\"
    }
    unset -nocomplain i
  "

  bind .dialog <<show>> "
    foreach sel_index \[.dialog.frame1.list curselection\] {
      .dialog.frame1.list itemconfigure \$sel_index -background \[lindex \[$w.textarea tag bind \$mem(\$sel_index) <<Revcolors>>\] \[lindex \[$w.textarea tag bind \$mem(\$sel_index) <<Metadata>>\] 3\]\] -foreground black
      textarea_tag_configure $w.textarea \$mem(\$sel_index) -background \[lindex \[$w.textarea tag bind \$mem(\$sel_index) <<Revcolors>>\] \[lindex \[$w.textarea tag bind \$mem(\$sel_index) <<Metadata>>\] 3\]\]
    }
    unset -nocomplain sel_index
  "


  vwait ok
  set dialogblock 0
  destroy .dialog

    bind . <<RaiseDialogs>> {}

  if {$ok == 1} {
    foreach i [lsort -integer [array names mem]] {
      $w.textarea tag lower $mem($i)
    }
    if {$info(selection_on_top)} {
      $w.textarea tag raise sel
      $w.textarea tag raise tempsel
    } else {
      $w.textarea tag lower sel
      $w.textarea tag lower tempsel
    }
    #set tags [$w.textarea tag names]
    foreach tag $deleted {
      textarea_tag_delete $w.textarea $tag
    }
  }
  register_undo_separator $w "Edit Features"
  unset ok
  unset deleted
  array unset mem
}

##############
## drop listbox element from drag
##############
proc listbox_drop {listbox list drop_index} {

}

##############
## create features from found highlighting and edit it
##############
proc feature_from_found {w} {
  global dialogblock temp_info info fea_info  ok2
  if {$dialogblock == 1} return
  if {[$w.textarea tag ranges foundf] == {} && [$w.textarea tag ranges foundr] == {}} {
    tk_messageBox -message [mc "There is no text highlighted from the find dialog."] -type ok -icon info -default ok
    return
  }
  set dialogblock 1

  set temp_info(name) "New Feature"
  set temp_info(format) $info(feature_default_gformat)
  set temp_info(type) "misc_feature"
  set temp_info(qual_list) ""
  set temp_info(qual_active) 0
  if {[dict exists $info(feature_default_type_colors) misc_feature]} {
    set temp_info(fwd_color) [lindex [dict get $info(feature_default_type_colors) misc_feature] 0]
    set temp_info(rev_color) [lindex [dict get $info(feature_default_type_colors) misc_feature] 1]
  } else {
    set temp_info(fwd_color) #6078ff
    set temp_info(rev_color) #62da54
  }
  if {[dict exists $info(feature_default_type_gformat) misc_feature]} {
    set temp_info(f_arrow) [lindex [dict get $info(feature_default_type_gformat) misc_feature arrow_data] 0]
    set temp_info(r_arrow) [lindex [dict get $info(feature_default_type_gformat) misc_feature arrow_data] 1]
    set temp_info(arrow_flip) [lindex [dict get $info(feature_default_type_gformat) misc_feature arrow_data] 2]
    set temp_info(g_width) [dict get $info(feature_default_type_gformat) misc_feature width]
  } else {
    set temp_info(f_arrow) [lindex [dict get $info(feature_default_gformat) arrow_data] 0]
    set temp_info(r_arrow) [lindex [dict get $info(feature_default_gformat) arrow_data] 1]
    set temp_info(arrow_flip) [lindex [dict get $info(feature_default_gformat) arrow_data] 2]
    set temp_info(g_width) [dict get $info(feature_default_gformat) width]
  }
  set temp_info(qual_list) [list]


  set a [edit_feature_dialog_make_dialog $w $w ""]
  vwait ok2

  if {$ok2 == 1} {
    foreach foundtag [list foundf foundr] dir [list 0 1] {
      foreach {start end} [$w.textarea tag ranges $foundtag] {
        set feature "f$fea_info($w,count)#"
        incr fea_info($w,count)
        textarea_tag_create $w.textarea $feature
        textarea_tag_add $w.textarea $feature $start $end
        #dict set temp_info(format) arrow_data [list $temp_info(f_arrow) $temp_info(r_arrow) $temp_info(arrow_flip)]
        #dict set temp_info(format) width $temp_info(g_width)
    
        textarea_tag_bind $w.textarea $feature <<Revcolors>> [list $temp_info(fwd_color) $temp_info(rev_color)]
        textarea_tag_bind $w.textarea $feature <<Metadata>> [list $temp_info(name) $temp_info(format) $temp_info(type) $dir $temp_info(qual_list)]
        if {$dir == 0} {
          textarea_tag_configure $w.textarea $feature -background $temp_info(fwd_color)
        } else {
          textarea_tag_configure $w.textarea $feature -background $temp_info(rev_color)
        }
        if {$temp_info(place_above) != "none"} {
          textarea_tag_raise $w.textarea $feature $temp_info(place_above)
        } else {
          textarea_tag_lower $w.textarea $feature
        }

        register_undo_separator $w "New Feature"
      }
    }
    features_to_tree_view $w

    if {$temp_info(apply_default)} {
      set info(feature_default_type_colors) [array get temp_colors]
      #dict set info(feature_default_type_gformat)  $temp_info(type) $temp_info(format) 
    }
  }

  #trace remove variable info(feature_color_favorites) write "fill_favs_menu $a $a.infoframe.colorframe.favs.menu temp_info(fwd_color) temp_info(rev_color);# "
  destroy $a
  bind . <<RaiseDialogs>> ""
  set dialogblock 0
  array unset temp_info 
  unset ok2 
}

##############
## create a feature from selection and edit it
##############
proc add_sel_feature_file_dialog {w} {
  global dialogblock info fea_info
  if {$dialogblock == 1} {return}
  #set dialogblock 1

  if {$info($w,locked)} {
    tk_messageBox -message [mc "Sorry, the file is locked"] -icon warning -type ok
    return
  }
  if {[$w.textarea tag ranges sel] != {}} {
    set tagname "f$fea_info($w,count)#"

    incr fea_info($w,count)
#selection used here 
    textarea_tag_create $w.textarea $tagname
    textarea_tag_add $w.textarea $tagname sel.first sel.last
##metadata here
    textarea_tag_bind $w.textarea $tagname <<Metadata>> [list "New Feature" $info(feature_default_gformat) "misc_feature" 0 ""]
    textarea_tag_bind $w.textarea $tagname <<Revcolors>> [list $info(feature_default_fcolor) $info(feature_default_rcolor)]

    textarea_tag_configure $w.textarea $tagname -background $info(feature_default_fcolor)
    if {[edit_feature_dialog $w $w $tagname] != "ok"} {
      textarea_tag_delete $w.textarea $tagname
      incr fea_info($w,count) -1
    } else {
      #features_to_tree_view $w; # this is done in edit_feature_dialog
     # register_undo_separator $w "Edit Feature"
    }
  } else {
    tk_messageBox -message [mc "There is no text selected."] -type ok -icon info -default ok
  }
  #set dialogblock 0
}

##############
## create a feature from selection and edit it - no dialog
##############
proc add_sel_feature_file {w} {
  global  info fea_info

  if {[$w.textarea tag ranges sel] != {}} {
    set tagname "f$fea_info($w,count)#"

    incr fea_info($w,count)
#selection used here 
    textarea_tag_create $w.textarea $tagname 
    textarea_tag_add $w.textarea $tagname sel.first sel.last
##metadata here
    textarea_tag_bind $w.textarea $tagname <<Metadata>> [list "New Feature" $info(feature_default_gformat) "misc_feature" 0 ""]
    textarea_tag_bind $w.textarea $tagname <<Revcolors>> [list $info(feature_default_fcolor) $info(feature_default_rcolor)]

    textarea_tag_configure $w.textarea $tagname -background $info(feature_default_fcolor)
    features_to_tree_view $w
    edit_box_treeviewselect $w
    add_feature_edit_box $w
    $w.tvframe.tv selection set $tagname
    update idletasks
    $w.edit_features_frame.nb.f1.textframe.name selection range 0 end
    $w.edit_features_frame.nb.f1.textframe.name icursor end
    focus $w.edit_features_frame.nb.f1.textframe.name
  } else {
    tk_messageBox -message [mc "There is no text selected."] -type ok -icon info -default ok
  }
}



##############
## Edit feature properties
##############
proc edit_feature_dialog {parent w feature {qualifier_number ""} {subwindow 0}} {
  global dialogblock ok2 temp_info info 
  if {$feature == ""} return
  if {!$subwindow && $dialogblock == 1} {return}
  if {$info($w,locked)} {
    tk_messageBox -message [mc "Sorry, the file is locked"] -icon warning -type ok
    return
  }
  set dialogblock 1
  set oldbind [bind . <<RaiseDialogs>>]

  set temp_info(name) [lindex [$w.textarea tag bind $feature <<Metadata>>] 0]
  set temp_info(format) [lindex [$w.textarea tag bind $feature <<Metadata>>] 1]
  set temp_info(type) [lindex [$w.textarea tag bind $feature <<Metadata>>] 2]
  set temp_info(dir) [lindex [$w.textarea tag bind $feature <<Metadata>>] 3]
  set temp_info(qual_list) [lindex [$w.textarea tag bind $feature <<Metadata>>] 4]

  if {$qualifier_number ne "" && [string is integer $qualifier_number]} {
    set temp_info(qual_active) [expr {2*$qualifier_number}]
  } else {
    set temp_info(qual_active) 0
  }
  set temp_info(fwd_color) [lindex [$w.textarea tag bind $feature <<Revcolors>>] 0]
  set temp_info(rev_color) [lindex [$w.textarea tag bind $feature <<Revcolors>>] 1]

  set temp_info(loc) [feature_coords_text $w $feature]
  set original_loc $temp_info(loc)
  if {$temp_info(dir) == 0} {set original_color $temp_info(fwd_color)} else {set original_color $temp_info(rev_color)}
  
  set a [edit_feature_dialog_make_dialog $parent $w $feature]
  
  if {$qualifier_number ne "" && $qualifier_number > -1} {
    $a.textframe.name selection clear
    $a.textframe.name icursor 0
    $a.qualifiersframe.f2.name selection range 0 end
    $a.qualifiersframe.f2.name icursor end
    focus $a.qualifiersframe.f2.name
  }
    
  vwait ok2
  if {$ok2 == 1 || $ok2 == -1} {
  ###execute changes


    set fwd_color $temp_info(fwd_color)
    set rev_color $temp_info(rev_color)

    #dict set temp_info(format) arrow_data [list $temp_info(f_arrow) $temp_info(r_arrow) $temp_info(arrow_flip)]
    #dict set temp_info(format) width $temp_info(g_width)
    #dict set temp_info(format) offset $temp_info(g_offset)


    textarea_tag_bind $w.textarea $feature <<Revcolors>> [list $fwd_color $rev_color]
    textarea_tag_bind $w.textarea $feature <<Metadata>> [list $temp_info(name) $temp_info(format) $temp_info(type) $temp_info(dir) $temp_info(qual_list)]
    if {[$w.textarea tag cget $feature -background] != {}} {
      if {$temp_info(dir) == 0} {
        textarea_tag_configure $w.textarea $feature -background $fwd_color
      } else {
        textarea_tag_configure $w.textarea $feature -background $rev_color
      }
    }

    if {$temp_info(place_above) != "none"} {
      textarea_tag_raise $w.textarea $feature $temp_info(place_above)
    } else {
      textarea_tag_lower $w.textarea $feature
    }

    register_undo_separator $w "Edit Feature"
    features_to_tree_view $w
    
    set return "ok"
    if {$temp_info(apply_default)} {
      dict set info(feature_default_type_colors) $temp_info(type) [list $temp_info(fwd_color) $temp_info(rev_color)]
      #dict set info(feature_default_type_gformat)  $temp_info(type) $temp_info(format) 
    }
  } else {
  ##cancel changes
##need to use the undo stack here--  apply_loc_list is adding changes to the undo stack already
   # apply_loc_list $w $feature $original_loc
   # textarea_tag_configure $w.textarea $feature -background $original_color
    set return "cancel"
  }

  #trace remove variable info(feature_color_favorites) write "fill_favs_menu $a $a.infoframe.colorframe.favs.menu temp_info(fwd_color) temp_info(rev_color);# "

  destroy $a
  bind . <<RaiseDialogs>> $oldbind
  array unset temp_info
  unset ok2
  if {!$subwindow} {set dialogblock 0}
  return $return
}

##############
## Edit feature -make the dialog window 
##############
proc edit_feature_dialog_make_dialog {parent w feature} {
global ok2 temp_info info genbank_divided_typelist genbank_typelist
  set a [toplevel .edit_feature_dialog2]
  wm title $a [mc "Edit Feature..."]
  wm protocol $a WM_DELETE_WINDOW "set ok2 -1"
  bind . <<RaiseDialogs>> "after 1 {catch {wm deiconify $a; raise $a}}"
  regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $parent] wgeom winx winy
  wm geometry [winfo toplevel $a] "+[expr (($winx<0)?0:$winx)+3]+[expr (($winy<0)?0:$winy)+50]"
  wm transient $a $parent
  if {[tk windowingsystem] == "aqua"} {
    ::tk::unsupported::MacWindowStyle style $a document {closeBox}
  }
    set ok2 0
    
  if {[tk windowingsystem] == "aqua"} {
    add_menubar_to_dialog_mac $w $a
  }
  grid [frame $a.textframe -relief ridge -borderwidth 2] -row 0 -column 1 -sticky nswe
  grid [frame $a.qualifiersframe -relief ridge -borderwidth 2] -row 1 -column 1 -sticky nswe
  grid [frame $a.qualifiersframe_empty -relief ridge -borderwidth 2] -row 1 -column 1 -sticky nswe
  grid [frame $a.infoframe -relief ridge -borderwidth 2] -row 2 -column 1 -sticky nswe
  grid [frame $a.okframe -relief ridge -borderwidth 2] -row 3 -column 1 -columnspan 2 -sticky nswe
  grid rowconfigure $a 0 -weight 1
  grid rowconfigure $a 1 -weight 0
  grid rowconfigure $a 2 -weight 0
  grid columnconfigure $a 1 -weight 1

  grid [entry $a.textframe.name -textvariable temp_info(name) -font dnafont -width 20] -row 0 -column 0 -columnspan 5 -sticky nwe

  if {$feature ne ""} {
    grid [text $a.textframe.loc -highlightthickness 0 -width 20 -height 2] -row 1 -column 0 -columnspan 4 -sticky nswe
    grid [checkbutton $a.textframe.compl -text [mc "Rev-Com"] -variable temp_info(dir) -onvalue 1 -offvalue 0 -command "edit_feature_dialog_manage_direction $w $feature"] -row 1 -column 4 -sticky w

    grid [frame $a.textframe.button] -row 2 -column 0 -columnspan 5 -sticky nswe
    grid [button $a.textframe.button.upper -text [mc "Uppercase Only"] -command "set temp_info(loc) \[locations_upper $w \$temp_info(loc)\]; event generate $a.textframe.loc <<update>>" ] -row 2 -column 0 -sticky w
    tooltip_install $a.textframe.button.upper [mc "Remove all lowercase text from the feature range"]
    grid [button $a.textframe.button.plus_sel -text [mc "Feature Plus Selection"] -command "set temp_info(loc) \[locations_plus_selection $w \$temp_info(loc) plus_sel\]; event generate $a.textframe.loc <<update>>" ] -row 2 -column 1 -sticky w
    tooltip_install $a.textframe.button.plus_sel [mc "Add text selection to the feature"]
    grid [button $a.textframe.button.minus_sel -text [mc "Feature Minus Selection"] -command "set temp_info(loc) \[locations_plus_selection $w \$temp_info(loc) minus_sel\]; event generate $a.textframe.loc <<update>>" ] -row 2 -column 2 -sticky w
    tooltip_install $a.textframe.button.minus_sel [mc "Remove text selection from the feature"]

    bind $a.textframe.loc <<update>> "
      $a.textframe.loc configure -state normal
      $a.textframe.loc delete 1.0 end
      $a.textframe.loc insert 1.0 \$temp_info(loc)
      $a.textframe.loc configure -state disabled
      apply_loc_list $w $feature \$temp_info(loc)
    "
    $a.textframe.loc insert 1.0 $temp_info(loc)
    $a.textframe.loc configure -state disabled
  }

  grid rowconfigure $a.textframe 0 -weight 0
  grid rowconfigure $a.textframe 1 -weight 1
  grid columnconfigure $a.textframe 0 -weight 1

  grid [button $a.qualifiersframe_empty.new -text [mc "Add Qualifier"] -command "edit_feature_dialog_manage_qualifiers $a add"] -row 0 -column 0
  grid [frame $a.qualifiersframe.f1] -row 0 -column 1 -sticky nswe
  grid [frame $a.qualifiersframe.f1.1] -row 0 -column 1 -sticky nswe
  grid [button $a.qualifiersframe.f1.1.add -text "+" -width 2 -command "edit_feature_dialog_manage_qualifiers $a add"] -row 0 -column 3 -sticky w
  tooltip_install $a.qualifiersframe.f1.1.add [mc "Add Qualifier"]
  grid [button $a.qualifiersframe.f1.1.delete -text "-" -width 2 -command "edit_feature_dialog_manage_qualifiers $a remove"] -row 0 -column 4 -sticky w
  tooltip_install $a.qualifiersframe.f1.1.delete [mc "Delete Qualifier"]
  grid [frame $a.qualifiersframe.f1.2] -row 1 -column 1 -sticky nswe
  grid [button $a.qualifiersframe.f1.2.prev -text "<" -width 1 -command "edit_feature_dialog_manage_qualifiers $a prev"] -row 0 -column 0 -sticky w
  tooltip_install $a.qualifiersframe.f1.2.prev [mc "Previous Qualifier"]
  grid [label $a.qualifiersframe.f1.2.label1 -text "0 of 0"] -row 0 -column 1 -sticky w
  grid [button $a.qualifiersframe.f1.2.next -text ">" -width 1 -command "edit_feature_dialog_manage_qualifiers $a next"] -row 0 -column 2 -sticky w
  tooltip_install $a.qualifiersframe.f1.2.next [mc "Next Qualifier"]
  grid [frame $a.qualifiersframe.f2] -row 0 -column 2 -sticky nswe
  grid [menubutton $a.qualifiersframe.f2.type -menu $a.qualifiersframe.f2.type.menu -textvariable temp_info(qual_type) -font labelfont -indicatoron 1] -row 0 -column 1 -sticky w
  menu $a.qualifiersframe.f2.type.menu
  set temp_info(qual_value) {}
  grid [entry $a.qualifiersframe.f2.name -textvariable temp_info(qual_value) -validate key -validatecommand "edit_feature_dialog_manage_qualifiers $a update %P" -font dnafont -width 40 -xscrollcommand "optionscrollbar $a.qualifiersframe.f2.sc"] -row 0 -column 2 -sticky swe
  grid [menubutton $a.qualifiersframe.f2.name_menubutton -textvariable temp_info(qual_value) -width 20 -menu $a.qualifiersframe.f2.name_menubutton.menu] -row 0 -column 2 -sticky nwe
  menu $a.qualifiersframe.f2.name_menubutton.menu
  grid [label $a.qualifiersframe.f2.nonstandard_flag -text [mc "*Nonstandard"]] -row 1 -column 1 -sticky w 
  grid [scrollbar $a.qualifiersframe.f2.sc -command "$a.qualifiersframe.f2.name xview" -orient horizontal] -row 1 -column 2 -sticky nwe
  edit_feature_dialog_manage_qualifiers $a "show"

  grid [frame $a.infoframe.typeframe] -row 0 -column 1 -sticky nswe
  grid [label $a.infoframe.typeframe.label1 -text [mc "Feature type:"]] -row 0 -column 1 -sticky w
  grid [menubutton $a.infoframe.typeframe.type -menu $a.infoframe.typeframe.type.menu -textvariable temp_info(type) -font labelfont -width 15 -indicatoron 1] -row 0 -column 2 -sticky we
  menu $a.infoframe.typeframe.type.menu


  foreach {header types} $genbank_divided_typelist {
    $a.infoframe.typeframe.type.menu add cascade -label $header -menu [menu $a.infoframe.typeframe.type.menu.[string tolower $header]]
    foreach type $types {
      if {[string index $type 0] eq "-"} {set typelabel " $type"} else {set typelabel $type}
      $a.infoframe.typeframe.type.menu.[string tolower $header] add radiobutton -label $typelabel -variable temp_info(type) -value $type -command "edit_feature_dialog_update_type $a $w $feature"

     ####add the -command to change the fwd and rev_color here
    }
  }
  if {$temp_info(type) ni $genbank_typelist } {
    $a.infoframe.typeframe.type.menu add radiobutton -label $temp_info(type) -variable temp_info(type) -value $temp_info(type) -command "edit_feature_dialog_update_type $a $w $feature"
  }
  #trace variable temp_info(type) w "bell;#"

  grid [frame $a.infoframe.colorframe] -row 1 -column 1 -sticky nswe
  grid [label $a.infoframe.colorframe.label2 -text [mc "Forward color:"]] -row 0 -column 1 -sticky w
  grid [color_button $a.infoframe.colorframe.fwdcolor temp_info(fwd_color) 12] -sticky w -row 0 -column 2
  grid [label $a.infoframe.colorframe.label3 -text [mc "Reverse color:"]] -row 0 -column 3
  grid [color_button $a.infoframe.colorframe.revcolor temp_info(rev_color) 12] -sticky w -row 0 -column 4
  grid [button $a.infoframe.colorframe.revcolor_same -text [mc "Same"] -command "set temp_info(rev_color) \$temp_info(fwd_color); edit_feature_dialog_manage_direction $w $feature"] -sticky w -padx 5 -row 0 -column 5
  tooltip_install  $a.infoframe.colorframe.revcolor_same [mc "Make the reverse color the same as the forward color"]
  if {[llength $info(feature_color_favorites)] > 0} {
    grid [menubutton $a.infoframe.colorframe.favs -menu $a.infoframe.colorframe.favs.menu -text [mc "Favorites"] -width 10 -indicatoron 1] -sticky w -padx 5 -row 0 -column 6
    menu $a.infoframe.colorframe.favs.menu
    fill_favs_menu $a $a.infoframe.colorframe.favs.menu temp_info(fwd_color) temp_info(rev_color)
  }

  grid [frame $a.infoframe.stackingframe] -row 2 -column 1 -sticky nswe
  grid [label $a.infoframe.stackingframe.l1 -text [mc "Place Directly Above Feature:"]] -row 0 -column 1 -sticky w
  grid [menubutton $a.infoframe.stackingframe.featutres -menu $a.infoframe.stackingframe.featutres.menu -textvariable temp_info(place_above_name) -font labelfont -width 15 -indicatoron 1] -row 0 -column 2 -sticky we
  menu $a.infoframe.stackingframe.featutres.menu
  $a.infoframe.stackingframe.featutres.menu insert 0 radiobutton -label [mc "Place on bottom"] -value "none" -variable temp_info(place_above) -command "set temp_info(place_above_name) \"[mc {Place on bottom}]\""
  set last_tag "none"
  foreach tag [$w.textarea tag names] {
    if {$tag == $feature} {
      set temp_info(place_above) $last_tag
      if {$last_tag != "none"} {
        set temp_info(place_above_name) [lindex [$w.textarea tag bind $last_tag <<Metadata>>] 0]
      } else {
        set temp_info(place_above_name) [mc "Place on bottom"]
      }
    } else {
      if {([regexp {f[0-9]+#} $tag]) && ([llength [$w.textarea tag ranges $tag]] > 1)} {
        $a.infoframe.stackingframe.featutres.menu insert 0 radiobutton -label [lindex [$w.textarea tag bind $tag <<Metadata>>] 0] -value $tag -variable temp_info(place_above) -command "set temp_info(place_above_name) \"[lindex [$w.textarea tag bind $tag <<Metadata>>] 0]\""
        set last_tag $tag
      }
    }
  }
  if {$temp_info(place_above) == {}} {
    set temp_info(place_above) $last_tag
    if {$last_tag != "none"} {
      set temp_info(place_above_name) [lindex [$w.textarea tag bind $last_tag <<Metadata>>] 0]
    } else {
      set temp_info(place_above_name) [mc "Place on bottom"]
    }
  }
  
  ## Don't set the graphic parameters here- do it in the graphic map config
  if {0} {
  set temp_info(f_arrow) [lindex [dict get $temp_info(format) arrow_data] 0]
  set temp_info(r_arrow) [lindex [dict get $temp_info(format) arrow_data] 1]
  set temp_info(arrow_flip) [lindex [dict get $temp_info(format) arrow_data] 2]
  set temp_info(g_width) [dict get $temp_info(format) width]
  set temp_info(g_offset) [dict get $temp_info(format) offset]

  grid [frame $a.infoframe.gformatframe] -row 3 -column 1 -sticky nswe
  grid [label $a.infoframe.gformatframe.l1 -text [mc "Forward arrow:"]] -row 0 -column 1 -sticky w
  #grid [entry $a.infoframe.gformatframe.e1 -textvariable temp_info(f_arrow)] -row 0 -column 2 -sticky w
  grid [menubutton $a.infoframe.gformatframe.fwda -textvariable temp_info(f_arrow_text)] -row 0 -column 2 -sticky w
  $a.infoframe.gformatframe.fwda configure -menu [menu $a.infoframe.gformatframe.fwda.m]
  fill_arrow_menu $a.infoframe.gformatframe.fwda.m $info(arrowlist) temp_info(f_arrow) temp_info(f_arrow_text) ""
  grid [label $a.infoframe.gformatframe.l2 -text [mc "Reverse arrow:"]] -row 1 -column 1 -sticky w
  #grid [entry $a.infoframe.gformatframe.e2 -textvariable temp_info(r_arrow)] -row 1 -column 2 -sticky w
  grid [menubutton $a.infoframe.gformatframe.reva -textvariable temp_info(r_arrow_text)] -row 1 -column 2 -sticky w
  $a.infoframe.gformatframe.reva configure -menu [menu $a.infoframe.gformatframe.reva.m]
  fill_arrow_menu $a.infoframe.gformatframe.reva.m $info(arrowlist) temp_info(r_arrow) temp_info(r_arrow_text) ""
  grid [checkbutton $a.infoframe.gformatframe.c1 -text [mc "Flip on reverse"] -variable temp_info(arrow_flip)]  -row 1 -column 3 -sticky w
  grid [label $a.infoframe.gformatframe.l3 -text [mc "Width:"]] -row 2 -column 1 -sticky w
  grid [entry $a.infoframe.gformatframe.e3 -textvariable temp_info(g_width)] -row 2 -column 2 -sticky w
  grid [label $a.infoframe.gformatframe.l4 -text [mc "Offset:"]] -row 3 -column 1 -sticky w
  grid [entry $a.infoframe.gformatframe.e4 -textvariable temp_info(g_offset)] -row 3 -column 2 -sticky w
  }


  #trace add variable info(feature_color_favorites) write "fill_favs_menu $a $a.infoframe.colorframe.favs.menu temp_info(fwd_color) temp_info(rev_color);# "


  if {$feature ne ""} {
    bind $a.infoframe.colorframe.fwdcolor <<updatevar>> "+;edit_feature_dialog_manage_direction $w $feature"
    bind $a.infoframe.colorframe.revcolor <<updatevar>> "+;edit_feature_dialog_manage_direction $w $feature"
  }

  grid [button $a.okframe.ok -text [mc "OK"] -command "set ok2 1" -default active] -row 0 -column 0 -padx 10 -pady 3
  grid [checkbutton $a.okframe.apply -text [mc "Make format default for feature type"] -variable temp_info(apply_default)] -row 0 -column 1 -padx 10 -pady 3
  set temp_info(apply_default) 0
  bind $a <Key-Return> "set ok2 1"
  $a.textframe.name selection range 0 end
  $a.textframe.name icursor end
  wm deiconify $a
  raise $a
  focus $a
  #update
  focus $a.textframe.name




  return $a
}

##########
## Manage feature type data
##########
proc edit_feature_dialog_update_type {a w feature} {
global info temp_info

  set type $temp_info(type)
  if {[dict exist $info(feature_default_type_colors) $type]} {
    set temp_info(fwd_color) [lindex [dict get $info(feature_default_type_colors) $type] 0]
    set temp_info(rev_color) [lindex [dict get $info(feature_default_type_colors) $type] 1]
  } else {
    set temp_info(fwd_color) $info(feature_default_fcolor)
    set temp_info(rev_color) $info(feature_default_rcolor)
  }
  textarea_tag_bind $w.textarea $feature <<Revcolors>> [list $temp_info(fwd_color) $temp_info(rev_color)]
  if {[dict exists $info(feature_default_type_gformat) $type]} {
    set temp_info(f_arrow) [lindex [dict get $info(feature_default_type_gformat) $type arrow_data] 0]
    set temp_info(r_arrow) [lindex [dict get $info(feature_default_type_gformat) $type arrow_data] 1]
    set temp_info(arrow_flip) [lindex [dict get $info(feature_default_type_gformat) $type arrow_data] 2]
    set temp_info(g_width) [dict get $info(feature_default_type_gformat) $type width]
  } else {
    set temp_info(f_arrow) [lindex [dict get $info(feature_default_gformat) arrow_data] 0]
    set temp_info(r_arrow) [lindex [dict get $info(feature_default_gformat) arrow_data] 1]
    set temp_info(arrow_flip) [lindex [dict get $info(feature_default_gformat) arrow_data] 2]
    set temp_info(g_width) [dict get $info(feature_default_gformat) width]
  }
  if {$type eq "primer_bind"} {
    if {![dict exists $temp_info(qual_list) "PCR_conditions"]} {
      set primer_seq ""
      if {[regexp {([0-9]+)\.\.([0-9]+)} $temp_info(loc) - loc1 loc2]} {
        incr loc1 -1
        set primer_seq [textarea_get $w.textarea [bp2ix $w.textarea $loc1] [bp2ix $w.textarea $loc2]]
      } elseif {[regexp {([0-9]+)\.\.([0-9]+)\,1\.\.([0-9]+)} $temp_info(loc) - loc1 loc2 loc3] && $loc2 == [ix2bp $w.textarea [end_ix $w.textarea]]} {
        incr loc1 -1
        set primer_seq "[textarea_get $w.textarea [bp2ix $w.textarea $loc1] [bp2ix $w.textarea $loc2]][textarea_get $w.textarea [bp2ix $w.textarea 0] [bp2ix $w.textarea $loc3]]"
      }
      if {$temp_info(dir)} {set primer_seq [revcom $primer_seq]}
      if {$primer_seq ne {} && [string length $primer_seq] <=75} {
		dict set temp_info(qual_list) "PCR_conditions" "primer_sequence:$primer_seq"
	  }
    }
  }
  set metadata [$w.textarea tag bind $feature <<Metadata>>]
  lset metadata 2 $type
  $w.textarea tag bind $feature <<Metadata>> $metadata
  
  edit_feature_dialog_manage_qualifiers $a show
  features_to_tree_view $w
}

##########
## Manage direction
##########
proc edit_feature_dialog_manage_direction {w feature} {
global temp_info
  if {$temp_info(dir) == 0} {
	textarea_tag_configure $w.textarea $feature -background $temp_info(fwd_color)
  } else {
    textarea_tag_configure $w.textarea $feature -background $temp_info(rev_color)
  }
  set metadata [$w.textarea tag bind $feature <<Metadata>>]
  lset metadata 3 $temp_info(dir)
  $w.textarea tag bind $feature <<Metadata>> $metadata
  textarea_tag_bind $w.textarea $feature <<Revcolors>> [list $temp_info(fwd_color) $temp_info(rev_color)]
  features_to_tree_view $w
}

##########
## Manage qualifiers display: prev/ next, add/remove, update qual_list as type and value are edited
##########
proc edit_feature_dialog_manage_qualifiers {a action {data {}}} {
global temp_info genbank_feature_key_qualifiers genbank_mandatory_qualifiers
  switch $action {
    "show" {
      ## check for missing mandatory qualifiers and add them
      if {[dict exists $genbank_mandatory_qualifiers [string tolower $temp_info(type)]]} {
        foreach req_qual [dict get $genbank_mandatory_qualifiers [string tolower $temp_info(type)]] {
          if {![dict exists $temp_info(qual_list) $req_qual]} {
            dict set temp_info(qual_list) $req_qual {}
          }
        }
      }
      if {$temp_info(qual_list) == [list]} {
        grid remove $a.qualifiersframe
        grid configure $a.qualifiersframe_empty
      } else {
        grid remove $a.qualifiersframe_empty
        grid configure $a.qualifiersframe
        set temp_info(qual_type) [lindex $temp_info(qual_list) [expr {$temp_info(qual_active)}]] 
        set value [lindex $temp_info(qual_list) [expr {1 + $temp_info(qual_active)}]]

        regexp {^\"(.*)\"$} $value - value
        set temp_info(qual_value) $value
        $a.qualifiersframe.f1.2.label1 configure -text "[expr {$temp_info(qual_active) / 2 +1}] of [expr {[llength $temp_info(qual_list)] / 2}]"
        $a.qualifiersframe.f2.type.menu delete 0 end
        if {[dict exists $genbank_feature_key_qualifiers $temp_info(type)]} {
          set found 0
          foreach q [dict get $genbank_feature_key_qualifiers $temp_info(type)] {
            $a.qualifiersframe.f2.type.menu add radiobutton -variable temp_info(qual_type) -label $q -value $q -command "edit_feature_dialog_change_qual_type $a"
            if {$temp_info(qual_type) eq $q} {
              set found 1
              grid remove $a.qualifiersframe.f2.nonstandard_flag
            }
          }
          if {!$found} {
            $a.qualifiersframe.f2.type.menu add radiobutton -variable temp_info(qual_type) -label $temp_info(qual_type) -value $temp_info(qual_type) -command "edit_feature_dialog_change_qual_type $a"
            grid configure $a.qualifiersframe.f2.nonstandard_flag
          }
        } else {
          set temp_info(qual_type) "note"
          $a.qualifiersframe.f2.type.menu add radiobutton -variable temp_info(qual_type) -label note -value note
        }
        edit_feature_dialog_change_qual_type $a
      }
    }
    "prev" {
      set temp_info(qual_active) [expr {($temp_info(qual_active) - 2) % [llength $temp_info(qual_list)]}]
      edit_feature_dialog_manage_qualifiers $a "show"
    }
    "next" {
      set temp_info(qual_active) [expr {($temp_info(qual_active) + 2) % [llength $temp_info(qual_list)]}]
      edit_feature_dialog_manage_qualifiers $a "show"
    }
    "add" {
      set temp_info(qual_list) [linsert $temp_info(qual_list) $temp_info(qual_active) note ""]
      edit_feature_dialog_manage_qualifiers $a "show"
    }
    "remove" {
      set temp_info(qual_list) [lreplace $temp_info(qual_list) $temp_info(qual_active) [expr {1 +$temp_info(qual_active)}]]
      if {$temp_info(qual_active)> 0 && $temp_info(qual_active) >= [llength $temp_info(qual_list)]} {
        incr  temp_info(qual_active) -2
      }
      edit_feature_dialog_manage_qualifiers $a "show"
    }
    "update" {
      if {[llength $temp_info(qual_list)] > $temp_info(qual_active)}  {
        lset temp_info(qual_list) [expr {1 + $temp_info(qual_active)}] $data
      }
    }
  }
  return 1
}

##########
## Manage qualifiers display: update the temp_info(qual_value), grid name_menubutton or name entry, set the tooltip for entry, check for valid data
##########
proc edit_feature_dialog_change_qual_type {a} {
global temp_info genbank_qualifier_values

  if {[set ix [lsearch -exact -nocase $genbank_qualifier_values [string tolower $temp_info(qual_type)]]] > -1} {
    set val_list [lindex $genbank_qualifier_values [expr {$ix+1}]]
  } else {
    set val_list "Unknown qualifier type"
  }

  if {$val_list eq "none"} {
    grid remove $a.qualifiersframe.f2.name
    grid remove $a.qualifiersframe.f2.name_menubutton
    grid remove $a.qualifiersframe.f2.sc
    set temp_info(qual_value) {}
    lset temp_info(qual_list) [expr {1 + $temp_info(qual_active)}] $temp_info(qual_value)
  } elseif {$val_list eq "text"} {
    grid configure $a.qualifiersframe.f2.name
    grid configure $a.qualifiersframe.f2.sc
    grid remove $a.qualifiersframe.f2.name_menubutton
        tooltip_install $a.qualifiersframe.f2.name "Free Text"
  } elseif {[llength $val_list] >  1} {
    grid remove $a.qualifiersframe.f2.name
    grid remove $a.qualifiersframe.f2.sc
    grid configure $a.qualifiersframe.f2.name_menubutton
    $a.qualifiersframe.f2.name_menubutton.menu delete 0 end
    foreach v $val_list {
      $a.qualifiersframe.f2.name_menubutton.menu add radiobutton -label $v -value $v -variable temp_info(qual_value) -command "lset temp_info(qual_list) \[expr {1 + \$temp_info(qual_active)}\] \$temp_info(qual_value)"
    }
    #set temp_info(qual_value) [string tolower $temp_info(qual_value)]
    if {[lsearch -nocase $val_list $temp_info(qual_value)] == -1} {
      set temp_info(qual_value) [lindex $val_list 0]
      lset temp_info(qual_list) [expr {1 + $temp_info(qual_active)}] $temp_info(qual_value)
    }
  } else {
    grid configure $a.qualifiersframe.f2.name
    grid configure $a.qualifiersframe.f2.sc
    grid remove $a.qualifiersframe.f2.name_menubutton
    tooltip_install $a.qualifiersframe.f2.name [lindex $val_list 0]
    if {$temp_info(qual_value) eq {}} {
      set temp_info(qual_value) [lindex $val_list 0]
      lset temp_info(qual_list) [expr {1 + $temp_info(qual_active)}] $temp_info(qual_value)
    }
  }
  lset temp_info(qual_list) $temp_info(qual_active) $temp_info(qual_type)
##  
}

##########
## Return location list formed by adding or subtracting the selection from a location list of a feature (sub-proc of rename_recolor_features)
##########
proc locations_plus_selection {w loc_list_text mode} {


  if {[$w.textarea tag ranges sel] == ""} {return $loc_list_text}

  set sel_start [expr {[ix2bp $w.textarea [$w.textarea index sel.first]] +1}]
  set sel_end [ix2bp $w.textarea [$w.textarea index sel.last]]
#selection used here 
  set loc_list [split [regsub -all {\.+} $loc_list_text ,] ".,"]
  set start_i [llength $loc_list]
  set end_i [llength $loc_list]
  for {set i 0} {$i < [llength $loc_list]} {incr i} {
    #find point in loc_list that sel_start is between (need to check if it is in the intron of a feature split at the origin)
    if {($sel_start <= [lindex $loc_list $i]) || (($i > 0) && ([lindex $loc_list [expr {$i-1}]] > [lindex $loc_list $i]) && ($sel_start > [lindex $loc_list [expr {$i-1}]]))} {
      set start_i $i
      break
    }
  }

  #for features split at the origin, need to check for sel_start in the exons at the begining of the sequenc
  if {([lindex $loc_list 0] > [lindex $loc_list end]) && ($start_i == 0) && ($sel_start < [lindex $loc_list end])} {
    while {([lindex $loc_list $i] > [lindex $loc_list [expr {$i-1}]]) && ($i < [llength $loc_list])} {
      incr i 
    }
   for {set i $i} {$i < [llength $loc_list]} {incr i} {
    #find point in loc_list that sel_start is between (need to check if it is in the intron of a feature split at the origin)
      if {($sel_start <= [lindex $loc_list $i])} {
        set start_i $i
        break
      }
    }
  }

  for {set i $i} {$i < [llength $loc_list]} {incr i} {
    if {($sel_end < [lindex $loc_list $i]) ||  (($i > 0) && ([lindex $loc_list [expr {$i-1}]] > [lindex $loc_list $i]) && ($sel_start > [lindex $loc_list $i]))} {
      set end_i $i
      break
    }
  }

  #even indices are in introns, odd in exons
  #need to check for circular sequences with 0 0 result (adding new exon to the beginning), see if it would be closer to add it to the end
  if {$mode == "plus_sel"} {
    ####plus_sel
    if {$start_i == [llength $loc_list]} {
      lappend loc_list $sel_start $sel_end
    } else {
      set loc_list [lreplace $loc_list $start_i [expr {$end_i-1}] {*}[expr {($start_i % 2)?"":$sel_start}] {*}[expr {($end_i % 2)?"":$sel_end}]]
    }
    #eliminate empty list elements
    set loc_list [lsearch -all -inline -not $loc_list {}]
    #fuse adjacent exons
    set loc_list2 [lindex $loc_list 0] 
    for {set i 1} {$i < [expr {[llength $loc_list] -1}]} {incr i} {
      if {[expr {$i % 2}] && ([expr {[lindex $loc_list $i] + 1}] == [lindex $loc_list [expr {$i +1}]])} {
        incr i 1

      } else {
        lappend loc_list2 [lindex $loc_list $i]
      }
    }
    lappend loc_list2 [lindex $loc_list end]
  } else {
    ####minus_sel
    if {($start_i == [llength $loc_list]) || ($end_i == 0)} {
    } elseif {($end_i == [llength $loc_list]) && ( ($start_i == 0) || (($start_i == 1) && ($sel_start == [lindex $loc_list 0])) )} {
      #deleting whole feature
      bell
      return $loc_list_text
    } else {

      set loc_list [lreplace $loc_list $start_i [expr {$end_i-1}] {*}[expr {($start_i % 2)?[expr {$sel_start-1}]:""}] {*}[expr {($end_i % 2)?[expr {$sel_end+1}]:""}]]
    }
    #eliminate empty list elements
    set loc_list [lsearch -all -inline -not $loc_list {}]
    #delete empty exons
    set loc_list2 [list] 
    for {set i 0} {$i < [llength $loc_list]} {incr i} {
      if {(![expr {$i % 2}]) && ([lindex $loc_list $i] > [lindex $loc_list [expr {$i +1}]])} {
        incr i 1
      } else {
        lappend loc_list2 [lindex $loc_list $i]
      }
    }
  }

    #make result text
    if {[llength $loc_list2] > 0} {
      set res_text "[lindex $loc_list2 0]..[lindex $loc_list2 1]"
      foreach {a b} [lrange $loc_list2 2 end] {
        set res_text "$res_text,$a..$b"
      } 
      return $res_text
   } else {
     return $loc_list_text
   }
}


##########
## Return location list of only uppercase chars (sub-proc of rename_recolor_features)
##########
proc locations_upper {w loc_list_text} {
  set loc_list [split [regsub -all {\.+} $loc_list_text ,] ".,"]
  set res_list [list]
  foreach {a b} $loc_list {
    set t [textarea_get $w.textarea [bp2ix $w.textarea [expr {$a-1}]] [bp2ix $w.textarea $b]]
    foreach c [regexp -all -indices -inline {[[:upper:]]+} $t] {
      lappend res_list [expr {[lindex $c 0] + $a}] [expr {[lindex $c 1] + $a}]
    }
  }
  if {$res_list != [list] } {
    set res_text "[lindex $res_list 0]..[lindex $res_list 1]"
    foreach {a b} [lrange $res_list 2 end] {
      set res_text "$res_text,$a..$b"
    } 
    return $res_text
  } else {
    return $loc_list_text
  }
}

##########
## Apply location list to a feature (sub-proc of rename_recolor_features)
##########
proc apply_loc_list {w tag loc_list_text} {
  #sputs apply_loc_list [$w.textarea tag bind f0# <<Metadata>>]
  set loc_list [split [regsub -all {\.+} $loc_list_text ,] ".,"]
  textarea_tag_remove $w.textarea $tag 1.0 end
  foreach {a b} $loc_list {
    incr a -1
    textarea_tag_add $w.textarea $tag [bp2ix $w.textarea $a] [bp2ix $w.textarea $b]
  }
    set tag_ranges [$w.textarea tag ranges $tag]
    if {([llength $tag_ranges] == 2) || (([llength $tag_ranges] == 4) && ([lindex $loc_list 0] > [lindex $loc_list end]) && ([lindex $tag_ranges 0] eq 1.0) && ([lindex $tag_ranges 4] eq [end_ix $w.textarea]))} {
      textarea_tag_delete $w.textarea [regsub f $tag fn]
    } elseif {([lindex $loc_list 0] > [lindex $loc_list end])} {
      textarea_tag_add $w.textarea [regsub f $tag fn] [bp2ix $w.textarea [expr {[lindex $loc_list 0] -1}]] [end_ix $w.textarea]
      textarea_tag_add $w.textarea [regsub f $tag fn] 1.0 [bp2ix $w.textarea [lindex $loc_list end]]
    } else {
      textarea_tag_add $w.textarea [regsub f $tag fn] [bp2ix $w.textarea [expr {[lindex $loc_list 0] -1}]] [bp2ix $w.textarea [lindex $loc_list end]]
    }


  register_undo_separator $w "Edit Feature Location"
  #$w.tvframe.tv set $feature Location $new_loc
  features_to_tree_view $w
}


##########
## Fill a feature favorite colors menu button
##########
proc fill_favs_menu {w menu fwd_color_var rev_color_var} {
  global info

  $menu delete 0 end
  foreach coloritem $info(feature_color_favorites) {
    $menu add command -label [lindex $coloritem 0] -command "set $fwd_color_var [lindex $coloritem 1]; set $rev_color_var [lindex $coloritem 2]; event generate $menu <<color_picked>>"
  }
  #$menu add separator
  #$menu add command -label [mc "Edit Favorites"] -command "edit_color_favorites $w"
  
}




##############
## converts a list of lines from a GenBank feature table to a tag list for put_tags
##############
##this uses regexp to split the whole table into features at once- much simpler code
proc feature_table_to_taglist2 {table {circular 0} {dna_length 0}} {
  foreach feature [regexp -inline -all { {5,7}[^\n]*\n(?: {21,23}[^\n]*\n)*?} $table] {
    regsub "\n$" $feature "" feature
    regsub -all "\n                     /" $feature \x0 feature
    regsub -all "\n                     " $feature " " feature
    set fealist [split $feature \x0]
    regexp  { {5,7}([^\s]*)\s+(.*)} [lindex $fealist 0] junk type range
    set fealist [lrange $fealist 1 end]
    sputs $type:$range
    foreach f $fealist {
      sputs     $f
    }
  }
}
##############
## converts a list of lines from a GenBank feature table to a tag list for put_tags
##############
proc feature_table_to_taglist {table {circular 0} {dna_length 0}} {
  global info
  set result [list]
  set default_palette [list #00DF87 #00D95A #008065 #13AAFE #3A93FE #2D64FE #00891F #00C6C3 #00D0FA #00D308 #2D64FE #EE92FE #A600FA #4856FE #FE09C9 #FE139F #CB00C4 #7160FE #912DFE #B394FE]
  set subtype ""
  set subdata ""
  set type ""
  set range ""
  set source_tag ""
  set i 0
  set c 0
  set genbank_type_list [list]
  set genbank_data_list [list]
  set info_label ""
  set Apeinfo_label ""
  set Apeinfo_fwd ""
  set Apeinfo_rev ""
  set Apeinfo_hidden 0
  set ApEinfo_group [list]
  set Apeinfo_gformat ""
  lappend table "     end   end"


  #regsub -all {\n                     /} $table \u0001 table
  #regsub -all {\n                     } $table " " table
  ## now each feature is on a new line, split by \u0001
  foreach line $table {
    if {[regexp { {21,23}/([^=]*)=(.*)} $line line next_subtype next_subdata] || [regexp { {21,23}/(.*)} $line line next_subtype]} {
      ##store the sub data
      if {$subtype == "ApEinfo_label"} {
        regsub -all \" $subdata {} subdata
        set Apeinfo_label $subdata
      } elseif {$subtype == "ApEinfo_fwdcolor"} {
        regsub -all \" $subdata {} subdata
        set Apeinfo_fwd $subdata
      } elseif {$subtype == "ApEinfo_revcolor"} {
        regsub -all \" $subdata {} subdata
        set Apeinfo_rev $subdata
      } elseif {$subtype == "ApEinfo_hidden"} {
          set Apeinfo_hidden 1
      } elseif {$subtype == "ApEinfo_graphicformat"} {
        regsub -all \" $subdata {} subdata
        set Apeinfo_gformat $subdata
      } elseif {$subtype == "ApEinfo_group"} {
        regsub -all \" $subdata {} subdata
        lappend ApEinfo_group $subdata
      }  elseif {$subtype == "label"} {
        regsub -all \" $subdata {} subdata
        set info_label $subdata
      } elseif {$subtype == "locus_tag"} {
        set info_label $subdata
      } elseif {$subtype == "ncRNA_class"} {
        regsub -all \" $subdata {} subdata
        set type  "ncRNA:$subdata"
      } elseif {$subtype == "regulatory_class"} {
        regsub -all \" $subdata {} subdata
        set type  "regulatory:$subdata"
      } elseif {$subtype == "recombination_class"} {
        regsub -all \" $subdata {} subdata
        set type  "misc_recomb:$subdata"
      } elseif {$subtype != ""} {
        lappend genbank_data_list $subdata
      }
      set subtype $next_subtype
      if { $subtype ni [list label locus_tag ApEinfo_label ApEinfo_fwdcolor ApEinfo_revcolor ApEinfo_hidden ApEinfo_graphicformat ApEinfo_group ncRNA_class regulatory_class recombination_class]} {
        regsub -all \" $subdata {} subdata
        lappend genbank_type_list $subtype
      }
      set subdata $next_subdata
      set c 1
    } elseif {[regexp { {21,23}(.*)} $line line continue]} {
      if {$c == 0} {
        set range "$range$continue"
      } else {
        set subdata "$subdata $continue"
      }
    } elseif {[regexp { {5,7}([^ ]*) *(.*)} $line line next_type next_range]} {
      ##next feature heading line found
      ##finish the previous feature
      if {$subtype in [list label locus_tag ApEinfo_label ApEinfo_fwdcolor ApEinfo_revcolor ApEinfo_hidden ApEinfo_graphicformat ApEinfo_group] } {
        regsub -all \" $subdata {} subdata
      }
      if {$subtype == "ApEinfo_label"} {
        set Apeinfo_label $subdata
      } elseif {$subtype == "ApEinfo_fwdcolor"} {
        set Apeinfo_fwd $subdata
      } elseif {$subtype == "ApEinfo_revcolor"} {
        set Apeinfo_rev $subdata
      } elseif {$subtype == "ApEinfo_hidden"} {
        set Apeinfo_hidden 1
      } elseif {$subtype == "ApEinfo_graphicformat"} {
        set Apeinfo_gformat $subdata
      } elseif {$subtype == "ApEinfo_group"} {
        lappend ApEinfo_group $subdata
      } elseif {$subtype == "label"} {
        set info_label $subdata
      } elseif {$subtype == "locus_tag"} {
        regsub -all \" $subdata {} subdata
        set info_label $subdata
      } elseif {$subtype == "ncRNA_class"} {
        regsub -all \" $subdata {} subdata
        set type  "ncRNA:$subdata"
      } elseif {$subtype == "regulatory_class"} {
        regsub -all \" $subdata {} subdata
        set type  "regulatory:$subdata"
      } elseif {$subtype == "recombination_class"} {
        regsub -all \" $subdata {} subdata
        set type  "misc_recomb:$subdata"
      } elseif {$subtype != ""} {
        lappend genbank_data_list $subdata
      }
      if {($type != "")} {
        ##interpret the range data

        if {[string match "*complement*" $range]} {
          set dir 1
        } else {
          set dir 0
        }

        #if feature contains an outside reference, can't use it
        if {[string first : $range] > -1} {
          set range ""
        }

        #convert ^'s and ..'s to .'s
        regsub -all {\.\.|\^} $range . temp_range
        regsub -all " " $temp_range "" temp_range

        set new_range [list]

        #process each location as defined as everything between ,'s
        foreach location [split $temp_range ,] {
          #take out everything that's not a number or a "."
          regsub -all {[^\.0-9]} $location "" location
          set location [split $location .]
          if {[catch {lsort -integer -increasing $location}]} {
            if {[lindex $location 1] == ""} {
              set location [list [lindex $location 0] [lindex $location 0]]
            }
            if {[lindex $location 0] == ""} {
              set location [list [lindex $location 1] [lindex $location 1]]
            }
          }
          if {[llength $location] == 1} {
            set location [concat $location $location]
          }
          if {($circular eq "circular") && ([llength $location] == 2) && ($dna_length > 0)} {
            if {[lindex $location 0] > [lindex $location 1]} {
              #VectorNTI stores features that span the origin as features with higher first index than second
              lappend new_range [list [expr {[lindex $location 0]-1}] [expr {$dna_length}]] [list 0 [lindex $location end]]
            } else {
              lappend new_range [list [expr {[lindex $location 0]-1}] [lindex $location end]]
            }
          } else {
            lappend new_range [list [expr {[lindex $location 0]-1}] [lindex $location end]]
          }
        }

        if {($circular== "circular")} {
          set new_range [join $new_range " "]
        } else {
          #this shouldn't be necessary, but wormbase (and possibly others) export unsorted joins- it can't be done on circular, because spanning the origin makes a range unsorted 
          set new_range [lsort -integer -increasing [join $new_range " "]]
        }
        ##need to assign the name based on the sub-data
        #label gene product notes
        if {$Apeinfo_label != ""} {
          set name $Apeinfo_label
        } elseif {$info_label != ""} {
          set name $info_label
        } elseif {[set index [lsearch $genbank_type_list "product"]] > -1} {
          set name [lindex $genbank_data_list $index]
        } elseif {[set index [lsearch $genbank_type_list "gene"]] > -1} {
          set name [lindex $genbank_data_list $index]
        } elseif {[set index [lsearch $genbank_type_list "note"]] > -1} {
          set name [lindex $genbank_data_list $index]
        } elseif {$type == "source"} {
          if {[set index [lsearch $genbank_type_list "organism"]] > -1} {
            set name "source:[lindex $genbank_data_list $index]"
          } else {
            set name "source"
          }
        } else {
          set name $type
        }
        set name [string range $name 0 100]
        regsub -all {\"} $name "" name

        ## autohide source if not an ApE formatted file (raw genbank)
        if {$Apeinfo_label == "" && $type == "source"} {
          set Apeinfo_hidden 1
        }

        ##need to assign the colors based on the type
        set Apeinfo_fwd [regsub -all {{[^[:alnum:]\s#]} } $Apeinfo_fwd ""]
        set Apeinfo_rev [regsub -all {{[^[:alnum:]\s#]} } $Apeinfo_rev ""]
        if {($Apeinfo_fwd != "") && (![catch {winfo rgb . $Apeinfo_fwd}])} {
          set fwd_color $Apeinfo_fwd
          if {($Apeinfo_rev != "")  && (![catch {winfo rgb . $Apeinfo_rev}])} {
            set rev_color $Apeinfo_rev
          } else {
            set rev_color $Apeinfo_fwd
          }
        } else {
          if {[set color_index [lsearch -exact $info(feature_default_type_colors) $type]] != -1} {
            set clist [lindex $info(feature_default_type_colors) [expr {$color_index+1}]]
          } else {
            #set clist {pink pink}
            set clist [list [lindex $default_palette 0] [lindex $default_palette 0]]
            set default_palette [list {*}[lrange $default_palette 1 end] [lindex $default_palette 0]]
          }
          set fwd_color [lindex $clist 0]
          set rev_color [lindex $clist 1]
        }
        
        #assign gformat based on type
        if {[catch {set ad [dict get $Apeinfo_gformat arrow_data]; dict get $Apeinfo_gformat width; dict get $Apeinfo_gformat offset}] || [llength $ad] !=3 || ([llength [lindex $ad 0]] % 2)|| ([llength [lindex $ad 1]] % 2) } {
          if {[catch {set Apeinfo_gformat [dict get $info(feature_default_type_gformat) $type]}]} {
            set Apeinfo_gformat $info(feature_default_gformat)
          }
        }

        set genbank_list [list]
        foreach subtype $genbank_type_list subdata $genbank_data_list {
            regexp {"(.*)"} $subdata - subdata
            set subdata [regsub -all {""} $subdata \"]
            if {$subtype eq "translation"} {
              set subdata [regsub -all " " $subdata ""] 
            } elseif {$subtype eq "PCR_conditions"} {
              if {[regexp {(.*primer sequence:\s?)([ACGTNBDHKMRSUVWY]{49,50})\s([ACGTNBDHKMRSUVWY]+)(\s?.*)} $subdata -- str1 str2 str3 str4]} {
                set subdata "$str1$str2$str3$str4"
              } 
            }
            lappend genbank_list $subtype $subdata
        }
        if {$Apeinfo_hidden} {
          set formatlist [list {} {} {}]
        } elseif {$dir == 0} {
          set formatlist [list $fwd_color {} {}]
        } else {
          set formatlist [list $rev_color {} {}]
        }
        set bindlist [list <<Revcolors>> <<Metadata>>]
##metadata here
        set actionlist [list [list $fwd_color $rev_color] [list $name $Apeinfo_gformat $type $dir $genbank_list $ApEinfo_group]]

        ###create the feature data 
        if {[llength $new_range] > 0} { 
          if {[llength $new_range] > 2} {
            if {($circular== "circular") && ([lindex $new_range 0] > [lindex $new_range end])} {
              #crosses the origin
              if {([llength $new_range] == 4) && ([lindex $new_range 1]== $dna_length) && ([lindex $new_range 2]== 0)} {
                #single range, just crosses the origin
                lappend result "f$i#" [list $new_range $formatlist $bindlist $actionlist]
              } else {
                #multi-range feature, that crosses the origin
                lappend result "f$i#" [list $new_range $formatlist $bindlist $actionlist]
                lappend result "fn$i#" [list [list [lindex $new_range 0] $dna_length 0 [lindex $new_range end]] [list {} {} {}] [list] [list]]
              }
            } else {
              #multi-range feature, doesn't cross the origin
              lappend result "f$i#" [list $new_range $formatlist $bindlist $actionlist]
              lappend result "fn$i#" [list [list [lindex $new_range 0] [lindex $new_range end]] [list {} {} {}] [list] [list]]
            }
          } else {
            #simple 1 range feature
            lappend result "f$i#" [list $new_range $formatlist $bindlist $actionlist]
          }
          incr i
        }
      }
      set type $next_type
      set range $next_range
      set subtype ""
      set subdata ""
      set genbank_type_list [list]
      set genbank_data_list [list]
      set info_label ""
      set Apeinfo_label ""
      set Apeinfo_fwd ""
      set Apeinfo_rev ""
      set Apeinfo_hidden 0
      set Apeinfo_gformat ""
      set ApEinfo_group [list]
      set c 0
    }
  }
  ##also need to return $source_tag
  return $result
}

##############
## interpret serial cloner features list
##############
proc serial_cloner_features_to_taglist {featurelist {circular 0} {dna_length 0}} {
  global info header
  set result [list]
  set header $featurelist
  if {$featurelist != {}} {
    set pointer 1
    binary scan [string index $header $pointer] c oh_pascal1
    incr pointer
    set oh1 [string range $header $pointer [expr {$pointer + $oh_pascal1 -1}]]
    incr pointer $oh_pascal1
    if {[catch {set oh_len [expr {abs($oh1)}]}]} {return [list]}
    set oh_seq1 [string range $header $pointer [expr {$pointer - 1 + $oh_len}]]
    incr pointer $oh_len
    binary scan [string index $header $pointer] c oh_pascal2
    incr pointer
    set oh2 [string range $header $pointer [expr {$pointer + $oh_pascal2 -1}]]
    incr pointer $oh_pascal2
    set oh_len [expr {abs($oh2)}]
    set oh_seq2 [string range $header $pointer [expr {$pointer - 1 + $oh_len}]]
    incr pointer $oh_len
    binary scan [string index $header $pointer] c feature_number
    incr pointer

    for {set i 0} {$i < $feature_number} {incr i} {
      binary scan [string index $header $pointer] c oh_pascal1
      incr pointer
      set name [string range $header $pointer [expr {$pointer + $oh_pascal1 -1}]]
      incr pointer $oh_pascal1
      binary scan [string index $header $pointer] c oh_pascal1
      incr pointer
      set desc [string range $header $pointer [expr {$pointer + $oh_pascal1 -1}]]
      set qual_list [list]
      ## can possibly get qualifiers from the desc string
      incr pointer $oh_pascal1
      binary scan [string index $header $pointer] c oh_pascal1
      incr pointer
      set type [string range $header $pointer [expr {$pointer + $oh_pascal1 -1}]]
      incr pointer $oh_pascal1
      binary scan [string index $header $pointer] c oh_pascal1
      incr pointer
      set start [string range $header $pointer [expr {$pointer + $oh_pascal1 -1}]]
      incr pointer $oh_pascal1
      binary scan [string index $header $pointer] c oh_pascal1
      incr pointer
      set end [string range $header $pointer [expr {$pointer + $oh_pascal1 -1}]]
      incr pointer $oh_pascal1
      binary scan [string range $header $pointer [expr {$pointer+3}]] cccc fwd show unk arrow
      incr pointer 4
      binary scan [string index $header $pointer] c oh_pascal1
      incr pointer
      set c_string [string range $header $pointer [expr {$pointer + $oh_pascal1 -1}]]
      incr pointer $oh_pascal1

      if {[catch {set Apeinfo_gformat [dict get $info(feature_default_type_gformat) $type]}]} {
        set Apeinfo_gformat $info(feature_default_gformat)
      }
      if {!$fwd} {
        set dir 1
        set a $end
        set end $start
        set start $a
      } else {
        set dir 0
      }
      incr start -1

      if {[regexp {([0-9]+)\,([0-9]+)\,([0-9]+)\,} $c_string - red green blue]} {
        set fwd_color [format "\#%02X%02X%02X" $red $green $blue]
      } else {
        set fwd_color cyan
      }
      set formatlist [list $fwd_color {} {}]
      set bindlist [list <<Revcolors>> <<Metadata>>]
      set actionlist [list [list $fwd_color $fwd_color] [list $name $Apeinfo_gformat $type $dir $qual_list]]
      if {$start < $end} {
        lappend result "f$i#" [list [list $start $end] $formatlist $bindlist $actionlist]
      } else {
        lappend result "f$i#" [list [list $start $dna_length] $formatlist $bindlist $actionlist]
        lappend result "f$i#" [list [list 0 $end] $formatlist $bindlist $actionlist]
      }
    }
  }
  return $result
}


##############
## interpret pdraw features list
##############
proc pdraw_features_to_taglist {pdrawlist} {
  global info
  set result [list]
  set i 0
  set fwd_color cyan
  set rev_color cyan
  set type "misc_feature"
  if {[catch {set Apeinfo_gformat [dict get $info(feature_default_type_gformat) $type]}]} {
    set Apeinfo_gformat $info(feature_default_gformat)
  }
  set genbank_list [list]
  foreach ft $pdrawlist {
    foreach {name start end type orient} $ft {}
    incr start -1
    incr end -1
    set dir [expr {($orient == -1) ? 0:1}]
    if {$dir == 0} {
      set formatlist [list $fwd_color {} {}]
    } else {
      set formatlist [list $rev_color {} {}]
    }
    set bindlist [list <<Revcolors>> <<Metadata>>]
    set actionlist [list [list $fwd_color $rev_color] [list $name $Apeinfo_gformat $type $dir $genbank_list]]
    lappend result "f$i#" [list [list $start $end] $formatlist $bindlist $actionlist]
  }
  return $result
}

##############
## fill cascade menu for pieces menu
##############
proc file_pieces_open_and_insert_postcommand {w menu} {
  global info
  if {![info exists info(pieces_dir_list)]} {
    return
  }
  $menu delete 0 end
  set max 20
  set j 0

  foreach dir $info(pieces_dir_list) {
	set file_list [glob  $dir/*.{ape,gb,dna,seq}]
	if {[llength $info(pieces_dir_list)] > 1} {
	  if {[llength $file_list] > 0} {
		set smenu $menu.menu$j
		catch {destroy $smenu}
		menu $smenu
		$menu add cascade -label [file tail $dir] -menu $smenu
        incr j
	  } else {
	    continue
	  }
	} else {
	  set smenu $menu
	}
	if {[llength $file_list] <= $max} {
	  foreach filename $file_list {
		$smenu add command -label [file rootname [file tail $filename]] -command "file_pieces_open_and_insert $w {$filename}"
	  }
	} else {
	  for {set i 0} {$i < [llength $file_list]} {incr i} {
		if {[expr {$i %  $max}] == 0} {
		  if {[winfo exists $smenu.menu[expr {$i /  $max}]]} {
			set pmenu $smenu.menu[expr {$i /  $max}]
			$pmenu delete 0 end
		  } else {
			set pmenu [menu $smenu.menu[expr {$i /  $max}]]
		  }
		  $smenu add cascade -label "[expr {$i +1}] - [expr {min([llength $file_list], $i + $max)}]" -menu $pmenu
		}
		set filename [lindex $file_list $i]
		$pmenu add command -label [file rootname [file tail $filename]] -command "file_pieces_open_and_insert $w {$filename}"
	  }
	}
	$smenu add separator
	$smenu add command -label [mc "Remove Directory %1\$s" [file tail $dir]] -command "file_pieces_open_and_insert_rem_dir $w {$dir}"
  }
  $menu add separator
  $menu add command -label [mc "Add Directory"] -command "file_pieces_open_and_insert_add_dir $w"
}

##############
## add directory to pieces menu  
##############
proc file_pieces_open_and_insert_rem_dir {w dir} {
  global info
  set i [lsearch -exact $info(pieces_dir_list) $dir]
  set info(pieces_dir_list) [lreplace $info(pieces_dir_list) $i $i]
}

##############
## add directory to pieces menu  
##############
proc file_pieces_open_and_insert_add_dir {w} {
  global info
  set dir [tk_chooseDirectory]
  if {$dir ne {} && [file readable $dir] &&$dir ni $info(pieces_dir_list) } {
    lappend info(pieces_dir_list) $dir
  }
}

##############
## Insert piece into window
##############
proc file_pieces_open_and_insert {w filename} {
  global info
  
  if {[file_lock_check $w 1]} {return}
  
  if {[catch {open_file $filename 2} data]} {return}
  lassign $data newdna filename filecomment circular methylated startindex new_title new_tags genbank_header_info filetype graphic_format_dict seguid_dict
  if {$info($w,mol_type) eq "DNA"} {
    if {[is_RNA $newdna]} {
      regsub -all {U} $newdna "T" text
      regsub -all {u} $newdna "t" text
    }
  } elseif {$info($w,mol_type) eq "RNA"} {
    if {![is_RNA $newdna]} {
      regsub -all {T} $newdna "U" text
      regsub -all {t} $newdna "u" text
    }
  }

  set text [atgcfilter $newdna $info(allowedkeys) 1]

  if {$newdna == ""} return
  

  if {[llength [$w.textarea tag ranges sel]] > 0} {
    textarea_delete $w.textarea sel.first sel.last
  } 

  textarea_insert $w.textarea [$w.textarea index insert] $newdna
  
  set insert_first [bp2ix $w.textarea [expr {[ix2bp $w.textarea [$w.textarea index insert]]-[string length $newdna]}]] 
  set insert_last  [$w.textarea index insert]

  split_tags_after_insertion $w $insert_first $insert_last


  put_tags $w.textarea [list [bp2ix $w.textarea [expr {[ix2bp $w.textarea [$w.textarea index insert]]-[string length $newdna]}]] [$w.textarea index insert]] $new_tags
  
  post_validate_seguid $w
  register_undo_separator $w [mc "Insert Piece"]
  features_to_tree_view $w
 
  select_region $w [bp2ix $w.textarea [expr {[ix2bp $w.textarea [$w.textarea index insert]]-[string length $newdna]}]] insert
  vertindexbalancer $w
  
}

##############
## fill cascade menu for auto open and annotate  
##############
proc feature_library_open_and_annotate_postcommand {w menu} {
  global info fea_info
  
  $menu delete 0 end
  set max 20
  set found 0
  set file_list [glob -nocomplain  $info(default_featuredir)/*.txt]
  if {[llength $file_list] <= $max} {
    foreach filename $file_list {
      $menu add radiobutton -label [file rootname [file tail $filename]] -variable fea_info(library_file) -value $filename -command "feature_library_open_and_annotate $w {$filename}"
      if {$filename eq $fea_info(library_file)} {
        set found 1
      }
    }
  } else {
    for {set i 0} {$i < [llength $file_list]} {incr i} {
      if {[expr {$i %  $max}] == 0} {
        if {[winfo exists $menu.menu[expr {$i /  $max}]]} {
          set pmenu $menu.menu[expr {$i /  $max}]
          $pmenu delete 0 end
        } else {
          set pmenu [menu $menu.menu[expr {$i /  $max}]]
        }
        $menu add cascade -label "[expr {$i +1}] - [expr {min([llength $file_list], $i + $max)}]" -menu $pmenu
      }
      set filename [lindex $file_list $i]
      $pmenu add radiobutton -label [file rootname [file tail $filename]] -variable fea_info(library_file) -value $filename -command "feature_library_open_and_annotate $w {$filename}"
        if {$filename eq $fea_info(library_file)} {
        set found 1
      }
    }
  }
  if {!$found} {
    set filename $fea_info(library_file)
    $menu insert 0 radiobutton -label [file rootname [file tail $filename]] -variable fea_info(library_file) -value $filename -command "feature_library_open_and_annotate $w {$filename}"
  }
}

##############
##  auto open and annotate using filename
##############
proc feature_library_open_and_annotate {w filename} {
  global fea_info
  
  if {$filename ne $fea_info(library_file)} {
    set templibrary [read_feature_library $filename]
	if {[lindex $templibrary 0] == "invalid file" } {
	  tk_messageBox -message [mc "%1\$s\n is an improperly formatted feature library." $filename]  -type ok -icon error
	} elseif {$templibrary == "invalid filename"} {
	  tk_messageBox -message [mc "%1\$s\n is not readable." $filename]  -type ok -icon error
	} else {
	  set fea_info(library) $templibrary
	  if {[tk windowingsystem] == "win32"} {
		  regsub -all {\\} $filename {/} filename
	  }
      set fea_info(library_file) $filename
      feature_scan $w
    }
  } else {
    feature_scan $w
  }
}

##############
## reads a new feature library and stores the feature list in fea_info(library) 
##############
#file format(tab sep): (0)name (1)plain text def (2)type (3)fwd_color (4)rev_color (5)graphic_format (6)dna/prot search (7) annotations_string (qualifiers data) (8) groups list
#library list: (0)name (1)regexp_fwd(flanked by paren) (2)regexp_rev (3)preseq (4)postseq (5)plain_text_def (6)type (7)fwd_color (8)rev_color (9)graphic_format (10)dna/prot search (11)annotations_string (qualifiers data) (12) groups list
 ## use lindex 9 (previously bold) to search type (0=dna 1=protein)
proc open_feature_library {{filename ""} {mode "new"} {msg 1}} {

  global info
  global fea_info dialogblock
  if {$dialogblock == 1} {return}
  set dialogblock 1
  set error 1
  while {$error == 1} {
    if {($filename == "") || (![file exists $filename])} {
      set focus_win [focus]
      if {![file isdirectory $info(default_featuredir)]} {
        global argv0
        set info(default_featuredir) [file dirname $argv0]
      }
      set filename [tk_getOpenFile -initialdir $info(default_featuredir) -title [mc "open ApE Features file"] -filetypes {{{Text Files} {.txt}} {{Tab Separated Text} {.tsv}} {{All Files} *}}]
      if {([winfo exists $focus_win]) && ($focus_win != ".")} {
        wm deiconify [winfo toplevel $focus_win]
        focus $focus_win
      }
    }

    set templibrary [read_feature_library $filename]

    if {[lindex $templibrary 0] == "invalid file" } {
      if {$msg && [tk_messageBox -message [mc "%1\$s\n is an improperly formatted feature library.\n%2\$s\nTry another?" $filename [string range [lindex $templibrary 1] 0 200]] -type yesno -icon error -default yes] == "yes"} {
        set error 1; #try again
        set filename ""
      } else {
        set error -1; #cancel
      }
    } elseif {$templibrary == "invalid filename"} {
      if {($filename != "") && $msg && ([tk_messageBox -message [mc "%1\$s is not readable. \n%2\$s\nTry another?" $filename  $nextfea] -type yesno -icon error -default yes] == "yes")} {
        set error 1; #try again
        set filename ""
      } else {
        set error -1; #cancel
      }
    } else {
      set error 0
    }
  }
 ; #while error reading file
  if {$error == 0} {
    if {$mode == "new"} {
      set fea_info(library) $templibrary
      if {[tk windowingsystem] == "win32"} {
        regsub -all {\\} $filename {/} filename
      }
      set fea_info(library_file) $filename
      if {$msg} {
        tk_messageBox -message [mc "Read %1\$s features from %2\$s." [llength $templibrary] [file tail $filename]] -type ok -icon info
      }
    } else {
      lappend fea_info(library) $templibrary
      set fea_info(library_file) ""
    }

    if {$info(featuredir_follows_open)} {
      set info(default_featuredir) [file dirname $filename]
    }
  } 

  set dialogblock 0
}

##############
## reads a feature library and returns it as list 
##############
#file format(tab sep): (0)name (1)plain_text_def (2)type (3)fwd_color (4)rev_color (5)graphic_format (6)dna/prot search (7)annotations_string (qualifiers data)
#library list: (0)name (1)regexp_fwd(flanked by paren) (2)regexp_rev (3)preseq (4)postseq (5)plain_text_def (6)type (7)fwd_color (8)rev_color (9)graphic_format (10)dna/prot search (11)annotations_string (qualifiers data)
 ## use lindex 9 (previously bold) to search type (0=dna 1=protein)
proc read_feature_library {filename} {
  global info
    if {![catch {set fileid [open $filename r]}]} {
      set templibrary ""
      while {([eof $fileid] != 1)} {
        set nextline [gets $fileid]
        if {([string index $nextline 0] != "#") && ($nextline != "") && ([regexp {[^\s\t]} $nextline])} {
          set nextfea [split $nextline \t]
          if {([llength $nextfea] < 2) ||([llength $nextfea] > 8) || ([lindex nextfea 6] == 0 && ([regexp -nocase {[^ACGTNBDHKMRSUVWY\s\+\#<>0-9]} [lindex $nextfea 1]] == 1)) || ([lindex nextfea 6] == 1 && ([regexp -nocase {[^ACDEFGHIKLMNPQRSTVWXY*\[\]<>]} [lindex $nextfea 1]] == 1))} {
            close $fileid
            return [list "invalid file" $nextfea]
          } else {
            set nextfea [concat $nextfea [lrange {{} {} {} {} {}} 0 [expr {6-[llength $nextfea]}]]]

            ######set defaults here
            if {[lindex $nextfea 2] == ""} {set nextfea [lreplace $nextfea 2 2 "misc_feature"]}
            if {[lindex $nextfea 3] == ""} {set nextfea [lreplace $nextfea 3 3 $info(feature_default_fcolor)]}
            if {[lindex $nextfea 4] == ""} {set nextfea [lreplace $nextfea 4 4 $info(feature_default_rcolor)]}
            if {[catch {winfo rgb . [lindex $nextfea 3]}]} {sputs "bad fcolor name ([lindex $nextfea 0]):[lindex $nextfea 3]"; set nextfea [lreplace $nextfea 3 3 $info(feature_default_fcolor)]}
            if {[catch {winfo rgb . [lindex $nextfea 4]}]} {sputs "bad rcolor name($nextline):[lindex $nextfea 4]"; set nextfea [lreplace $nextfea 4 4 $info(feature_default_rcolor)]}
            # graphic format dict. (maybe add ital bool bold bool etc. for sequence formatting?)
            if {[lindex $nextfea 5] == 0} {set nextfea [lreplace $nextfea 5 5 {}]}
            if {[catch {dict values [lindex $nextfea 5]}]} {
              sputs bad graphic format dict: [lindex $nextfea 0]  [lindex $nextfea 5]
              set nextfea [lreplace $nextfea 5 5 {}]
            }
             # 0 =DNA, 1 = protein_with_intron, 2 = protein_no_intron
            if {[lindex $nextfea 6] ni {0 1 2}} {set nextfea [lreplace $nextfea 6 6 0]}

            ######set the regexp strings
            set regexpfwd [lindex $nextfea 1] 
            lassign [text_to_regexp [lindex $nextfea 1] [lindex $nextfea 2] [lindex $nextfea 6]] regexpfwd regexprev preseq postseq
            if {[string length [regsub -all -nocase {[^a-z]} $regexpfwd ""]] > 3} {
              #featurelib element:
              #(0)name (1)regexp_fwd(flanked by paren) (2)regexp_rev (3)preseq (4)postseq (5)plain_text_def (6)type (7)fwd_color (8)rev_color (9)graphic_format (10)dna/prot search (11)annotations_string (qualifiers data)
              if {$regexpfwd != $regexprev} {
                lappend templibrary [linsert $nextfea 1 $regexpfwd $regexprev $preseq $postseq]
              } else {
                lappend templibrary [linsert $nextfea 1 $regexpfwd "" $preseq $postseq]
              }
            } else {
              sputs "Feature too short:$nextline $regexpfwd"
            }
          }
        }
      }; #while not end of file
      close $fileid
      return $templibrary
    } else {
      #file doesn't exist
      return "invalid filename"
    }
}


##############
## lconvert text string to regexp preseq and posseq
## returns regexpfwd regexprev preseq postseq
##############
proc text_to_regexp {regexpfwd feature_type regexp_type} {
  ######set the regexp strings
  #for all lower case, set to all upper case
  if {![regexp {[A-Z]} $regexpfwd]} {set regexpfwd [string toupper $regexpfwd]}   
  if {![regexp {(.*)<(.*)} $regexpfwd a preseq regexpfwd]} {
    set preseq ""
    ######for primer sequences, set the preseq to all leading lower case chars
    if {$feature_type == "primer_bind"} {
      if {![regexp {^([a-z]+)(.*)} $regexpfwd -- preseq regexpfwd]} {
        set preseq ""
      }
      set regexpfwd [string toupper $regexpfwd]
    }
  }
  set preseq [string toupper $preseq]
  if {![regexp {(.*)>(.*)} $regexpfwd a regexpfwd postseq]} {set postseq ""}
  set postseq [string toupper $postseq]

  # 0 =DNA, 1 = protein_with_intron, 2 = protein_no_intron
  if {$regexp_type == 0} {
  ### DNA feature
    set regexpfwd "($regexpfwd)"
    regsub -all {\s} $regexpfwd "" regexpfwd
    regsub -all {[a-z]+} $regexpfwd ")&(" regexpfwd
    regsub -all {[nN]} $regexpfwd "." regexpfwd
    #remove duplicate + and #
    regsub -all {\++} $regexpfwd "+" regexpfwd
    regsub -all {[\+\#][\+\#]+} $regexpfwd "#" regexpfwd
    #remove leading and trailing # and +
    regsub -all {^\+} $regexpfwd "" regexpfwd
    regsub -all {^\#} $regexpfwd "" regexpfwd
    regsub -all {\+$} $regexpfwd "" regexpfwd
    regsub -all {\#$} $regexpfwd "" regexpfwd
    #convert # and + to .*?
    regsub -all {\+} $regexpfwd ").*?(" regexpfwd
    regsub -all {\#} $regexpfwd ".*?" regexpfwd
    #remove empty parens
    regsub -all {\(\)} $regexpfwd "" regexpfwd

    #substitute degenerate codes
    set regexpfwd [regsubpattern $regexpfwd]
    #make the reverse pattern
    set regexprev [revcom_regexp $regexpfwd]
    regsub -all {\?\*\.} $regexprev .*? regexprev
  } elseif {$regexp_type in [list 1 2]} { 
    # 0 =DNA, 1 = protein_with_intron, 2 = protein_no_intron
    ## Protein sequence- requires all uppercase, can include ONLY [ACYG] aa groups (NOT [^ACYG], use the inverse of the group instead). X is converted to [ACDEFGHIKLMNPQRSTVWY] for use in string match
    ## preseq/postseq can be string of aa, or -#. -# indicates a leading sequence that gets removed from the match after the find is completed
    ## preseq/postseq a string of aa &<  or >& means stretch the sequence until the first time the tail sequence matches, without a stop codon 
    if {$regexp_type in [list 2]} {
      ## no_intron proteins can use (aa_list) instead of [aa_list], with the aa being o or 1 instance of the aa
      regsub -all {\(X\)} $regexpfwd {[ACDEFGHIKLMNPQRSTVWY]?} regexpfwd
      regsub -all {\(} $regexpfwd {[} regexpfwd
      regsub -all {\)} $regexpfwd {]?} regexpfwd
    }
    regsub -all {X} $regexpfwd {[ACDEFGHIKLMNPQRSTVWY]} regexpfwd
    if {[llength [set regexpfwd [regexp -all -inline {[\?ACDEFGHIKLMNPQRSTVWY*]|\[[ACDEFGHIKLMNPQRSTVWY*]+\]\??} $regexpfwd]]] == 0} {
      set regexpfwd {}
      set preseq {}
      set postseq {}
    } else {
      regsub -all {\*} $regexpfwd {\*} regexpfwd
      set regexprev [lreverse $regexpfwd]
      regsub -all {\*} $regexprev {\*} regexprev
      regsub -all {X} $preseq  {[ACDEFGHIKLMNPQRSTVWY]} preseq
      if {[regexp {\-[0-9]+}  $preseq]} {
      } elseif {[llength [set preseq [regexp -all -inline {[\?\&ACDEFGHIKLMNPQRSTVWY*]|\[[ACDEFGHIKLMNPQRSTVWY*]+\]} $preseq]]] == 0} {
        set preseq {}
      }
      regsub -all {X} $postseq {[ACDEFGHIKLMNPQRSTVWY]} postseq
      if {[regexp {\-[0-9]+}  $postseq]} {
      } elseif {[llength [set postseq [regexp -all -inline {[\?\&ACDEFGHIKLMNPQRSTVWY*]|\[[ACDEFGHIKLMNPQRSTVWY*]+\]} $postseq]]] == 0} {
        set postseq {}
      }
    }
  }
  if {[catch {regexp $regexpfwd ""}] || [catch {regexp $regexprev ""} err]} {
    return [list "" "" "" ""]
  } else {
    return [list $regexpfwd $regexprev $preseq $postseq]
  }
}

##############
## lists feature tags found in a DNA window 
##############
proc list_features {w {text_only 0}} {
  global info toolbar_images
  global modstring modifier dialogblock
  if {($text_only == 0)} {
    if {($dialogblock == 1)} {return}
    set dialogblock 1
  }

#set t $a.textframe.text
#$t image create 7.0 -image $toolbar_images(button_info)
#$t tag add 7.0 7.0 button_tag
#$t tag bind button_tag <Enter> "$t configure -cursor arrow"
#$t tag bind button_tag <Leave> "$t configure -cursor xterm"

  if {!$text_only} {
    set a [new_analysis_window $w "Features List" features_list]
    create_textframe $a 80

    set colwidth0 20
    set colwidth1 20
    set colwidth2 20

    catch {$a.textframe.text insert end "[clock format [clock seconds] -format $info(clock_format)]\n"}
    $a.textframe.text insert end "[wm title $w] \n"
    $a.textframe.text insert end "$info($w,filename) \n"
    $a.textframe.text insert end "Features List\n\n"


    $a.textframe.text insert end [format "%-*s%-*s%-*s\n" $colwidth0 [mc "Name"] $colwidth1 [mc "type"] $colwidth2 [mc "location"]] heading
    $a.textframe.text tag configure heading -underline true
  }
  set result ""

  foreach tag [$w.textarea tag names] {
    if {([regexp {f[0-9]+#} $tag]) && ([llength [$w.textarea tag ranges $tag]] > 1)} {

      set metadata [$w.textarea tag bind $tag <<Metadata>>]

      set loc [feature_coords_text $w $tag]
      set direction [expr {[lindex $metadata 3]?"rev:":""}]


  ##use get_feature_exons_indexes
      set fn_tagrange [$w.textarea tag ranges [regsub f $tag fn]]
      if {[llength $fn_tagrange] > 0} {
        if {[llength $fn_tagrange] > 2} {
          set x1 [lindex $fn_tagrange 2]
          set x2 [lindex $fn_tagrange 3]
        } else {
          set x1 [lindex $fn_tagrange 0]
          set x2 [lindex $fn_tagrange 1]
        }
      } else {
        if {[llength [$w.textarea tag ranges $tag]] > 2} {
          set x1 [lindex [$w.textarea tag ranges $tag] 2]
          set x2 [lindex [$w.textarea tag ranges $tag] 3]
        } else {
          set x1 [lindex [$w.textarea tag ranges $tag] 0]
          set x2 [lindex [$w.textarea tag ranges $tag] 1]
        }
      }
      if {!$text_only} {
        $a.textframe.text insert end [format "%-*s%-*s%-*s\n" $colwidth0 [lindex $metadata 0] $colwidth1 [lindex $metadata 2] $colwidth2 "$direction$loc"] $tag
        $a.textframe.text tag bind $tag <Button-1> "select_region $w \[bp2ix $w.textarea [ix2bp $w.textarea $x1]\] \[bp2ix $w.textarea [ix2bp $w.textarea $x2]\]"
        lappend info($w,linked_events) [list $a.textframe.text $tag <Button-1>]
        $a.textframe.text tag bind $tag <Any-Enter> "%W tag configure $tag -foreground red; %W tag raise $tag sel"
        $a.textframe.text tag bind $tag <Any-Leave> "%W tag configure $tag -foreground black; %W tag lower $tag sel"
      } else {
        set result "$result[lindex $metadata 0]\t[lindex $metadata 2]\t$direction$loc\n"
      }
    }
  }

  if {!$text_only} {
    set outputmenu [add_output_menu $a.textframe.text "Text" text $w]
    bind $a <Button-1> "focus $a.textframe.text" 
    bindtags $a.textframe.text [list $a.textframe.text AnalysisText $a . all]
    wm deiconify $a
    if {[info exists info(last_analysis_xy)]} {
      wm geometry [winfo toplevel $a] [textbox_geometry $a.textframe.text {*}$info(last_analysis_xy)]
    } else {
      scan [wm geometry [winfo toplevel $a]] "%dx%d+%d+%d" w h x y
      wm geometry [winfo toplevel $a] [textbox_geometry $a.textframe.text $x $y]
    }
    $a.textframe.text configure -state disabled
    window_on_screen $a
    focus $a.textframe.text
  }
  if {($text_only == 0)} {
    set dialogblock 0
  }
  return $result
}

##############
## edit a feature element
##############
#file format(tab sep): (0)name (1)plain_text_def (2)type (3)fwd_color (4)rev_color (5)bold (6)graphic_format (7)annotations_string (qualifiers data)
#library list: (0)name (1)regexp_fwd(flanked by paren) (2)regexp_rev (3)preseq (4)postseq (5)plain_text_def (6)type (7)fwd_color (8)rev_color (9)graphic_format (10)dna/prot search (11)annotations_string (qualifiers data)
 ## use lindex 9 (previously bold) to search type (0=dna 1=protein)
proc edit_feature_in_library {w feature_number} {
  global info temp_info temp_colors fea_info ok2 dialogblock clip_sel genbank_typelist genbank_divided_typelist
  if {$dialogblock == 1 || [winfo exists .edit_feature_dialog]} {return}
  set dialogblock 1

  set temp_info(name) [lindex [lindex $fea_info(library) $feature_number] 0]
  set temp_info(regexp) [lindex [lindex $fea_info(library) $feature_number] 5]
  set temp_info(fwd_color) [lindex [lindex $fea_info(library) $feature_number] 7]
  set temp_info(rev_color) [lindex [lindex $fea_info(library) $feature_number] 8]
  set temp_info(type) [lindex [lindex $fea_info(library) $feature_number] 6]
  set temp_info(feature_type) [lindex [lindex $fea_info(library) $feature_number] 10]
  if {$temp_info(feature_type) eq {}} {set temp_info(feature_type) 0}
  set temp_info(notes) [lindex [lindex $fea_info(library) $feature_number] 11]
  array set temp_colors $info(feature_default_type_colors)

  set a [toplevel .edit_feature_dialog]
  wm title $a [mc "Edit Feature Definition..."]
  wm protocol $a WM_DELETE_WINDOW "set ok2 -1"
  bind $a <KeyPress-Escape>  "set ok2 -1"
  set raisedialogstore [bind . <<RaiseDialogs>>]
  bind . <<RaiseDialogs>> "wm deiconify $a; raise $a"
  regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $w] wgeom winx winy
  wm geometry [winfo toplevel $a] "+[expr (($winx<0)?0:$winx)+3]+[expr (($winy<0)?0:$winy)+50]"
  wm transient $a $w
  if {[tk windowingsystem] == "aqua"} {
    ::tk::unsupported::MacWindowStyle style $a document {closeBox}
  }
  set ok2 0

  grid [frame $a.textframe -relief ridge -borderwidth 2] -row 0 -column 1 -sticky nswe
  grid [frame $a.infoframe -relief ridge -borderwidth 2] -row 1 -column 1 -sticky nswe
  grid [frame $a.okframe -relief ridge -borderwidth 2] -row 2 -column 1 -columnspan 2 -sticky nswe
  grid rowconfigure $a 0 -weight 1
  grid rowconfigure $a 1 -weight 0
  grid rowconfigure $a 2 -weight 0
  grid columnconfigure $a 1 -weight 1

  grid [entry $a.textframe.name -textvariable temp_info(name) -font dnafont -width 50] -row 0 -column 0 -columnspan 2 -sticky nwe

  grid [text $a.textframe.regexp -height 10 -width 50 -wrap char -yscrollcommand "optionscrollbar $a.textframe.scroll" -font dnafont] -row 1 -column 0 -sticky nswe
  grid [scrollbar $a.textframe.scroll -command "$a.textframe.regexp yview"] -row 1 -column 1 -sticky nse
  grid [frame $a.textframe.dna_buttons] -row 2 -column 0 -columnspan 2 -sticky nswe
  grid [button $a.textframe.dna_buttons.upper -text [mc "Uppercase"] -command "event generate $a.textframe.regexp <<toupper>>"] -row 0 -column 0 -sticky ns
  grid [button $a.textframe.dna_buttons.lower -text [mc "Lowercase"] -command "event generate $a.textframe.regexp <<tolower>>"] -row 0 -column 1 -sticky ns
  grid [button $a.textframe.dna_buttons.lowertoplus -text [mc "Lowercase to +"] -command "event generate $a.textframe.regexp <<lowertoplus>>"] -row 0 -column 2 -sticky ns
  grid [button $a.textframe.dna_buttons.makeaa -text [mc "Make AA seq"] -command "event generate $a.textframe.regexp <<makeaa>>"] -row 0 -column 3 -sticky ns

  grid [frame $a.textframe.aa_buttons] -row 2 -column 0 -columnspan 2 -sticky nswe
  grid [checkbutton $a.textframe.aa_buttons.intron  -text [mc "Scan with introns"] -variable temp_info(aa_intron) -onvalue 1 -offvalue 0 -selectcolor white ] -row 0 -column 2 -sticky nsw
  grid [label $a.textframe.aa_buttons.makeaa -text [mc "Amino acid sequence"] ] -row 0 -column 1 -sticky nsw

  if {$temp_info(feature_type) != 0} {
    ## non-DNA type
    grid remove $a.textframe.dna_buttons
    if {$temp_info(feature_type) == 2} {
      set temp_info(aa_intron) 1
    } else {
      set temp_info(aa_intron) 0
    }
  } else {
    grid remove $a.textframe.aa_buttons
  }

  grid rowconfigure $a.textframe 1 -weight 1
  grid columnconfigure $a.textframe 0 -weight 1

  $a.textframe.regexp insert 1.0 $temp_info(regexp)

  grid [label $a.infoframe.label1 -text [mc "Feature type:"]] -row 0 -column 1
  grid [menubutton $a.infoframe.type -menu $a.infoframe.type.menu -textvariable temp_info(type) -font labelfont -width 10] -row 0 -column 2
  grid [label $a.infoframe.label2 -text [mc "Forward color:"]] -row 1 -column 1
  grid [color_button $a.infoframe.fwdcolor temp_info(fwd_color) 12] -sticky w -row 1 -column 2
  grid [label $a.infoframe.label3 -text [mc "Reverse color:"]] -row 1 -column 3
  grid [color_button $a.infoframe.revcolor temp_info(rev_color) 12] -sticky w -row 1 -column 4
  grid [button $a.infoframe.revcolor_same -text [mc "Same"] -command "set temp_info(rev_color) \$temp_info(fwd_color)"] -sticky w -padx 5 -row 1 -column 5
  #grid [menubutton $a.infoframe.favs -menu $a.infoframe.favs.menu -text [mc "Favorites"] -width 10] -sticky w -padx 5 -row 1 -column 6
 # menu $a.infoframe.favs.menu
  #fill_favs_menu $a $a.infoframe.favs.menu temp_info(fwd_color) temp_info(rev_color)

  #trace add variable info(feature_color_favorites) write "fill_favs_menu $a $a.infoframe.favs.menu temp_info(fwd_color) temp_info(rev_color);# "
 # trace add variable temp_info(fwd_color) write  "if {\[info exists temp_colors(\$temp_info(type))\]} {set temp_colors(\$temp_info(type)) \[list \$temp_info(fwd_color) \[lindex \$temp_colors(\$temp_info(type)) 1\]\]} else {set temp_colors(\$temp_info(type)) \[list \$temp_info(fwd_color) \$temp_info(rev_color)\]} ;#"
 # trace add variable temp_info(rev_color) write "if {\[info exists temp_colors(\$temp_info(type))\]} {set temp_colors(\$temp_info(type)) \[list \[lindex \$temp_colors(\$temp_info(type)) 0\] \$temp_info(rev_color)\]} else {set temp_colors(\$temp_info(type)) \[list \$temp_info(fwd_color) \$temp_info(rev_color)\]} ;#"

  grid [button $a.okframe.ok -text [mc "OK"] -command "set ok2 1"] -row 0 -column 0

  menu $a.infoframe.type.menu


  foreach {header types} $genbank_divided_typelist {
    $a.infoframe.type.menu add cascade -label $header -menu [menu $a.infoframe.type.menu.[string tolower $header]]
    foreach type $types {
      if {[string index $type 0] eq "-"} {set typelabel " $type"} else {set typelabel $type}
      $a.infoframe.type.menu.[string tolower $header] add radiobutton -label $typelabel -variable temp_info(type) -value $type -command "if {\[info exists temp_colors($type)\]} {set temp_info(fwd_color) \[lindex \$temp_colors($type) 0\]; set temp_info(rev_color) \[lindex \$temp_colors($type) 1\]} else {set temp_info(fwd_color) $info(feature_default_fcolor); set temp_info(rev_color) $info(feature_default_rcolor); set temp_colors($type) \[list $info(feature_default_fcolor) $info(feature_default_rcolor)\]}"
    }
  }
  if {[lsearch -exact $genbank_typelist $temp_info(type)] == -1} {
    $a.infoframe.type.menu add radiobutton -label $temp_info(type) -variable temp_info(type) -value $temp_info(type) -command "if {\[info exists temp_colors($type)\]} {set temp_info(fwd_color) \[lindex \$temp_colors($type) 0\]; set temp_info(rev_color) \[lindex \$temp_colors($type) 1\]} else {set temp_info(fwd_color) $info(feature_default_fcolor); set temp_info(rev_color) $info(feature_default_rcolor); set temp_colors($type) \[list $info(feature_default_fcolor) $info(feature_default_rcolor)\]}"
  }
  regexp {([0-9]*)x([0-9]*)\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry [winfo toplevel $a]] wgeom winw winh winx winy
  if {[expr {$winx+$winw}] > [winfo screenwidth .]} {set winx [expr {[winfo screenwidth .]-$winw}]}
  if {$winx < 0} {set winx 0}
  if {[expr {$winy+$winh}] > [winfo screenheight .]} {set winy [expr {[winfo screenheight .]-$winh}]}
  if {$winy < 0} {set winy 0}
  wm geometry [winfo toplevel $a] "+$winx+$winy"

  bind $a.textframe.regexp <<makeaa>> "
    grid remove $a.textframe.dna_buttons
    grid configure $a.textframe.aa_buttons
    set temptext \[$a.textframe.regexp get 1.0 end\] 
     $a.textframe.regexp delete 1.0 end
     regsub -all {\[^A-Za-z\]+} \$temptext {} temptext
     $a.textframe.regexp insert 1.0 \[translate \$temptext\]   
     set temp_info(feature_type) 1  
  "

  bind $a.textframe.regexp <<toupper>> "
    if {\[$a.textframe.regexp tag ranges sel\] != {}} {
      set temptext \[$a.textframe.regexp get sel.first sel.last\] 
      $a.textframe.regexp delete sel.first sel.last
# selection used here
      $a.textframe.regexp insert insert \[string toupper \$temptext\]
      $a.textframe.regexp tag add sel insert-\[string length \$temptext\]char insert
      unset temptext
    }
  "
  bind $a.textframe.regexp <<tolower>> "
    if {\[$a.textframe.regexp tag ranges sel\] != {}} {
      set temptext \[$a.textframe.regexp get sel.first sel.last\] 
      $a.textframe.regexp delete sel.first sel.last
# selection used here
      $a.textframe.regexp insert insert \[string tolower \$temptext\]
      $a.textframe.regexp tag add sel insert-\[string length \$temptext\]char insert
      unset temptext
    }
  "

  bind $a.textframe.regexp <<lowertoplus>> "
    set temptext \[$a.textframe.regexp get 1.0 end\]
    $a.textframe.regexp delete 1.0 end
    $a.textframe.regexp insert 1.0 \[regsub -all {\[a-z\\s\]+} \$temptext +\]
    unset temptext
  "

  bind $a.textframe.regexp <<aa_toupper>> "
    if {\[$a.textframe.regexp tag ranges sel\] != {}} {
      set temptext \[$a.textframe.regexp get sel.first sel.last\] 
      $a.textframe.regexp delete sel.first sel.last
# selection used here
      $a.textframe.regexp insert insert \[string toupper \$temptext\]
      $a.textframe.regexp tag add sel insert-\[string length \$temptext\]char insert
      unset temptext
    }
  "
  bind $a.textframe.regexp <<aa_tolower>> "
    if {\[$a.textframe.regexp tag ranges sel\] != {}} {
      set temptext \[$a.textframe.regexp get sel.first sel.last\] 
      $a.textframe.regexp delete sel.first sel.last
# selection used here
      $a.textframe.regexp insert insert \[string tolower \$temptext\]
      $a.textframe.regexp tag add sel insert-\[string length \$temptext\]char insert
      unset temptext
    }
  "

  bind $a.textframe.regexp <<Paste>> "
    if {!\[catch {::tk::GetSelection $a.textframe.regexp CLIPBOARD} clip_sel\]} {
      if {\[tk windowingsystem\] ne \"x11\"} {
        catch {$a.textframe.regexp delete sel.first sel.last}
      }
      # selection used here
      regsub -all -nocase {\[^ACGTNBDHKMRSUVWY\\+\\#<>\]} \$clip_sel \"\" clip_sel
      $a.textframe.regexp insert insert \$clip_sel
    }
   break
  "

  focus $a
  $a.textframe.name selection range 0 end
  focus $a.textframe.name
  set continue 1

  while {$continue} {

    vwait ok2
    ###execute changes
    if {$ok2 == 1} {
      set featuretext [$a.textframe.regexp get 1.0 end]
      regsub -all "\ +" $featuretext "" featuretext 
      regsub -all "\n+" $featuretext "" featuretext 
      set regexpfwd $featuretext
      if {$temp_info(feature_type) == 1 &&  $temp_info(aa_intron)} {
        set temp_info(feature_type) 2
      }
      lassign [text_to_regexp $regexpfwd  $temp_info(type) $temp_info(feature_type)]  regexpfwd regexprev preseq postseq

      if {[string length [regsub -all -nocase {[^a-z]} $regexpfwd ""]] > 3} {
        #featurelib element:
        #(0)name (1)regexp_fwd(flanked by paren) (2)regexp_rev (3)preseq (4)postseq (5)plain_text_def (6)type (7)fwd_color (8)rev_color (9)graphic_format (10)dna/prot search (11)annotations_string (qualifiers data)
        if {$regexpfwd != $regexprev} {
          set newfea [list $temp_info(name) $regexpfwd $regexprev $preseq $postseq $featuretext $temp_info(type) $temp_info(fwd_color) $temp_info(rev_color) 0 $temp_info(feature_type) ""]
        } else {
          set newfea [list $temp_info(name) $regexpfwd "" $preseq $postseq $featuretext $temp_info(type) $temp_info(fwd_color) $temp_info(rev_color) 0 $temp_info(feature_type) ""]
        }
        #sputs $newfea
        set fea_info(library) [lreplace [K $fea_info(library) [set fea_info(library) {}]] $feature_number $feature_number $newfea]
        set return "ok"
        set continue 0
      } elseif {"$preseq$regexpfwd$postseq" eq ""} {
        set return "cancel"
        set continue 0
      } else {
        bell
        tk_messageBox -message [mc "%s isn't valid, try again." "$preseq<$regexpfwd>$postseq"] -icon warning -type ok 
        set ok2 0
        set continue 1
      }
    } else {
      set return "cancel"
      set continue 0
    }
  }


  set dialogblock 0
  destroy $a
  bind . <<RaiseDialogs>> $raisedialogstore
  bind $w <FocusIn> ""
  bind $w <Map> ""
  bind $w <Activate> ""
  trace remove variable info(feature_color_favorites) write "fill_favs_menu $a $a.infoframe.favs.menu temp_info(fwd_color) temp_info(rev_color);# "
  trace remove variable temp_info(fwd_color) write  "if {\[info exists temp_colors(\$temp_info(type))\]} {set temp_colors(\$temp_info(type)) \[list \$temp_info(fwd_color) \[lindex \$temp_colors(\$temp_info(type)) 1\]\]} else {set temp_colors(\$temp_info(type)) \[list \$temp_info(fwd_color) \$temp_info(rev_color)\]} ;#"
  trace remove variable temp_info(rev_color) write "if {\[info exists temp_colors(\$temp_info(type))\]} {set temp_colors(\$temp_info(type)) \[list \[lindex \$temp_colors(\$temp_info(type)) 0\] \$temp_info(rev_color)\]} else {set temp_colors(\$temp_info(type)) \[list \$temp_info(fwd_color) \$temp_info(rev_color)\]} ;#"
  set info(feature_default_type_colors) [array get temp_colors]

  unset -nocomplain ok2 clip_sel
  array unset temp_info 
  array unset temp_colors
  set return $return
}

##############
## adds selected DNA to curent feature library via edit_feature
##############
#library list: (0)name (1)regexp_fwd(flanked by paren) (2)regexp_rev (3)preseq (4)postseq (5)plain_text_def (6)type (7)fwd_color (8)rev_color (9)graphic_format (10)dna/prot search (11)annotations_string (qualifiers data)

proc add_sel_feature_library {w} {
  global info fea_info dialogblock
  if {$dialogblock == 1} {return}
  set dialogblock 1

  if {[$w.textarea tag ranges sel] != {}} {
    set text [textarea_get $w.textarea sel.first sel.last]
#selection used here 
    set regexpfwd $text
    regsub -all {[a-z]+} $regexpfwd ")&(" regexpfwd
    regsub -all {[nN\*]} $regexpfwd "." regexpfwd
    regsub -all {\(\)} $regexpfwd "" regexpfwd
    set regexpfwd [regsubpattern $regexpfwd]
    set regexprev [revcom_regexp $regexpfwd]
    regsub -all {\?\*\.} $regexprev .*? regexprev
  } else {
    set text ""
    set regexpfwd ""
    set regexprev ""
  }
  set new_fea [list "New Feature" "($regexpfwd\)" "($regexprev\)" "" "" $text "misc_feature" $info(feature_default_fcolor) $info(feature_default_rcolor) 0 0 {}]
  set dialogblock 0
  edit_feature_library $w $new_fea
}



##############
## edit, import and save curent feature library
##############
#library list: (0)name (1)regexp_fwd(flanked by paren) (2)regexp_rev (3)preseq (4)postseq (5)plain_text_def (6)type (7)fwd_color (8)rev_color (9)graphic_format (10)dna/prot search (11)annotations_string (qualifiers data)
proc edit_feature_library {w {new_fea ""}} {
#new
#import
#save as
  global info fea_info new_fea_global new_fea_window_global
  global ok
  global mem deleted dialogblock
  if {$dialogblock == 1} {return}
  set dialogblock 1

  toplevel .dialog
  wm title .dialog [mc "Edit Feature Library..."]
  wm protocol .dialog WM_DELETE_WINDOW "set ok -1"
  bind .dialog <KeyPress-Escape>  "set ok -1"

  bind . <<RaiseDialogs>> "wm deiconify .dialog; raise .dialog"
  bind .dialog <FocusIn> "event generate . <<RaiseDialogs>>"
  bind .dialog <Map> "event generate . <<RaiseDialogs>>"
  bind .dialog <Activate> "event generate . <<RaiseDialogs>>"

  regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $w] wgeom winx winy
  wm geometry .dialog "+[expr (($winx<0)?0:$winx)+3]+[expr (($winy<0)?0:$winy)+50]"
  wm transient .dialog $w
  if {[tk windowingsystem] == "aqua"} {
    #::tk::unsupported::MacWindowStyle style .dialog document {closeBox resizable}
    ::tk::unsupported::MacWindowStyle style .dialog document {closeBox horizontalZoom verticalZoom}
  }
  set ok 0

  set library_store $fea_info(library)

  #menu .dialog.menubar
  #menu .dialog.menubar.librarymenu
  #  .dialog.menubar add cascade -menu .dialog.menubar.librarymenu -label [mc "Library"]
  #  .dialog.menubar.librarymenu add command -label [mc "Import Features from Feature File"]  -state disabled  -command "bell"
  #  .dialog.menubar.librarymenu add command -label [mc "Import Features from DNA Sequence"]  -state disabled  -command "bell"
  #  .dialog.menubar.librarymenu add command -label [mc "Save As..."] -command "set dialogblock 0; save_feature_library; set dialogblock 1"

  #.dialog configure -menu .dialog.menubar

  #if {[tk windowingsystem] == "aqua"} {
    #define the apple menu
    #menu .dialog.menubar.apple
    #.dialog.menubar add cascade -menu .dialog.menubar.apple
    #.dialog.menubar.apple add command -label [mc "About ApE"] -command "about_dialog $w" -state disabled
    #.dialog.menubar.apple add separator
    #.dialog.menubar.apple add command -label [mc "Preferences..."]  -command "configure_preferences $w" -state disabled 
  #}


  grid [frame .dialog.frame1 -relief flat] -row 0 -column 0 -sticky nswe
  grid [listbox .dialog.frame1.list -yscrollcommand "optionscrollbar .dialog.frame1.scroll" -selectmode extended -activestyle none -background white] -row 0 -column 0 -sticky nswe
  grid [scrollbar .dialog.frame1.scroll -command ".dialog.frame1.list yview"] -row 0 -column 1 -sticky nse
  grid rowconfigure .dialog.frame1 0 -weight 1
  grid columnconfigure .dialog.frame1 0 -weight 1
  grid columnconfigure .dialog.frame1 1 -weight 0
  grid [frame .dialog.frame2 -relief ridge -borderwidth 2] -row 1 -column 0 -sticky swe
  grid [button .dialog.frame2.selall -text [mc "Select All"] -command "event generate .dialog <<sel_all>>"] -row 0 -column 0 -sticky we
  grid [button .dialog.frame2.raise -text [mc "Raise"] -command "event generate .dialog <<raise>>"] -row 0 -column 1 -sticky we
  grid [button .dialog.frame2.lower -text [mc "Lower"] -command "event generate .dialog <<lower>>"] -row 0 -column 2 -sticky we
  grid [button .dialog.frame2.delete -text [mc "Delete"] -command "event generate .dialog <<delete>>"] -row 0 -column 3 -sticky we
  grid [button .dialog.frame2.edit -text [mc "Edit"] -command "
    if {\[.dialog.frame1.list curselection\] != {}} {
      set dialogblock 0
      set pointer \[lindex \[.dialog.frame1.list curselection\] 0 \]
      edit_feature_in_library .dialog \$mem(\$pointer)
      set dialogblock 1
      .dialog.frame1.list delete \$pointer
      .dialog.frame1.list insert \$pointer \[lindex \[lindex \$fea_info(library) \$mem(\$pointer)] 0\]
      .dialog.frame1.list itemconfigure \$pointer -background \[lindex \[lindex \$fea_info(library) \$mem(\$pointer)] 7\]
      .dialog.frame1.list selection set \$pointer
      unset pointer
    }
  "] -row 0 -column 4 -sticky we
  #grid [button .dialog.frame2.new -text [mc "New"] -command "event generate .dialog <<new>>"] -row 0 -column 5 -sticky we
  grid [menubutton .dialog.frame2.new -text [mc "New..."] -menu .dialog.frame2.new.menu] -row 0 -column 5 -sticky we
  menu .dialog.frame2.new.menu
  .dialog.frame2.new.menu add command -label [mc "New Blank Feature"] -command "event generate .dialog <<new>>"
  foreach win [dnawindows_list 1] {
    .dialog.frame2.new.menu add  cascade -menu [menu .dialog.frame2.new.menu$win] -label [file rootname [wm title $win]]
    ".dialog.frame2.new.menu$win" add command -label [mc "New Features From Selected"] -command  "set new_fea_window_global $win; event generate .dialog <<new_from_sequence_selected>>"
    ".dialog.frame2.new.menu$win" add command -label [mc "New Features From All"] -command  "set new_fea_window_global $win; event generate .dialog <<new_from_sequence_all>>"
  }

  grid [frame .dialog.frame3 -relief raised] -row 2 -column 0 -sticky swe
  grid [button .dialog.frame3.ok -text [mc "Save Changes"] -command "set ok 1" -default active] -row 0 -column 0 -padx 5 -pady 3 -sticky we
  bind .dialog <Key-Return> "set ok 1"
  grid [button .dialog.frame3.ok_scan -text [mc "Save Changes As..."] -command "set ok 2"] -row 0 -column 1 -padx 5 -pady 3 -sticky we
  grid [button .dialog.frame3.cancel -text [mc "Cancel"] -command "set ok -1"] -row 0 -column 2 -padx 5 -pady 3 -sticky we
  grid [checkbutton .dialog.frame3.scan -text [mc "Scan on Close"] -variable info(feature_scan_on_close) -onvalue 1 -offvalue 0 -selectcolor white] -row 0 -column 3 -padx 5 -pady 3 -sticky we
  grid [label .dialog.filelabel -textvariable fea_info(library_file) -justify right -width 50] -row 3 -column 0 -sticky new
  grid rowconfigure .dialog 0 -weight 1
  grid rowconfigure .dialog 1 -weight 0
  grid rowconfigure .dialog 2 -weight 0
  grid columnconfigure .dialog 0 -weight 1

  #bind .dialog.frame1.list <Shift-Button-1> {listbox_multiple %W [%W index @%x,%y];break}
  #bind .dialog.frame1.list <Button-1> {bell; .dialog.frame1.list selection clear 0 end; .dialog.frame1.list selection set [%W index @%x,%y]}

  bind .dialog.frame1.list <Double-Button-1> "
    if {\[.dialog.frame1.list curselection\] != {}} {
      set dialogblock 0
      set pointer \[lindex \[.dialog.frame1.list curselection\] 0 \]
      edit_feature_in_library .dialog \$mem(\$pointer)
      set dialogblock 1
      .dialog.frame1.list delete \$pointer
      .dialog.frame1.list insert \$pointer \[lindex \[lindex \$fea_info(library) \$mem(\$pointer)] 0\]
      .dialog.frame1.list itemconfigure \$pointer -background \[lindex \[lindex \$fea_info(library) \$mem(\$pointer)] 7\]
      .dialog.frame1.list selection set \$pointer
      unset pointer
    }
  "



  regexp {([0-9]*)x([0-9]*)\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry .dialog] wgeom winw winh winx winy
  if {[expr {$winx+$winw}] > [winfo screenwidth .]} {set winx [expr {[winfo screenwidth .]-$winw}]}
  if {$winx < 0} {set winx 0}
  if {[expr {$winy+$winh}] > [winfo screenheight .]} {set winy [expr {[winfo screenheight .]-$winh}]}
  if {$winy < 0} {set winy 0}
  wm geometry .dialog "+$winx+$winy"
  update idletasks
  focus .dialog.frame1.list


  bind .dialog <<fill_list>> {
    array unset mem
    set i 0
    #set i [expr {[llength $fea_info(library)]-1}]
    set n 0
    foreach feature $fea_info(library) {
      .dialog.frame1.list insert end [lindex $feature 0]
      .dialog.frame1.list itemconfigure end -background [lindex $feature 7]
      set mem($i) $n
      incr i 1
      incr n 1
    }
    set feature ""
    unset n i feature
    set deleted [list]
    .dialog.frame1.list selection set 0
    .dialog.frame1.list selection anchor 0
  }

  bind .dialog <<sel_all>> {
    .dialog.frame1.list selection set 0 end
    .dialog.frame1.list selection anchor 0
  }

  bind .dialog <<raise>> {
    foreach i [.dialog.frame1.list curselection] {
      if {$i > 0} {
        set nstore [.dialog.frame1.list get $i]
        set cstore [.dialog.frame1.list itemcget $i -background]
        .dialog.frame1.list delete $i
        set tstore $mem($i)
        set mem($i) $mem([expr {$i-1}])
        incr i -1
        .dialog.frame1.list insert $i $nstore
        .dialog.frame1.list itemconfigure $i -background $cstore       
        set mem($i) $tstore
        .dialog.frame1.list selection set $i
        unset nstore cstore tstore
      }

    }
    if {[.dialog.frame1.list curselection] != {}} {
      .dialog.frame1.list see [lindex [.dialog.frame1.list curselection] 0]
      unset i
    }

  } 

  bind .dialog <<lower>> {
    for {set j [expr {[llength [.dialog.frame1.list curselection]]-1}]} {$j > -1} {incr j -1} {
      set i [lindex [.dialog.frame1.list curselection] $j]
      if {$i < [expr {[.dialog.frame1.list index end] -1}]} {
        set nstore [.dialog.frame1.list get $i]
        set cstore [.dialog.frame1.list itemcget $i -background]
        .dialog.frame1.list delete $i
        set tstore $mem($i)
        set mem($i) $mem([expr {$i+1}])
        incr i 1
        .dialog.frame1.list insert $i $nstore
        .dialog.frame1.list itemconfigure $i -background $cstore       
        set mem($i) $tstore
        .dialog.frame1.list selection set $i
        unset nstore cstore tstore
      }
    }
    if {[.dialog.frame1.list curselection] != {}} {
      .dialog.frame1.list see [lindex [.dialog.frame1.list curselection] end]
      unset i j
    }
  }
  bind .dialog <<delete>> {
    if {[tk_messageBox -title [mc "Delete features from Library"] -message [mc "Are you sure you want to delete %s features from the library?" [llength [.dialog.frame1.list curselection]]] -type okcancel -icon question] == "ok"} {
      for {set j [expr {[llength [.dialog.frame1.list curselection]]-1}]} {$j > -1} {incr j -1} {
        set i [lindex [.dialog.frame1.list curselection] $j]
        .dialog.frame1.list delete $i
        .dialog.frame1.list selection set $i
        lappend deleted $mem($i)
        while {$i <= [expr {[.dialog.frame1.list index end] - 1}]} {
          set mem($i) $mem([expr {$i+1}])
          incr i
        }
        array unset mem $i 
      }
      unset j i
    }
  } 

  bind .dialog <<new>> {
    if {![info exists new_fea_global] || ($new_fea_global == "")} {
      set new_fea_global [list "New Feature" "" "" "" "" "" "misc_feature" $info(feature_default_fcolor) $info(feature_default_rcolor) 0 0 ""]
    }
    lappend fea_info(library) $new_fea_global
    set dialogblock 0
    set result [edit_feature_in_library .dialog [expr {[llength $fea_info(library)]-1}]]
    #sputs "result=$result"
    if {$result != "ok"} {
      set fea_info(library) [lrange $fea_info(library) 0 end-1]
    } else {
      for {set i [.dialog.frame1.list index end]} {$i > 0} {incr i -1} {
        set mem($i) $mem([expr {$i-1}])
      }
      set mem(0) [expr {[llength $fea_info(library)]-1}]
      .dialog.frame1.list insert 0 [lindex [lindex $fea_info(library) end] 0]
      .dialog.frame1.list itemconfigure 0 -background [lindex [lindex $fea_info(library) end] 7]
      .dialog.frame1.list selection clear 0 end
      .dialog.frame1.list selection set 0
      .dialog.frame1.list selection anchor 0
      unset i
    }
    set new_fea_global ""
  }

  bind .dialog <<new_from_sequence_selected>> {
    set tv $new_fea_window_global.tvframe.tv
    set text $new_fea_window_global.textarea
    foreach tag [$tv selection] {
      if {([regexp {f[0-9]+#} $tag]) && ([llength [$text tag ranges $tag]] > 1)} {
        set metadata [$text tag bind $tag <<Metadata>>]
        set new_f [feature_to_library_element $new_fea_window_global $tag]
        if {![feature_exists_in_library $new_f] || [tk_messageBox -type yesno -message [mc "Feature %s is a duplicate. Do you want to add it?" [lindex $metadata 0] ] -icon question -default yes] == "yes"} {
          lappend fea_info(library) $new_f
          for {set i [.dialog.frame1.list index end]} {$i > 0} {incr i -1} {
            set mem($i) $mem([expr {$i-1}])
          }
          set mem(0) [expr {[llength $fea_info(library)]-1}]
          .dialog.frame1.list insert 0 [lindex [lindex $fea_info(library) end] 0]
          .dialog.frame1.list itemconfigure 0 -background [lindex [lindex $fea_info(library) end] 7]
        }
      }
    }
    set new_fea_window_global ""
    unset tag tv metadata i
  }

  bind .dialog <<new_from_sequence_all>> {
    set text $new_fea_window_global.textarea
    foreach tag [$text tag names] {
      if {([regexp {f[0-9]+#} $tag]) && ([llength [$text tag ranges $tag]] > 1)} {
        set metadata [$text tag bind $tag <<Metadata>>]
        set new_f [feature_to_library_element $new_fea_window_global $tag]
        if {![feature_exists_in_library $new_f]  || [tk_messageBox -type yesno -message [mc "Feature %s is a duplicate. Do you want to add it?"  [lindex $metadata 0]]  -icon question -default yes] == "yes"} {
          lappend fea_info(library) $new_f
          for {set i [.dialog.frame1.list index end]} {$i > 0} {incr i -1} {
            set mem($i) $mem([expr {$i-1}])
          }
          set mem(0) [expr {[llength $fea_info(library)]-1}]
          .dialog.frame1.list insert 0 [lindex [lindex $fea_info(library) end] 0]
          .dialog.frame1.list itemconfigure 0 -background [lindex [lindex $fea_info(library) end] 7]
        }
      }
    }
    set new_fea_window_global ""
    unset tag text metadata i
  }


  event generate .dialog <<fill_list>>

 ##if select !=-1, then we are editing a new element
  if {$new_fea != {}} {
    set new_fea_global $new_fea
    event generate .dialog <<new>>
  }
  vwait ok
  set dialogblock 0
  destroy .dialog

  bind . <<RaiseDialogs>> ""

  if {$ok > 0} {
    ##put the changes into the feature library
    foreach i [lsort -increasing -integer [array names mem]] {
      lappend new_feature_list [lindex $fea_info(library) $mem($i)]
    }
    set fea_info(library) $new_feature_list

    if {$ok == 1} { 
      save_feature_library $fea_info(library_file)
    } elseif {$ok ==2} {
      save_feature_library
    }

    if {$info(feature_scan_on_close) == 1} {
      feature_scan $w
    }
  } else {
    ###revert to the saved version of the file
    set fea_info(library) $library_store
  }

  unset -nocomplain ok deleted new_fea_global new_fea_window_global
  array unset mem

}


##############
## return a feature library element from a sequence feature
##############
#library list: (0)name (1)regexp_fwd(flanked by paren) (2)regexp_rev (3)preseq (4)postseq (5)plain_text_def (6)type (7)fwd_color (8)rev_color (9)graphic_format (10)dna/prot search (11)annotations_string (qualifiers data)
proc feature_to_library_element {w tag} {
  global info
  set intron_start ""
  set text ""
  foreach index_range [get_feature_exons_indexes $w $tag] {
    if {$intron_start ne ""} {
      set intron_end [$w.textarea index [lindex $index_range 0]]
      if {[$w.textarea compare $intron_start < $intron_end]} {
        append text [string tolower [textarea_get $w.textarea $intron_start $intron_end]]
      } else {
        append text [string tolower [textarea_get $w.textarea $intron_start end]]
        append text [string tolower [textarea_get $w.textarea 1.0 $intron_end]]
      }
    }
    set intron_start [$w.textarea index [lindex $index_range 1]]
    append text [string toupper [textarea_get $w.textarea {*}$index_range]]
    
  }
  set text  [regsub -all \n $text ""]
  #<<Metadata>>:(0)name, (1)format_info, (2)type, (3)fwd/rev, (4)annotations_string (qualifiers data)
  lassign [$w.textarea tag bind $tag <<Metadata>>] f_name f_format f_type f_dir f_qual
  lassign [$w.textarea tag bind $tag <<Revcolors>>] f_fwd_color f_rev_color
  if {$f_dir} {
    set text [revcom $text]
  }
  set regexpfwd $text
  regsub -all {[a-z]+} $regexpfwd ")&(" regexpfwd
  regsub -all {[nN\*]} $regexpfwd "." regexpfwd
  regsub -all {\(\)} $regexpfwd "" regexpfwd
  set regexpfwd [regsubpattern $regexpfwd]
  set regexprev [revcom_regexp $regexpfwd]
  regsub -all {\?\*\.} $regexprev .*? regexprev
  set new_fea [list $f_name "($regexpfwd\)" "($regexprev\)" "" "" $text $f_type $f_fwd_color $f_rev_color $f_format 0 $f_qual]
  return $new_fea
}

##############
## check whether a feature is duplicate in the current library
##############
proc feature_exists_in_library {f} {
  global fea_info
  set name [lindex $f 0]
  set def [lindex $f 5]
  foreach f0 $fea_info(library) {
    if {[lindex $f0] eq $name || [lindex $f0 5] eq $def} {
      return 1
    }
  }
  return 0
}

##############
## save a feature library
##############
#file format(tab sep): (0)name (1)plain_text_def (2)type (3)fwd_color (4)rev_color (5)graphic_format (6)dna/prot search (7)annotations_string (qualifiers data)
#library list: (0)name (1)regexp_fwd(flanked by paren) (2)regexp_rev (3)preseq (4)postseq (5)plain_text_def (6)type (7)fwd_color (8)rev_color (9)graphic_format (10)dna/prot search (11)annotations_string (qualifiers data)
 ## use lindex 9 (previously bold) to search type (0=dna 1=protein)
proc save_feature_library {{filename ""}} {
  global info fea_info
  global mem deleted dialogblock

  if {$dialogblock == 1} {return}
  set dialogblock 1
  if {![file isdirectory $info(default_featuredir)]} {
    global argv0
    set info(default_featuredir) [file dirname $argv0]
  }
  if {[set parent_win [focus]] == ""} {
    set parent_win .
  }
  set parent_win [winfo toplevel $parent_win]
  if {![file exists $filename]} {
    set filename [tk_getSaveFile -title [mc "Save Feature File"] -initialdir $info(default_featuredir) -defaultextension ".txt" -filetypes {{"Text File" ".txt"}}]
  }

  while {($filename != "") && ([catch {set feature_file [open $filename w]}])} {
    catch {close $feature_file}
    tk_messageBox -title [mc "Feature File not Writable"] -message [mc "The file %s is not writable. It may be locked." $filename] -type ok -icon warning -default ok
    set filename [tk_getSaveFile -title [mc "Save Feature File"] -initialdir $info(default_featuredir) -defaultextension ".txt"  -filetypes {{"Text File" ".txt"}}]
  }

  if {$filename != ""} {
  
    foreach feature $fea_info(library) {
      puts $feature_file "[lindex $feature 0]\t[lindex $feature 5]\t[lindex $feature 6]\t[lindex $feature 7]\t[lindex $feature 8]\t[lindex $feature 9]\t[lindex $feature 10]\t[lindex $feature 11]"
    }
    close $feature_file
    set fea_info(library_file) $filename

  } else {
      set fea_info(library_file) ""
  }
  set dialogblock 0
}


##############
## Save features from a sequence out to a library formatted file
##############
proc features_to_feature_library {w {split 0}} {
  global dialogblock

  if {$dialogblock == 1} {return}
  set dialogblock 1

  if {[set parent_win [focus]] == ""} {
    set parent_win .
  }
  set parent_win [winfo toplevel $parent_win]
  set filename ""
  if {![file exists $filename]} {
    set filename [tk_getSaveFile -title [mc "Save Feature File"] -parent $parent_win  -defaultextension ".txt"  -filetypes {{"Text File" ".txt"}}]
  }

  while {($filename != "") && ([catch {set feature_file [open $filename w]}])} {
    catch {close $feature_file}
    tk_messageBox -title [mc "Feature File not Writable"] -message [mc "The file %s is not writable. It may be locked." $filename] -type ok -icon warning -default ok
    set filename [tk_getSaveFile -title [mc "Save Feature File"] -initialdir $info(default_featuredir) -defaultextension ".txt"  -filetypes {{"Text File" ".txt"}}]
  }

  if {$filename != ""} {
    set templist [feature_find $w 1 [ix2bp $w.textarea end]]
    foreach {name tag} $templist {
      regsub fn $tag f tag
      set revcolors [$w.textarea tag bind $tag <<Revcolors>>]
      set fwd_color [lindex $revcolors 0]
      set rev_color [lindex $revcolors 1]
      set metadata [$w.textarea tag bind $tag <<Metadata>>]
      set type [lindex $metadata 2]
      set dir [lindex $metadata 3]
      #sputs $tag $name $revcolors $type $dir
      set seq ""
      set len [ix2bp $w.textarea end]
      set ranges [feature_coords $w $tag 0 $len]
      #sputs $name $ranges
      set lastb 0
      foreach range $ranges {
        foreach {a b} $range {}
        incr b
        if {$a == 0 && $lastb == $len} {
          set seq [lreplace $seq end end "[lindex $seq end][string toupper [textarea_get $w.textarea [bp2ix $w.textarea $a] [bp2ix $w.textarea $b]]]"]
        } else {
          lappend seq [string toupper [textarea_get $w.textarea [bp2ix $w.textarea $a] [bp2ix $w.textarea $b]]]
        }
        set lastb $b
      }
      set seq [join $seq +]
      if {$dir} {
        set seq [revcom $seq]
      }
    #sputs $name $seq
      if {$split ==0} {
        puts $feature_file "$name\t$seq\t$type\t$fwd_color\t$rev_color\t0\t0\t"
      } else {
        ## do split feature blocks
        foreach exon [split $seq +] {
          for {set i 0} {$i < [expr {[string length $exon]/ $split}]} {incr i } {
            puts $feature_file "$name\t[string range $exon [expr {$i*$split}] [expr {$i*$split+$split-1}]]\t$type\t$fwd_color\t$rev_color\t0\t0\t"
          }
          if {[expr {[string length $exon] % $split}] >0} {
            puts $feature_file "$name\t[string range $exon end-[expr {$split-1}] end]\t$type\t$fwd_color\t$rev_color\t0\t0\t"
          }
        }
      }
    }
    close $feature_file
  }
  set dialogblock 0
}

##############
## dialog box to edit feature color favorites
##############
proc edit_color_favorites {w} {
  global info temp_info_favorites dialogblock ok3

  #if {$dialogblock == 1} {return}
  #set dialogblock 1

  set temp_info_favorites(color_favorites) $info(feature_color_favorites)

  set temp_info_favorites(fwd_color)  [lindex [lindex $temp_info_favorites(color_favorites) 0] 1]
  set temp_info_favorites(rev_color)  [lindex [lindex $temp_info_favorites(color_favorites) 0] 2]

  set a [toplevel .edit_color_favorites]
  wm title $a [mc "Edit Color Favorites..."]
  wm protocol $a WM_DELETE_WINDOW "set ok3 -1"
  bind $a <KeyPress-Escape>  "set ok3 -1"
  set raisedialogstore [bind . <<RaiseDialogs>>]
  bind . <<RaiseDialogs>> "+sputs raise;after 300 \"wm deiconify $a; raise $a\""
  regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry [winfo toplevel $w]] wgeom winx winy

  wm geometry [winfo toplevel $a] "+[expr min (max ($winx,0), [winfo vrootwidth .]-200)+3]+[expr min (max ($winy,0),[winfo vrootheight .]-200)+50]"
  if {[tk windowingsystem] != "aqua"} {
    wm transient $a $w
  } else {
    ::tk::unsupported::MacWindowStyle style $a document {closeBox}
  }
  set ok3 0
 
  grid [frame $a.f1 -relief ridge -borderwidth 2] -sticky nswe -row 0 -column 0
  grid [frame $a.f1.listframe] -sticky nswe -row 0 -column 0 -columnspan 2
  grid [listbox $a.f1.listframe.listbox -width 30 -yscrollcommand "optionscrollbar $a.f1.listframe.vert" -selectmode single -activestyle none -background white] -row 0 -column 0 -sticky nswe
  grid [scrollbar $a.f1.listframe.vert -orient vertical -command "$a.f1.listframe.listbox yview"] -row 0 -column 1 -sticky nsw
  grid rowconfigure $a.f1.listframe 0 -weight 1
  grid [button $a.f1.add -text [mc "Add New"] -command "event generate $a.f1.listframe.listbox <<ListboxAddNew>>"] -row 1 -column 0 -sticky n
  grid [button $a.f1.del -text [mc "Delete"] -command "event generate $a.f1.listframe.listbox <<ListboxDelete>>"] -row 1 -column 1 -sticky n
  grid rowconfigure $a.f1 0 -weight 1

  grid [frame $a.f2 -relief ridge -borderwidth 2] -sticky nswe -row 1 -column 0
  grid [entry $a.f2.name -width 20 -textvariable temp_info_favorites(name) -validate key] -row 0 -column 0 -columnspan 4 -sticky nw
  grid [label $a.f2.l1 -text [mc "forward:"]] -row 1 -column 0 -sticky nw
  grid [color_button $a.f2.fwd_color temp_info_favorites(fwd_color)] -row 1 -column 1 -sticky nw
  grid [label $a.f2.l2 -text [mc "reverse:"]] -row 1 -column 2 -sticky n
  grid [color_button $a.f2.rev_color temp_info_favorites(rev_color)] -row 1 -column 3 -sticky nw
  grid [button $a.f2.same -text [mc "Same"] -command "set temp_info_favorites(rev_color) \$temp_info_favorites(fwd_color)"] -row 1 -column 4 -sticky nw

  grid [frame $a.f3 -relief ridge] -sticky nswe -row 2 -column 0
  grid [button $a.f3.ok -text [mc "OK"] -command "set ok3 1" -default active] -row 0 -column 1 -padx 10 -pady 3
  bind $a <Key-Return> "set ok2 1"
  grid [button $a.f3.cancel -text [mc "Cancel"] -command "set ok3 -1"] -row 0 -column 2 -padx 10 -pady 3

  grid columnconfigure $a 0 -weight 1
  grid rowconfigure $a 0 -weight 1



  foreach color_item $temp_info_favorites(color_favorites) {
    $a.f1.listframe.listbox insert end [lindex $color_item 0]
    $a.f1.listframe.listbox itemconfigure end -background  [lindex $color_item 1]
  }

  #trace add variable temp_info_favorites(name) write "event generate $a.f1.listframe.listbox <<ListboxUpdateselection>>;#"

  bind $a.f1.listframe.listbox <<ListboxAddNew>> "
    $a.f1.listframe.listbox configure -state normal
    lappend temp_info_favorites(color_favorites) \[list \"\" \$info(feature_default_fcolor) \$info(feature_default_rcolor)\]
    $a.f1.listframe.listbox insert end \"\"
    $a.f1.listframe.listbox itemconfigure end -background \$info(feature_default_fcolor)
    $a.f1.listframe.listbox selection set end
    if {\$temp_info_favorites(old_sel) > -1} {
      $a.f1.listframe.listbox selection clear \$temp_info_favorites(old_sel)
    } else {
      $a.f2.name configure -state normal
      $a.f2.fwd_color configure -state normal
      $a.f2.rev_color configure -state normal
      $a.f1.del configure -state normal
    }
    event generate $a.f1.listframe.listbox <<ListboxSelect>>
  "

  $a.f2.name configure -vcmd "
    if {\$temp_info_favorites(old_sel) > -1} {
      $a.f1.listframe.listbox delete \$temp_info_favorites(old_sel)
      $a.f1.listframe.listbox insert \$temp_info_favorites(old_sel) %P
      $a.f1.listframe.listbox itemconfigure \$temp_info_favorites(old_sel) -background \$temp_info_favorites(fwd_color)
      $a.f1.listframe.listbox selection set \$temp_info_favorites(old_sel)
      $a.f1.listframe.listbox see \$temp_info_favorites(old_sel)
    }
    expr {1}
  "

  bind $a.f1.listframe.listbox <<ListboxDelete>> "
    if {\$temp_info_favorites(old_sel) > -1} {
      set temp_info_favorites(color_favorites) \[lreplace \$temp_info_favorites(color_favorites) \$temp_info_favorites(old_sel) \$temp_info_favorites(old_sel)\]
      $a.f1.listframe.listbox delete \$temp_info_favorites(old_sel)
      if {\$temp_info_favorites(old_sel) == \[$a.f1.listframe.listbox index end\]} {
        incr temp_info_favorites(old_sel) -1
      }
      if {\$temp_info_favorites(old_sel) == -1} {
          event generate $a.f1.listframe.listbox <<ListboxEmpty>>
      } else {
        $a.f1.listframe.listbox selection set \$temp_info_favorites(old_sel)
        $a.f2.name delete 0 end
        $a.f2.name insert end \[lindex \[lindex \$temp_info_favorites(color_favorites) \[$a.f1.listframe.listbox curselection\]\] 0\]
        set temp_info_favorites(fwd_color)  \[lindex \[lindex \$temp_info_favorites(color_favorites) \[$a.f1.listframe.listbox curselection\]\] 1\]
        set temp_info_favorites(rev_color)  \[lindex \[lindex \$temp_info_favorites(color_favorites) \[$a.f1.listframe.listbox curselection\]\] 2\]
      }
    }
  "
  bind $a.f1.listframe.listbox <<ListboxEmpty>> "
    $a.f2.name delete 0 end
    $a.f2.name configure -state disabled
    $a.f1.listframe.listbox configure -state disabled
    $a.f2.fwd_color configure -state disabled
    $a.f2.rev_color configure -state disabled
    $a.f1.del configure -state disabled
  "

  bind $a.f1.listframe.listbox <<ListboxSelect>> "
    if {\$temp_info_favorites(old_sel) !=  \[$a.f1.listframe.listbox curselection\]} {
      if {\$temp_info_favorites(old_sel) > -1} {
        set temp_info_favorites(old_item) \[list \$temp_info_favorites(name) \$temp_info_favorites(fwd_color) \$temp_info_favorites(rev_color)\]
        set temp_info_favorites(color_favorites) \[lreplace \$temp_info_favorites(color_favorites) \$temp_info_favorites(old_sel) \$temp_info_favorites(old_sel) \$temp_info_favorites(old_item)\]
        $a.f1.listframe.listbox itemconfigure \$temp_info_favorites(old_sel) -background \$temp_info_favorites(fwd_color)
      }
      if {\[llength \$temp_info_favorites(color_favorites)\] > 0} {
        set temp_info_favorites(old_sel) \[$a.f1.listframe.listbox curselection\]
        set temp_info_favorites(fwd_color)  \[lindex \[lindex \$temp_info_favorites(color_favorites) \$temp_info_favorites(old_sel)\] 1\]
        set temp_info_favorites(rev_color)  \[lindex \[lindex \$temp_info_favorites(color_favorites) \$temp_info_favorites(old_sel)\] 2\]
        set temp_info_favorites(name) \[lindex \[lindex \$temp_info_favorites(color_favorites) \$temp_info_favorites(old_sel)\] 0\]
      }
    }
  "

  if {[llength $temp_info_favorites(color_favorites)] > 0} {
    $a.f1.listframe.listbox selection set 0
    $a.f1.listframe.listbox selection anchor 0
    set temp_info_favorites(old_sel) 0
    $a.f2.name insert end [lindex [lindex $temp_info_favorites(color_favorites) 0] 0]
  } else {
    set temp_info_favorites(old_sel) -1
    update idletasks
    event generate $a.f1.listframe.listbox <<ListboxEmpty>>
  }

  after 300 "raise $a"
  after 350 "focus $a.f2.name"

  vwait ok3
  if {$ok3 == 1} {
    set temp_info_favorites(old_item) [list $temp_info_favorites(name) $temp_info_favorites(fwd_color) $temp_info_favorites(rev_color)]
    set temp_info_favorites(color_favorites) [lreplace $temp_info_favorites(color_favorites) $temp_info_favorites(old_sel) $temp_info_favorites(old_sel) $temp_info_favorites(old_item)]
    set info(feature_color_favorites) $temp_info_favorites(color_favorites)
  }
  #set dialogblock 0
  destroy $a
  bind . <<RaiseDialogs>> $raisedialogstore

  unset ok3
  array unset temp_info_favorites

}

##############
## scans a dna window textbox and stores the cutsites in the info array as info($w,$enzyme) 
##############

proc findenzymes {w} {
  global info

  if {![info exists info($w,scanned)]} {set info($w,scanned) 0}
  if {$info($w,scanned)} {return}

  global longnamelist 
  global hexlist 
  global enzymes
  global enzinfo

  
  foreach enzyme $enzymes {
    set info($w,$enzyme) [list]
    set info($w,enzdir,$enzyme) [list]
  }
  set info($w,MDam) [list]
  set info($w,MDcm) [list]

  set str [textarea_get $w.textarea 1.0 [end_ix $w.textarea]]
  set last [string length $str]

  if {[string length $str] < 4} {return}

  if {$info($w,circular) == "circular"} {
    set str "$str[textarea_get $w.textarea 1.0 [bp2ix $w.textarea 63]]"
  }

  ## scan the longnames using the regexp search function
  foreach enzymeelement $longnamelist {
    set enzname [lindex $enzymeelement 0]
    set patternf [lindex $enzymeelement 1]
    set patternr [lindex $enzymeelement 2]

    if {$patternr != {}} {
      set templist [list]
      foreach found [regexp -nocase -indices -all -inline -- $patternf $str] {
        if {[lindex $found 0] < $last} {
          #lappend info($w,$enzname) [expr {[lindex $found 0]+1}]
          #lappend info($w,enzdir,$enzname) 0
          lappend templist [list [expr {[lindex $found 0]+1}] 0]
        }
      }
      foreach found [regexp -nocase -indices -all -inline -- $patternr $str] {
        if {[lindex $found 0] < $last} {
          #reverse pattern
          #lappend info($w,$enzname) [expr {[lindex $found 0]+1}]
          #lappend info($w,enzdir,$enzname) 1
          lappend templist [list [expr {[lindex $found 0]+1}] 1]
        }
      }
      #sort by the site location
      set templist [lsort -index 0 -integer $templist]
      foreach element $templist {
        foreach {s1 d1} $element {}
        lappend info($w,$enzname) $s1
        lappend info($w,enzdir,$enzname) $d1
      }

    } else {
      foreach found [regexp -nocase -indices -all -inline -- $patternf $str] {
        if {[lindex $found 0] < $last} {
          lappend info($w,$enzname) [expr {[lindex $found 0]+1}]
          lappend info($w,enzdir,$enzname) 0
        }
      }
    }
  }


  ## scan using the hexarray for all sites <=6bp long
  array set a {a 0 A 0 c 1 C 1 g 2 G 2 t 3 T 3 n 0 N 0 * 0 b 1 B 1 d 0 D 0 h 0 H 0 k 2 K 2 m 0 M 0 r 0 R 0 s 1 S 1 v 0 V 0 w 0 W 0 y 1 Y 1}
  array set b {a 8 A 8 c 4 C 4 g 2 G 2 t 1 T 1 n 15 N 15 * 15 b 7 B 7 d 11 D 11 h 13 H 13 k 3 K 3 m 12 M 12 r 10 R 10 s 6 S 6 v 14 V 14 w 9 W 9 y 5 Y 5}

  if {$info($w,circular) == "circular"} {
    set len [expr ($last+5)]
    if {$len > [string length $str]} {
      set len [string length $str]
    }
  } else {
    set len $last
  }

  set h 0

  if {[string length $str] == 4} {
    for {set i 0} {$i < 4} {incr i} {
      set h [expr {($h << 2) & 0xfff | $a([string index $str $i])}]
    }
  } else {
    for {set i 0} {$i < 5} {incr i} {
      set h [expr {($h << 2) & 0xfff | $a([string index $str $i])}]
    }
  }

  set v "0x[string map {A 8 B 7 C 4 D b G 2 H d K 3 M c N f * f R a S 6 T 1 V e W 9 Y 5} [string toupper [string range $str 0 4]]]"

  for {set i 5} {$i < $len} {incr i} {
    set h [expr {($h << 2) & 0xfff | $a([string index $str $i])}]
    set v [expr {($v << 4) & 0xffffff | $b([string index $str $i])}]
    if {[lindex $hexlist $h] != {}} {
      foreach enzname [lindex $hexlist $h] {
        set inc 0
        foreach enz_vcode $enzinfo(enz_vcode,$enzname) {
          if {[expr {$enz_vcode & $v}] == 0} {
            #if enz_vcode is 2nd element of the list, the enzyme is in reverse pattern
            lappend info($w,$enzname) [expr {$i-4}]
            lappend info($w,enzdir,$enzname) $inc
          }
          incr inc
        }
      }
    }
  }

  if {$info($w,circular) != "circular"} {
    #Check explicitly for 5 and 4 bp sites at the end
    set h [expr {($h << 2) & 0xfff}]
    set v [expr {($v << 4) & 0xffffff | 15}]
    if {[lindex $hexlist $h] != {}} {
      foreach enzname [lindex $hexlist $h] {
        set inc 0
        foreach enz_vcode $enzinfo(enz_vcode,$enzname) {
          if {([expr {$enz_vcode & $v}] == 0) && ([string length $enzinfo(flatpat,$enzname)] < 6)} {
            lappend info($w,$enzname) [expr {$i-4}]
            lappend info($w,enzdir,$enzname) $inc
          }
          incr inc
        }
      }
    }
    set h [expr {($h << 2) & 0xfff}]
    set v [expr {($v << 4) & 0xffffff | 15}]
    if {[lindex $hexlist $h] != {}} {
      foreach enzname [lindex $hexlist $h] {
        set inc 0
        foreach enz_vcode $enzinfo(enz_vcode,$enzname) {
          if {([expr {$enz_vcode & $v}] == 0) && ([string length $enzinfo(flatpat,$enzname)] < 5)} {
            lappend info($w,$enzname) [expr {$i-3}]
            lappend info($w,enzdir,$enzname) $inc
          }
          incr inc
        }
      }
    }

    #take out enzymes with cut sites past the ends
    foreach enz $enzymes {
      if {[set len [string length $enzinfo(flatpat,$enz)]] < [set max [expr {max ([lindex $enzinfo(enz_cut_sites,$enz) 0],[lindex $enzinfo(enz_cut_sites,$enz) 1])}]] } {
        #look for reverse sites cutting past 0
        set s 0
        set lm [expr {$max-$len}]
        set i 0
        while {$i < [llength  $info($w,$enz)] && ($s<$lm)} {
          set s [lindex $info($w,$enz) $i]
          set d [lindex $info($w,enzdir,$enz) $i]
          if {$d && $s < $lm} {
            #check s and d for site past end and take out the site
            set info($w,$enz) [lreplace $info($w,$enz) $i $i]
            set info($w,enzdir,$enz) [lreplace $info($w,enzdir,$enz) $i $i]
          } else {
            incr i
          }
        } 
        #look for fwd sites cutting past end
        set s $last
        set lm  [expr {$last-$max+1}]
        set i [llength  $info($w,$enz)]
        while {$i > 0 && ($s > $lm)} {
          incr i -1
          set s [lindex $info($w,$enz) $i]
          set d [lindex $info($w,enzdir,$enz) $i]
          if {(!$d && $s > $lm)} {
            #check s and d for site past end and take out the site
            set info($w,$enz) [lreplace $info($w,$enz) $i $i]
            set info($w,enzdir,$enz) [lreplace $info($w,enzdir,$enz) $i $i]
          }
        }
      }    }
  }

  initialize_methylation $w

  set info($w,scanned) 1
  if {$info($w,Dam_Dcm_methylated) == 1} {toggle_methylation $w}

#sputs Total time [expr $btime-$atime]ms.
#sputs Longnames time [expr $dtime-$ctime]ms.
#sputs vscan time [expr $ftime-$etime]ms.
#sputs initialize_methylation time [expr $htime-$gtime]ms.
}

################
## for Dam/Dcm blocked enzymes, add a list of unblocked sites into info($w,mstore,$enzyme)
################
proc initialize_methylation {w} {
  global info
  global enzinfo

  if {($info($w,circular) == "circular")} {
    set last [expr {[ix2bp $w.textarea end]}]
    if {[llength $info($w,MDcm)] > 1 } {
      set info($w,MDcm) [concat [expr {[lindex $info($w,MDcm) end-1]-$last}] [expr {[lindex $info($w,MDcm) end]-$last}] $info($w,MDcm) [expr {[lindex $info($w,MDcm) 0]+$last}] [expr {[lindex $info($w,MDcm) 1]+$last}]]
    } elseif {[llength $info($w,MDcm)] > 0} {
      set info($w,MDcm) [concat [expr {[lindex $info($w,MDcm) end]-$last}] $info($w,MDcm) [expr {[lindex $info($w,MDcm) 0]+$last}]]
    }
    if {[llength $info($w,MDam)] > 1 } {
      set info($w,MDam) [concat [expr {[lindex $info($w,MDam) end-1]-$last}] [expr {[lindex $info($w,MDam) end]-$last}] $info($w,MDam) [expr {[lindex $info($w,MDam) 0]+$last}] [expr {[lindex $info($w,MDam) 1]+$last}]]
    } elseif {[llength $info($w,MDam)] > 0} {
      set info($w,MDam) [concat [expr {[lindex $info($w,MDam) end]-$last}] $info($w,MDam) [expr {[lindex $info($w,MDam) 0]+$last}]]
    }
  }
#example: {MDam {{BcgI 2 9} {BclI 2 3} {BsaBI 1 8} {BspHI 5 0} {ClaI 0 5} {HphI 4 0} {Hpy188I 4 0} {MboI 1 2} {MboII 4 0} {NruI 5 0} {TaqI 3 0} {XbaI 5 0}}} {MDcm {{AlwNI 0 8} {ApaI 5 0} {AvaII 4 0} {PflMI 1 9} {PpuMI 6 0} {ScrFI 1 3} {SexAI 2 4} {SfiI 12 0} {StuI 4 1}}}
  foreach enzyme $info(blocked_enzymes) {
    set info($w,mstore,$enzyme) $info($w,$enzyme)
    set info($w,mstore_dir,$enzyme) $info($w,enzdir,$enzyme)
  }
  foreach methylase $enzinfo(enz_methylaselist) {
    set metsiteslist $info($w,[lindex $methylase 0])
    foreach blocked_enzyme [lindex $methylase 1] {
      set enzyme [lindex $blocked_enzyme 0]  
      #set info($w,mstore,$enzyme) [not_in_list [not_in_list $info($w,$enzyme) $metsiteslist [lindex $blocked_enzyme 1]] $metsiteslist [lindex $blocked_enzyme 2]]  
      set templist [not_in_list $info($w,$enzyme) $info($w,enzdir,$enzyme) $metsiteslist [lindex $blocked_enzyme 1]]    
      set templist [not_in_list {*}$templist $metsiteslist [lindex $blocked_enzyme 2]] 
      set info($w,mstore,$enzyme) [lindex $templist 0]
      set info($w,mstore_dir,$enzyme) [lindex $templist 1]
    }
  }
  #AbaSI AoxI BisI BlsI DpnI FspEI GlaI GluI KroI LpnPI MalI MspJI MteI PcsI PkrI SgeI
  foreach z [list DpnI MalI] {
    if {[array names info "$w,$z"] != ""} {
      set info($w,$z) [list]
      set info($w,enzdir,$z) [list]
    }
  }
}

###########
## return a list of elements in list a that are not in list b, when each element of a has dif added to it before the comparison. a2 is a second list that gets deleted in sync with a
###########
proc not_in_list {a a2 b dif} {
  if {$b == [list]} {
    return [list $a $a2]
  }
  set i 0
  set j 0
  set res [list]
  set res2 [list]
  set lena [llength $a]
  set lenb [llength $b]
  while {($i < $lena) && ($j < $lenb)} {
    while {($i < $lena) && ([expr {[lindex $a $i] + $dif}] < [lindex $b $j])} {
      lappend res [lindex $a $i]
      lappend res2 [lindex $a2 $i]
      incr i
    }

    while {($i < $lena) && ($j < $lenb) && ([expr {[lindex $a $i] + $dif}] >= [lindex $b $j])} {
      if {([expr {[lindex $a $i] + $dif}] == [lindex $b $j])} {
        incr i
      }
      incr j
    }
    while {($j == $lenb) && ($i < $lena)} {
      lappend res [lindex $a $i]
      lappend res2 [lindex $a2 $i]
      incr i
    }
  }
  return [list $res $res2]
}

################
## Turn Dam/Dcm methylation on/off by swapping info($w,$enzyme) and info($w,mstore,$enzyme)
################
proc toggle_methylation {w} {
  global info

  if {$info($w,scanned) == 0} {
    findenzymes $w
    return
  }

  foreach enzyme $info(blocked_enzymes) {
    set templist $info($w,$enzyme) 
    set info($w,$enzyme) $info($w,mstore,$enzyme)
    set info($w,mstore,$enzyme) $templist
    set templist $info($w,enzdir,$enzyme) 
    set info($w,enzdir,$enzyme) $info($w,mstore_dir,$enzyme)
    set info($w,mstore_dir,$enzyme) $templist
  }

}
################
## Primer scan conditions dialog
################
proc primer_window_old {w} {
  global info
  global ok dialogblock modifier
  if {$dialogblock == 1} {return}
  set a [new_dialog $w "Find PCR Primers" "FIND"]
  bind $a <<Cancel>> "set ok -1"
  bind $a <<OK>> "set ok 1"
  grid [label $a.lmin -text [mc "Minimum"]] -row 0 -column 2
  grid [label $a.lmax -text [mc "Maximum"]] -row 0 -column 3
  grid [label $a.llen -text [mc "Length: "]] -row 1 -column 1 -sticky e
  grid [ttk::spinbox $a.elenmin -width 4 -textvariable info(primer_len_min) -from 10 -to 100 -validate all -validatecommand "entry_integer %P %W %V 1 100"] -row 1 -column 2
  grid [ttk::spinbox $a.elenmax -width 4 -textvariable info(primer_len_max) -from 10 -to 100 -validate all -validatecommand "entry_integer %P %W %V 1 100"] -row 1 -column 3
  grid [label $a.lTm -text "Tm: "] -row 2 -column 1 -sticky e
  grid [ttk::spinbox $a.eTmmin -width 4 -textvariable info(primer_Tm_min) -from 40 -to 80 -validate all -validatecommand "entry_integer %P %W %V 1 100"] -row 2 -column 2
  grid [ttk::spinbox $a.eTmmax -width 4 -textvariable info(primer_Tm_max) -from 40 -to 80 -validate all -validatecommand "entry_integer %P %W %V 1 100"] -row 2 -column 3
  grid [label $a.l%gc -text "%GC: " -justify right] -row 3 -column 1 -sticky e
  grid [ttk::spinbox $a.e%gcmin -width 4 -textvariable info(primer_gc_min) -from 0 -to 100 -validate all -validatecommand "entry_integer %P %W %V 0 100"] -row 3 -column 2
  grid [ttk::spinbox $a.e%gcmax -width 4 -textvariable info(primer_gc_max) -from 0 -to 100 -validate all -validatecommand "entry_integer %P %W %V 0 100"] -row 3 -column 3
  grid [label $a.lclamp -text [mc "GC clamp: "]] -row 4 -column 1 -sticky e
  grid [ttk::spinbox $a.eclampmin -width 4 -textvariable info(primer_clamp_min) -from 0 -to 5 -validate all -validatecommand "entry_integer %P %W %V 0 100"] -row 4 -column 2
  grid [ttk::spinbox $a.eclampmax -width 4 -textvariable info(primer_clamp_max) -from 0 -to 5 -validate all -validatecommand "entry_integer %P %W %V 0 100"] -row 4 -column 3
  grid [label $a.lconcec -text [mc "Consecutive bases: "]] -row 5 -column 1 -sticky e
  grid [ttk::spinbox $a.econsecmax -width 4 -textvariable info(primer_consec_max) -from 0 -to 5 -validate all -validatecommand "entry_integer %P %W %V 0 100"] -row 5 -column 3

  grid [frame $a.concframe -relief ridge -borderwidth 3] -row 6 -column 1 -columnspan 3 -pady 3
    grid [label $a.concframe.lsalt -text [mc "Salt (mM):"]] -row 0 -column 1
    grid [ttk::spinbox $a.concframe.esalt -width 4 -textvariable info(primer_salt) -from 0 -to 1000 -validate all -validatecommand "entry_integer %P %W %V 1 1000"] -row 0 -column 2
    grid [label $a.concframe.ldna -text [mc "Primer (nM):"]] -row 1 -column 1
    grid [ttk::spinbox $a.concframe.edna -width 4 -textvariable info(primer_dna) -from 10 -to 1000 -validate all -validatecommand "entry_integer %P %W %V 1 1000"] -row 1 -column 2

  grid [frame $a.scomp -relief ridge -borderwidth 3] -row 7 -column 1 -columnspan 3 -pady 1
    grid [label $a.scomp.ltot -text [mc "total"]] -row 0 -column 1
    grid [label $a.scomp.ladj -text [mc "adjacent"]] -row 0 -column 2
    grid [label $a.scomp.ltp -text "3'"] -row 0 -column 3
    grid [checkbutton $a.scomp.lscomp -text [mc "Self complement: "] -variable info(primer_check_sc) -selectcolor white] -row 1 -column 0 -sticky e
    grid [ttk::spinbox $a.scomp.scomptot -width 4 -textvariable info(primer_scomp_tot_max) -from 0 -to 10 -validate all -validatecommand "entry_integer %P %W %V 1 1000" -width 3] -row 1 -column 1
    grid [ttk::spinbox $a.scomp.scompadj -width 4 -textvariable info(primer_scomp_adj_max) -from 0 -to 10 -validate all -validatecommand "entry_integer %P %W %V 1 1000" -width 3] -row 1 -column 2
    grid [ttk::spinbox $a.scomp.scompthree -width 4 -textvariable info(primer_scomp_3_max) -from 0 -to 10 -validate all -validatecommand "entry_integer %P %W %V 1 1000" -width 3] -row 1 -column 3
    grid [label $a.scomp.lhcomp -text [mc "Heterodimer: "]] -row 2 -column 0 -sticky e
    grid [ttk::spinbox $a.scomp.hcomptot -width 4 -textvariable info(primer_hcomp_tot_max) -from 0 -to 10 -validate all -validatecommand "entry_integer %P %W %V 1 1000" -width 3] -row 2 -column 1
    grid [ttk::spinbox $a.scomp.hcompadj -width 4 -textvariable info(primer_hcomp_adj_max) -from 0 -to 10 -validate all -validatecommand "entry_integer %P %W %V 1 1000" -width 3] -row 2 -column 2
    grid [ttk::spinbox $a.scomp.hcompthree -width 4 -textvariable info(primer_hcomp_3_max) -from 0 -to 10 -validate all -validatecommand "entry_integer %P %W %V 1 1000" -width 3] -row 2 -column 3
    #grid [label $a.scomp.lholigo -text [mc "Oligo: "]] -row 3 -column 0 -sticky e
    grid [entry $a.scomp.scompoligo -width 10 -textvariable info(primer_hcomp_oligo) -validate key -validatecommand {if {[regexp {[^atcgATGC]} %P] || ([string length %P] > 40)} {bell; return 0} else {return 1}} -width 35] -row 3 -column 0 -columnspan 4


  grid [label $a.lscan -text [mc "Orientation:"]] -row 8 -column 1 -sticky e
  tk_optionMenu $a.direction info(primer_scan) "5'-->3'" "3'<--5'"
  grid $a.direction -row 8 -column 2
  grid [label $a.lsort -text [mc "Sort by:"]] -row 9 -column 1 -sticky e
  tk_optionMenu $a.sort info(primer_sort) " 5'  " "  3'  " "length" "  %GC " "  Tm  "
  grid $a.sort -row 9 -column 2

  set ok 0
  if {!$info(android)} {
    grid [button $a.ok -width 9 -text [mc "OK"] -command "set ok 1" -default active] -row 10 -column 1 -columnspan 3 -padx 10 -pady 3
    bind $a <Key-Return> "set ok 1"
  }
  #grab $a
  focus $a
  update idletasks
  regexp {([0-9]*)x([0-9]*)\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry [winfo toplevel $a]] wgeom winw winh winx winy
  if {[expr {$winx+$winw}] > [winfo screenwidth .]} {set winx [expr {[winfo screenwidth .]-$winw}]}
  if {$winx < 0} {set winx 0}
  if {[expr {$winy+$winh}] > [winfo screenheight .]} {set winy [expr {[winfo screenheight .]-$winh}]}
  if {$winy < 0} {set winy 0}
  wm geometry [winfo toplevel $a] "+$winx+$winy"

  vwait ok
  set dialogblock 0
  foreach entry [list concframe.edna concframe.esalt scomp.scompoligo scomp.hcompthree scomp.hcompadj scomp.hcomptot scomp.scompthree scomp.scompadj scomp.scomptot eclampmax eclampmin e%gcmax e%gcmin eTmmax eTmmin elenmin elenmax] {
    $a.$entry validate
  }
  destroy $a
  bind . <<RaiseDialogs>> ""
  if {$ok == 1} {primer_scan_old $w}
  unset ok
}

################
## Primer scan
################
proc primer_scan_old {w} {
  global info
  global modifier
  global modstring

  $w configure -cursor watch
  $w.textarea configure -cursor watch
  update idletasks
  set log_dna [expr {1.987 * log( $info(primer_dna) / 1000000000.0)}] 
  set log_salt [expr {12 * log10($info(primer_salt) / 1000.0)}]

  if {[$w.textarea tag ranges sel] == ""} {
    if {[tk_messageBox -type okcancel -message [mc "No DNA is selected. Do you want to search the entire selection?"] -icon question -default ok] == "cancel"} {
      $w configure -cursor arrow
      $w.textarea configure -cursor xterm
      return
    }
    set first 1.0
    set last [end_ix $w.textarea]
  } else {
    set first [$w.textarea index sel.first]
    set last  [$w.textarea index sel.last]
  }
#selection used here 
  if {$info(primer_scan) == "3'<--5'"} {
    set text [textarea_get $w.textarea $first $last]
  } else {
    set text [revcom [textarea_get $w.textarea $first $last]]
  }
  set consec_regexp "[string repeat a [expr {1+$info(primer_consec_max)}]]|[string repeat c [expr {1+$info(primer_consec_max)}]]|[string repeat g [expr {1+$info(primer_consec_max)}]]|[string repeat t [expr {1+$info(primer_consec_max)}]]"
  set hc_oligo [string tolower $info(primer_hcomp_oligo)]

  regsub -nocase -all {[^acgt]} $text "t" text
  if {[string length $text] < $info(primer_len_min)} {
    tk_messageBox -type ok -message [mc "Selection is smaller than the minimum primer size"] -icon warning -default ok
    $w configure -cursor arrow
    $w.textarea configure -cursor xterm
    raise $w
    focus $w
    return
  }
  set text [string tolower $text]
  array set sadd {aa 222 tt 222 at 204 ta 213 ca 158 tg 296 gt 155 ac 293 ct 141 ag 279 ga 153 tc 291 cg 272 gc 244 gg 199 cc 199}
  array set hadd {aa 79 tt 79 at 72 ta 72 ca 63 tg 107 gt 62 ac 106 ct 56 ag 100 ga 60 tc 104 cg 106 gc 98 gg 80 cc 80}
  array set srem {aa -222 tt -222 at -204 ta -213 ca -296 tg -158 gt -293 ac -155 ct -279 ag -141 ga -291 tc -153 cg -272 gc -244 gg -199 cc -199}
  array set hrem {aa -79 tt -79 at -72 ta -72 ca -107 tg -63 gt -106 ac -62 ct -100 ag -56 ga -104 tc -60 cg -106 gc -98 gg -80 cc -80}
  
  if {[string first [string index $text 0] "at"] > -1} {
    set htot -46
    set stot -82 
    set gc 0
  } else {
    set htot -2
    set stot 56
    set gc 1
  }

  for {set i 0} {$i < [expr {$info(primer_len_min)-1}]} {incr i} {
    incr htot $hadd([string range $text $i [expr $i+1]])
    incr stot $sadd([string range $text $i [expr $i+1]])
    if {[string first [string index $text [expr $i+1]] "gc"] > -1} {incr gc}
  }
  set hmem $htot
  set smem $stot
  set gcmem $gc
 
  #set min_sc $info(primer_scomp_3_max)
  #if {$info(primer_scomp_adj_max) < $min_sc} {
  #  set min_sc $info(primer_scomp_adj_max)
  #}
  #if {$info(primer_scomp_tot_max) < $min_sc} {
  #  set min_sc $info(primer_scomp_tot_max)
  #}

  set primer_Tm_max [expr {$info(primer_Tm_max) + 0.4999999999}]
  set primer_Tm_min [expr {$info(primer_Tm_min) - 0.5}]
  set j $i
  set k 0

  set primerlist [list]
  while {$k < [expr {[string length $text]-$info(primer_len_min)-1}]} {
    regexp "^(g|c)*" [string range $text $k $j] clamp
    if {([string length $clamp] >= $info(primer_clamp_min)) && ([string length $clamp] <= $info(primer_clamp_max))} {
      while {[expr {$j-$k}] < $info(primer_len_max)} {
        if {[regexp $consec_regexp [string range $text $k $j]]} {
          break
        }
        set Tm [expr {$htot * 100.0 / ($stot * 0.1 - $log_dna) - 273.15 + $log_salt}]
        if {($Tm > $primer_Tm_max)} {
          break
        }
        if {($Tm > $primer_Tm_min && ([expr {$gc * 100 / ($j-$k+1)}] >= $info(primer_gc_min)) && ([expr {$gc * 100 / ($j-$k+1)}] <= $info(primer_gc_max)))} {
         #######add primer to list of acceptable primers here
          if {$info(primer_check_sc)} {
            set potential [revcom [string range $text $k $j]]
            set sc_list [oligo_self_compl $potential $potential]
            if {([lindex $sc_list 0] < $info(primer_scomp_tot_max)) && ([lindex $sc_list 1] < $info(primer_scomp_adj_max)) && ([lindex $sc_list 2] < $info(primer_scomp_3_max))} {
              if {$hc_oligo != ""} {
                set hc_list [oligo_self_compl $potential $hc_oligo]
                if {([lindex $hc_list 0] < $info(primer_hcomp_tot_max)) && ([lindex $hc_list 1] < $info(primer_hcomp_adj_max)) && ([lindex $hc_list 2] < $info(primer_hcomp_3_max))} {
                  lappend primerlist [list [expr $k+1] [expr $j+1] [string range $text $k $j] [expr {$gc * 100 / ($j-$k+1)}] $Tm [expr {$j-$k+1}] $sc_list $hc_list]
                }
              } else {
                lappend primerlist [list [expr $k+1] [expr $j+1] [string range $text $k $j] [expr {$gc * 100 / ($j-$k+1)}] $Tm [expr {$j-$k+1}] $sc_list "-----"]
              }
            }
          } elseif {$hc_oligo != ""} {
            set potential [revcom [string range $text $k $j]]
            set hc_list [oligo_self_compl $potential $hc_oligo]
            if {([lindex $hc_list 0] < $info(primer_hcomp_tot_max)) && ([lindex $hc_list 1] < $info(primer_hcomp_adj_max)) && ([lindex $hc_list 2] < $info(primer_hcomp_3_max))} {
              lappend primerlist [list [expr $k+1] [expr $j+1] [string range $text $k $j] [expr {$gc * 100 / ($j-$k+1)}] $Tm [expr {$j-$k+1}] "-----" $hc_list]
            }
          } else {
            lappend primerlist [list [expr $k+1] [expr $j+1] [string range $text $k $j] [expr {$gc * 100 / ($j-$k+1)}] $Tm [expr {$j-$k+1}] "-----" "-----"]
          }
        }
        if {($j == [expr {[string length $text]-1}])} {
          break
        }
        incr htot $hadd([string range $text $j [expr $j+1]])
        incr stot $sadd([string range $text $j [expr $j+1]])
        if {[string first [string index $text [expr $j+1]] "gc"] > -1} {incr gc}
        incr j
      }
    }
    incr hmem $hrem([string range $text $k [expr $k+1]])
    incr smem $srem([string range $text $k [expr $k+1]])
    if {[string first [string index $text $k] "gc"] > -1} {incr gcmem -1}
    incr k
    if {$i < [expr {[string length $text]-1}]} {
      incr hmem $hadd([string range $text $i [expr $i+1]])
      incr smem $sadd([string range $text $i [expr $i+1]])
      if {[string first [string index $text [expr $i+1]] "gc"] > -1} {incr gcmem}
      set j [incr i]
    } else {
      set j $i
    }
    set htot $hmem
    set stot $smem
    set gc $gcmem  
  }
  if {$primerlist != [list]} {
    set a [new_analysis_window $w "Find PCR Primers" find_primers]


    set first_tab [expr {[font measure dnafont "100000 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 100028"]/[winfo pixels $a "1c"]*1.01}]
    set tab_spacing [expr {[font measure dnafont "length "]/[winfo pixels $a "1c"]*1.0}]
    grid [text $a.heading -background $info(bg_color) -foreground $info(label_fg_color) -height 1 -relief flat -font labelfont -wrap none -width 120 -tabs "[expr {$first_tab}]c center [expr {$first_tab+$tab_spacing}]c center [expr {$first_tab+2*$tab_spacing}]c center [expr {$first_tab+3*$tab_spacing}]c left"] -row 0 -column 0 -columnspan 2 -sticky nswe
    #$a.heading insert end "[mc "Primer (5'-->3')"] \t[mc "length"]\t[mc "%GC"]\t[mc "Tm(\xB0\C)"]\t[mc "self/other(max adj 3')"]\n" 
    $a.heading configure -font dnafont
    $a.heading insert end [format %-54s%-7s%-4s%-7s%-7s\n [mc "Primer (5'-->3')"] [mc "length"] [mc "%GC"] [mc "Tm(\xB0\C)"] [mc "self/other(max adj 3')"]]
    $a.heading configure -state disabled 

    create_textframe $a 80
    #grid [text $a.textframe.text -yscrollcommand "$a.scroll set" -font dnafont -wrap none -width 120 -tabs "[expr {$first_tab}]c center [expr {$first_tab+$tab_spacing}]c center [expr {$first_tab+2*$tab_spacing}]c center [expr {$first_tab+3*$tab_spacing}]c left" -insertontime 0 -insertofftime 1000 -setgrid 1] -row 1 -column 0 -rowspan 2 -sticky nswe
    #grid [scrollbar $a.scroll -orient vertical -command "$a.textframe.text yview"] -row 1 -column 1 -sticky nswe
    #grid [frame $a.sp -height 10] -row 2 -column 1 -sticky swe

    $a.textframe.text configure -wrap none -width 120 -tabs "[expr {$first_tab}]c center [expr {$first_tab+$tab_spacing}]c center [expr {$first_tab+2*$tab_spacing}]c center [expr {$first_tab+3*$tab_spacing}]c left" -insertontime 0 -insertofftime 1000 -setgrid 1
    grid columnconfigure $a 0 -weight 1
    grid columnconfigure $a 1 -weight 0
    grid rowconfigure $a 2 -weight 1

    catch {$a.textframe.text insert end "[clock format [clock seconds] -format $info(clock_format)]\n"}
    set line_width [expr {int(($first_tab+4*$tab_spacing)*[winfo pixels $a "1c"]/[font measure dnafont "W"])}]
    for {set u 0} {$u < [string length [wm title $w]]} {incr u [expr {$line_width+1}]} {
      $a.textframe.text insert end "[string range [wm title $w] $u [expr {$u+ $line_width}]]\n"
    }
    #$a.textframe.text insert end "$info($w,filename) \n"
    $a.textframe.text insert end "From [expr {[ix2bp $w.textarea $first]+1}] to [ix2bp $w.textarea $last] ($info(primer_scan)) \n\n"
    $a.textframe.text insert end "Find PCR Primers\n" 
    #$a.textframe.text insert end "[mc "Primer (5'-->3')"] \t[mc "length"]\t[mc "%GC"]\t[mc "Tm(\xB0\C)"]\t[mc "self/other(max adj 3')"]\n"
    $a.textframe.text insert end [format %-54s%-7s%-4s%-7s%-7s\n [mc "Primer (5'-->3')"] [mc "length"] [mc "%GC"] [mc "Tm(\xB0\C)"] [mc "self/other(max adj 3')"]]
    set first [ix2bp $w.textarea $first]
    set last [ix2bp $w.textarea $last]
    set t 0

    switch $info(primer_sort) {
      " 5'  " {set primerlist [lsort -decreasing -integer -index 1 $primerlist]}
      "  3'  " {set primerlist [lsort -decreasing -integer -index 0 $primerlist]}
      "length" {set primerlist [lsort -integer -index 5 $primerlist]}
      "  %GC " {set primerlist [lsort -integer -index 3 $primerlist]}
      "  Tm  " {set primerlist [lsort -index 4 $primerlist]}
    }
    foreach primer $primerlist {
      if {$info(primer_scan) == "3'<--5'"} {
        $a.textframe.text insert end "[expr {$first+[lindex $primer 1]}] "
        $a.textframe.text insert end "[string toupper [revcom [lindex $primer 2]]] " "tag$t"
        $a.textframe.text insert end "[expr {$first+[lindex $primer 0]}]"
        $a.textframe.text tag bind "tag$t" <Button-1> "$a.textframe.text tag remove sel 1.0 end
          $a.textframe.text tag add sel tag$t.first tag$t.last
          $a.textframe.text mark set insert tag$t.last
          $a.textframe.text mark set anchor tag$t.first
          $a.textframe.text mark set tk::anchor$w.textarea tag$t.first
          select_region $w [bp2ix $w.textarea [expr {$first+[lindex $primer 0]-1}]] [bp2ix $w.textarea [expr {$first+[lindex $primer 1]}]]"
      } else {
        $a.textframe.text insert end "[expr {1+$last-[lindex $primer 1]}] "
        $a.textframe.text insert end "[string toupper [revcom [lindex $primer 2]]] " "tag$t"
        $a.textframe.text insert end "[expr {1+$last-[lindex $primer 0]}]"
        $a.textframe.text tag bind "tag$t" <Button-1> "$a.textframe.text tag remove sel 1.0 end
          $a.textframe.text tag add sel tag$t.first tag$t.last
          $a.textframe.text mark set insert tag$t.last
          $a.textframe.text mark set anchor tag$t.first
          $a.textframe.text mark set tk::anchor$w.textarea tag$t.first
          select_region $w [bp2ix $w.textarea [expr {$last-[lindex $primer 1]}]] [bp2ix $w.textarea [expr {$last-[lindex $primer 0]+1}]]"
      }
      $a.textframe.text tag bind "tag$t" <Double-Button-1> [$a.textframe.text tag bind "tag$t" <Button-1>]
      $a.textframe.text tag bind "tag$t" <Any-Leave> "%W tag remove highlite 1.0 end"
      $a.textframe.text tag bind "tag$t" <Any-Motion> "%W tag remove highlite 1.0 end; %W tag add highlite tag$t.first tag$t.last"
      $a.textframe.text tag bind "tag$t" <Enter> "%W tag remove highlite 1.0 end; %W tag add highlite tag$t.first tag$t.last"


      lappend info($w,linked_events) [list $a.textframe.text "tag$t" <Button-1>]

      $a.textframe.text insert end [string repeat " " [expr {55- [string length [$a.textframe.text get "end-1line linestart" "end-1line lineend"]]}]]
      $a.textframe.text insert end [format %3u [lindex $primer 5]]
      $a.textframe.text insert end [format %6u [lindex $primer 3]]
      $a.textframe.text insert end [format %5.0f [lindex $primer 4]]
      $a.textframe.text insert end [string repeat " " 4]
      if {[lindex [lindex $primer 6] 0] != "-----"} {
        $a.textframe.text insert end "[lrange [lindex $primer 6] 0 2]" "self_tag$t"
        $a.textframe.text tag bind "self_tag$t" <Any-Leave> "tooltip_leave %W; %W tag remove highlite 1.0 end"
        $a.textframe.text tag bind "self_tag$t" <Enter> "tooltip_enter %W {[primer_align_oligo_text [revcom [lindex $primer 2]] [revcom [lindex $primer 2]] [lrange [lindex $primer 6] 3 5]]} 1 dnafont; %W tag remove highlite 1.0 end; %W tag add highlite self_tag$t.first self_tag$t.last"
      } else {
        $a.textframe.text insert end "[lindex [lindex $primer 6] 0]"
      }
        $a.textframe.text insert end " /"
      if {[lindex [lindex $primer 7] 0] != "-----"} {
        $a.textframe.text insert end "[lrange [lindex $primer 7] 0 2]\n" "other_tag$t"
        $a.textframe.text tag bind "other_tag$t" <Any-Leave> "tooltip_leave %W; %W tag remove highlite 1.0 end"
        $a.textframe.text tag bind "other_tag$t" <Enter> "tooltip_enter %W {[primer_align_oligo_text  $hc_oligo [revcom [lindex $primer 2]] [lrange [lindex $primer 7] 3 5]]} 1 dnafont; %W tag remove highlite 1.0 end; %W tag add highlite other_tag$t.first other_tag$t.last"
      } else {
        $a.textframe.text insert end "[lindex [lindex $primer 7] 0] \n"
      }



      incr t
    }
    $a.textframe.text tag configure highlite -foreground red
    $a.textframe.text tag raise highlite sel
    bind $a.textframe.text <Button-1> "if \{\[lsearch -exact \[$a.textframe.text tag names @%x,%y\] sel\] != -1\} break"
    $a.textframe.text configure -state disabled
    set outputmenu [add_output_menu $a.textframe.text "Text" text $w]
    bind $a <Button-1> "focus $a.textframe.text" 
    bindtags $a.textframe.text [list $a.textframe.text AnalysisText $a . all]
    wm deiconify $a
    if {[info exists info(last_analysis_xy)]} {
      wm geometry [winfo toplevel $a] [textbox_geometry $a.textframe.text {*}$info(last_analysis_xy)]
    } else {
      scan [wm geometry [winfo toplevel $a]] "%dx%d+%d+%d" wid high xpt ypt
      wm geometry [winfo toplevel $a] [textbox_geometry $a.textframe.text $xpt $ypt]
    }
    window_on_screen $a
    focus $a.textframe.text
  } else {
    tk_messageBox -type ok -message [mc "No primers found"] -icon info -default ok
  }
  $w configure -cursor arrow
  $w.textarea configure -cursor xterm
}

################
## returns a text of aligning two oligos with given spacings
################
proc primer_align_oligo_text {o1 o2 spacing_list} {

  set result ""
  set o1 [string toupper $o1]
  set o2 [string toupper $o2]
  if {[string length $o1] > [string length $o2] } {
    set o3 $o1
    set o1 $o2
    set o2 $o3
    unset o3
  }
  foreach spacing $spacing_list {
    set line1 [string repeat " " [expr {$spacing}]]5'$o1
    append line1 3'
    set line2 [string repeat " " [expr {-$spacing}]]3'[string reverse $o2]5'
    append line1 [string repeat " " [expr {[string length $line2]-[string length $line1]}]]
    append line2 [string repeat " " [expr {[string length $line1]-[string length $line2]}]]
    set mline ""
    foreach a [split [string map {5 * 3 * ' * " " *} $line1] ""] b [split [string map {A T T A C G G C} $line2] ""] {
      append mline [expr {($a==$b)?"|":" "}]
    }
    append result $line1\n$mline\n$line2\n\n
  }
  set result [string trim $result \n]
  return $result
}

################
## find the complementarity between two oligos
################
#returns list of total, adjacent, and 3'

proc oligo_self_compl {o1 o2} {
  if {[string length $o2] < [string length $o1]} {
    set o3 $o1
    set o1 $o2
    set o2 $o3
  }
  set o2 [revcom $o2]
  set len_dif [expr {[string length $o2] - [string length $o1]}]

  set max_match 0
  set max_match_loc [expr {-[string length $o1]}]
  set max_adj 0
  set max_adj_loc [expr {-[string length $o1]}]
  set max_three 0
  set max_three_loc [expr {-[string length $o1]}]
  for {set i [expr {-[string length $o1]}]} {$i < [expr {[string length $o2]}]} {incr i} {
    if {$i <= 0} {
      set top [string range $o1 [expr {-$i}] end]
      set bottom [string range $o2 0 [expr {[string length $top]-1}]]
    } else {
      set bottom [string range $o2 $i [expr {$i+[string length $o1]-1}]]
      set top [string range $o1 0 [expr {[string length $bottom]-1}]]
    }
    set this_max_match 0
    set this_adj 0
    set this_adj_working 0
    set bottom_flag 1
    foreach x [split $top ""] y [split $bottom ""] {
      if {$x == $y} {
        incr this_max_match
        incr this_adj_working
        if {$this_adj_working > $this_adj} {set this_adj $this_adj_working}
      } else {
        if {($this_adj_working > $max_three) && ($i <= 0) && ($bottom_flag)} {set max_three $this_adj_working; set max_three_loc $i}
        set this_adj_working 0
        set bottom_flag 0  
      }
    }
    #sputs "$top\n$bottom\n$this_max_match $this_adj $this_adj_working $max_three"
    if {$this_max_match > $max_match} {set max_match $this_max_match; set max_match_loc $i}
    if {$this_adj > $max_adj} {set max_adj $this_adj; set max_adj_loc $i}
    #if {($this_adj_working > $max_three) && ($i <= $len_dif)} {set max_three $this_adj_working;}
  }
  return [list $max_match $max_adj $max_three $max_match_loc $max_adj_loc $max_three_loc]
} 



###############
## New primer commands
###############

proc primer_window {w} {
  global info dialogblock
  global   modifier modifier2 modstring modstring2 temp_info enzymes enzinfo
  if {$dialogblock == 1} {return}
  set a [new_dialog $w "Find PCR Primers" "FIND"]
  bind $a <<OK>> "primer_save_column_headings $a; dialog_cancel $a"
  bind $a <<Cancel>> "primer_save_column_headings $a; dialog_cancel $a"
  wm resizable $a 1 1


  grid [frame $a.treeframe] -row 1 -column  0 -rowspan 7  -sticky nswe
  grid [set tv [ttk::treeview $a.treeframe.tv  -yscrollcommand "optionscrollbar $a.treeframe.sc" -height 10]] -row 1 -column 1 -sticky nswe
  $tv configure  -selectmode browse -columns { Score 5' 3' Length Prod_Len Tm %GC Clamp Name Sum_Score} -displaycolumns {Name Score 5' 3' Length Prod_Len  Tm %GC }
  $tv heading #0 -text [mc "Sequence"] 
  $tv column #0 -width 70 -minwidth 50 -stretch 1 -anchor e
  $tv heading Score -text "[mc Score]  \u2193" -command "treeview_sort $tv Score 0 -integer;$tv see \[lindex \[$tv selection\] 0\]"
  $tv column Score -width 40 -minwidth 5 -stretch 1 -anchor w
  $tv heading 5' -text 5' -command "treeview_sort $tv 5' 0 -integer;$tv see \[lindex \[$tv selection\] 0\]"
  $tv column 5' -width 30 -minwidth 5 -stretch 1 -anchor w
  $tv heading 3'  -text 3'  -command "treeview_sort $tv 3' 0 -integer;$tv see \[lindex \[$tv selection\] 0\]"
  $tv column 3' -width 30 -minwidth 5 -stretch 1 -anchor w
  $tv heading Length -text [mc "Length"] -command "treeview_sort $tv Length 0 -integer;$tv see \[lindex \[$tv selection\] 0\]"
  $tv column Length -width 30 -minwidth 5 -stretch 1 -anchor w
  $tv heading Prod_Len -text [mc "Prod. Len"] -command "treeview_sort $tv Prod_Len 0 -integer;$tv see \[lindex \[$tv selection\] 0\] "
  $tv column Prod_Len -width 30 -minwidth 5 -stretch 1 -anchor w
  $tv heading Tm -text Tm -command "treeview_sort $tv Tm 0 -real;$tv see \[lindex \[$tv selection\] 0\]"
  $tv column Tm -width 30 -minwidth 5 -stretch 1 -anchor w
  $tv heading %GC -text %GC -command "treeview_sort $tv %GC 0 -integer;$tv see \[lindex \[$tv selection\] 0\]"
  $tv column %GC -width 30 -minwidth 5 -stretch 1 -anchor w
  $tv heading Clamp -text [mc "3'GC"] -command "treeview_sort $tv Clamp 0 -integer;$tv see \[lindex \[$tv selection\] 0\]"
  $tv column Clamp -width 30 -minwidth 5 -stretch 1 -anchor w
  $tv heading Name -text [mc "Name"] -command "treeview_sort $tv Name;$tv see \[lindex \[$tv selection\] 0\]"
  $tv column Name -width 30 -minwidth 5 -stretch 1 -anchor w
  $tv heading Sum_Score -text [mc "Sum Score"] -command "treeview_sort $tv Sum_Score 0 -integer;$tv see \[lindex \[$tv selection\] 0\]"
  $tv column Sum_Score -width 30 -minwidth 5 -stretch 1 -anchor w
  #$tv heading Self -text [mc Self] -command "treeview_sort $tv Self"
  #$tv column Self -width 30 -minwidth 5 -stretch 1 -anchor w
  grid [scrollbar $a.treeframe.sc -orient vertical -command "$a.treeframe.tv yview" -width 15] -row 1 -column 2 -sticky nse 
  grid rowconfigure $a.treeframe 1 -weight 1
  grid columnconfigure $a.treeframe 1 -weight 1
  $tv tag configure incompatible -foreground $info(primer_incompatible_color_fg)
  $tv tag configure bad -foreground [ mix_color [ttk::style configure Treeview -fieldbackground] gray50 80]
  bind $tv <<TreeviewSelect>> "primer_window_update_primer_pairs $a left"
  bind $tv <<Sort_column>> Score
  bind $tv <<Sort_direction>> 1
  bind $tv <$modifier-Key-c> "event generate $tv <<Copy>>"
  bind $tv <<Copy>> "clipboard clear;clipboard_append \[primer_window_get_text $a left 0\]"
      
  bind $tv <<RightClick>> "primer_rightclick %W %x %y "
  
  grid rowconfigure $a 7 -weight 1
  grid columnconfigure $a 0 -weight 1 -uniform 1
  grid columnconfigure $a 6 -weight 1 -uniform 1

  grid [frame $a.treeframe2] -row 1 -column  6 -rowspan 7  -sticky nswe
  grid [set tv [ttk::treeview $a.treeframe2.tv  -yscrollcommand "optionscrollbar $a.treeframe2.sc" -height 10 ]] -row 1 -column 1 -sticky nswe
  $tv configure  -selectmode browse -columns { Score 5' 3' Length Prod_Len Tm %GC Clamp Name Sum_Score} -displaycolumns {Name Score 5' 3' Length Prod_Len  Tm %GC }
  $tv heading #0 -text [mc "Sequence"] 
  $tv column #0 -width 50 -minwidth 50 -stretch 1 -anchor e
  $tv heading Score -text "[mc Score]  \u2193" -command "treeview_sort $tv Score 0 -integer;$tv see \[lindex \[$tv selection\] 0\]"
  $tv column Score -width 40 -minwidth 5 -stretch 1 -anchor w
  $tv heading 5' -text 5' -command "treeview_sort $tv 5' 0 -integer;$tv see \[lindex \[$tv selection\] 0\]"
  $tv column 5' -width 30 -minwidth 5 -stretch 1 -anchor w
  $tv heading 3' -text 3' -command "treeview_sort $tv 3' 0 -integer;$tv see \[lindex \[$tv selection\] 0\]"
  $tv column 3' -width 30 -minwidth 5 -stretch 1 -anchor w
  $tv heading Length -text [mc Length] -command "treeview_sort $tv Length 0 -integer;$tv see \[lindex \[$tv selection\] 0\]"
  $tv column Length -width 30 -minwidth 5 -stretch 1 -anchor w
  $tv heading Prod_Len -text [mc "Prod. Len"] -command "treeview_sort $tv Prod_Len 0 -integer;$tv see \[lindex \[$tv selection\] 0\]"
  $tv column Prod_Len -width 30 -minwidth 5 -stretch 1 -anchor w
  $tv heading Tm -text Tm -command "treeview_sort $tv Tm 0 -real;$tv see \[lindex \[$tv selection\] 0\]"
  $tv column Tm -width 30 -minwidth 5 -stretch 1 -anchor w
  $tv heading %GC -text %GC -command "treeview_sort $tv %GC 0 -integer;$tv see \[lindex \[$tv selection\] 0\]"
  $tv column %GC -width 30 -minwidth 5 -stretch 1 -anchor w
  $tv heading Clamp -text [mc "3'GC"] -command "treeview_sort $tv Clamp 0 -integer;$tv see \[lindex \[$tv selection\] 0\]"
  $tv column Clamp -width 30 -minwidth 5 -stretch 1 -anchor w
  $tv heading Name -text [mc "Name"] -command "treeview_sort $tv Name;$tv see \[lindex \[$tv selection\] 0\]"
  $tv column Name -width 30 -minwidth 5 -stretch 1 -anchor w
  $tv heading Sum_Score -text [mc "Sum Score"] -command "treeview_sort $tv Sum_Score 0 -integer;$tv see \[lindex \[$tv selection\] 0\]"
  $tv column Sum_Score -width 30 -minwidth 5 -stretch 1 -anchor w
  #$tv heading Self -text [mc Self] -command "treeview_sort $tv Self"
  #$tv column Self -width 30 -minwidth 5 -stretch 1 -anchor w
  grid [scrollbar $a.treeframe2.sc -orient vertical -command "$a.treeframe2.tv yview" -width 15] -row 1 -column 2 -sticky nse 
  grid rowconfigure $a.treeframe2 1 -weight 1
  grid columnconfigure $a.treeframe2 1 -weight 1
  $tv tag configure incompatible -foreground  $info(primer_incompatible_color_fg)
  $tv tag configure bad -foreground [ mix_color [ttk::style configure Treeview -fieldbackground] gray50 80]
  bind $tv <<TreeviewSelect>> "primer_window_update_primer_pairs $a right"
  bind $tv <<Sort_column>> Score
  bind $tv <<Sort_direction>> 1
  bind $tv <<RightClick>> "primer_rightclick %W %x %y "
  bind $tv <$modifier-Key-c> "event generate $tv <<Copy>>"
  bind $tv <<Copy>> "clipboard clear;clipboard_append \[primer_window_get_text $a right 0\]"
  
  set ridge "flat"
  grid [frame $a.templframe ] -row 1 -column 2 -sticky nswe -columnspan 3 
  grid [frame $a.templframe.templ ] -row 1 -column 1 -sticky nswe
  grid [label $a.templframe.templ.templ1 -text [mc "Template:"]] -row 1 -column 1 -sticky w
  grid [menubutton $a.templframe.templ.template -textvariable temp_info(pcr_template_display)] -row 1 -column 2  -sticky w
  tooltip_install $a.templframe.templ.template [mc "Select template sequence to design primers for."]
  $a.templframe.templ.template configure -menu [menu $a.templframe.templ.template.menu]
    foreach window [dnawindows_list 1] {
      $a.templframe.templ.template.menu add radiobutton -command "set temp_info(pcr_template_display) \[file rootname \[wm title $window\]\]; set temp_info(primer_target) \"\"; update_primer_target_menu $a" -variable temp_info(template_window) -value $window -label [file rootname [wm title $window]]
      if {$w eq $window} {
        set temp_info(template_window) $w
        set temp_info(pcr_template_display) [file rootname [wm title $window]]
      }
    }
    grid [frame $a.templframe.space] -row 2 -column 1 -sticky nswe
      grid [frame $a.templframe.space.space3 ] -row 0 -column 1 -columnspan 4 -sticky nswe
      grid [label $a.templframe.space.space3.targ -text [mc "Target:"]] -row 1 -column 1 -sticky w
      grid [menubutton $a.templframe.space.space3.target -textvariable temp_info(primer_target_text) ] -row 1 -column 2  -sticky w
      tooltip_install $a.templframe.space.space3.target [mc "Select the target sequence within the template."]
      $a.templframe.space.space3.target configure -menu [menu $a.templframe.space.space3.target.menu -postcommand "update_primer_target_menu $a"]
    
    grid [frame $a.templframe.space.space4 ] -row 1 -column 1 -columnspan 4 -sticky nswe
      grid [menubutton $a.templframe.space.space4.five -textvariable temp_info(primer_spacing_5_3_text) ] -row 1 -column 1  -sticky w
      tooltip_install $a.templframe.space.space4.five [mc "Select whether to measure distances relative to 5' or 3' end of potential primers."]
      $a.templframe.space.space4.five configure -menu [menu $a.templframe.space.space4.five.menu]
      foreach ft [list "primer" "primer 5' end" "primer 3' end"] v [list -1 0 1] {
        $a.templframe.space.space4.five.menu add radiobutton -label [mc $ft] -command "set temp_info(primer_spacing_5_3_text) {[mc $ft]}; set info(primer_spacing_5_3) $v; primer_window_fill_primer_treeviews $a"
        if {$info(primer_spacing_5_3) == $v} {
          set temp_info(primer_spacing_5_3_text) [mc $ft]
        }   
       }
      grid [label $a.templframe.space.space4.atml -text [mc "at most"]] -row 1 -column 2 -sticky w
      grid [ttk::spinbox $a.templframe.space.space4.elenmin -width 4 -textvariable info(primer_spacing_max) -from 1 -to 2000 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 1 2000"  -command "primer_window_fill_primer_treeviews $a"] -row 1 -column 3 -sticky w
      tooltip_install $a.templframe.space.space4.elenmin [mc "Select the maximum distance the primer end can be from the target."]
      grid [label $a.templframe.space.space4.llen -text [mc "bp"]] -row 1 -column 4 -sticky w
      grid [menubutton $a.templframe.space.space4.inout -textvariable temp_info(primer_spacing_in_out_text) ] -row 1 -column 5  -sticky w
      tooltip_install $a.templframe.space.space4.inout [mc "Select whether to search for potential primers insde or outside of the the target sequence."]
      $a.templframe.space.space4.inout configure -menu [menu $a.templframe.space.space4.inout.menu]
      foreach ft [list inside outside] v [list 0 1] {
        $a.templframe.space.space4.inout.menu add radiobutton -label [mc $ft] -command "set temp_info(primer_spacing_in_out_text) {[mc $ft]}; set info(primer_spacing_in_out) $v; primer_window_fill_primer_treeviews $a"
        if {$info(primer_spacing_in_out) == $v} {
          set temp_info(primer_spacing_in_out_text) [mc $ft]
        }   
      }
      grid [label $a.templframe.space.space4.targ -text [mc "target"]] -row 1 -column 6 -sticky w

    grid [frame $a.templframe.space3 ] -row 3 -column 1 -sticky nswe
      grid [label $a.templframe.space3.show -text [mc "Only show the best"]] -row 1 -column 2 -sticky w
      grid [menubutton $a.templframe.space3.primersshow -textvariable info(numer_of_primers_to_show) ] -row 1 -column 3  -sticky w
      tooltip_install $a.templframe.space3.primersshow [mc "Limit the numer of primers to show."]
      grid [label $a.templframe.space3.primersl -text [mc "primers."]] -row 1 -column 4 -sticky w
      $a.templframe.space3.primersshow  configure -menu [menu $a.templframe.space3.primersshow.menu]
      foreach ft [list 3 5 10 15 20 25 50 100]  {
        $a.templframe.space3.primersshow.menu add radiobutton -label $ft -variable info(numer_of_primers_to_show) -command "primer_window_fill_primer_treeviews $a"
      }
          
          
    grid [frame $a.templframe.space2 ] -row 4 -column 1 -sticky nswe
	  grid [label $a.templframe.space2.sellabl -text [mc "Selecting a primer in the tables:"]] -row 1 -column 3
	  tooltip_install $a.templframe.space2.sellabl [mc "Select the primer or PCR sequence in the original template window when you select a potential primer."]
	  grid [ttk::menubutton $a.templframe.space2.sel -textvariable temp_info(primer_template_selection_text) ] -row 1 -column 4  -sticky w
	  tooltip_install $a.templframe.space2.sel [mc "Set your preference for selecting the primer or PCR sequence in the original template window."]
	  $a.templframe.space2.sel configure -menu [menu $a.templframe.space2.sel.menu]
	  $a.templframe.space2.sel.menu insert end radiobutton -command "set temp_info(primer_template_selection_text) \{[mc {Do Nothing}]\}" -label [mc "Do Nothing"] -variable info(primer_template_selection) -value 0
	  $a.templframe.space2.sel.menu insert end radiobutton -command "set temp_info(primer_template_selection_text) \{[mc {Select PCR Product}]\}" -label [mc "Select PCR Product"] -variable info(primer_template_selection) -value 1
	  $a.templframe.space2.sel.menu insert end radiobutton -command "set temp_info(primer_template_selection_text) \{[mc {Select Primer Sequence}]\}" -label [mc "Select Primer Sequence"] -variable info(primer_template_selection) -value 2
	  set info(primer_template_selection) 0
	  set temp_info(primer_template_selection_text) [lindex [list [mc {Keeps the Original Selection}] [mc {Selects PCR Product}] [mc {Selects Primer Sequence}] ] $info(primer_template_selection)] 
    
  #grid [checkbutton $a.templframe.space3.target_inv -text [mc "Inverse PCR"] -variable info(pcr_inverse) -command "primer_window_fill_primer_treeviews $a"] -row 1 -column 3  -sticky w

      grid columnconfigure $a.templframe 1 -weight 1

  grid [ttk::separator $a.sep1] -row 2 -column 2 -sticky nswe -columnspan 3 

  grid [frame $a.minmaxframe -relief $ridge -borderwidth 3] -row 3 -column 2 -sticky nswe  -columnspan 3 
  
    grid [label $a.minmaxframe.filt -text [mc "Filter"]] -row 0 -column 2 -columnspan 2
    tooltip_install $a.minmaxframe.filt [mc "Potential primers will only be shown that meet the following filter parameters."]
    grid [label $a.minmaxframe.lmin -text [mc "Minimum"]] -row 1 -column 2
    tooltip_install $a.minmaxframe.lmin [mc "Potential primers will only be shown that meet the following minimum values, inclusive."]
    grid [label $a.minmaxframe.lmax -text [mc "Maximum"]] -row 1 -column 3
    tooltip_install $a.minmaxframe.lmax [mc "Potential primers will only be shown that meet the following maximum values, inclusive."]
    
    grid [ttk::separator  $a.minmaxframe.vertseparator -orient vertical] -row 0 -column 4 -rowspan 9 -sticky ns
        
    grid [label $a.minmaxframe.sort -text [mc "Score (Lower is Better)"]] -row 0 -column 5 -columnspan 4 -sticky s
    tooltip_install $a.minmaxframe.sort [mc "Primers are scored by the sum of their difference from the preferred value multiplied by the score weight of each parameter."]
    grid [label $a.minmaxframe.pref -text [mc "Preferred Value"]] -row 1 -column 5
    tooltip_install $a.minmaxframe.pref [mc "Set each preferred value for your primer parameters. A perfect match to these values will give a score of zero"]
    grid [label $a.minmaxframe.lweight -text [mc "Weight"]] -row 1 -column 6
    tooltip_install $a.minmaxframe.lweight [mc "Set the weight to 100 for each important parameter. Set the weight to 0 for any parameter that you want to ignore.\n"]
    grid [ttk::checkbutton $a.minmaxframe.lweightgt -text [mc "Weight >"] -variable info(primer_use_wt_gt) -command "primer_window_target_weights_gt_dialog $a.minmaxframe 1"] -row 1 -column 7
    tooltip_install $a.minmaxframe.lweightgt [mc "Turn on/off second weight parameter. Weights < are applied to values less than the preferred value. Weights > are applied to values greater than the preferred value."]
    
    grid [label $a.minmaxframe.llen -text [mc "Length: "]] -row 2 -column 1 -sticky e
    tooltip_install $a.minmaxframe.llen [mc "Length in bases of the potential primer."]
    grid [ttk::spinbox $a.minmaxframe.elenprefer -width 4 -textvariable info(primer_len_prefer) -from 10 -to 100 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 10 100 blank" -command "primer_window_fill_primer_treeviews $a"] -row 2 -column 5
    grid [ttk::spinbox $a.minmaxframe.elenweight -width 4 -textvariable info(primer_len_wt_lt) -from 0 -to 100 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 0 100" -command "primer_window_fill_primer_treeviews $a"] -row 2 -column 6
    grid [ttk::spinbox $a.minmaxframe.elenweightgt -width 4 -textvariable info(primer_len_wt_gt) -from 0 -to 100 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 0 100 max" -command "primer_window_fill_primer_treeviews $a"] -row 2 -column 7
    grid [ttk::spinbox $a.minmaxframe.elenmin -width 4 -textvariable info(primer_len_min) -from 10 -to 100 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 10 100" -command "primer_window_fill_primer_treeviews $a"] -row 2 -column 2
    grid [ttk::spinbox $a.minmaxframe.elenmax -width 4 -textvariable info(primer_len_max) -from 10 -to 100 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 10 100 max" -command "primer_window_fill_primer_treeviews $a"] -row 2 -column 3

    grid [label $a.minmaxframe.lTm -text "Tm: "] -row 3 -column 1 -sticky e
    tooltip_install $a.minmaxframe.lTm [mc "Melting temperature in C of the potential primer."]
    grid [ttk::spinbox $a.minmaxframe.eTmprefer -width 4 -textvariable info(primer_Tm_prefer) -from 40 -to 80 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 40 80 blank" -command "primer_window_fill_primer_treeviews $a"] -row 3 -column 5
    grid [ttk::spinbox $a.minmaxframe.eTmweight  -width 4 -textvariable info(primer_Tm_wt_lt) -from 0 -to 100 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 0 100" -command "primer_window_fill_primer_treeviews $a"] -row 3 -column 6
    grid [ttk::spinbox $a.minmaxframe.eTmweightgt  -width 4 -textvariable info(primer_Tm_wt_gt) -from 0 -to 100 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 0 100 max" -command "primer_window_fill_primer_treeviews $a"] -row 3 -column 7
    grid [ttk::spinbox $a.minmaxframe.eTmmin -width 4 -textvariable info(primer_Tm_min) -from 40 -to 80 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 40 80" -command "primer_window_fill_primer_treeviews $a"] -row 3 -column 2
    grid [ttk::spinbox $a.minmaxframe.eTmmax -width 4 -textvariable info(primer_Tm_max) -from 40 -to 80 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 40 80 max" -command "primer_window_fill_primer_treeviews $a"] -row 3 -column 3

    grid [label $a.minmaxframe.l%gc -text "%GC: " -justify right] -row 4 -column 1 -sticky e
    tooltip_install $a.minmaxframe.l%gc [mc "Percent of bases that are G or C in the potential primer."]
    grid [ttk::spinbox $a.minmaxframe.e%gcprefer -width 4 -textvariable info(primer_gc_prefer) -from 0 -to 100 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 0 100 blank" -command "primer_window_fill_primer_treeviews $a"] -row 4 -column 5
    grid [ttk::spinbox $a.minmaxframe.e%gcweight -width 4 -textvariable info(primer_gc_wt_lt) -from 0 -to 100 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 0 100" -command "primer_window_fill_primer_treeviews $a"] -row 4 -column 6
    grid [ttk::spinbox $a.minmaxframe.e%gcweightgt -width 4 -textvariable info(primer_gc_wt_gt) -from 0 -to 100 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 0 100 max" -command "primer_window_fill_primer_treeviews $a"] -row 4 -column 7
    grid [ttk::spinbox $a.minmaxframe.e%gcmin -width 4 -textvariable info(primer_gc_min) -from 0 -to 100 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 0 100" -command "primer_window_fill_primer_treeviews $a"] -row 4 -column 2
    grid [ttk::spinbox $a.minmaxframe.e%gcmax -width 4 -textvariable info(primer_gc_max) -from 0 -to 100 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 0 100 max" -command "primer_window_fill_primer_treeviews $a"] -row 4 -column 3
    
    grid [label $a.minmaxframe.lclamp -text [mc "3' GC: "]] -row 5 -column 1 -sticky e
    tooltip_install $a.minmaxframe.lclamp [mc "Number of consecutive G or C bases in the extreme 3' end of the potential primer."]
    grid [ttk::spinbox $a.minmaxframe.eclampprefer -width 4 -textvariable info(primer_clamp_prefer) -from 0 -to 5 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 0 5 blank" -command "primer_window_fill_primer_treeviews $a"] -row 5 -column 5
    grid [ttk::spinbox $a.minmaxframe.eclampweight -width 4 -textvariable info(primer_clamp_wt_lt) -from 0 -to 100 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 0 100" -command "primer_window_fill_primer_treeviews $a"] -row 5 -column 6
    grid [ttk::spinbox $a.minmaxframe.eclampweightgt -width 4 -textvariable info(primer_clamp_wt_gt) -from 0 -to 100 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 0 100 max" -command "primer_window_fill_primer_treeviews $a"] -row 5 -column 7
    grid [ttk::spinbox $a.minmaxframe.eclampmin -width 4 -textvariable info(primer_clamp_min) -from 0 -to 5 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 0 5" -command "primer_window_fill_primer_treeviews $a"] -row 5 -column 2
    grid [ttk::spinbox $a.minmaxframe.eclampmax -width 4 -textvariable info(primer_clamp_max) -from 0 -to 5 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 0 5 max" -command "primer_window_fill_primer_treeviews $a"] -row 5 -column 3
    
    grid [label $a.minmaxframe.lconcec -text [mc "Homopolymer: "]] -row 6 -column 1 -columnspan 2 -sticky e
    tooltip_install $a.minmaxframe.lconcec [mc "Length of strings of consecutive identical bases (ex. strings of GGGGG or TTTTTT) anywhere in the potential primer."]
    grid [ttk::spinbox $a.minmaxframe.econsecmax -width 4 -textvariable info(primer_consec_max) -from 1 -to 15 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 0 15 max" -command "primer_window_fill_primer_treeviews $a"] -row 6 -column 3
        
    grid [label $a.minmaxframe.lscomp -text [mc "Self Complementarity:"] ] -row 7 -column 1 -columnspan 2 -sticky e
    tooltip_install $a.minmaxframe.lscomp [mc "Maximum allowed alignment score of the potential primer to itself. Scores are +1 for match, -1 for mismatch and -2 for a gap."]
    grid [ttk::spinbox $a.minmaxframe.scomptot -width 4 -textvariable info(primer_scomp_tot_max) -from 0 -to 20 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 0 20 blank" -width 4 -command "primer_window_fill_primer_treeviews $a"] -row 7 -column 3
    grid [label $a.minmaxframe.lscomp3 -text [mc "Self 3' Complementarity:"] ] -row 8 -column 1 -columnspan 2 -sticky e
    tooltip_install $a.minmaxframe.lscomp3 [mc "Maximum allowed alignment score of the potential primer to itself, with at least one base matching at the 3' end. Scores are +1 for match, -1 for mismatch and -2 for a gap."]
    grid [ttk::spinbox $a.minmaxframe.scompthree -width 4 -textvariable info(primer_scomp_3_max) -from 0 -to 10 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 1 10 blank" -width 4 -command "primer_window_fill_primer_treeviews $a"] -row 8 -column 3
  
    grid [ttk::checkbutton $a.minmaxframe.lcompf -text [mc ""]  -variable info(primer_use_comp_filter) -command "primer_window_fill_primer_treeviews $a"] -row 9 -column 1 -columnspan 1 -sticky e
    grid [ttk::menubutton $a.minmaxframe.mcompf -text [mc "Composition Filters"] -menu $a.minmaxframe.mcompf.menu]  -sticky w -row 9 -column 2 -columnspan 4
    menu $a.minmaxframe.mcompf.menu -postcommand "primer_window_fill_comp_filter_menu $a $a.minmaxframe.mcompf.menu"
    grid [ttk::entry $a.minmaxframe.ecompf -textvariable info(primer_comp_filter_text) -validate focusout -validatecommand " primer_window_fill_primer_treeviews $a; return 1"] -sticky ew -row 9 -column 3 -columnspan 4
    grid remove $a.minmaxframe.ecompf
    bind $a.minmaxframe.ecompf <Key-Return> "focus $a.minmaxframe.scomptot"
    set help_text [mc "Composition filters: semicolon/comma separated lists of:
1. filter a range of bases in the primer for a minimum or maximum number of bases: 
(i or e)   +/-index1   +/-index2   min_number_of_bases   max_number_of_bases   list_of_bases_or_degenerate_code
  i means (i)nclude: require the primer to meet the condition
  e means (e)xclude: reject all primers that meet the condition
  +index are bases counting from the 5' end of the primer. +1 is the first 5' base
  -index are bases counting from the 3' end. -1 is the first 3' base
  the list of bases is just a string of the bases you want to look for. To look for either G or C use GC or use the IUPAC degenerate code S
2. filter a range of bases in the primer for a minimum or maximum number of adjacent bases: 
(i)nclude/(e)xclude +/-index1 +/-index2 -1 max_number_of_bases_allowed list_of_bases_or_degenerate_code
  using -1 as the minimum number of bases signals that you are NOT looking for a total count of the search base but are looking for a consecutive string of adjacent occurences of that base
3. filter a range of bases in the primer for a sequence(s): 
(i)nclude/(e)xclude +/-index1 +/-index2 -2 0 sequence_to_find
  using -2 as the minimum number of bases signals that you are NOT looking for a total count of the search base but are looking for an exact occurence of your search string.
  The maximum number of bases is ignored, but must be an integer.
  The search string can use the | character to search for alternative strings.
  To search for EITHER the string CGA or GCA, use CGA|GCA. 
  To match more than one possibility, you MUST use the degenerate code.
  The string WWG will search for AAG, ATG, TAG, and TTG
Examples:

Require exactly 3 GC pairs in the last 5 bases of the primer
i -5 -1 3 3 s
or
i -3 -1 3 3 gc
Remove primers with more than 6 adjacent C or G anywhere in the sequence
i +1 -1 -1 6 s
or
i +1 -1 -1 5 gc
Remove primers ending with the sequence gc or the sequence cg:
e -2 -1 -2 0 gc|cg
"]  
    menu $a.minmaxframe.ecompf.popupmenu
    $a.minmaxframe.ecompf.popupmenu add command  -label [mc "Copy help text to clipboard"] -command "clipboard clear;clipboard_append \{$help_text\}"
    bind $a.minmaxframe.ecompf <<RightClick>> "tk_popup $a.minmaxframe.ecompf.popupmenu %X %Y"

    tooltip_install $a.minmaxframe.ecompf [mc "Right click to copy help text to the clipboard."]
    tooltip_install $a.minmaxframe.lcompf [mc "Turn the composition filtering on or off."]

    grid [ttk::button $a.minmaxframe.show -command "set info(primer_window_show_advanced) \[expr {!\$info(primer_window_show_advanced)}\];primer_window_show_hide_advanced $a"] -row 10 -column 1 -columnspan 2
    tooltip_install $a.minmaxframe.show [mc "The simplified default values are designed to not fail to find a primer, but are not designed to find the best primer. Please turn on advanced setting to set primer filters and compatibility checks."]
    grid [ttk::separator $a.minmaxframe.sep1] -row 11 -column 1 -sticky nswe -columnspan 7 
    grid [label $a.minmaxframe.complablel -text [mc "Primer Pair Incompatibility"]] -row 12 -column 1  -columnspan 2 -sticky w
    tooltip_install $a.minmaxframe.complablel [mc "User selected primer pairs are compared for compatibility. All of the right side primers are compared to the selected left side primer and vice versa. Incompatible primers are colored with the color selected."]
    grid [color_button $a.minmaxframe.compcolor info(primer_incompatible_color_fg) [font actual labelfont -size]] -row 12 -column 3 -sticky w
    tooltip_install $a.minmaxframe.compcolor [mc "Select the color used to indicate incompatible primers here."]
    bind $a.minmaxframe.compcolor <<color_picked>> "$a.treeframe2.tv tag configure incompatible -foreground \$info(primer_incompatible_color_fg); $a.treeframe.tv tag configure incompatible -foreground \$info(primer_incompatible_color_fg); after idle \"wm deiconify $a\""
    grid [label $a.minmaxframe.ltmdif -text [mc "Pair Tm difference: "]] -row 13 -column 1  -columnspan 2 -sticky e
    tooltip_install $a.minmaxframe.ltmdif [mc "The maximum difference in melting temperature of the two selected primers."]
    grid [ttk::spinbox $a.minmaxframe.tmdifmax -width 4 -textvariable info(primer_tmdiff_max) -from 0 -to 20 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 0 20 max 2" -command "primer_window_update_hetro_data $a"] -row 13 -column 3
    grid [label $a.minmaxframe.lhcomp -text [mc "Pair Complementarity:"] ]  -row 14 -column 1  -columnspan 2 -sticky e
    tooltip_install $a.minmaxframe.lhcomp [mc "Maximum allowed alignment score of the potential primer to each other. Scores are +1 for match, -1 for mismatch and -2 for a gap."]
    grid [ttk::spinbox $a.minmaxframe.hcomptot -width 4 -textvariable info(primer_hcomp_tot_max) -from 0 -to 50 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 0 20 blank" -width 4 -command "primer_window_update_hetro_data $a"] -row 14 -column 3
    grid [label $a.minmaxframe.lhcomp3 -text [mc "Pair 3' Complementarity:"]]  -row 15 -column 1  -columnspan 2 -sticky e
    tooltip_install $a.minmaxframe.lhcomp3 [mc "Maximum allowed alignment score of the potential primer to each other, with at least one base matching at the 3' end. Scores are +1 for match, -1 for mismatch and -2 for a gap."]
    grid [ttk::spinbox $a.minmaxframe.hcompthree -width 4 -textvariable info(primer_hcomp_3_max) -from 0 -to 50 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 0 20 blank" -width 4 -command "primer_window_update_hetro_data $a"] -row 15 -column 3
    grid [label $a.minmaxframe.holigolabel -text [mc "Pair oligo:"]]  -row 16 -column 0  -columnspan 3 -sticky e
    tooltip_install $a.minmaxframe.holigolabel [mc "Primer incompatibility will be scored relative to this oligo sequence instead of the selection on the other side."]
    grid [ttk::entry $a.minmaxframe.hcompoligo -width 10 -textvariable info(primer_hcomp_oligo) -validate key -validatecommand {if {[regexp {[^atcgATGC]} %P] || ([string length %P] > 40)} {bell; return 0} else {return 1}} -width 35] -row 16 -column 3 -columnspan 4

   
  grid [ttk::separator $a.sep2] -row 4 -column 2 -sticky nswe -columnspan 3 

  grid [frame $a.nameframe -relief $ridge -borderwidth 3] -row 5 -column 2 -sticky nswe  -columnspan 3 -pady 3
      grid [label $a.nameframe.pnamel -text [mc "Next Primer Name:"]] -row 0 -column 1 -sticky e
      tooltip_install $a.nameframe.pnamel "Set the name that will be applied to primers using the command in the menu button to the right. Also use the menu button to set variable text in the name."
      grid [ttk::entry $a.nameframe.entry -textvariable info(primer_name_string) -width 15] -row 0 -column 2  -columnspan 1 -sticky w
      tooltip_install $a.nameframe.entry "Set the name that will be applied to primers using the command in the menu button to the right. Also use the menu button to set variable text in the name."
      grid [ttk::menubutton $a.nameframe.sub -text [mc "Name Primers"] -menu $a.nameframe.sub.menu ] -row 0 -column 3 -columnspan 1
      tooltip_install $a.nameframe.sub [mc "Commands for adding names to potential primers can be found here."]
        menu $a.nameframe.sub.menu 
        $a.nameframe.sub.menu add command -label [mc "Add Names to Selected Primer Pairs"] -command "primer_window_add_name $a left; primer_window_add_name $a right"
        $a.nameframe.sub.menu add command -label [mc "Add Name to Selected Left Primer"] -command "primer_window_add_name $a left"
        $a.nameframe.sub.menu add command -label [mc "Add Name to Selected Right Primer"] -command "primer_window_add_name $a right"
        $a.nameframe.sub.menu add command -label [mc "Clear Names From Selected Primer Pairs"] -command "primer_window_add_name $a left clear; primer_window_add_name $a right clear"
        $a.nameframe.sub.menu add cascade -label [mc "Insert Substitution Codes into Name Field"] -menu [menu $a.nameframe.sub.menu.sub]
        foreach {mlabel subs} [list [mc "Next Number"] %# [mc "Next Number (3 digit)"] %3 [mc "Next Number(4 digit)"] %4 [mc "Next Number(5 digit)"] %5 [mc "Next Number(6 digit)"] %6  [mc "Target Name"] %T  [mc "Template Name"] %t [mc "Direction Fwd/Rev"] %W [mc "Direction fwd/rev"] %w [mc "Direction F/R"] %F [mc "Direction f/r"] %f [mc "5' Location"] %L [mc "Year"] %y [mc "Month"] %m [mc "Day"] %d [mc "Just a %% character"] %% ] {
          $a.nameframe.sub.menu.sub  add command -label [mc "$mlabel (%1\$s)" $subs] -command "$a.nameframe.entry insert insert \"$subs\""
        }
      grid [label $a.nameframe.pnuml -text [mc "Next Primer Number:"]] -row 1 -column 1
      tooltip_install $a.nameframe.pnuml [mc "If your primer name contains a %%# substitution variable, this will be the primer number of the next name applied."]
      grid [ttk::spinbox $a.nameframe.pnumber -textvariable info(primer_next_number) -from 0 -to 20 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 0 100000 min" -width 4 -command ""] -row 1 -column 2 -columnspan 1 -sticky w
      tooltip_install $a.nameframe.pnumber [mc "If your primer name contains a %%# substitution variable, this will be the primer number of the next name applied."]

      
  grid [frame $a.concframe -relief $ridge -borderwidth 3] -row 6 -column 2 -sticky nswe  -columnspan 3 -pady 3
  grid remove $a.concframe
    grid [label $a.concframe.lsalt -text [mc "Na+ (mM):"]] -row 0 -column 1
    grid [ttk::spinbox $a.concframe.esalt -width 4 -textvariable info(primer_salt) -from 0 -to 1000 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 1 1000" -command "primer_window_fill_primer_treeviews $a"] -row 0 -column 2
    grid [label $a.concframe.lsalt2 -text [mc "Mg++ (mM):"]] -row 0 -column 3
    grid [ttk::spinbox $a.concframe.esalt2 -width 4 -textvariable info(primer_salt2) -from 0 -to 1000 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 1 1000" -command "primer_window_fill_primer_treeviews $a"] -row 0 -column 4
    grid [label $a.concframe.ldna -text [mc "Primer (nM):"]] -row 1 -column 1
    grid [ttk::spinbox $a.concframe.edna -width 4 -textvariable info(primer_dna) -from 10 -to 1000 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 1 1000" -command "primer_window_fill_primer_treeviews $a"] -row 1 -column 2
    grid [label $a.concframe.ldntp -text [mc "dNTP (mM):"]] -row 1 -column 3
    grid [ttk::spinbox $a.concframe.edntp -width 4 -textvariable info(primer_dntp) -from 1 -to 1000 -validate all -validatecommand "primer_window_entry_integer %s %P %W %V 1 1000" -command "primer_window_fill_primer_treeviews $a"] -row 1 -column 4

  primer_window_target_weights_gt_dialog $a.minmaxframe
  set temp_info(primer_target) ""
  update_primer_target_menu $a

    grid [ttk::separator $a.sep3] -row 1 -column 1 -sticky ns -rowspan 9
    grid [ttk::separator $a.sep4] -row 1 -column 5 -sticky ns -rowspan 9
    
  grid [frame $a.left_cmd] -row 8 -column 0 -sticky nswe 
    grid [ttk::menubutton $a.left_cmd.cmd -text [mc "Left Primer"] ] -row 1 -column 2 
    tooltip_install $a.left_cmd.cmd [mc "Commands for copy/paste or saving primers from the left side list can be found here."]
    $a.left_cmd.cmd  config -menu [menu $a.left_cmd.cmd.menu]
    $a.left_cmd.cmd.menu insert end command -command "primer_window_add_remove_primer_feature $a left \[lindex \[$a.treeframe.tv selection\] 0\] 1" -label [mc "Add/ Remove Selected Primer as primer_bind Feature"]
    #$a.left_cmd.cmd.menu insert end command -command "primer_window_add_remove_primer_feature $a left \[lindex \[$a.treeframe.tv selection\] 0\] 1" -label [mc "Remove Selected Primer as Feature in Template Sequence"]
    $a.left_cmd.cmd.menu insert end command -command "clipboard clear;clipboard_append \[primer_window_get_text $a left 0\]" -label [mc "Copy Selected Primer: Sequence Only"]
    $a.left_cmd.cmd.menu insert end command -command "clipboard clear;clipboard_append \[primer_window_get_text $a left 1\]" -label [mc "Copy Selected Primer: Tab Delimited Name + Sequence"] 
    $a.left_cmd.cmd.menu insert end command -command "clipboard clear;clipboard_append \[primer_window_get_text $a left 2 1\]" -label [mc "Copy Selected Primer: Tab Delimited Text"] 
    $a.left_cmd.cmd.menu insert end command -command "clipboard clear;clipboard_append \[primer_window_get_text $a left 2 0\]" -label [mc "Copy Table: Tab Delimted Text"] 
    #$a.left_cmd.cmd.menu insert end command -command "sputs save to text" -label [mc "Save Selected Primer to Text File..."] -state disabled
    #$a.left_cmd.cmd.menu insert end command -command "sputs append to text" -label [mc "Append Selected Primer to Text File..."] -state disabled
    
    grid [label $a.left_cmd.addl -text [mc "5' Add:"]] -row 1 -column 3
    tooltip_install $a.left_cmd.addl [mc "Enter bases to add to the 5' end of the left primer here."]
    grid [ttk::entry $a.left_cmd.add -width 10 -textvariable temp_info(left_primer_add_seq) -width 9] -row 1 -column 4
    set temp_info(left_primer_add_seq) ""
    tooltip_install $a.left_cmd.add [mc "Enter bases to add to the 5' end of the left primer here."]
    grid [ttk::menubutton $a.left_cmd.re -text [mc "RE"] -menu $a.left_cmd.re.menu] -row 1 -column 5 
    tooltip_install $a.left_cmd.re [mc "Find restriction enzyme recognition sites to add to the 5' end of the left primer here."]
     ## add RE to menu
	  set count 0
	  set menu_num 0
	  set menu [menu $a.left_cmd.re.menu]
	  $menu delete 0 end
	  foreach enz $enzymes {
		if {[expr {$count % 15}] ==0} {
		  if {$count != 0} {
			$menu entryconfigure end -label "$first_enz-$last_enz"
		  }
		  catch {destroy $menu.m$menu_num}
		  set current_menu [menu $menu.m$menu_num]
		  incr menu_num
		  $menu add cascade -menu $current_menu
		  set first_enz $enz
		}
		if {$enzinfo(flatpat,$enz) eq [revcom $enzinfo(flatpat,$enz)]} {
		  $current_menu add command -label $enz  -command "$a.left_cmd.add insert insert  $enzinfo(flatpat,$enz)"
		} else {
		  $current_menu add command -label [mc {%1$s (Fowrard)} $enz]  -command "$a.left_cmd.add insert insert $enzinfo(flatpat,$enz)"
		  $current_menu add command -label [mc {%1$s (Reverse)} $enz]  -command "$a.left_cmd.add insert insert [revcom $enzinfo(flatpat,$enz)]"
		}
		set last_enz $enz
		incr count
	  }
	  $menu entryconfigure end -label "$first_enz-$last_enz" 
    grid [frame $a.center_cmd] -row 8 -column 2 -columnspan 3  -sticky nswe
    grid [ttk::menubutton $a.center_cmd.cmd -text [mc "Primer Pairs"]] -row 1 -column 2 
    tooltip_install $a.center_cmd.cmd [mc "Commands for PCR, copy/paste, or saving primer pairs can be found here."]
    $a.center_cmd.cmd  config -menu [menu $a.center_cmd.cmd.menu]
    $a.center_cmd.cmd.menu insert end command -command "primer_window_do_pcr $a" -label [mc "New PCR"] 
    $a.center_cmd.cmd.menu insert end command -command "select_best_pair $a" -label [mc "Select Best Scoring Primer Pair"]
    $a.center_cmd.cmd.menu insert end command -command "clipboard clear;clipboard_append \[primer_window_get_text $a both 0\]" -label [mc "Copy Selected Primer Pair: Sequences Only"]
    $a.center_cmd.cmd.menu insert end command -command "clipboard clear;clipboard_append \[primer_window_get_text $a both 1\]" -label [mc "Copy Selected Primer Pair: Tab Delimited Name + Sequence"]
    $a.center_cmd.cmd.menu insert end command -command "clipboard clear;clipboard_append \[primer_window_get_text $a both 2 1\]" -label [mc "Copy Selected Primer Pair: Tab Delimited Text "]
    $a.center_cmd.cmd.menu insert end separator
    $a.center_cmd.cmd.menu insert end command -command "primer_window_add_remove_primer_feature $a clear_all {}" -label [mc "Clear All New Primer Features From Template"]
    #$a.center_cmd.cmd.menu insert end command -command "sputs save to text" -label [mc "Save Selected Primers to Text File..."] -state disabled
    #$a.center_cmd.cmd.menu insert end command -command "sputs append to text" -label [mc "Append Selected Primers to Text File..."] -state disabled

    grid [ttk::menubutton $a.center_cmd.reset_values -text [mc "Set Values"]] -row 1 -column 3
    tooltip_install $a.center_cmd.reset_values [mc "If you are not finding a primer, remove the primer filters. Simplified defaults are designed to find at least one primer in most cases, but is not optimized to find the best primer pairs. Use advanced or Primer3 default values to try to find better primers at the expense of not always finding a primer."]
    $a.center_cmd.reset_values  config -menu [menu $a.center_cmd.reset_values.menu]
    $a.center_cmd.reset_values.menu insert end command -command "primer_window_set_values $a 2" -label [mc "Set Values to Simplified Default"] 
    $a.center_cmd.reset_values.menu insert end command -command "primer_window_set_values $a 1" -label [mc "Set Values to Advanced Default"] 
    $a.center_cmd.reset_values.menu insert end command -command "primer_window_set_values $a 3" -label [mc "Set Values to Primer3 Defaults"] 
    $a.center_cmd.reset_values.menu insert end command -command "primer_window_set_values $a 5" -label [mc "Set Values to User Defined Defaults"] 
    $a.center_cmd.reset_values.menu insert end separator
    $a.center_cmd.reset_values.menu insert end command -command "primer_window_set_values $a 4" -label [mc "Remove Primer Filters"] 
    $a.center_cmd.reset_values.menu insert end separator
    $a.center_cmd.reset_values.menu insert end command -command "primer_window_set_values $a 6" -label [mc "Store Current Values as User Defined Defaults"] 
    

    
  grid [frame $a.right_cmd] -row 8 -column 6 -sticky nswe  
    grid [ttk::menubutton $a.right_cmd.cmd -text [mc "Right Primer"]] -row 1 -column 2 
    tooltip_install $a.right_cmd.cmd [mc "Commands for copy/paste or saving primers from the right side list can be found here."]
    $a.right_cmd.cmd  config -menu [menu $a.right_cmd.cmd.menu]
    $a.right_cmd.cmd.menu insert end command -command "primer_window_add_remove_primer_feature $a right \[lindex \[$a.treeframe2.tv selection\] 0\] 1" -label [mc "Add/ Remove Selected Primer as primer_bind Feature"]
    #$a.right_cmd.cmd.menu insert end command -command "primer_window_add_remove_primer_feature $a right \[lindex \[$a.treeframe2.tv selection\] 0\] 1" -label [mc "Remove Selected Primer as Feature in Template Sequence"]
    $a.right_cmd.cmd.menu insert end command -command "clipboard clear;clipboard_append \[primer_window_get_text $a right 0\]" -label [mc "Copy Selected Primer: Sequence Only"]
    $a.right_cmd.cmd.menu insert end command -command "clipboard clear;clipboard_append \[primer_window_get_text $a right 1\]" -label [mc "Copy Selected Primer: Tab Delimited Name + Sequence"]
    $a.right_cmd.cmd.menu insert end command -command "clipboard clear;clipboard_append \[primer_window_get_text $a right 2 1\]" -label [mc "Copy Selected Primer: Tab Delimited Text"] 
    $a.right_cmd.cmd.menu insert end command -command "clipboard clear;clipboard_append \[primer_window_get_text $a right 2 0\]" -label [mc "Copy Table: Tab Delimted Text"]
    #$a.right_cmd.cmd.menu insert end command -command "sputs save to text" -label [mc "Save Selected Primer to Text File..."] -state disabled
    #$a.right_cmd.cmd.menu insert end command -command "sputs append to text" -label [mc "Append Selected Primer to Text File..."] -state disabled
    grid [label $a.right_cmd.addl -text [mc "5' Add:"]] -row 1 -column 3
    tooltip_install $a.right_cmd.addl [mc "Enter bases to add to the 5' end of the right primer here."]
    grid [ttk::entry $a.right_cmd.add -width 10 -textvariable temp_info(right_primer_add_seq) -width 9] -row 1 -column 4
    set temp_info(right_primer_add_seq) ""
    tooltip_install $a.right_cmd.add [mc "Enter bases to add to the 5' end of the right primer here."]
    grid [ttk::menubutton $a.right_cmd.re -text [mc "RE"] -menu $a.right_cmd.re.menu] -row 1 -column 5 
    tooltip_install $a.right_cmd.re [mc "Find restriction enzyme recognition sites to add to the 5' end of the right primer here."]
         ## add RE to menu
	  set count 0
	  set menu_num 0
	  set menu [menu $a.right_cmd.re.menu]
	  $menu delete 0 end
	  foreach enz $enzymes {
		if {[expr {$count % 15}] ==0} {
		  if {$count != 0} {
			$menu entryconfigure end -label "$first_enz-$last_enz"
		  }
		  catch {destroy $menu.m$menu_num}
		  set current_menu [menu $menu.m$menu_num]
		  incr menu_num
		  $menu add cascade -menu $current_menu
		  set first_enz $enz
		}
		if {$enzinfo(flatpat,$enz) eq [revcom $enzinfo(flatpat,$enz)]} {
		  $current_menu add command -label $enz  -command "$a.right_cmd.add insert insert  $enzinfo(flatpat,$enz)"
		} else {
		  $current_menu add command -label [mc {%1$s (Fowrard)} $enz]  -command "$a.right_cmd.add insert insert $enzinfo(flatpat,$enz)"
		  $current_menu add command -label [mc {%1$s (Reverse)} $enz]  -command "$a.right_cmd.add insert insert [revcom $enzinfo(flatpat,$enz)]"
		}
		set last_enz $enz
		incr count
	  }
	  $menu entryconfigure end -label "$first_enz-$last_enz" 
  if {!$info(android)} {
    grid [ttk::button $a.ok -width 9 -text [mc "Close"] -command "event generate $a <<OK>>"] -row 9 -column 3 
  }

  primer_window_show_hide_advanced $a


  focus $a
}

###############
proc primer_rightclick {tv x y} {
  global temp_info info
  switch [$tv identify region $x $y] {
    "cell" -
    "tree" {
      ## primer sequence column
      set item [$tv identify item $x $y] 
      set selected 0
      set pcr 0
      if {$item in [$tv selection]} {
        set selected 1
        if {[.dialog.treeframe.tv selection] ne {} && [.dialog.treeframe2.tv selection] ne {}} {
          set pcr 1
          if {$tv eq ".dialog.treeframe.tv"} {
            set other_selected_item [lindex [.dialog.treeframe2.tv selection] 0]
          } else {
            set other_selected_item [lindex [.dialog.treeframe.tv selection] 0]
          }
        }
      }
      set side [expr {($tv eq ".dialog.treeframe.tv")?"left":"right"}]
      set direction [expr {($tv eq ".dialog.treeframe.tv")?0:1}]
      set a [winfo toplevel $tv]
      lassign [$tv item $item -values] score five_prime three_prime length prod_len tm perc_GC clamp name sum_score
      set seq [$tv item $item -text]
      #sputs tree $tv $item $data_dict $seq
      catch {destroy $tv.headingpopupmenu}
	  menu $tv.headingpopupmenu
	  $tv.headingpopupmenu add command  -label "$name $five_prime - $three_prime $seq" -command "" -state disabled
	  $tv.headingpopupmenu add separator
	  $tv.headingpopupmenu add command  -label [mc "Select Primer in Template"] -command "primer_rightclick_select $side $five_prime $three_prime" 
	  if {$pcr} {
	   # $tv.headingpopupmenu add command  -label [mc "Select PCR in Template"] -command "" -state disabled
	  }
	  $tv.headingpopupmenu add command  -label [mc "Add/ Remove primer_bind Feature in Template"] -command "primer_window_add_remove_primer_feature $a $side $item 1"
	  set next_name [primer_generate_name $temp_info(template_window) $info(primer_next_number) $direction $five_prime $temp_info(primer_target_text)]
	  if {$name eq {}} {
	    $tv.headingpopupmenu add command  -label [mc "Add Name to Primer: %1\$s" $next_name] -command "primer_rightclick_name $tv $item"
	  } else {
	    $tv.headingpopupmenu add command  -label [mc "Erase Primer Name: %1\$s" $next_name] -command "primer_rightclick_name $tv $item 1"
	  }
	  if {$pcr} {
	   # $tv.headingpopupmenu add command  -label [mc "Add Names to Primer Pair and Add to Template as Features"] -command "" -state disabled
	  }
	  $tv.headingpopupmenu insert end separator
	  $tv.headingpopupmenu insert end command -command "clipboard clear;clipboard_append \[primer_window_get_text $a $side 0 $item\]" -label [mc "Copy Primer: Sequence Only"]
      $tv.headingpopupmenu insert end command -command "clipboard clear;clipboard_append \[primer_window_get_text $a $side 1 $item\]" -label [mc "Copy Primer: Tab Delimited Name + Sequence"]
      $tv.headingpopupmenu insert end command -command "clipboard clear;clipboard_append \[primer_window_get_text $a $side 2 $item\]" -label [mc "Copy Primer: Tab Delimited Text"] 
	  #$tv.headingpopupmenu add command  -label [mc "Show Properties"] -command "" -state disabled
	  tk_popup $tv.headingpopupmenu [expr {[winfo rootx $tv] + $x}] [expr {[winfo rooty $tv] + $y}] 
    }
    "separator" {
      ## header separator
    }
    "nothing" {
    ## no primer - treeview background
    }
    "heading" {
	  set col_id [$tv identify column $x $y] 
	  if {![regexp {#([0-9]+)} $col_id -- col]} {return}
	  catch {destroy $tv.headingpopupmenu}
	  menu $tv.headingpopupmenu
	  if {$col > 0} {
		if {$col > 1} {
		  $tv.headingpopupmenu add command  -label [mc "Move %1\$s Left" [$tv heading $col_id -text]] -command "primer_rightclick_move_column $tv $col -1"
		}
		if {$col < [llength [$tv cget -displaycolumns]]} {
		  $tv.headingpopupmenu add command  -label [mc "Move %1\$s Right" [$tv heading $col_id -text]] -command "primer_rightclick_move_column $tv $col +1"
		}
		$tv.headingpopupmenu add separator
	  }
	  set i 0
	  $tv.headingpopupmenu add checkbutton  -label [$tv heading #0 -text] -variable temp_info(column_on_$i) -state disabled
	  foreach column [$tv cget -displaycolumns] {
		incr i
		if {[bind $tv <<Sort_column>>] eq $column} {
			$tv.headingpopupmenu add checkbutton  -label [$tv heading $column -text] -variable temp_info(column_on_$i) -command "primer_rightclick_on_off $tv $column 0" -state disabled
		} else {
		  $tv.headingpopupmenu add checkbutton  -label [$tv heading $column -text] -variable temp_info(column_on_$i) -command "primer_rightclick_on_off $tv $column 0"
		}
	
		set temp_info(column_on_$i) 1
	  }
	  set last_i $i
	  foreach column [$tv cget -columns] {
		if {$column in [$tv cget -displaycolumns]} {continue}
		if {$i == $last_i} {
		  $tv.headingpopupmenu add separator
		}
		incr i
		$tv.headingpopupmenu add checkbutton  -label [$tv heading $column -text] -variable temp_info(column_on_$i) -command "primer_rightclick_on_off $tv $column $col"
		set temp_info(column_on_$i) 0
	  }
	  tk_popup $tv.headingpopupmenu [expr {[winfo rootx $tv] + $x}] [expr {[winfo rooty $tv] + $y}] 
    }
    default {
    }
  }
}

##################
proc primer_save_column_headings {a} {
  global info
  foreach tv [list $a.treeframe.tv $a.treeframe2.tv] {
	dict set info(primer_find_column_dict) $tv displaycolumns [$tv cget -displaycolumns]
	dict set info(primer_find_column_dict) $tv sort_column [bind $tv <<Sort_column>>] 
	dict set info(primer_find_column_dict) $tv sort_direction [bind $tv <<Sort_direction>>] 
  }
}

##################
proc primer_rightclick_move_column {tv col direction} {
  set disply_col [$tv cget -displaycolumns]
  incr col -1
  set item [lindex $disply_col $col]
  set new_col [expr {$col+$direction}]
  lset disply_col $col [lindex $disply_col $new_col]
  lset disply_col $new_col $item
  $tv configure -displaycolumns $disply_col

}

##################
proc primer_rightclick_on_off {tv column col} {
  global info
  if {$col ==0 && [set found [lsearch -exact [$tv cget -displaycolumns] $column]] > -1} {
    $tv configure -displaycolumns [lreplace [$tv cget -displaycolumns] $found $found]
  } else {
    $tv configure -displaycolumns [linsert [$tv cget -displaycolumns] $col $column]
  }
  dict set info(primer_find_column_dict) $tv displaycolumns [$tv cget -displaycolumns]
}

#################
proc primer_rightclick_select {side 5_prime 3_prime} {
  global temp_info
  if {$side eq "left"} {
	if {$5_prime < $3_prime} {
	  select_region $temp_info(template_window) [bp2ix $temp_info(template_window).textarea [expr {$5_prime-1}]] [bp2ix $temp_info(template_window).textarea [expr {$3_prime}]]
	} else {
	  select_region $temp_info(template_window) [bp2ix $temp_info(template_window).textarea [expr {0}]] [bp2ix $temp_info(template_window).textarea [expr {$3_prime}]]
	}
  } else {
	if {$5_prime > $3_prime} {
	select_region $temp_info(template_window) [bp2ix $temp_info(template_window).textarea [expr {$3_prime-1}]] [bp2ix $temp_info(template_window).textarea [expr {$5_prime}]]
	} else {
	select_region $temp_info(template_window) [bp2ix $temp_info(template_window).textarea [expr {$3_prime-1}]] [end_ix $temp_info(template_window).textarea]
	} 
  }
}

#################
proc primer_rightclick_name {tv item {clear 0}} {
  global temp_info info
  if {$clear} {
  	$tv set $item Name {}
  } else {
	set direction [expr {($tv eq ".dialog.treeframe.tv")?0:1}]
	lassign [$tv item $item -values] score 5_prime 3_prime length prod_len tm perc_GC clamp name sum_score
	$tv set $item Name [primer_generate_name $temp_info(template_window) $info(primer_next_number) $direction $5_prime $temp_info(primer_target_text)]
	regsub -all %% $info(primer_name_string) "" sub
	if {[regexp {%[#3-6]} $sub]} {
		incr info(primer_next_number)
	}
  }
}

###############
proc update_primer_target_menu {a} {
  global temp_info info
  set w $temp_info(template_window)
  set seq_length [ix2bp $w.textarea [end_ix $w.textarea]]
  $a.templframe.space.space3.target.menu delete 0 end
  ## set up selection item first
  if {[$w.textarea tag ranges sel] != {}} {
    set sel_first [ix2bp $w.textarea [$w.textarea index sel.first]]
    set sel_last [ix2bp $w.textarea [$w.textarea index sel.last]]
    if {$sel_first == $seq_length && $sel_last == $seq_length} {
      incr sel_first -1
    }
  } else { 
    set sel_first [expr {max(0,[ix2bp $w.textarea [$w.textarea index insert]]-1)}]
    set sel_last [expr {min($seq_length,[ix2bp $w.textarea [$w.textarea index insert]]+1)}]
  }

  if {[expr {$sel_last - $sel_first}] > 0} {
    set label [mc "Selected %s - %s" [expr {$sel_first+1}] [expr {$sel_last}]]
  } else {
    set label [mc "No Target (No Selection > 1bp)"]
    set sel_first 0
    set sel_last 0
  }
  
  $a.templframe.space.space3.target.menu insert 0 radiobutton -command "set temp_info(primer_target_text) \"$label\";set temp_info(primer_target_left) $sel_first; set temp_info(primer_target_right) $sel_last; primer_window_fill_primer_treeviews $a" -label $label -variable temp_info(primer_target) -value "selection"
  if {$temp_info(primer_target) eq "selection"} {
    set temp_info(primer_target_text) $label
    set temp_info(primer_target_left) $sel_first
    set temp_info(primer_target_right) $sel_last
  }
  
  if {$info($w,circular) eq "circular" && [expr {$sel_last - $sel_first}] > 40} {
    ## Set up inverse PCR here
    set label [mc "Inverse PCR Selected %s - %s" [expr {$sel_last}] [expr {$sel_first+1}]]
    $a.templframe.space.space3.target.menu insert 1 radiobutton -command "set temp_info(primer_target_text) \"$label\";set temp_info(primer_target_left) $sel_last; set temp_info(primer_target_right) $sel_first; primer_window_fill_primer_treeviews $a" -label $label -variable temp_info(primer_target) -value "inverse selection"
    if {$temp_info(primer_target) eq "inverse selection"} {
      set temp_info(primer_target_text) $label
      set temp_info(primer_target_left) $sel_last
      set temp_info(primer_target_right) $sel_first
    }
  } 
  
  #now fill in the features from the treeview
  set tv $w.tvframe.tv
  foreach ftag [$tv children {}] {
    if {$ftag eq "hidden"} {continue}
    set range [$w.textarea tag ranges $ftag]
    if {[set fnrange [$w.textarea tag ranges [regsub f $ftag fn]]] > 0} {
      set range $fnrange
    }

    if {$range =={}} {continue}
    set metadata [$w.textarea tag bind $ftag <<Metadata>>]
    set fname [lindex $metadata 0]
    if {[llength $range] > 2} {
     set sel_first [ix2bp $w.textarea [lindex $range 2]] 
     set sel_last [ix2bp $w.textarea [lindex $range 1]]
     set feature_length [expr {$seq_length- $sel_first + $sel_last}]
    } else {
     set sel_first [ix2bp $w.textarea [lindex $range 0]]
     set sel_last [ix2bp $w.textarea [lindex $range 1]]
     set feature_length [expr {$sel_last- $sel_first}]
    }
    if {$feature_length < 30 || [lindex $metadata 2] eq "primer_bind"} {continue}
    $a.templframe.space.space3.target.menu insert end radiobutton -command "set temp_info(primer_target_text) \"$fname\"; set temp_info(primer_target_left) $sel_first; set temp_info(primer_target_right) $sel_last; primer_window_fill_primer_treeviews $a" -label $fname -variable temp_info(primer_target) -value $ftag
  }
  if {$temp_info(primer_target) eq {}} {
    $a.templframe.space.space3.target.menu invoke 0
  }
}

###############
proc primer_window_entry_integer {curr c w mode min max {default min} {command 0}} {
  if {$mode in [list "focusin" "focusout"] || $curr == $c} {return 1}
  set a [winfo toplevel $w]
  if {$mode != "key"} {
    if {(![string is integer -strict $c]) || ($c< $min)} {
      $w delete 0 end
      switch $default {
         "blank" {
          }
         "max" {
            $w insert end $max
          }
          "min" -
          default {
            $w insert end $min
          }
       }
      #after idle "if {\[winfo exists $w\]} {$w config -validate all}"
    } elseif {$c > $max} {
      $w delete 0 end
      $w insert end $max
      #after idle "if {\[winfo exists $w\]} {$w config -validate all}"
    }
  } else {
    if {[string equal $c " "]} {return 0}
    if {[regexp {[^0-9]} $c]} {return 0}
  }
  switch $command {
    1 {after idle "primer_window_update_hetro_data $a"}
    2 {after idle  "primer_window_update_primer_pairs $a left;primer_window_update_primer_pairs $a right"}
    0 -
    default {after idle "primer_window_fill_primer_treeviews $a"}   
  }
  return  1
 ##check to be sure target is between min and max- which to set if mismatched?

}


###############
proc primer_window_target_weights_gt_dialog {f {fill_primers 0}} {
  global info
  foreach e [list elenweightgt eTmweightgt e%gcweightgt eclampweightgt] {
    if {$info(primer_use_wt_gt)} {
      grid configure $f.$e
    } else {
      grid remove  $f.$e
    }
  }
  if {$info(primer_use_wt_gt)} {
    $f.lweight configure -text [mc "Weight <"]
    $f.lweightgt configure -text [mc "Weight >"]
  } else {
    $f.lweight configure -text [mc "Weight"]
    $f.lweightgt configure -text [mc ""]
  }
  if {$fill_primers} {
    primer_window_fill_primer_treeviews [winfo toplevel $f]
  }
}

###############
# [list $a.minmaxframe.hcompoligo $a.minmaxframe.holigolabel $a.minmaxframe.hcompthree $a.minmaxframe.lhcomp3 $a.minmaxframe.hcomptot $a.minmaxframe.lhcomp $a.minmaxframe.tmdifmax $a.minmaxframe.ltmdif $a.minmaxframe.compcolor $a.minmaxframe.complablel $a.minmaxframe.sep1 $a.minmaxframe.scompthree $a.minmaxframe.lscomp3 $a.minmaxframe.scomptot $a.minmaxframe.lscomp $a.minmaxframe.mcompf $a.minmaxframe.lcompf $a.minmaxframe.econsecmax $a.minmaxframe.lconcec $a.minmaxframe.eclampweight $a.minmaxframe.eclampprefer $a.minmaxframe.e%gcweight $a.minmaxframe.e%gcprefer $a.minmaxframe.eTmweight $a.minmaxframe.eTmprefer $a.minmaxframe.elenmax $a.minmaxframe.elenmin $a.minmaxframe.elenweight $a.minmaxframe.elenprefer $a.minmaxframe.llen $a.minmaxframe.vertseparator $a.minmaxframe.lweightgt $a.minmaxframe.lweight $a.minmaxframe.pref $a.minmaxframe.sort $a.nameframe] 
proc primer_window_show_hide_advanced {a} {
  global info
  
  foreach f [list $a.minmaxframe.elenmin $a.minmaxframe.elenmax $a.minmaxframe.eTmmin $a.minmaxframe.eTmmax $a.minmaxframe.e%gcmin $a.minmaxframe.e%gcmax $a.minmaxframe.eclampmin $a.minmaxframe.eclampmax $a.minmaxframe.filt $a.minmaxframe.lmin $a.minmaxframe.lmax $a.minmaxframe.hcompoligo $a.minmaxframe.holigolabel $a.minmaxframe.hcompthree $a.minmaxframe.lhcomp3 $a.minmaxframe.hcomptot $a.minmaxframe.lhcomp $a.minmaxframe.tmdifmax $a.minmaxframe.ltmdif $a.minmaxframe.compcolor $a.minmaxframe.complablel $a.minmaxframe.sep1 $a.minmaxframe.scompthree $a.minmaxframe.lscomp3 $a.minmaxframe.scomptot $a.minmaxframe.lscomp $a.minmaxframe.mcompf $a.minmaxframe.lcompf $a.minmaxframe.econsecmax $a.minmaxframe.lconcec $a.minmaxframe.elenmax $a.minmaxframe.elenmin $a.minmaxframe.vertseparator] {
    if {$info(primer_window_show_advanced)} {
      grid configure $f
    } else {
      grid remove $f
    }
  }
  if {$info(primer_window_show_advanced)} {
     $a.minmaxframe.show configure -text [mc "Hide Advanced"]
  } else {
     $a.minmaxframe.show configure -text [mc "Show Advanced"]
  }
  primer_window_target_weights_gt_dialog $a.minmaxframe 1
}


###############
proc primer_window_set_values {a level} {
  global info
  switch $level {
    0 -
    1 {
    ## Advanced initial values
	  array set info {primer_len_min 20 primer_len_max 25 primer_len_prefer 22 primer_len_wt_lt 100 primer_len_wt_gt 100 \
	  primer_Tm_min 55 primer_Tm_max 60 primer_Tm_prefer 59 primer_Tm_wt_lt 100 primer_Tm_wt_gt 100 \
	  primer_gc_min 45 primer_gc_max 60 primer_gc_prefer 50 primer_gc_wt_lt 100 primer_gc_wt_gt 100 \
	  primer_clamp_min 1 primer_clamp_max 2 primer_clamp_prefer 1 primer_clamp_wt_lt 0 primer_clamp_wt_gt 0 \
	  primer_consec_max 3 \
	  primer_use_wt_gt 0 primer_use_comp_filter 1 \
	  primer_tmdiff_max 4 \
	  primer_scomp_tot_max 8 primer_scomp_3_max 3 primer_hcomp_tot_max 8 primer_hcomp_3_max 3 \
      }
    }
    2 {
    ## Simplified values
	  array set info {primer_len_min 20 primer_len_max 25 primer_len_prefer 22 primer_len_wt_lt 100 primer_len_wt_gt 100 \
	  primer_Tm_min 50 primer_Tm_max 65 primer_Tm_prefer 59 primer_Tm_wt_lt 100 primer_Tm_wt_gt 100 \
	  primer_gc_min 40 primer_gc_max 65 primer_gc_prefer 50 primer_gc_wt_lt 100 primer_gc_wt_gt 100 \
	  primer_clamp_min 1 primer_clamp_max 2 primer_clamp_prefer 1 primer_clamp_wt_lt 0 primer_clamp_wt_gt 0 \
	  primer_consec_max "" \
	  primer_use_wt_gt 0 primer_use_comp_filter 0 \
	  primer_tmdiff_max "" \
	  primer_scomp_tot_max "" primer_scomp_3_max "" primer_hcomp_tot_max "" primer_hcomp_3_max "" \
      }
    }
    3 {
    ## Primer3 values
	  array set info {primer_len_min 18 primer_len_max 27 primer_len_prefer 20 primer_len_wt_lt 100 primer_len_wt_gt 100 \
	  primer_Tm_min 57 primer_Tm_max 63 primer_Tm_prefer 60 primer_Tm_wt_lt 100 primer_Tm_wt_gt 100 \
	  primer_gc_min 20 primer_gc_max 80 primer_gc_prefer 50 primer_gc_wt_lt 0 primer_gc_wt_gt 0 \
	  primer_clamp_min 0 primer_clamp_max 5 primer_clamp_prefer 1 primer_clamp_wt_lt 0 primer_clamp_wt_gt 0 \
	  primer_consec_max 5 \
	  primer_use_wt_gt 0 primer_use_comp_filter 0 \
	  primer_tmdiff_max 100 \
	  primer_scomp_tot_max 8 primer_scomp_3_max 3 primer_hcomp_tot_max 8 primer_hcomp_3_max 3 \
      }
    }
    4 {
    ## Remove Filters
	  array set info {primer_len_min 10 primer_len_max 100  \
	  primer_Tm_min "" primer_Tm_max "" \
	  primer_gc_min "" primer_gc_max ""\
	  primer_clamp_min "" primer_clamp_max ""  \
	  primer_consec_max "" \
	  primer_use_comp_filter 0  \
	  primer_scomp_tot_max "" primer_scomp_3_max ""
      }
    }
    5 {
    ## Set to user defined
	  array set info $info(primer_user_default_parameters)
    }
    6 {
    ## store user defined
      set result [dict create]
      foreach p [list primer_Tm_max primer_Tm_min primer_Tm_prefer primer_Tm_wt_gt primer_Tm_wt_lt primer_clamp_max primer_clamp_min primer_clamp_prefer primer_clamp_wt_gt primer_clamp_wt_lt primer_consec_max primer_gc_max primer_gc_min primer_gc_prefer primer_gc_wt_gt primer_gc_wt_lt primer_hcomp_3_max primer_hcomp_tot_max primer_len_max primer_len_min primer_len_prefer primer_len_wt_gt primer_len_wt_lt primer_scomp_3_max primer_scomp_tot_max primer_tmdiff_max primer_use_comp_filter primer_use_wt_gt] {
        dict set result $p $info($p)
      }
      set info(primer_user_default_parameters) $result
    }
  }
  if {$level == 0} {
  ## initialize startup values that don't need to change with user reset to default
    array set info {primer_spacing_5_3 -1 primer_spacing_max 100 primer_spacing_in_out 1 primer_comp_filter_text {1 e -2 -1 -2 0 gc|cg; 1 i +1 -1 -1 6 s;1 i +1 -1 -1 6 w} \
    primer_incompatible_color_fg "#C0C0C0" primer_window_show_advanced 0 \
    primer_salt 50 primer_dna 250 \
	primer_scomp_adj_max 5 primer_hcomp_adj_max 5 primer_check_sc 1 primer_scan "5'-->3'"\
    }
  } else {
  ## user reset values, update the primer lists
	primer_window_target_weights_gt_dialog $a.minmaxframe 0
	primer_window_fill_primer_treeviews $a
  }
}

###############
proc primer_window_fill_primer_treeviews {a} {
  ##search for primers and fill and resort both treeviews here
  ## call primer_window_update_primer_pairs with left side
  global temp_info info
  set w $temp_info(template_window)
  set seq_length [ix2bp $w.textarea [end_ix $w.textarea]]
  if {[catch {expr {$info(primer_len_max) +0}}]} {
    set info(primer_len_max) 100
  }
  if {[catch {expr {$info(primer_spacing_max) +0}}]} {
    set info(primer_spacing_max) 1
  }
  set primer_store [list]
  if {[$a.treeframe.tv selection] ne {}} {
    set selected_item [lindex [$a.treeframe.tv selection] 0] 
    set primer_store [list [$a.treeframe.tv item $selected_item -text] [$a.treeframe.tv set $selected_item "5'"] [$a.treeframe.tv set $selected_item "3'"]]
  }
  set primer_store2 [list]
  if {[$a.treeframe2.tv selection] ne {}} {
    set selected_item [lindex [$a.treeframe2.tv selection] 0] 
    set primer_store2 [list [$a.treeframe2.tv item $selected_item -text] [$a.treeframe2.tv set $selected_item "5'"] [$a.treeframe2.tv set $selected_item "3'"]]
  }
  $a.treeframe.tv delete [$a.treeframe.tv children {}]
  $a.treeframe2.tv delete [$a.treeframe2.tv children {}]
  if {$temp_info(primer_target_left) ==0 && $temp_info(primer_target_right) == 0} {
    return
  }
  if {$info(primer_spacing_in_out) } { 
    ##outside
    if {$info(primer_spacing_5_3) == -1} {
      set primer_spacing_5_3 1
    } else {
      set primer_spacing_5_3 $info(primer_spacing_5_3)
    }
    set left0 [expr {$temp_info(primer_target_left) -  $info(primer_spacing_max) - ($primer_spacing_5_3?$info(primer_len_max):0)}]
    set left1 [expr {max($temp_info(primer_target_left), $left0+$info(primer_len_max))}]
    set left_keep0 [expr {$temp_info(primer_target_left) -  $info(primer_spacing_max)}]
    set left_keep1 $temp_info(primer_target_left)
    set right1 [expr {$temp_info(primer_target_right) +  $info(primer_spacing_max) + ($primer_spacing_5_3?$info(primer_len_max):0)}]
    set right0 [expr {min($temp_info(primer_target_right),$right1-$info(primer_len_max))}]
    set right_keep1 [expr {$temp_info(primer_target_right) +  $info(primer_spacing_max)}]
    set right_keep0 $temp_info(primer_target_right)
  } else {
    #inside
    if {$info(primer_spacing_5_3) == -1} {
      set primer_spacing_5_3 0
    } else {
      set primer_spacing_5_3 $info(primer_spacing_5_3)
    }
    set left1 [expr {$temp_info(primer_target_left) +  $info(primer_spacing_max) + ($primer_spacing_5_3?0:$info(primer_len_max))}]
    set left0 [expr {min($left1-$info(primer_len_max), $temp_info(primer_target_left) )}]
    set left_keep0 $temp_info(primer_target_left)
    set left_keep1 [expr {$temp_info(primer_target_left) +  $info(primer_spacing_max)}]
    set right0 [expr {$temp_info(primer_target_right) -  $info(primer_spacing_max) - ($primer_spacing_5_3?0:$info(primer_len_max))}]
    set right1 [expr {max($right0+$info(primer_len_max),$temp_info(primer_target_right))}]
    set right_keep0 [expr {$temp_info(primer_target_right) -  $info(primer_spacing_max)}]
    set right_keep1 $temp_info(primer_target_right)
  }

  ## find left primer list
  if {$info($w,circular) ne "circular"} {
    set left0 [expr {max(0, $left0)}]
    set left_keep0 [expr {max(0, $left_keep0)}]
    set left1 [expr {min($left1, $seq_length)}]
    set left_keep1 [expr {min($left_keep1, $seq_length)}]
  } 

  if {$left0 < 0 || $left1 > $seq_length} {
    set text "[textarea_get $w.textarea [bp2ix $w.textarea [expr {$left0 % $seq_length}]] [bp2ix $w.textarea $seq_length]][textarea_get $w.textarea [bp2ix $w.textarea 0] [bp2ix $w.textarea [expr {$left1 % $seq_length}]]]"
  } else {
    set text [textarea_get $w.textarea [bp2ix $w.textarea $left0] [bp2ix $w.textarea $left1]]
  }

  set tv $a.treeframe.tv
  set pcount 0
  foreach primer [primer_scan $text $left0 0] {
    lassign $primer seq score 5_prime 3_prime length prod_len tm perc_GC clamp name sum_score
    if {$info(primer_spacing_5_3)==1 || ($info(primer_spacing_in_out) && $info(primer_spacing_5_3)==-1)} {
      set end $3_prime
    } else {
      set end $5_prime
    }
    if {$end >$left_keep0 && $end <= $left_keep1} {
      set ix [$tv insert {} end -text [lindex $primer 0] -values [list $score [expr {$5_prime % $seq_length}] [expr {$3_prime % $seq_length}] $length $prod_len $tm $perc_GC $clamp $name $sum_score]]
      if {[list $seq [expr {$5_prime % $seq_length}] [expr {$3_prime % $seq_length}]] eq $primer_store} {
        $tv selection set $ix
      }
      incr pcount
      if {$pcount >= $info(numer_of_primers_to_show)} {break}
    }
  }

  if {[bind $tv <<Sort_column>>] eq "name"} {
    treeview_sort $tv [bind $tv <<Sort_column>>] 1
  } elseif {[bind $tv <<Sort_column>>] eq "Tm"} {
    treeview_sort $tv [bind $tv <<Sort_column>>] 1 -real
  } else {
    treeview_sort $tv [bind $tv <<Sort_column>>] 1 -integer
  }


  
  ## find right primer list
  if {$info($w,circular) ne "circular"} {
    set right0 [expr {max(0, $right0)}]
    set right_keep0 [expr {max(0, $right_keep0)}]
    set right1 [expr {min($right1, $seq_length)}]
    set right_keep1 [expr {min($right_keep1, $seq_length)}]
  } 

  if {$right0 < 0 || $right1 > $seq_length} {
    set text "[textarea_get $w.textarea [bp2ix $w.textarea [expr {$right0 % $seq_length}]] [bp2ix $w.textarea $seq_length]][textarea_get $w.textarea [bp2ix $w.textarea 0] [bp2ix $w.textarea [expr {$right1 % $seq_length}]]]"
  } else {
    set text [textarea_get $w.textarea [bp2ix $w.textarea $right0] [bp2ix $w.textarea $right1]]
  }

  set tv $a.treeframe2.tv
  set pcount 0
  foreach primer [primer_scan $text $right0 1] {
    lassign $primer seq score 5_prime 3_prime length prod_len tm perc_GC clamp name sum_score
    if {$info(primer_spacing_5_3)==1 || ($info(primer_spacing_in_out) && $info(primer_spacing_5_3)==-1)} {
      set end $3_prime
    } else {
      set end $5_prime
    }
    if {$end >$right_keep0 && $end <= $right_keep1} {
      set ix [$tv insert {} end -text [lindex $primer 0] -values [list $score [expr {$5_prime % $seq_length}] [expr {$3_prime % $seq_length}] $length $prod_len $tm $perc_GC $clamp $name $sum_score]]
      if {[list $seq [expr {$5_prime % $seq_length}] [expr {$3_prime % $seq_length}]] eq $primer_store2} {
        $tv selection set $ix
      }
      incr pcount
      if {$pcount >= $info(numer_of_primers_to_show)} {break}
    }
  }
  if {[bind $tv <<Sort_column>>] eq "name"} {
    treeview_sort $tv [bind $tv <<Sort_column>>] 1
  } elseif {[bind $tv <<Sort_column>>] eq "Tm"} {
    treeview_sort $tv [bind $tv <<Sort_column>>] 1 -real
  } else {
    treeview_sort $tv [bind $tv <<Sort_column>>] 1 -integer
  }
  
  set tv1 $a.treeframe.tv
  if {[bind $tv1 <<Sort_column>>] eq "Score" && [bind $tv1 <<Sort_direction>>] && [bind $tv <<Sort_column>>] eq "Score"  && [bind $tv <<Sort_direction>>]} {
    select_best_pair $a
  } else {
	if {[$tv1 selection] eq [list]} {
	  $tv1 selection set [lindex [$tv1 children {}] 0]
	}
	$tv1 see [lindex [$tv1 selection] 0] 
	if {[$tv selection] eq [list]} {
	  $tv selection set [lindex [$tv children {}] 0]
	}
	$tv see [lindex [$tv selection] 0] 
  }
  
  primer_window_update_primer_pairs $a left
  primer_window_update_primer_pairs $a right
}

###############
proc primer_window_update_hetro_data {a} {
  set tv1 $a.treeframe.tv
    set tv $a.treeframe2.tv
  if {[bind $tv1 <<Sort_column>>] eq "Score" && [bind $tv1 <<Sort_direction>>] && [bind $tv <<Sort_column>>] eq "Score"  && [bind $tv <<Sort_direction>>]} {
    select_best_pair $a
  }
  primer_window_update_primer_pairs $a left
  primer_window_update_primer_pairs $a right
}


###############
proc select_best_pair {a} {
  set tv1 $a.treeframe.tv
  set tv2 $a.treeframe2.tv 
  set best_so_far 100000000
  set left_items [$tv1 children {}]
  set right_items [$tv2 children {}]
  set left_selected [lindex $left_items 0]
  set right_selected [lindex $right_items 0]
  set best_right_score [$tv2 set $right_selected Score]
  if {$left_items ne {} && $right_items ne {}} {
	foreach left_item $left_items {
	  set current_left_score [$tv1 set $left_item Score]
	  if {[expr {$current_left_score + $best_right_score}] > $best_so_far} {break}
	  lassign [$tv1 item $left_item -values] score 5_prime 3_prime length prod_len tm perc_GC clamp name sum_score
	  set seq [$tv1 item $left_item -text]
	  foreach right_item $right_items {
		lassign [$tv2 item $right_item -values] score2 5_prime2 3_prime2 length2 prod_len2 tm2 perc_GC2 clamp2 name2 sum_score2
		set seq2 [$tv2 item $right_item -text]
		if {![primer_incompatible $seq $tm $seq2 $tm2]} {
		  if {[expr {$score +$score2}] <  $best_so_far} {
			set best_so_far [expr {$score +$score2}]
			set left_selected $left_item
			set right_selected $right_item
		  }
		  break
		}
	  }
	}
  }

  $tv1 selection set $left_selected
  $tv2 selection set $right_selected
}

###############
proc primer_window_update_primer_pairs {a side {update_selection 1}} {
  ## set left or right primer mismatch highlight (use hetrodimer and maxTm) after a selection on the right or left sides
  ## set product length for left and right selection (0 if no primer selected on other side)
  ## a second mismatch highlight for primers that are not pointing at each other (possible if the region is shorter than the max spacing)
  ## or possibly a hidden item that things are moved as children of if they don't make a product
  global info temp_info
  if {$side eq "left"} {
    set tv1 $a.treeframe.tv
    set tv2 $a.treeframe2.tv 
  } else {
    set tv1 $a.treeframe2.tv
    set tv2 $a.treeframe.tv 
  }
  set selected [lindex [$tv1 selection] 0]
  if {$selected eq ""} {return}
  set seq_length [ix2bp $temp_info(template_window).textarea [end_ix $temp_info(template_window).textarea]]
  lassign [$tv1 item $selected -values] score 5_prime 3_prime length prod_len tm perc_GC clamp name sum_score
  set seq [$tv1 item $selected -text]
  
  $tv2 tag remove incompatible
  foreach item [$tv2 children {}] {
    lassign [$tv2 item $item -values] score2 5_prime2 3_prime2 length2 prod_len2 tm2 perc_GC2 clamp2 name2 sum_score2
    set prod_len [expr {((($side eq "left")?-1:1)*($3_prime - $3_prime2)) % $seq_length + $length  + $length2 -1}]
    $tv2 set $item Prod_Len $prod_len
    $tv2 set $item Sum_Score [expr {$score+$score2}]
    if {$info(primer_hcomp_oligo) eq {}} {
	  set seq2 [$tv2 item $item -text]
	}  else {
	  set seq2 $info(primer_hcomp_oligo)
	  set tm2 [Tm $seq2]
	}
    if {[primer_incompatible $seq $tm $seq2 $tm2] } {
	  $tv2 tag add incompatible $item
    }
  }
  if {$update_selection && [info exists info(primer_template_selection)]} {
	switch $info(primer_template_selection) {
	  0 {
		## no change
	  }
	  1 { 
	  #PCR
		set selected2 [lindex [$tv2 selection] 0]
		if {$selected2 eq ""} {
		  if {$side eq "left"} {
			if {$5_prime < $3_prime} {
			  select_region $temp_info(template_window) [bp2ix $temp_info(template_window).textarea [expr {$5_prime-1}]] [bp2ix $temp_info(template_window).textarea [expr {$3_prime}]]
			} else {
			  select_region $temp_info(template_window) [bp2ix $temp_info(template_window).textarea [expr {0}]] [bp2ix $temp_info(template_window).textarea [expr {$3_prime}]]
			}
		  } else {
			if {$5_prime > $3_prime} {
			  select_region $temp_info(template_window) [bp2ix $temp_info(template_window).textarea [expr {$3_prime-1}]] [bp2ix $temp_info(template_window).textarea [expr {$5_prime}]]
			} else {
			  select_region $temp_info(template_window) [bp2ix $temp_info(template_window).textarea [expr {$3_prime-1}]] [end_ix $temp_info(template_window).textarea]
			}
		  }
		} else {
		  lassign [$tv2 item $selected2 -values] score2s 5_prime2s 3_prime2s length2s prod_len2s tm2s perc_GC2s clamp2s name2s
		  if {$side eq "left"} {
			if {$5_prime < $5_prime2s} {
			  select_region $temp_info(template_window) [bp2ix $temp_info(template_window).textarea [expr {$5_prime-1}]] [bp2ix $temp_info(template_window).textarea [expr {$5_prime2s}]]
			} else {
			  select_region $temp_info(template_window) [bp2ix $temp_info(template_window).textarea [expr {$5_prime-1}]] [end_ix $temp_info(template_window).textarea]
			}
		  } else {
			if {$5_prime > $5_prime2s} {
			  select_region $temp_info(template_window) [bp2ix $temp_info(template_window).textarea [expr {$5_prime2s-1}]] [bp2ix $temp_info(template_window).textarea [expr {$5_prime}]]
			} else {
			  select_region $temp_info(template_window) [bp2ix $temp_info(template_window).textarea [expr {0}]] [bp2ix $temp_info(template_window).textarea [expr {$5_prime}]]
			}
		  }
		}
	  }
	  2 { 
	  #selected
		if {$side eq "left"} {
		  if {$5_prime < $3_prime} {
			select_region $temp_info(template_window) [bp2ix $temp_info(template_window).textarea [expr {$5_prime-1}]] [bp2ix $temp_info(template_window).textarea [expr {$3_prime}]]
		  } else {
			select_region $temp_info(template_window) [bp2ix $temp_info(template_window).textarea [expr {0}]] [bp2ix $temp_info(template_window).textarea [expr {$3_prime}]]
		  }
		} else {
		  if {$5_prime > $3_prime} {
		  select_region $temp_info(template_window) [bp2ix $temp_info(template_window).textarea [expr {$3_prime-1}]] [bp2ix $temp_info(template_window).textarea [expr {$5_prime}]]
		  } else {
		  select_region $temp_info(template_window) [bp2ix $temp_info(template_window).textarea [expr {$3_prime-1}]] [end_ix $temp_info(template_window).textarea]
		  } 
		}
	  }
	}
  }
}

#################
proc primer_incompatible {seq tm seq2 tm2} {
  global info
  if {[string is integer -strict $info(primer_tmdiff_max)] && [expr {abs($tm - $tm2)}] > $info(primer_tmdiff_max)} {
	return 1
  }
  if {[string is integer -strict $info(primer_hcomp_3_max)] || [string is integer -strict $info(primer_hcomp_tot_max)]} {
	lassign [align $seq $seq2 ] hc_score3 hc_score hc_oligos
	if {([string is integer -strict $info(primer_hcomp_3_max)] && $hc_score3 > $info(primer_hcomp_3_max)) || ([string is integer -strict $info(primer_hcomp_tot_max)] && $hc_score > $info(primer_hcomp_tot_max))} {
	  return 1
	}
  }
  return 0
}

###############
proc primer_window_add_remove_primer_feature {a side primer_item {delete 0}} {
  global info temp_info
  
  if {$side eq "clear_all"} {
	if {[info exists temp_info(added_feature_dict)]} {
	  set w $temp_info(template_window)
	  foreach primer [dict keys $temp_info(added_feature_dict)] {
	    lassign $primer template 5_prime 3_prime direction seq
	    if {$w eq $template} {
	      set tagname [dict get $temp_info(added_feature_dict) $primer]
	      dict unset temp_info(added_feature_dict) $primer
		  textarea_tag_delete $w.textarea $tagname
		  register_undo_separator $w "Delete Feature"
	    }
	  }
	  features_to_tree_view $w
	}
	return
  }
  if {$side eq "left"} {
    set tv $a.treeframe.tv
    set direction 0
  } else {
    set tv $a.treeframe2.tv
    set direction 1
  }
  if {![info exists temp_info(added_feature_dict)]} {
    set temp_info(added_feature_dict) [dict create]
  }
  set selected [lindex [$tv selection] 0]
  if {$primer_item eq ""} {return}
  lassign [$tv item $primer_item -values] score 5_prime 3_prime length prod_len tm perc_GC clamp primer_name sum_score
  set seq [$tv item $primer_item -text]
  set w $temp_info(template_window)
  if {[dict exists $temp_info(added_feature_dict) [list $w $5_prime $3_prime $direction $seq]]} {      
	  #feature exists and delete- remove it
	  set tagname [dict get $temp_info(added_feature_dict) [list $w $5_prime $3_prime $direction $seq]]
	  dict unset temp_info(added_feature_dict) [list $w $5_prime $3_prime $direction $seq]
	  textarea_tag_delete $w.textarea $tagname
	  features_to_tree_view $w
	  register_undo_separator $w "Delete Feature"
  } else {
    # add new primer feature if adding and it doesn't already exist
    set tagname [add_primer_feature_file $w $5_prime $3_prime $direction $seq $primer_name]
    dict set temp_info(added_feature_dict) [list $w $5_prime $3_prime $direction $seq] $tagname
  }
}


####################
## generate primer name (%#, %3-6=3-6 digit number with fixed size,%F=F/R, %f=f/r,%W=Fwd/Rev, %w=fwd/rev, %T=target name, %t=template name, %L= 5' end position, %y=year_2_digit %Y=year_4_digit %m=month_2_digit %b=month_3_letter %d=day)
####################
proc primer_generate_name {w number direction five_prime target} {
  global info
  set name $info(primer_name_string)
  set name [string map [list %% % %# $number %3 [format %03s $number] %4 [format %04s $number] %5 [format %05s $number] %6 [format %06s $number]  %w [expr {$direction?"rev":"fwd"}]  %W [expr {$direction?"Rev":"Fwd"}] %f [expr {$direction?"r":"f"}]  %F [expr {$direction?"R":"F"}] %T $target %t [file rootname [wm title $w]] %L $five_prime] $name]
  set name  [clock format [clock seconds] -format $name]
  return $name
}

#################
proc primer_window_add_name {a side {clear ""}} {
  global info temp_info
  if {$side eq "left"} {
    set tv1 $a.treeframe.tv
    set direction 0
  } else {
    set tv1 $a.treeframe2.tv
    set direction 1
  }
  set selected [lindex [$tv1 selection] 0]
  if {$selected eq ""} {return}
  if {$clear eq "clear"} {
    $tv1 set $selected Name {}
  } else {
    lassign [$tv1 item $selected -values] score 5_prime 3_prime length prod_len tm perc_GC clamp name sum_score
    $tv1 set $selected Name [primer_generate_name $temp_info(template_window) $info(primer_next_number) $direction $5_prime $temp_info(primer_target_text)]
    regsub -all %% $info(primer_name_string) "" sub
    if {[regexp {%[#3-6]} $sub]} {
      incr info(primer_next_number)
    }
  }
}

#################
# mode: 0 sequence, 1 name \t seq, 2 tab delimited table
proc primer_window_get_text {a side mode {item_list 0}} {
  global temp_info
  set result ""
  switch $mode {
    0 {
      switch $side {
        "left" {
          set tv1 $a.treeframe.tv
          if {$item_list == 0} {
            set item_list [$tv1 selection]
          }
          foreach item $item_list {
            set seq [$tv1 item $item -text]
            lappend result "$temp_info(left_primer_add_seq)$seq"
          }
        }
        "right" {
          set tv1 $a.treeframe2.tv
          if {$item_list == 0} {
            set item_list [$tv1 selection]
          }
          foreach item $item_list {
            set seq [$tv1 item $item -text]
            lappend result "$temp_info(right_primer_add_seq)$seq"
          }
        }
        "both" -
        default {
          set tv1 $a.treeframe.tv
          set item [lindex [$tv1 selection] 0]
          set seq [$tv1 item $item -text]
          set tv1 $a.treeframe2.tv
          set item [lindex [$tv1 selection] 0]
          set seq2 [$tv1 item $item -text]
          set result [list "$temp_info(left_primer_add_seq)$seq" "$temp_info(right_primer_add_seq)$seq2"]
        }
      }
      set result [join $result \n]
    }
    1 {
      switch $side {
        "left" {
          set tv1 $a.treeframe.tv
          if {$item_list == 0} {
            set item_list [$tv1 selection]
          }
          foreach item $item_list {
            set seq [$tv1 item $item -text]
            lassign [$tv1 item $item -values] score 5_prime 3_prime length prod_len tm perc_GC clamp name sum_score
            lappend result "$name\t$temp_info(left_primer_add_seq)$seq"
          }
        }
        "right" {
          set tv1 $a.treeframe2.tv
          if {$item_list == 0} {
            set item_list [$tv1 selection]
          }
          foreach item $item_list {
            set seq [$tv1 item $item -text]
            lassign [$tv1 item $item -values] score 5_prime 3_prime length prod_len tm perc_GC clamp name sum_score
            lappend result "$name\t$temp_info(right_primer_add_seq)$seq"
          }
        }
        "both" -
        default {
          set tv1 $a.treeframe.tv
          set item [lindex [$tv1 selection] 0]
          set seq [$tv1 item $item -text]
          lassign [$tv1 item $item -values] score 5_prime 3_prime length prod_len tm perc_GC clamp name sum_score
          set tv1 $a.treeframe2.tv
          set item [lindex [$tv1 selection] 0]
          set seq2 [$tv1 item $item -text]
          lassign [$tv1 item $item -values] score2 5_prime2 3_prime2 length2 prod_len2 tm2 perc_GC2 clamp2 name2 sum_score2
          set result [list "$name\t$temp_info(left_primer_add_seq)$seq" "$name2\t$temp_info(right_primer_add_seq)$seq2"]
        }
      }
      set result [join $result \n]
    }
    2 {
      switch $side {
        "right" {
          set tv_list [list $a.treeframe2.tv]
          set add_list [list right_primer_add_seq]
        }
        "both" {
          set tv_list [list $a.treeframe.tv $a.treeframe2.tv]
          set add_list [list left_primer_add_seq right_primer_add_seq]
        }
        "left" -
        default {
          set tv_list [list $a.treeframe.tv]
          set add_list [list left_primer_add_seq]
        }
      }
      set result [list]
      foreach tv1 $tv_list add_side $add_list {
        lappend result [join [list [mc "Sequence"] {*}[$tv1 cget -displaycolumns]] \t]
		if {$item_list == 1} {
		  set items [$tv1 selection]
		} elseif {$item_list == 0} {
		  set items [$tv1 children {}]
		} else {
		  set items $item_list
		}
		foreach item $items {
		  set row_result [list "$temp_info($add_side)[$tv1 item $item -text]"]
		  foreach dcol [$tv1 cget -displaycolumns] {
			lappend row_result [$tv1 set $item $dcol]
		  }
		  lappend result [join $row_result \t]
		}
	  }
      set result [join $result \n]
    }
  }
  return $result
}

##############
proc add_primer_feature_file {w five_prime three_prime direction sequence primer_name} {
  global  info fea_info temp_info

  set tagname "f$fea_info($w,count)#"
  incr fea_info($w,count)
#selection used here 
  textarea_tag_create $w.textarea $tagname 
  if {$direction} {
    if {$five_prime> $three_prime } {
      textarea_tag_add $w.textarea $tagname [bp2ix $w.textarea [expr {$three_prime-1}]] [bp2ix $w.textarea $five_prime]
    } else {
      textarea_tag_add $w.textarea $tagname [bp2ix $w.textarea 0] [bp2ix $w.textarea $five_prime]
      textarea_tag_add $w.textarea $tagname [bp2ix $w.textarea [expr {$three_prime-1}]] [end_ix $w.textarea]
    }
  } else {
    if {$five_prime < $three_prime } {
      textarea_tag_add $w.textarea $tagname [bp2ix $w.textarea [expr {$five_prime-1}]] [bp2ix $w.textarea $three_prime]
    } else {
      textarea_tag_add $w.textarea $tagname [bp2ix $w.textarea 0] [bp2ix $w.textarea $three_prime]
      textarea_tag_add $w.textarea $tagname [bp2ix $w.textarea [expr {$five_prime-1}]] [end_ix $w.textarea]
    }
  }
##metadata here
  if {[dict exist $info(feature_default_type_colors) primer_bind]} {
    set fwd_color [lindex [dict get $info(feature_default_type_colors) primer_bind] 0]
    set rev_color [lindex [dict get $info(feature_default_type_colors) primer_bind] 1]
  } else {
    set fwd_color $info(feature_default_fcolor)
    set rev_color $info(feature_default_rcolor)
  }
  if {[dict exists $info(feature_default_type_gformat) primer_bind]} {
    set gformat [dict get $info(feature_default_type_gformat) primer_bind]
  } else {
    set gformat $info(feature_default_gformat)
  }
  
  set qualifiers [list]
  if {$direction} {
    set sequence "$temp_info(right_primer_add_seq)$sequence"
  } else {
    set sequence "$temp_info(left_primer_add_seq)$sequence"
  }
  lappend qualifiers PCR_conditions [mc "primer sequence:%1\$s" $sequence]
    #      lappend new_taglist [list $tag [lindex $meta 0] [lindex $meta 3] [lindex $meta 2] [feature_coords_text $w $tag]  [lindex $meta 4]]
  textarea_tag_bind $w.textarea $tagname <<Metadata>> [list $primer_name $gformat "primer_bind" $direction $qualifiers {}]
  textarea_tag_bind $w.textarea $tagname <<Revcolors>> [list $fwd_color $rev_color]
  if {$direction} {
    textarea_tag_configure $w.textarea $tagname -background $rev_color
  } else {
    textarea_tag_configure $w.textarea $tagname -background $fwd_color
  }
  features_to_tree_view $w
  edit_box_treeviewselect $w
  $w.tvframe.tv selection set $tagname
  update idletasks
  return $tagname
}

################
proc primer_window_do_pcr {a} {
  global info temp_info

  set tv1 $a.treeframe.tv
  set tv2 $a.treeframe2.tv

  set selected [lindex [$tv1 selection] 0]
  set selected2 [lindex [$tv2 selection] 0]  
  if {$selected eq "" || $selected2 eq ""} {return}
  
  lassign [$tv1 item $selected -values] score 5_prime 3_prime length prod_len tm perc_GC clamp primer_name sum_score
  set seq [$tv1 item $selected -text]
  ## add 5' extension here
  set full_seq "$temp_info(left_primer_add_seq)$seq"
  
  lassign [$tv2 item $selected2 -values] score2 5_prime2 3_prime2 length2 prod_len2 tm2 perc_GC2 clamp2 primer_name2 sum_score2
  set seq2 [$tv2 item $selected2 -text]
  ## add 5' extension here
  set full_seq2 "$temp_info(right_primer_add_seq)$seq2"

##metadata here
  if {[dict exist $info(feature_default_type_colors) primer_bind]} {
    set fwd_color [lindex [dict get $info(feature_default_type_colors) primer_bind] 0]
    set rev_color [lindex [dict get $info(feature_default_type_colors) primer_bind] 1]
  } else {
    set fwd_color $info(feature_default_fcolor)
    set rev_color $info(feature_default_rcolor)
  }

  set fwd_qual_list [list]
  lappend fwd_qual_list PCR_conditions  [mc "primer sequence:%1\$s" $full_seq]
  set rev_qual_list [list]
  lappend rev_qual_list PCR_conditions  [mc "primer sequence:%1\$s" $full_seq2"]
  
  lappend data fwd_primer_name $primer_name
  lappend data fwd_primer_colors [list $fwd_color $rev_color]
  lappend data fwd_primer_qualifiers $fwd_qual_list
  lappend data fwd_primer_i $3_prime
  lappend data fwd_primer_seq $full_seq
  lappend data fwd_primer_j  [string length $full_seq]

  lappend data rev_primer_name $primer_name2
  lappend data rev_primer_colors [list $fwd_color $rev_color]
  lappend data rev_primer_qualifiers $rev_qual_list
  lappend data rev_primer_i [expr {$3_prime2-1}]
  lappend data rev_primer_seq $full_seq2
  lappend data rev_primer_j  [string length $full_seq2]

  pcr_dialog_do_pcr $temp_info(template_window) $data

}


#################
## Composition filters: semicolon/comma separated lists of:(i)nclude/(e)xclude +/-index1 +/-index2 min# max# bases; (i)nclude/(e)xclude +/-index1 +/-index2 -1 max# adjacent_bases; (i)nclude/(e)xclude +/-index1 +/-index2 -2 1 literal
## set li [primer_window_make_comp_filter "e -2 -1 -2 0 gc|cg;i +1 -1 -1 5 r"]
## primer_window_apply_comp_filter $li AAACGACACGA
proc primer_window_make_comp_filter {} {
  global info
  set result [list]
  set text $info(primer_comp_filter_text)
  foreach f [split $text ";,"] {
    if {[scan $f {%i %1[ei]%i%i%i%i %[ACGTNRYMKSWBDHVacgtnrymkswbdhv|]} active mode ix1 ix2 min max chars] == 7} {
      set mode [expr {$mode eq "i"}]
      if {$min >=0} {
        ## min and max count of single base
        set action 0
        if {[string length $chars] > 1} {
          set regexp_str "\[$chars\]"
        } else {
          set regexp_str [string map -nocase {a [a] c [c] g [g] t [t] b [cgt] d [agt] h [act] k [gt] m [ac] n [acgt] r [ag] s [gc] v [acg] w [at] y [ct]} $chars]
        }
      } elseif {$min == -1} {
        ## max count of adjacent single base
        set action 1
        if {[string length $chars] > 1} {
          set regexp_str "\[$chars\]"
        } else {
          set regexp_str [string map -nocase {a [a] c [c] g [g] t [t] b [cgt] d [agt] h [act] k [gt] m [ac] n [acgt] r [ag] s [gc] v [acg] w [at] y [ct]} $chars]
        }
        set regexp_str [string repeat $regexp_str [expr {$max+1}]]
      } elseif {$min == -2} {
        set action 2
        ## presence of regexp string (with degenerate substitutions)
        set regexp_str [string map -nocase {b [cgt] d [agt] h [act] k [gt] m [ac] n [acgt] r [ag] s [gc] v [acg] w [at] y [ct]} $chars]
      }
      if {[catch {regexp -nocase -all $regexp_str {}}]} {
        set regexp_str {}
      }
      if {$ix1 <-1} {set ix1 "end[expr {$ix1+1}]"} elseif {$ix1 == -1} {set ix1 "end"} elseif {$ix1 > 0} {set ix1 "[expr {$ix1-1}]"} else {continue}
      if {$ix2 <-1} {set ix2 "end[expr {$ix2+1}]"} elseif {$ix2 == -1} {set ix2 "end"} elseif {$ix2 > 0} {set ix2 "[expr {$ix2-1}]"} else {continue}
      if {$regexp_str ne {}} {
        lappend result [list $action $mode $ix1 $ix2 $min $max $regexp_str] $active
      }
    }
  }
  return $result
}

#convert filters to dropdown labels:
## {Keep only primers that have/ Reject primers that have} more than {0-25} and less than {0-25} {IUPAC with list} bases between index {5'>1-35, 3'>1-35} and index {5'>1-35, 3'>1-35}
## {Keep only primers that have/ Reject primers that have} a string of at most {0-25} {IUPAC with list} consecutive bases between index {5'>1-35, 3'>1-35} and index {5'>1-35, 3'>1-35}
## {Keep only primers that have/ Reject primers that have} the sequence(s) {free text} between index {5'>0-35, 3'>0-35} and index {5'>1-35, 3'>1-35}
proc primer_window_fill_comp_filter_menu {a menu} {
  global info temp_info
  $menu delete 0 end
  set i 0
  set text $info(primer_comp_filter_text)
  foreach f [split $text ";,"] {
    if {[scan $f {%i %1[ei]%i%i%i%i %[ACGTNRYMKSWBDHVacgtnrymkswbdhv|]} active mode ix1 ix2 min max chars] == 7} {
      if {$mode eq "i"} {
		set mode_text [mc "Keep only primers that have"]
	  } else {
		set mode_text [mc "Reject primers that have"]
	  }
      if {$min >=0} {
        ## min and max count of single base
        if {[string length $chars] > 1} {
          set regexp_str $chars
        } else {
          set regexp_str [string map -nocase {b CGT d AGT h ACT k GT m AC n ACGT r AG s GC v ACG w AT y CT} $chars]
        }
        set label_text [mc "%1\$s more than %2\$s and less than %3\$s %4\$s bases between index %5\$s and index %6\$s" $mode_text $min $max $regexp_str $ix1 $ix2 ]
        $menu add checkbutton  -label $label_text -variable temp_info(filter_on_$i) -command "primer_filter_on_off $i; primer_window_fill_primer_treeviews $a"
      } elseif {$min == -1} {
        ## max count of adjacent single base
        if {[string length $chars] > 1} {
          set regexp_str $chars
        } else {
          set regexp_str [string map -nocase {b CGT d AGT h ACT k GT m AC n ACGT r AG s GC v ACG w AT y CT} $chars]
        }
        set label_text [mc "%1\$s a string of at most %2\$s %3\$s bases between index %4\$s and index %5\$s" $mode_text $max $regexp_str $ix1 $ix2 ]
        $menu add checkbutton  -label $label_text -variable temp_info(filter_on_$i) -command "primer_filter_on_off $i; primer_window_fill_primer_treeviews $a"
      } elseif {$min == -2} {
        ## presence of regexp string (with degenerate substitutions)
        set label_text [mc "%1\$s the sequence(s) %2\$s between index %3\$s and index %4\$s" $mode_text $chars $ix1 $ix2 ]
        $menu add checkbutton  -label $label_text -variable temp_info(filter_on_$i) -command "primer_filter_on_off $i; primer_window_fill_primer_treeviews $a"
      }
    }
    set temp_info(filter_on_$i) $active
    incr i
  }
}
#################
proc primer_filter_on_off {i} {
  global info 
  set text  $info(primer_comp_filter_text)
  set flist [split $text ";,"] 
  set on [lindex $flist $i 0]
  lset flist  $i 0 [expr {!$on}]
  set info(primer_comp_filter_text) [join $flist ";"]
}


#################
proc primer_window_apply_comp_filter {filter_dict seq} {
  foreach {filter active} $filter_dict {
    if {!$active} {continue}
    lassign $filter action mode ix1 ix2 min max regexp_str
    set count [regexp -nocase -all $regexp_str [string range $seq $ix1 $ix2]]
    switch $action {
      0 {
      ## min and max count of single base
        if {$count < $min || $count > $max} {
          if {$mode} {return 0}
        } else {
          if {!$mode} {return 0}
        }
      }
      1 {
      ## max count of adjacent single base
        if {$count > 0} {
          if {$mode} {return 0}
        } else {
          if {!$mode} {return 0}
        }
      }
      2 {
      ## presence of regexp string (with degenerate substitutions)
        if {$count ==0} {
          if {$mode} {return 0}
        } else {
          if {!$mode} {return 0}
        }
      }
    }
  }
  return 1
}

#################
proc primer_scan {text {bp_offset 0} {rev 0}} {
#selection used here 
  global info
  set log_dna [expr {1.987 * log( $info(primer_dna) / 1000000000.0)}] 
  set log_salt [expr {12 * log10($info(primer_salt) / 1000.0)}]

  set primer_Tm_max [expr {[string is integer -strict $info(primer_Tm_max)]?($info(primer_Tm_max) + 0.4999999999):1000}]
  set primer_Tm_min [expr {[string is integer -strict $info(primer_Tm_min)]?($info(primer_Tm_min) - 0.5):0}]
  set primer_clamp_min [expr {[string is integer -strict $info(primer_clamp_min)]?$info(primer_clamp_min):0}]
  set primer_clamp_max [expr {[string is integer -strict $info(primer_clamp_max)]?$info(primer_clamp_max):1000}]
  set primer_gc_min [expr {[string is integer -strict $info(primer_gc_min)]?$info(primer_gc_min):0}]
  set primer_gc_max [expr {[string is integer -strict $info(primer_gc_max)]?$info(primer_gc_max):100}]
  set primer_coposition_filter_dict [primer_window_make_comp_filter]

  if {[string is integer -strict $info(primer_consec_max)] && $info(primer_consec_max)>0} {
    set consec_regexp "[string repeat a [expr {1+$info(primer_consec_max)}]]|[string repeat c [expr {1+$info(primer_consec_max)}]]|[string repeat g [expr {1+$info(primer_consec_max)}]]|[string repeat t [expr {1+$info(primer_consec_max)}]]"
  } else {
    set consec_regexp "\u0"
  }

  foreach e [list primer_len_wt_lt primer_Tm_wt_lt primer_gc_wt_lt primer_clamp_wt_lt primer_len_prefer primer_Tm_prefer primer_gc_prefer primer_clamp_prefer] {
    if {[string is integer -strict $info($e)]} {
      set $e $info($e)
    } else {
      set $e 0
    }
  }
  foreach e [list primer_len_wt_gt primer_Tm_wt_gt primer_gc_wt_gt primer_clamp_wt_gt] e_lt [list primer_len_wt_lt primer_Tm_wt_lt primer_gc_wt_lt primer_clamp_wt_lt] {
    if {$info(primer_use_wt_gt)} {
      if {[string is integer -strict $info($e)]} {
        set $e $info($e)
      } else {
        set $e 0
      }
    } else {
      if {[string is integer -strict $info($e_lt)]} {
        set $e $info($e_lt)
      } else {
        set $e 0
      }
    }
  }

  if {[catch {expr {$info(primer_len_min) +0}}]} {
    set info(primer_len_min) 10
  }  
  if {[catch {expr {$info(primer_len_max) +0}}]} {
    set info(primer_len_max) 100
  }
  regsub -nocase -all {[^acgt]} $text "t" text
  if {[string length $text] < $info(primer_len_min)} {
    return [list]
  }
  ## seaches for primers as 3' to 5' so that clamp can work
  set text [string tolower $text]
  if {!$rev} {
    set text [revcom $text]
    set bp_offset [expr {$bp_offset +[string length $text]}]
  }

  array set sadd {aa 222 tt 222 at 204 ta 213 ca 158 tg 296 gt 155 ac 293 ct 141 ag 279 ga 153 tc 291 cg 272 gc 244 gg 199 cc 199}
  array set hadd {aa 79 tt 79 at 72 ta 72 ca 63 tg 107 gt 62 ac 106 ct 56 ag 100 ga 60 tc 104 cg 106 gc 98 gg 80 cc 80}
  array set srem {aa -222 tt -222 at -204 ta -213 ca -296 tg -158 gt -293 ac -155 ct -279 ag -141 ga -291 tc -153 cg -272 gc -244 gg -199 cc -199}
  array set hrem {aa -79 tt -79 at -72 ta -72 ca -107 tg -63 gt -106 ac -62 ct -100 ag -56 ga -104 tc -60 cg -106 gc -98 gg -80 cc -80}
  
  if {[string first [string index $text 0] "at"] > -1} {
    set htot -46
    set stot -82 
    set gc 0
  } else {
    set htot -2
    set stot 56
    set gc 1
  }

  for {set i 0} {$i < [expr {$info(primer_len_min)-1}]} {incr i} {
    set c [string range $text $i [expr $i+1]]
    incr htot $hadd($c)
    incr stot $sadd($c)
    if {[string first [string index $text [expr $i+1]] "gc"] > -1} {incr gc}
  }
  set hmem $htot
  set smem $stot
  set gcmem $gc



  set j $i
  set k 0

  set primerlist [list]
  while {$k < [expr {[string length $text]-$info(primer_len_min)+1}]} {
    regexp "^(g|c)*" [string range $text $k $j] clamp
    set clamp_len [string length $clamp] 
    if {($clamp_len >= $primer_clamp_min) && ($clamp_len <= $primer_clamp_max)} {
      while {[expr {$j-$k}] < $info(primer_len_max)} {
        if {[regexp $consec_regexp [string range $text $k $j]]} {
          break
        }
        set Tm [expr {$htot * 100.0 / ($stot * 0.1 - $log_dna) - 273.15 + $log_salt}]
        if {($Tm > $primer_Tm_max)} {
          break
        }
        set potential [revcom [string range $text $k $j]]
        if {($Tm > $primer_Tm_min && ([expr {$gc * 100.0 / ($j-$k+1)}] >= $primer_gc_min) && ([expr {$gc * 100.0 / ($j-$k+1)}] <= $primer_gc_max)) && (!$info(primer_use_comp_filter) || [primer_window_apply_comp_filter $primer_coposition_filter_dict $potential])} {
          set sc_score -1
          set sc_score3 -1
          set sc_oligos [list [list {} {} {}] [list {} {} {}]]
          if {[string is integer -strict $info(primer_scomp_tot_max)] || [string is integer -strict $info(primer_scomp_3_max)]} {
            lassign [align $potential $potential  ] sc_score3 sc_score sc_oligos
          }
          if {(![string is integer -strict $info(primer_scomp_tot_max)] || $sc_score <= $info(primer_scomp_tot_max)) && (![string is integer -strict $info(primer_scomp_3_max)] || $sc_score3 <= $info(primer_scomp_3_max))} {
            set len [expr {$j-$k+1}]
            set Tm_round [expr {round($Tm*10)/10.0}] 
            set len_score [expr {int( ($primer_len_prefer eq "")? 0: (($len-$primer_len_prefer)<0?($primer_len_wt_gt * ($len-$primer_len_prefer)):($primer_len_wt_lt * ($primer_len_prefer-$len)))   ) }]
            set tm_score [expr {int( ($primer_Tm_prefer eq "")? 0: (($Tm-$primer_Tm_prefer)<0?int(round($primer_Tm_wt_gt * ($Tm_round-$primer_Tm_prefer))):int(round($primer_Tm_wt_lt * ($primer_Tm_prefer-$Tm_round)))) )}]
            set gc_score [expr {int( ($primer_gc_prefer eq "")? 0: (($gc * 100.0 / $len-$primer_gc_prefer)<0?($primer_gc_wt_gt * ($gc * 100.0 / $len-$primer_gc_prefer)):($primer_gc_wt_lt * ($primer_gc_prefer-$gc * 100.0 / $len))) )}]
            set clamp_score [expr {int( ($primer_clamp_prefer eq "")? 0: (($clamp_len-$primer_clamp_prefer)<0?($primer_clamp_wt_gt * ($clamp_len-$primer_clamp_prefer)):($primer_clamp_wt_lt * ($primer_clamp_prefer-$clamp_len)))) }]
            set score [expr {abs($len_score + $tm_score + $gc_score + $clamp_score)}]
            if {!$rev} {
              lappend primerlist [list $potential $score [expr {-$j+$bp_offset}] [expr {-$k+$bp_offset}] $len 0 $Tm_round [expr {round($gc * 100.0 / ($j-$k+1))}]  $clamp_len "" 0]
            } else {
              lappend primerlist [list $potential $score [expr {$bp_offset+$j+1}] [expr {$bp_offset+$k+1}] $len 0 $Tm_round [expr {round($gc * 100.0 / ($j-$k+1))}]  $clamp_len "" 0]
            }
          }
        }
        if {($j == [expr {[string length $text]-1}])} {
          break
        }
        incr htot $hadd([string range $text $j [expr $j+1]])
        incr stot $sadd([string range $text $j [expr $j+1]])
        if {[string first [string index $text [expr $j+1]] "gc"] > -1} {incr gc}
        incr j
      }
    }
    incr hmem $hrem([string range $text $k [expr $k+1]])
    incr smem $srem([string range $text $k [expr $k+1]])
    if {[string first [string index $text $k] "gc"] > -1} {incr gcmem -1}
    incr k
    if {$i < [expr {[string length $text]-1}]} {
      incr hmem $hadd([string range $text $i [expr $i+1]])
      incr smem $sadd([string range $text $i [expr $i+1]])
      if {[string first [string index $text [expr $i+1]] "gc"] > -1} {incr gcmem}
      set j [incr i]
    } else {
      set j $i
    }
    set htot $hmem
    set stot $smem
    set gc $gcmem  
  }

  if {[info exists info(numer_of_primers_to_show)]} {
    set primerlist [lsort -increasing -integer -index 1 $primerlist]
  }
  return $primerlist
}

######################
## use for finding off-target binding sites
######################
## needs to filter for multiple hits of the real binding site, or just take out the real site and anything within 5 or 6 bp
## needs to filter out anything with a gap in the last 3 bp? 4bp? 5bp? use a parameter to set this?
proc find_off_target_binding {primer template threshold_score {calc_align 0}} {

  set result_loc_list [list]

  # option to set a weaker threshold for 3' matches
  set threshold_score_3 $threshold_score
  
  set last_score_list [lrepeat [expr {[string length $primer]}] 0]
  set trace_lists [list]
  set max_3_loc -1
  set max_3_score -1
  set max_t_loc -1
  set max_t_score -1
  
  set i 0
  set template_s $template
  set template [revcom [string toupper $template]]
  set primer_s $primer
  set primer [string toupper $primer]
  foreach tc [split $template ""] {
    set score_list [list]
    #trace values: up 0 left -1 upleft 1
    set next_trace_list [list 0]
    set last_up_left_score 0
    set last_left_score 0
    foreach pc [split $primer ""]  up_score $last_score_list {
      if {$tc eq $pc} {
        set match_score [expr {$last_up_left_score+1}]
      } else {
        set match_score [expr {$last_up_left_score-1}]
      } 
      set left_score [expr {$last_left_score -2}]
      set last_up_left_score $up_score
      set up_score [expr {$up_score -2}]
      if {$match_score >= $left_score} {
        if {$match_score >= $up_score} { 
          set trace 1
          set last_left_score $match_score
        } else {
          set trace 0
          set last_left_score $up_score
        }
      } else {
        if {$left_score >= $up_score} { 
          set trace -1
          set last_left_score $left_score
        } else {
          set trace 0
          set last_left_score $up_score
        }
      }
      lappend next_trace_list $trace
      lappend score_list $last_left_score
    }
    lappend trace_lists $next_trace_list
    set last_score_list $score_list

    if {$tc eq $pc} {
      if {$last_left_score >= $threshold_score_3} {
        lappend result_loc_list $i $last_left_score 1
      }
    } elseif {$last_left_score >= $threshold_score} {
      lappend result_loc_list $i $last_left_score 0
    }
    
    incr i
  }


  set match_result [list]
  if {$calc_align} { 
    foreach {loc score match_3} $result_loc_list {
      lappend match_result [show_alignment $primer_s $template_s $trace_lists $loc]
    }
  }
  
  return [list $result_loc_list $match_result]
}


######################
## use for scoring self and heterodimer
######################
proc align {primer template {calc_align 0}} {

  set last_score_list [lrepeat [expr {[string length $primer]}] 0]
  set trace_lists [list]
  set score_lists [list]
  set match_3 [list {} {} {}]
  set match_t [list {} {} {}]
  set max_3_loc -1
  set max_3_score -1
  set max_t_loc -1
  set max_t_score -1
  set cutoff 8
  set i 0
  set template_s $template
  set template [revcom [string toupper $template]]
  set primer_s $primer
  set primer [string toupper $primer]
  foreach tc [split $template ""] {
    set score_list [list]
    #trace values: up 0 left -1 upleft 1
    set next_trace_list [list 0]
    set last_up_left_score 0
    set last_left_score 0
    foreach pc [split $primer ""]  up_score $last_score_list {
      if {$tc eq $pc} {
        set match_score [expr {$last_up_left_score+1}]
      } else {
        set match_score [expr {$last_up_left_score-1}]
      } 
      set left_score [expr {$last_left_score -2}]
      set last_up_left_score $up_score
      set up_score [expr {$up_score -2}]
      if {$match_score >= $left_score} {
        if {$match_score >= $up_score} { 
          set trace 1
          set last_left_score $match_score
        } else {
          set trace 0
          set last_left_score $up_score
        }
      } else {
        if {$left_score >= $up_score} { 
          set trace -1
          set last_left_score $left_score
        } else {
          set trace 0
          set last_left_score $up_score
        }
      }
      lappend next_trace_list $trace
      lappend score_list $last_left_score
    }
    lappend trace_lists $next_trace_list
    lappend score_lists $score_list
    set last_score_list $score_list

    if {$last_left_score > $max_t_score} {
      set max_t_loc $i
      set max_t_score $last_left_score
    }
    if {$tc eq $pc} {
      if {$last_left_score > $max_3_score} {
        #lappend match_3 [list $i $last_left_score]
        set max_3_loc $i
        set max_3_score $last_left_score
      }
    } 
    incr i
  }
  #sputs $trace_lists
  #sputs $score_lists
  
  if {$calc_align} { 
    if {$max_3_loc > -1} {
      set match_3 [show_alignment $primer_s $template_s $trace_lists $max_3_loc]
    }
    if {$max_t_loc > -1} {
      set match_t [show_alignment $primer_s $template_s $trace_lists $max_t_loc]
    }
  } else {
    set match_3 {}
    set match_t {}
  }
  return [list $max_3_score $max_t_score [list $match_3 $match_t]]
}


###############
proc show_alignment {primer template trace_list seed} {

  set template [string reverse $template]
  set j [expr {[string length $primer]}]
  set i $seed
  set r [expr {[string length $template] - $seed-1}]
  set result0 [string repeat - $r]
  set result1 [string range $template end-[expr {$r-1}] end]
  set align_string [string repeat " " $r]
  set m 0
  while {$j > -1 && $i > -1 && $m < 200} {
    incr m
    set n [lindex $trace_list $i $j]
    switch $n {
      -1 {
        set result0 "[string index $primer $j-1]$result0"
        set result1 "-$result1"
        set align_string " $align_string"
        incr j -1
      }
      0 {
        set result0 "-$result0"
        set result1 "[string index $template $i]$result1"
        set align_string " $align_string"
        incr i -1
      }
      1 {
        set result0 "[string index $primer $j-1]$result0"
        set result1 "[string index $template $i]$result1"
        if {[string toupper [string index $primer $j-1]] eq [string toupper [com [string index $template $i]]]} {
          set align_string "|$align_string"
        } else {
          set align_string "#$align_string"
        }
        incr i -1
        incr j -1
      }
    }
  }

  set result0 "[string range $primer 0 [expr {$j-1}]]$result0"
  set result1 "[string repeat - $j]$result1"
  set align_string "[string repeat " " $j]$align_string"
  #sputs $result0
  #sputs $align_string
  #sputs $result1
  set seqstart -1
  set seqend [string length $result0]
  if {[regexp -indices {^-+} $result0 startreg]} {
    lassign $startreg a seqstart
  }
  if {[regexp -indices -- {-+$} $result0 endreg]} {
    lassign $endreg seqend b
  }
  incr seqstart 1
  incr seqend -1
  set result0 [string range $result0 $seqstart $seqend]
  set align_string [string range $align_string $seqstart $seqend]
  set result1 [string range $result1 $seqstart $seqend]
  return [list $result0 $align_string $result1]
}


  #catch {destroy $menu}
 # $s.j.bottom.f3.overlap.menu add cascade  -label [mc "Restriction Sites"] -menu [menu $menu]
proc add_re_menu {menu command} {
  set count 0
  set menu_num 0
  foreach enz $enzymes {
    # skip metylation requiring enzymes
    if {$enz in [list AbaSI AoxI BisI BlsI DpnI FspEI GlaI GluI KroI LpnPI MalI MspJI MteI PcsI PkrI SgeI]} {continue}
    set flatpat $enzinfo(flatpat,$enz)
    if {[regexp {[^ACGT]} $flatpat]} {continue}
    if {[expr {$count % 15}] ==0} {
      if {$count != 0} {
        $menu entryconfigure end -label "$first_enz-$last_enz"
      }
      catch {destroy $menu.m$menu_num}
      set current_menu [menu $menu.m$menu_num]
      incr menu_num
      $menu add cascade -menu $current_menu
      set first_enz $enz
    }
    set new_command [string map %f $flatpat %e $enz $command]
    $current_menu add command -label $enz  -command $new_command
    set last_enz $enz
    incr count
  }
  $menu entryconfigure end -label "$first_enz-$last_enz"
}

##############
## New align dialog with multiple sequences aligned to a reference sequence
##############
proc align_dialog2 {w} {
  global info  
  global align_ref_seq align_windows_list
  global align_seq align_seq_winlist align_prog align_sel_list align_dir_list
  global ok dialogblock 
###algn windows data shows up in:
#global align_ref_seq
#global list align_windows_list- list of windows to align to

  if {$dialogblock == 1} {return}
  set s [new_dialog $w "Align DNA" "ALIGN"]
  bind $s <<Cancel>> "set ok -1"
  bind $s <<OK>> "set ok 1"

###sequences windows in this frame
  grid [frame $s.seqsframe] -row 1 -column 1 -sticky nswe
  grid [label $s.seqsframe.label1 -text [mc "Reference Sequence:"]] -row 1 -column 1 -sticky ne
  menubutton $s.seqsframe.win_button1
    menu $s.seqsframe.win_button1.menu
    foreach window [dnawindows_list 1] {
      $s.seqsframe.win_button1.menu add radiobutton -command "$s.seqsframe.win_button1 configure -text \{[wm title $window]\}" -label [wm title $window] -variable align_ref_seq -value $window 
    }
    set abi_list [lsort -unique [lsearch -all -inline -regexp [winfo children .] {.abi_window[0-9]+$}]]
    if {[llength $abi_list] > 0} {
      $s.seqsframe.win_button1.menu add separator
      foreach window $abi_list {
        $s.seqsframe.win_button1.menu add radiobutton -command "$s.seqsframe.win_button1 configure -text \{[wm title $window]\}" -label [wm title $window] -variable align_ref_seq -value $window 
      }
    }
  $s.seqsframe.win_button1 configure -text [wm title $w] -menu $s.seqsframe.win_button1.menu -indicatoron 1 -relief raised -width 60 
  bind $s.seqsframe.win_button1.menu <<MenuSelect>> "focus $s"

  grid $s.seqsframe.win_button1 -row 1 -column 2 -columnspan 3

  grid [checkbutton $s.seqsframe.local1 -width 14 -variable info(align_select_region1) -text [mc "Selection Only"] -onvalue "selection" -offvalue "all" -indicator on -selectcolor white] -row 1 -column 5
  grid [checkbutton $s.seqsframe.rc1 -width 10 -variable info(align_select_rc1) -text [mc "Rev-Com"] -offvalue "forward" -onvalue "rev/com" -indicator on -selectcolor white] -row 1 -column 6

  if {$align_ref_seq ne $w} {
    set info(align_select_rc1) "forward" 
    set info(align_select_region1) "all"
    set info(align_windows_dict) [dict create]
  }
  set align_ref_seq $w


  grid [labelframe $s.seqsframe.alignwins -text [mc "Align to Windows"]] -row 2 -column 1 -columnspan 6 -sticky nswe
  grid rowconfigure $s.seqsframe.alignwins 1 -weight 1
  grid columnconfigure $s.seqsframe.alignwins 1 -weight 1


#add in the first alignment window menu button in the menubutton frame
  #grid [frame $s.seqsframe.alignwins.meubuttonframe] -row 1 -column 1 -sticky nswe
  #align_add_window_menu $s.seqsframe.alignwins.meubuttonframe 0

##removed from the grid in favor of the window list view for now
  #grid remove $s.seqsframe.alignwins.meubuttonframe

#add in the window list frame
  grid [frame $s.seqsframe.alignwins.listframe] -row 1 -column 1 -sticky nswe
  align_fill_window_list_treeview $s.seqsframe.alignwins.listframe

###alignment parameteres in this frame
  grid [labelframe $s.alignparams -text [mc "Alignment Parameters"]] -row 4 -column 1 -sticky nswe
  grid [label $s.alignparams.blockslabel -text [mc "Blocks:"]] -row 4 -column 1 -sticky ne
  menubutton $s.alignparams.blocksbut -indicatoron 1 -relief raised -width 10 -textvariable info(align_blocksize)
  menu $s.alignparams.blocksbut.blocks
    $s.alignparams.blocksbut.blocks add radiobutton -label "200" -value 200 -variable info(align_blocksize) -command  "if { !\$info(ignore_NWmax)} {$s.alignparams.nwframe.nwmaxentry configure -state normal}"
    $s.alignparams.blocksbut.blocks add radiobutton -label "100" -value 100 -variable info(align_blocksize) -command  "if { !\$info(ignore_NWmax)} {$s.alignparams.nwframe.nwmaxentry configure -state normal}"
    $s.alignparams.blocksbut.blocks add radiobutton -label "50" -value 50 -variable info(align_blocksize) -command  "if { !\$info(ignore_NWmax)} {$s.alignparams.nwframe.nwmaxentry configure -state normal}"
    $s.alignparams.blocksbut.blocks add radiobutton -label "20" -value 20 -variable info(align_blocksize) -command  "if { !\$info(ignore_NWmax)} {$s.alignparams.nwframe.nwmaxentry configure -state normal}"
    $s.alignparams.blocksbut.blocks add radiobutton -label "15" -value 15 -variable info(align_blocksize) -command  "if { !\$info(ignore_NWmax)} {$s.alignparams.nwframe.nwmaxentry configure -state normal}"
    $s.alignparams.blocksbut.blocks add radiobutton -label "10" -value 10 -variable info(align_blocksize) -command  "if { !\$info(ignore_NWmax)} {$s.alignparams.nwframe.nwmaxentry configure -state normal}"
    $s.alignparams.blocksbut.blocks add radiobutton -label [mc "N-W align all"] -value "N-W align all" -variable info(align_blocksize) -command  "$s.alignparams.nwframe.nwmaxentry configure -state disabled"
  $s.alignparams.blocksbut configure -menu $s.alignparams.blocksbut.blocks
  bind $s.alignparams.blocksbut <<MenuSelect>> "focus $s.alignparams"

  grid $s.alignparams.blocksbut -row 4 -column 2 -sticky nw

  grid [label $s.alignparams.nwmaxlabel -text [mc "N-W max:"]] -row 4 -column 3 -sticky ne
  grid [entry $s.alignparams.nwmaxentry -validate key -width 4 -vcmd "check_char %S" -textvariable info(NWmax)] -row 4 -column 4 -sticky nw

  grid [frame $s.alignparams.nwframe] -row 4 -column 3 -columnspan 3 -sticky nw
  grid [label $s.alignparams.nwframe.nwmaxlabel -text [mc "N-W max:"]] -row 4 -column 3 -sticky ne
  grid [entry $s.alignparams.nwframe.nwmaxentry -validate key -width 4 -vcmd "check_char %S" -textvariable info(NWmax)] -row 4 -column 4 -sticky nw
  if { $info(ignore_NWmax)  || $info(align_blocksize) eq "N-W align all"} {
    $s.alignparams.nwframe.nwmaxentry configure -state disabled
  } else {
    $s.alignparams.nwframe.nwmaxentry configure -state normal
  }
  grid [checkbutton $s.alignparams.nwframe.ignorenw -text [mc "Always do Alignment"] -onvalue 1 -offvalue 0 -variable info(ignore_NWmax) -command  "if { \$info(ignore_NWmax)  || \$info(align_blocksize) eq \"N-W align all\"} {$s.alignparams.nwframe.nwmaxentry configure -state disabled} else {$s.alignparams.nwframe.nwmaxentry configure -state normal}"] -row 4 -column 5 

  grid [label $s.alignparams.mmplabel -text [mc "Mismatch Penalty:"]] -row 5 -column 1 -sticky ne
  menubutton $s.alignparams.mmpbut -indicatoron 1 -relief raised -width 10 -textvariable info(mm_penalty)
  menu $s.alignparams.mmpbut.mmpmenu
    foreach val {0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 -0.8 -0.9 -1 -1.1 -1.2 -1.3 -1.4 -1.5 -1.6 -1.7 -1.8 -1.9 -2} {
       $s.alignparams.mmpbut.mmpmenu add radiobutton -label " $val" -value $val -variable info(mm_penalty)
    }
  $s.alignparams.mmpbut configure -menu $s.alignparams.mmpbut.mmpmenu
  bind $s.alignparams.mmpbut.mmpmenu <<MenuSelect>> "focus $s.alignparams"
  grid $s.alignparams.mmpbut -row 5 -column 2 -sticky nw

  grid [label $s.alignparams.gapplabel -text [mc "Gap Penalty:"]] -row 5 -column 3 -sticky ne
  menubutton $s.alignparams.gappbut -indicatoron 1 -relief raised -width 10 -textvariable info(gap_penalty)
  menu $s.alignparams.gappbut.gapp
    foreach val {0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 -0.8 -0.9 -1 -1.1 -1.2 -1.3 -1.4 -1.5 -1.6 -1.7 -1.8 -1.9 -2} {
       $s.alignparams.gappbut.gapp add radiobutton -label " $val" -value $val -variable info(gap_penalty)
    }
  $s.alignparams.gappbut configure -menu $s.alignparams.gappbut.gapp
  bind $s.alignparams.gappbut.gapp <<MenuSelect>> "focus $s.alignparams"
  grid $s.alignparams.gappbut -row 5 -column 4 -sticky nw

  grid [label $s.alignparams.gapeplabel -text [mc "Gap Ext. Penalty:"]] -row 5 -column 5 -sticky ne
  menubutton $s.alignparams.gapepbut -indicatoron 1 -relief raised -width 10 -textvariable info(gap_extension_penalty)
  menu $s.alignparams.gapepbut.gapep
    foreach val {0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 -0.8 -0.9 -1} {
      $s.alignparams.gapepbut.gapep add radiobutton -label " $val" -value $val -variable info(gap_extension_penalty)
    }
  $s.alignparams.gapepbut configure -menu $s.alignparams.gapepbut.gapep
  bind $s.alignparams.gapepbut.gapep <<MenuSelect>> "focus $s.alignparams"
  grid $s.alignparams.gapepbut -row 5 -column 6 -sticky nw

  grid [label $s.alignparams.widthentrylabel -text [mc "Line Width:"]] -row 6 -column 1 -sticky ne
  grid [entry $s.alignparams.widthentry -width 5 -validate key -vcmd "check_char %S" -textvariable info(align_linewidth)] -row 6 -column 2 -sticky nw
  grid [checkbutton $s.alignparams.highlight -selectcolor white -text [mc "Copy Highlighting from Sequence"] -onvalue 1 -offvalue 0 -variable info(align_copy_highlight)] -row 6 -column 3 -columnspan 2

  grid [label $s.alignparams.phredtrimlabel -text [mc "Trim ends with Phred <:"]] -row 7 -column 1 -sticky ne
  grid [entry $s.alignparams.phredtrim -width 5 -validate key -vcmd "check_char %S" -textvariable info(align_phredtrim)] -row 7 -column 2 -sticky nw

  grid [checkbutton $s.alignparams.alignmenttrim -selectcolor white -text [mc "Show Only Aligned Regions"] -onvalue 1 -offvalue 0 -variable info(align_trim_to_alignment)] -row 7 -column 3 -columnspan 2

  grid [checkbutton $s.alignparams.alignmentnames  -text [mc "Show Sequence Names"] -onvalue 1 -offvalue 0 -variable info(align_show_seq_names)] -row 8 -column 1 -columnspan 2
  
  grid [button $s.alignparams.hide_alignparams -text [mc "Hide Alignment Parameters"] -command "grid configure $s.show_alignparams; grid remove $s.alignparams"] -row 9 -column 1 -sticky n -columnspan 2
  grid [button $s.alignparams.reset_alignparams -text [mc "Reset Alignment Parameters"] -command "set info(mm_penalty) -0.1; set info(gap_penalty) -1; set info(gap_extension_penalty) -0.2"] -row 9 -column 3 -sticky nw -columnspan 2

  grid remove $s.alignparams
  grid [button $s.show_alignparams -text [mc "Show Alignment Parameters"] -command "grid remove $s.show_alignparams; grid configure $s.alignparams"] -row 4 -column 1 -sticky nsw


###ok and cancel in this frame
  if {!$info(android)} {
    grid [frame $s.okframe] -row 7 -column 1
    grid [button $s.okframe.ok -text [mc "OK"] -command "set ok 1" -default active -state disabled] -row 1 -column 1 -padx 10 -pady 3
    bind $s <Key-Return> "set ok 1"
    grid [button $s.okframe.cancel -text [mc "Cancel"] -command "set ok -1"] -row 1 -column 2 -padx 10 -pady 3
  #grab $s
  }
  focus $s

  update idletasks
  #regexp {([0-9]*)x([0-9]*)\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $s] wgeom winw winh winx winy
  #if {[expr {$winx+$winw}] > [winfo screenwidth .]} {set winx [expr {[winfo screenwidth .]-$winw}]}
  #if {$winx < 0} {set winx 0}
  #if {[expr {$winy+$winh}] > [winfo screenheight .]} {set winy [expr {[winfo screenheight .]-$winh}]}
  #if {$winy < 0} {set winy 0}
  #wm geometry $s "+$winx+$winy"

  vwait ok

### do output here
  set dialogblock 0
  if {$info(NWmax) == ""} {set info(NWmax) 5000; set info(ignore_NWmax) 1}
  if {$info(align_linewidth) == ""} {set info(align_linewidth) 100}
 # wm withdraw $s
  if {$ok == 1} {
    #set align_windows_list [list]
    #set temp_align_dir_list $align_dir_list
    set align_dir_list [list]
    #set temp_align_sel_list $align_sel_list
    set align_sel_list [list]
    #multi-list windows list
    #if {[grid info $s.seqsframe.alignwins.listframe] != ""} {
    #  foreach selection [$s.seqsframe.alignwins.listframe.windowlist curselection] {
    #    lappend align_windows_list [lindex $align_seq_winlist $selection] 
    #    lappend align_dir_list [lindex $temp_align_dir_list $selection] 
    #    lappend align_sel_list [lindex $temp_align_sel_list $selection]
    #  }
    #}  else {
      #convert align_seq($i) array to list of windows
    #}
    #treeview windows list
    set align_windows_list [$s.seqsframe.alignwins.listframe.windowlist selection] 
    set info(align_windows_dict) [dict create]
    foreach selection $align_windows_list {
      lappend align_dir_list [$s.seqsframe.alignwins.listframe.windowlist set $selection Direction] 
      lappend align_sel_list [$s.seqsframe.alignwins.listframe.windowlist set $selection Range]
      dict set info(align_windows_dict) $selection [list [$s.seqsframe.alignwins.listframe.windowlist set $selection Range] [$s.seqsframe.alignwins.listframe.windowlist set $selection Direction]]
    }

    #add progress bar
    set align_prog 0
    if {$info(use_tile)} {
      grid [ttk::progressbar $s.align_prog -maximum [llength $align_windows_list] -variable align_prog -orient horizontal -mode determinate] -row 4 -column 1  -sticky new
    } else {
      grid [label $s.align_prog_label -width 50 -text [mc "Aligning sequences, Please wait..."]] -row 4 -column 1  -sticky nw
      grid [label $s.align_prog -width 50 -textvariable align_prog] -row 4 -column 2  -sticky nw
    }
    grid remove $s.show_alignparams
    grid remove $s.alignparams
    #update idletasks
    output_alignment2 $align_ref_seq $info(align_select_region1) $info(align_select_rc1) $align_windows_list $align_dir_list $align_sel_list
  }
  #grab release $s

  destroy $s

  bind . <<RaiseDialogs>> ""
  unset ok 
  catch {unset align_seq align_ref_seq align_sel_list align_seq_winlist align_dir_list}
  return ""
}


###########
## subroutine of align_dialog2 - not used
###########
proc align_add_window_menu {frame i} {
  global info align_seq

  set j [expr {$i +1}]
  menubutton $frame.awin_button$i -width 3
    menu $frame.awin_button$i.menu
    #$frame.awin_button$i.menu add command -command {sputs show list} -label [mc "Show windows list"]
    if {$i > 0} {
      $frame.awin_button$i.menu add command -command "set align_seq($i) \"\"; $frame.awin_button$i configure -text  \[mc {Select Window to align}\]" -label [mc "No Window"]
      $frame.awin_button$i.menu add separator
    }

    foreach window [dnawindows_list 1] {
####need to check for existence of $frame.win_button$j before calling align_add_window
      $frame.awin_button$i.menu add radiobutton -command "$frame.awin_button$i configure -text \{[wm title $window]\}; event generate $frame <<add_blank>>" -label [wm title $window] -variable align_seq($i) -value $window 
    }
    set abi_list [lsort -unique [lsearch -all -inline -regexp [winfo children .] {.abi_window[0-9]+$}]]
    if {[llength $abi_list] > 0} {
      $frame.awin_button$i.menu add separator
      foreach window $abi_list {
        $frame.awin_button$i.menu add radiobutton -command "$frame.awin_button$i configure -text \{[wm title $window]\}; if \{!\[winfo exists $frame.awin_button$j\]\} \{align_add_window_menu $frame $j\}" -label [wm title $window] -variable align_seq($i) -value $window 
      }
    }
  $frame.awin_button$i configure -text [mc "Select Window to align"] -menu $frame.awin_button$i.menu -indicatoron 1 -relief raised -width 60 
  set align_seq($i) ""
  bind $frame.awin_button$i.menu <<MenuSelect>> "focus [winfo toplevel $frame]"
  grid $frame.awin_button$i -row [expr {$i+2}] -column 2 -columnspan 3

 ##binding to add new menubutton if all are filled
  bind $frame <<add_blank>> "
    set seqframecheck 1
    foreach element \[array names align_seq\] {
      if {\$align_seq(\$element) == \"\"} {set seqframecheck 0}
    } 
    if {\$seqframecheck} {
      align_add_window_menu $frame $j
    }
    unset seqframecheck
  "
  #endbind $frame <<add_blank>> 
}

###########
## subroutine of align_dialog2- makes a 3 list window selection box- not used
###########
## NOT USED
proc align_fill_window_list0 {s} {
  global align_seq_winlist align_sel_list align_dir_list

  set align_sel_list [list]
  set align_dir_list [list]

  grid [listbox $s.windowlist -yscrollcommand "multilist_optionscrollbar $s.windowlistscroll {$s.windowlist_dir $s.windowlist_sel}" -bg white -selectmode extended -height 10  -activestyle none] -row 1 -column 1 -sticky nswe
  grid [listbox $s.windowlist_sel -yscrollcommand "multilist_optionscrollbar $s.windowlistscroll {$s.windowlist $s.windowlist_dir}" -bg white -selectmode extended -height 10  -width 10 -activestyle none -listvariable align_sel_list] -row 1 -column 2 -sticky nswe
  grid [listbox $s.windowlist_dir -yscrollcommand "multilist_optionscrollbar $s.windowlistscroll {$s.windowlist $s.windowlist_sel}" -bg white -selectmode extended -height 10  -width 10 -activestyle none -listvariable align_dir_list] -row 1 -column 3 -sticky nswe

  grid [scrollbar $s.windowlistscroll -command "multilist_scroll {$s.windowlist $s.windowlist_dir $s.windowlist_sel} yview"] -row 1 -column 4 -sticky nsw

  grid columnconfigure $s 1 -weight 1
  grid rowconfigure $s 1 -weight 1

  set counti 0
  set align_seq_winlist [list]
      foreach abwindow [lsearch -all -inline -regexp [winfo children .] {.abi_window[0-9]+$}] {
          $s.windowlist insert end  "[wm title $abwindow]"
          $s.windowlist_dir insert end [mc Best]
          $s.windowlist_sel insert end [mc All]
          if {($counti % 2) == 1} {
             set bgcolor #FFF5F5
          } else {
            set bgcolor gray93
          }
          foreach list_box {windowlist windowlist_dir windowlist_sel} {
            $s.$list_box itemconfigure end -background $bgcolor
          }
          incr counti
          lappend align_seq_winlist $abwindow
      }
      foreach windowelement [dnawindows_list 1] {
        $s.windowlist insert end [wm title $windowelement]
        $s.windowlist_dir insert end [mc Best]
        $s.windowlist_sel insert end [mc All]
        if {($counti % 2) == 1} {
          foreach list_box {windowlist windowlist_dir windowlist_sel} {
            $s.$list_box itemconfigure end -background #F5F5FF
          }
        }
        incr counti
        lappend align_seq_winlist $windowelement
      }
  set top [winfo toplevel $s]
  bind $s.windowlist <<ListboxSelect>> "$s.windowlist_dir selection clear 0 end; $s.windowlist_sel selection clear 0 end; foreach w \[$s.windowlist curselection\] {$s.windowlist_dir selection set \$w; $s.windowlist_sel selection set \$w}; if {\[$s.windowlist curselection\] =={}} {$top.okframe.ok configure -state disabled} else {$top.okframe.ok configure -state normal}"
  bind $s.windowlist_sel <<ListboxSelect>> "$s.windowlist_dir selection clear 0 end; $s.windowlist selection clear 0 end; foreach w \[$s.windowlist_sel curselection\] {$s.windowlist_dir selection set \$w; $s.windowlist selection set \$w}; if {\[$s.windowlist curselection\] =={}} {$top.okframe.ok configure -state disabled} else {$top.okframe.ok configure -state normal}"
  bind $s.windowlist_dir <<ListboxSelect>> "$s.windowlist_sel selection clear 0 end; $s.windowlist= selection clear 0 end; foreach w \[$s.windowlist_dir curselection\] {$s.windowlist_sel selection set \$w; $s.windowlist selection set \$w}; if {\[$s.windowlist curselection\] =={}} {$top.okframe.ok configure -state disabled} else {$top.okframe.ok configure -state normal}"

  bind $s.windowlist_sel <Button-1> "toggle_align_sel $s.windowlist_sel %x %y; break"
  bind $s.windowlist_dir <Button-1> "toggle_align_sel $s.windowlist_dir %x %y; break"

}

###########
## subroutine of align_dialog2
###########
proc multilist_scroll {windows command args} {
  foreach window $windows {{*}"$window $command $args"}
}
###########
## subroutine of align_dialog2
###########
proc multilist_optionscrollbar {scrollbar windows  args} {
    {*}"optionscrollbar $scrollbar $args"
    multilist_scroll $windows yview moveto [lindex $args 0]
}
###########
## subroutine of align_dialog2
###########
proc toggle_align_sel {list_box x y} {
  set item [$list_box index @$x,$y]
  set text [$list_box get $item]
  set sel_list [list [mc All] [mc Selection]]
  set dir_list [list  [mc Rev-Com] [mc Best] [mc Forward]]

  if {[set list_index [lsearch -exact $sel_list $text]] > -1} {
    set new_text [lindex $sel_list [expr {($list_index +1) % 2}]]
  } elseif {[set list_index [lsearch -exact $dir_list $text]] > -1} {
    set new_text [lindex $dir_list [expr {($list_index +1) % 3}]]
  }
  set sel_store [$list_box curselection]
  set bg_store [$list_box itemcget $item -background]
  $list_box delete $item
  $list_box insert $item $new_text
  $list_box itemconfigure $item -background $bg_store
  foreach w $sel_store {
    $list_box selection set $w
  }

}

###############
## make align-multi winfow list a treeview
###############
proc align_fill_window_list_treeview {s} {
  global info modifier abi_info

  grid [ttk::treeview $s.windowlist -yscrollcommand "optionscrollbar $s.windowlistscroll" -selectmode extended -height 10 ] -row 1 -column 1 -sticky nswe
  grid [scrollbar $s.windowlistscroll -command "$s.windowlist yview"] -row 1 -column 4 -sticky nsw
  grid columnconfigure $s 1 -weight 1
  grid rowconfigure $s 1 -weight 1

  set t $s.windowlist
  $t configure -columns {Range Direction}
  $t heading #0 -text [mc "Window"]
  $t column #0 -width 200 -minwidth 50 -stretch 1 -anchor e
  $t heading Range -text Range
  $t column Range -width 80 -minwidth 50 -stretch 0 -anchor c
  $t heading Direction -text Direction;# -command "treeview_sort $t Direction"
  $t column Direction -width 80 -minwidth 50 -stretch 1 -anchor c

  foreach abiwindow [lsearch -all -inline -regexp [winfo children .] {.abi_window[0-9]+$}] {
    if {[wm state $abiwindow] eq "withdrawn"} {continue}
    $s.windowlist insert {} end  -id $abiwindow -text "[wm title $abiwindow]" -tag abi
    if {[dict exists $info(align_windows_dict) $abiwindow]} {
      $s.windowlist selection add  $abiwindow     
      $s.windowlist set $abiwindow Range [lindex [dict get $info(align_windows_dict) $abiwindow] 0]
      $s.windowlist set $abiwindow Direction [lindex [dict get $info(align_windows_dict) $abiwindow] 1]
    } else {
      $s.windowlist set $abiwindow Range All
      $s.windowlist set $abiwindow Direction Best
    }
  }
  foreach windowelement [dnawindows_list 1] {
    $s.windowlist insert {} end  -id $windowelement -text "[wm title $windowelement]" -tag seq
    if {[dict exists $info(align_windows_dict) $windowelement]} {
      $s.windowlist selection add  $windowelement 
      $s.windowlist set $windowelement Range [lindex [dict get $info(align_windows_dict) $windowelement] 0]
      $s.windowlist set $windowelement Direction [lindex [dict get $info(align_windows_dict) $windowelement] 1]
    } else {
      $s.windowlist set $windowelement Range All
      $s.windowlist set $windowelement Direction Best
    }
  }
  $s.windowlist tag configure abi -background #FFF5F5 -foreground black
  $s.windowlist tag configure seq -background #F5F5FF -foreground black
  $t tag configure sel -background $info(text_select_bg_color)
  set top [winfo toplevel $s]
  bind $t <<TreeviewSelect>> "treeview_manageselection $t; if {\[$s.windowlist selection\] =={}} {$top.okframe.ok configure -state disabled} else {$top.okframe.ok configure -state normal}"
  bind $t <<OldSelection>> [$s.windowlist selection]

  bind $s.windowlist <Button-1> "toggle_align_treeview $s.windowlist %x %y press; break"
  bind $s.windowlist <Shift-Button-1> "toggle_align_treeview $s.windowlist %x %y extend; break"
  bind $s.windowlist <$modifier-Button-1> "toggle_align_treeview $s.windowlist %x %y toggle; break"
  bind $s.windowlist <$modifier-KeyPress-a> "$s.windowlist selection set \[$s.windowlist children {}\]"
  bind $s.windowlist <Shift-$modifier-KeyPress-A> "$s.windowlist selection set {}"
  bind [winfo toplevel $s.windowlist] <$modifier-KeyPress-a> "$s.windowlist selection set \[$s.windowlist children {}\]"
  bind [winfo toplevel $s.windowlist] <Shift-$modifier-KeyPress-A> "$s.windowlist selection set {}"

  bind $t <B1-Motion> "treeview_move $t %x %y"

  bind $t <ButtonRelease-1> "treeview_release $t %x %y"
}

###############
## Generate output window for align_dialog2 (multi-alignment)
###############
proc toggle_align_treeview {t x y op} {
#sputs [$t identify region $x $y] [$t identify row $x $y] if {[$t identify region $x $y] eq "cell"} ;# can use identify item when 8.6 is available"
  if {[$t identify row $x $y] ne {}} {
    set col [$t identify column $x $y]  
    set row [$t identify row $x $y]
    if {[$t column $col -id] eq "Range" && [lsearch {Selection All} [$t set $row Range]] > -1 } {
      $t set $row Range [lindex {All Selection} [lsearch {Selection All} [$t set $row Range]]]
    } elseif {[$t column $col -id] eq "Direction" && [lsearch {Reverse Forward Best} [$t set $row Direction]] > -1} {

      $t set $row Direction [lindex {Best Forward Reverse} [lsearch {Reverse Best Forward} [$t set $row Direction]]]
     # $t set $row Direction [lindex  {Forward Reverse} [lsearch {Reverse Forward} [$t set $row Direction]]]
    } else {
      switch $op {
        press {
          ttk::treeview::Press $t $x $y
        }
        extend {
          ttk::treeview::Select $t $x $y extend 
        }
        toggle {
          ttk::treeview::Select $t $x $y toggle
        }
      }
    }
  } else {
    switch $op {
      press {
        ttk::treeview::Press $t $x $y
      }
      extend {
        ttk::treeview::Select $t $x $y extend 
      }
      toggle {
        ttk::treeview::Select $t $x $y toggle
      }
    }
  }
}

###############
## Generate output window for align_dialog2 (multi-alignment)
###############
proc output_alignment2 {align_ref_seq align_select_region1 align_select_rc1 align_windows_list align_dir_list align_sel_list {alignment_parameters_dict {}}} {
  global info abi_info
  global  align_prog
  global modifier
  global modstring
  set xdir 1
  set parameter_store [dict create]
  foreach key [dict keys $alignment_parameters_dict] {
    dict set parameter_store $key $info($key)
    set info($key) [dict get $alignment_parameters_dict $key]
  }
  set circular_reference_seq 0
  if {[string first .abi_window $align_ref_seq] == -1} {
    ###window1 is a sequence window
    #$align_ref_seq.textarea configure -cursor watch
    set window_type1 "sequence"
    if {($align_select_region1 == "selection") && ([$align_ref_seq.textarea tag nextrange sel 1.0] != "")} {
#selection used here 
      set xdna [textarea_get $align_ref_seq.textarea sel.first sel.last]
      if {$align_select_rc1 == "rev/com"} {
        set xfirst [expr {1+[ix2bp $align_ref_seq.textarea [$align_ref_seq.textarea index sel.last]]}]
        set xdna [revcom $xdna]
        set xdir -1
      } else {
        set xfirst [ix2bp $align_ref_seq.textarea [$align_ref_seq.textarea index sel.first]]
#selection used here 
      }
    } else {
      if {$info($align_ref_seq,circular) == "circular"} {
        set circular_reference_seq 1
      }
      set xdna [textarea_get $align_ref_seq.textarea 1.0 [end_ix $align_ref_seq.textarea]]
      if {$align_select_rc1 == "rev/com"} {
        set xfirst [expr {1+[ix2bp $align_ref_seq.textarea [end_ix $align_ref_seq.textarea]]}]
        set xdna [revcom $xdna]
        set xdir -1
      } else {
        set xfirst 0
      }
    }
    set cds_lines [cds_trans_lines $align_ref_seq]
  } else {
    ###window1 is an abi window
    set window_type1 "abi"
    if {($align_select_region1 == "selection")} {
      set abi_seq [abi_get_seq $align_ref_seq sel.first sel.last]
      if {$abi_seq == ""} {
        set abi_seq [abi_get_seq $align_ref_seq start end]
      }
    } elseif {$info(align_phredtrim) > 0} {
      set phredmin -1
      set phredmax 0
      for {set phredi 0} {$phredi < [llength $abi_info($align_ref_seq,basecall_prob_called,edited)]} {incr phredi} {
        if {[lindex $abi_info($align_ref_seq,basecall_prob_called,edited) $phredi] > $info(align_phredtrim)} {
          if {$phredmin == -1} {set phredmin $phredi}
          set phredmax $phredi
        }
      }
      if {$phredmin < $phredmax && $phredmin > -1} {
        set abi_seq [abi_get_seq $align_ref_seq [lindex $abi_info($align_ref_seq,basecall_loc,edited) $phredmin] [lindex $abi_info($align_ref_seq,basecall_loc,edited) $phredmax]]
      } else {
        set abi_seq [abi_get_seq $align_ref_seq start end]
      }
    } else {
      set abi_seq [abi_get_seq $align_ref_seq start end]
    }
    if {$align_select_rc1 == "rev/com"} {
      set xdna [revcom [lindex $abi_seq 1]]
      if {!$abi_info($align_ref_seq,rev_com)} {
        set xdir -1
        set xfirst [expr {1+[lindex $abi_seq 0]+[string length [lindex $abi_seq 1]]}]
      } else {
        set xfirst [expr {[llength [$align_ref_seq.c find withtag basecall]]-[lindex $abi_seq 0]-[string length [lindex $abi_seq 1]]}]
      }
    } else {
      set xdna [lindex $abi_seq 1]
      if {$abi_info($align_ref_seq,rev_com)} {
        set xdir -1
        set xfirst [expr {1+[llength [$align_ref_seq.c find withtag basecall]]-[lindex $abi_seq 0]}]
      } else  {
        set xfirst [expr {[lindex $abi_seq 0]}]
      }
    }
    set cds_lines [list]
  }
  regsub -all {[^ABCDGHKMNRSTVWYabcdghkmnrstvwy]} $xdna N xdna
  if {![info exists info(($align_ref_seq,linked_events)]} {set info($align_ref_seq,linked_events) [list]}

#align each window to the reference
  set xout_list [list]
  set yout_list [list]
  set yfirst_list [list]
  set ydir_list [list]
  set ystart_list [list]
  set yend_list [list]
  set lineout_list [list]

  foreach align_select_window2 $align_windows_list align_dir $align_dir_list align_sel $align_sel_list {
    set ydir 1
    if {[string first .abi_window $align_select_window2] == -1} {
    ###window2 is a sequence window
      if {($align_sel eq [mc "Selection"]) && ([$align_select_window2.textarea tag nextrange sel 1.0] != "")} {
        set ydna [textarea_get $align_select_window2.textarea sel.first sel.last]
#selection used here 
        set yfirst [ix2bp $align_select_window2.textarea [$align_select_window2.textarea index sel.first]]
#selection used here 
      } else {
        set ydna [textarea_get $align_select_window2.textarea 1.0 [end_ix $align_select_window2.textarea]]
        set yfirst 0
      }
      set ystart $yfirst
      set yend [expr {$ystart+[string length $ydna]}]
    } else {
      ###window2 is an abi window
      if {($align_sel eq [mc "Selection"])} {
        set abi_seq [abi_get_seq $align_select_window2 sel.first sel.last]
        if {$abi_seq == ""} {
          set abi_seq [abi_get_seq $align_select_window2 start end]
        }
      } elseif {$info(align_phredtrim) > 0} {
        set phredmin -1
        set phredmax 0
        for {set phredi 0} {$phredi < [llength $abi_info($align_select_window2,basecall_prob_called,edited)]} {incr phredi} {
          if {[lindex $abi_info($align_select_window2,basecall_prob_called,edited) $phredi] > $info(align_phredtrim)} {
            if {$phredmin == -1} {set phredmin $phredi}
            set phredmax $phredi
          }
        }
        sputs phred $phredmin $phredmax
        if {$phredmin < $phredmax && $phredmin > -1} {
          set abi_seq [abi_get_seq $align_select_window2 [lindex $abi_info($align_select_window2,basecall_loc,edited) $phredmin] [lindex $abi_info($align_select_window2,basecall_loc,edited) $phredmax]]
        } else {
          set abi_seq [abi_get_seq $align_select_window2 start end]
        }
      } else {
        set abi_seq [abi_get_seq $align_select_window2 start end]
      }
      set ydna [lindex $abi_seq 1]

      if {$abi_info($align_select_window2,rev_com)} {
        set ydir -1
        set yfirst [expr {1+[llength [$align_select_window2.c find withtag basecall]]-[lindex $abi_seq 0]}]
        set yend $yfirst
        set ystart [expr {$yend-[string length $ydna]}]
      } else  {
        set yfirst [expr {[lindex $abi_seq 0]}]
        set ystart $yfirst
        set yend [expr {$ystart+[string length $ydna]}]
      }
    }
    regsub -all {[^ABCDGHKMNRSTVWYabcdghkmnrstvwy]} $ydna N ydna

    if {($info(align_blocksize) != "N-W align all") && ($info(align_blocksize) > 2000)} {
      set info(align_blocksize) 2000
    }
    if {($align_dir eq "Best")} {
      set align_dir [get_best_align_dir $xdna $ydna]
    }


    if {$align_dir eq "Reverse"} {
      set ydna [revcom $ydna]
    }
    if {$info(align_blocksize) != "N-W align all"} {
      set resultlist [block_align3 $xdna $ydna $info(align_blocksize)]
    } else {
      ###set resultlist [NW_affine_align $xdna $ydna 1]
      set resultlist [NW_affine_align_both_ends $xdna $ydna 1]
    }

    set xout [lindex $resultlist 0]
    set yout [lindex $resultlist 1]
    set lineout [lindex $resultlist 2]

    ## re-align gapped left or right overhangs from a circular reference
    ## do we need something to push the gaps off of the left end?
    if { $circular_reference_seq} {
      # take out leading mismatches in front of a gap- the leading gap shouldn't be a penalty
      if {[regexp {(^[\s#]+)(.*)} $lineout - mismatches rest_of_lineout]} {
        set mml [string length $mismatches]
        set lineout "[string map {# ""} $mismatches][string map {" " ""} $mismatches]$rest_of_lineout"
        set xout_mm [string range $xout 0 $mml-1]
        set xout "[string repeat {-} [expr {[string length $xout_mm]-[string length [string map {{-} {}} $xout_mm]]}]][string map {{-} {}} $xout_mm][string range $xout $mml end]"
        set yout_mm [string range $yout 0 $mml-1]
        set yout "[string repeat {-} [expr {[string length $yout_mm]-[string length [string map {{-} {}} $yout_mm]]}]][string map {{-} {}} $yout_mm][string range $yout $mml end]"
        set resultlist [list $xout $yout $lineout]
      }
      if {[set xdash [regexp -inline -indices -- {-+$} $xout]] ne {} && [set ydash [regexp -inline -indices -- {^-+} $yout]] ne {}} {
        # refrence sequence overhangs on the left
        set x_left [lindex $ydash 0 1] 
        set y_right [expr {[lindex $xdash 0 1] - [lindex $xdash 0 0]}] 
        if {$info(align_blocksize) != "N-W align all"} {
          set resultlist1 [block_align3 [string range $xdna 0 $x_left] [string range $ydna end-$y_right end] $info(align_blocksize)]
        } else {
          set resultlist1 [NW_affine_align [string range $xdna 0 $x_left] [string range $ydna end-$y_right end] 1]
        }
        if {($align_dir ne "Forward" && $ydir==1) || ($align_dir eq "Forward" && $ydir==-1) } {
         set yfirst [expr {$ystart + $y_right +1}]
        } else {
         set yfirst [expr {$yend - $y_right - 1}]
        }
        set resultlist0 $resultlist
        set resultlist [list]
        incr x_left
        incr y_right
        foreach list_right $resultlist0 list_left $resultlist1 {
          lappend resultlist "$list_left[string range $list_right  $x_left end-$y_right]"
        }
      } elseif {[set xdash [regexp -inline -indices --  {^-+} $xout]] ne {} && [set ydash [regexp -inline -indices -- {-+$} $yout]] ne {}} {
        # refrence sequence overhangs on the right
        set x_right [expr {[lindex $ydash 0 1] - [lindex $ydash 0 0]}]
        set y_left [expr {[lindex $xdash 0 1] - [lindex $xdash 0 0]}] 

        if {$info(align_blocksize) != "N-W align all"} {
          set resultlist1 [block_align3 [string range $xdna end-$x_right end] [string range $ydna 0 $y_left] $info(align_blocksize)]
        } else {
          set resultlist1 [NW_affine_align [string range $xdna end-$x_right end] [string range $ydna 0 $y_left] 1]
        }
        if {($align_dir ne "Forward" && $ydir==1) || ($align_dir eq "Forward" && $ydir==-1)} {
          set yfirst  [expr {$yend - $y_left - 1}]
        } else {
          set yfirst  [expr {$ystart + $y_left + 1}]
        }
        set resultlist0 $resultlist
        set resultlist [list]
        incr y_left
        incr x_right
        foreach list_left $resultlist0 list_right $resultlist1 {
          lappend resultlist "[string range $list_left  $y_left end-$x_right]$list_right"
        }
      }
      set xout [lindex $resultlist 0]
      set yout [lindex $resultlist 1]
      set lineout [lindex $resultlist 2]
    }

    lappend xout_list $xout
    lappend yout_list $yout
    lappend lineout_list $lineout
    if {$align_dir eq "Forward"} {
      lappend ydir_list $ydir
      lappend yfirst_list $yfirst
    } else {
      lappend ydir_list [expr {-1 * $ydir}]
      lappend yfirst_list [expr {1+ $yfirst + $ydir * [regexp -all {[a-zA-Z]} [lindex $resultlist 1]]}] 
    }
    lappend ystart_list $ystart
    lappend yend_list $yend


    if {![info exists info(($align_select_window2,linked_events)]} {set info($align_select_window2,linked_events) [list]}
    #increment progress bar
    incr align_prog
    update idletasks
  }

  #***build cds translations here then add those to the master alignment


  foreach tagdata $cds_lines {
    lappend xout_list [string repeat " " [string length $xdna]] [string repeat " " [string length $xdna]]
    foreach {transdata dnadata} [lrange $tagdata 1 end] {
      if {($align_select_region1 == "selection") && ([$align_ref_seq.textarea tag nextrange sel 1.0] != "")} {
        set selfirst [ix2bp $align_ref_seq.textarea [$align_ref_seq.textarea index sel.first]]
#selection used here 
      } else {
          set selfirst 0
      }
      set transdata [string range $transdata $selfirst [expr {$selfirst +[string length $xdna]-1}]]
      set dnadata [string range $dnadata $selfirst [expr {$selfirst +[string length $xdna]-1}]]
      if {$xdir== -1} {
        set transdata [string reverse $transdata]
        set dnadata [revcom $dnadata]
      }
      lappend yout_list $transdata $dnadata
    }
  }


  #align each alignment to generate the final multi-alignment
  set mm_list [align_master_match $xout_list $yout_list $lineout_list]

  #****take the cds translations back out from yout_list here
  set cds_lists [lrange [lindex $mm_list 1] end-[expr {2*[llength $cds_lines]-1}] end]
  set mm_list [lreplace $mm_list 1 1 [lrange [lindex $mm_list 1] 0 end-[expr {2*[llength $cds_lines]}]]]
  set mm_list [lreplace $mm_list 2 2 [lrange [lindex $mm_list 2] 0 end-[expr {2*[llength $cds_lines]}]]]

  #####
  ##make output window
  set left_margin 8
  if {$info(align_show_seq_names)} {
    set title_spacing [string length [file rootname [wm title $align_ref_seq]]]
    foreach align_select_window2 $align_windows_list {
      set title_spacing [expr {max($title_spacing, [string length [file rootname [wm title $align_select_window2]]])}]
    }
    set left_margin [expr {$left_margin + $title_spacing}]
  }
  if {[llength $align_windows_list] > 1} {
    set a [new_analysis_window $align_ref_seq "[mc {Alignment to %1$s windows} [llength $align_windows_list]]" multi_alignment]
  } else {
    set a [new_analysis_window $align_ref_seq "[mc {Alignment to %1$s} [wm title [lindex $align_windows_list 0]]]" multi_alignment]
  }

  # make controls frame at the bottom
  grid [frame $a.ctrl_frame] -row 3 -column 0
  grid [label $a.ctrl_frame.mismatch -text [mc "Window:"]] -row 1 -column 1 -sticky w
  grid [menubutton $a.ctrl_frame.search_window -menu $a.ctrl_frame.search_window.menu -textvariable info($a,search_window_title)] -row 1 -column 2 -sticky w
    menu $a.ctrl_frame.search_window.menu
    $a.ctrl_frame.search_window.menu add radiobutton -command "set info($a,search_window_title) [mc {Any}]" -label [mc "Any"] -variable info($a,search_window) -value "" 
    foreach window $align_windows_list {
      $a.ctrl_frame.search_window.menu add radiobutton -command "set info($a,search_window_title) [wm title $window]" -label [wm title $window] -variable info($a,search_window) -value $window 
    }
    set info($a,search_window) ""
    set info($a,search_window_title) [mc "Any"]
    grid [button $a.ctrl_frame.find_mm -text [mc "Mismatch"] -command "align_dialog_highlight_mismatch $a mm"]  -row 1 -column 3  -sticky w
    grid [button $a.ctrl_frame.find_ins -text [mc "Insert"] -command "align_dialog_highlight_mismatch $a ins"]  -row 1 -column 4  -sticky w
    grid [button $a.ctrl_frame.find_del -text [mc "Deletion"] -command "align_dialog_highlight_mismatch $a del"]  -row 1 -column 5  -sticky w
    grid [button $a.ctrl_frame.find_any -text [mc "All"] -command "align_dialog_highlight_mismatch $a all"]  -row 1 -column 6  -sticky w

    grid [label $a.ctrl_frame.result -textvariable info($a,search_result)]  -row 2 -column 1 -columnspan 5 -sticky w

 # make text frame
  create_textframe $a [expr {$info(align_linewidth) + 2*$left_margin + 1}]
  #summary info
  catch {$a.textframe.text insert end "[clock format [clock seconds] -format $info(clock_format)]\n"}
  $a.textframe.text insert end "[wm title $align_ref_seq] from [expr {$xfirst + $xdir}] to [expr {$xfirst + $xdir*[string length $xdna]}]\n"
  $a.textframe.text insert end "[mc {Alignment to}]\n"
  set unattempted_warning 0
  foreach align_select_window2 $align_windows_list lineout $lineout_list {
    $a.textframe.text insert end "[wm title $align_select_window2]--  "
    $a.textframe.text insert end "[mc Matches]:[regexp -all {\|} $lineout]; "
    $a.textframe.text insert end "[mc Mismatches]:[regexp -all {\#} $lineout]; "
    #** should not count leading and trailing gaps
    set gap_count [regexp -all {\s} $lineout]
    set leading_gap [string length [regexp -inline {^\s*} $lineout]]
    set trailing_gap [string length [regexp -inline {\s*$} $lineout]]
    $a.textframe.text insert end "[mc Gaps]:[expr {max(0,$gap_count - $leading_gap - $trailing_gap +4)}]"
    #** should only show unattempted if >0; add warning statement
    if {[regexp -all {\.} $lineout] > 0} {
      $a.textframe.text insert end "; [mc Unattempted]:[regexp -all {\.} $lineout]"
      set unattempted_warning 1
    }
     $a.textframe.text insert end \n
  }


  set xout  [lindex $mm_list 0]
  set yout_list [lindex $mm_list 1]
  set lout_list [lindex $mm_list 2]
  ##replace leading and trailing -'s
  regexp {(^-*)(.*?)(-*$)} $xout fill xleading body xtrailing
  set xout "[string repeat "~" [string length $xleading]]$body[string repeat "~" [string length $xtrailing]]"
  set yout_temp [list]
  set leading_trim [string length $xout]
  set trailing_trim [string length $xout]
  foreach yout $yout_list lout $lout_list {
    regexp {(^-*)(.*?)(-*$)} $yout fill leading body trailing
    lappend yout_temp "[string repeat "~" [string length $leading]]$body[string repeat "~" [string length $trailing]]"
    set leading_trim [expr {min($leading_trim, max([string length $leading], [string length $xleading]))}]
    set trailing_trim [expr {min($trailing_trim, max([string length $trailing], [string length $xtrailing]))}]
  }
  set yout_list $yout_temp
  #** take out leading and trailing ref seq lines that have no alignment here?
  #needs to trim each string in $cds_lists, $yout_list, $xout; adjust $xfirst (using $dir and  [regexp -all  {[^- ~]}]), $yfirst_list (using $ydir_list)
  if {$info(align_trim_to_alignment)} {
    #sputs align trim $leading_trim $trailing_trim $yfirst_list $ydir_list
    set cdslinetemp [list]
    foreach cdsline $cds_lists {
      lappend cdslinetemp [string range $cdsline $leading_trim end-$trailing_trim]
    }
    set cds_lists $cdslinetemp
    unset cdslinetemp
    set xfirst [expr {$xfirst + $xdir * [regexp -all  {[^- ~]} [string range $xout 0 $leading_trim-1]]}]
    set xout [string range $xout $leading_trim end-$trailing_trim]
    set youttemp [list]
    set louttemp [list]
    set yfirsttemp [list]
    foreach yout $yout_list ydir $ydir_list yfirst $yfirst_list lout $lout_list {
#sputs $yfirst $ydir $leading_trim [expr {$yfirst + $ydir * [regexp -all  {[^- ~]} [string range $yout 0 $leading_trim-1]]}]
      lappend yfirsttemp [expr {$yfirst + $ydir * [regexp -all  {[^- ~]} [string range $yout 0 $leading_trim-1]]}]
      lappend youttemp [string range $yout $leading_trim end-$trailing_trim]
      lappend louttemp [string range $lout $leading_trim end-$trailing_trim]
    }
    set yout_list $youttemp
    set lout_list $louttemp
    set yfirst_list $yfirsttemp
    unset youttemp yfirsttemp louttemp
  }
  ###make the top index line
  set spacing [expr {($xdir==-1)? (1 + ($xfirst-1) % 10) : (10 - ($xfirst % 10))}]
  set dot 0
  set x 0
  set xdots ""
  while {[set dot [string length [regexp -inline "(?:-*\[^-\]){$spacing}" [string range $xout $x end]]]] != 0} {
    append xdots "[string repeat " " [expr {$dot-1}]]*"
    set spacing 10
    incr x $dot
  }


  #break output into text lines x is the index of the first character of the line being displayed
  for {set x 0} {$x < [expr {[string length $xout]}]} {incr x $info(align_linewidth)} {
    #insert the index line
    $a.textframe.text insert end \n
    $a.textframe.text insert end "[string repeat " " $left_margin][string range $xdots $x [expr {$x+$info(align_linewidth)-1}]]\n"

    #insert cds translation lines
    foreach cdsline $cds_lists {
      set cdsoutline [string range $cdsline $x [expr {$x+$info(align_linewidth)-1}]]
      if {[regexp {[^\s\-]} $cdsoutline]} {
        $a.textframe.text insert end "[string repeat " " $left_margin]$cdsoutline\n"
      }
    }

    #insert the xout line
    set xchars [regexp -all  {[^- ~]} [string range $xout $x [expr {$x+$info(align_linewidth)-1}]]]
    set x_linestart [expr {$xfirst+ $xdir*([regexp -all  {[^- ~]} [string range $xout 0 $x-1]] + (($xchars>0)?1:0))}]
    if {$info(align_show_seq_names)} {
      $a.textframe.text insert end [format "%$title_spacing\s%[expr {$left_margin - $title_spacing -1}]u[expr {$xdir>0?">":"<"}]" [file rootname [wm title $align_ref_seq]] $x_linestart]
    } else {
      $a.textframe.text insert end [format "%[expr {$left_margin -1}]u[expr {$xdir>0?">":"<"}]" $x_linestart]
    }
    set dnastarts [$a.textframe.text index end-1char]
    set lstag "ls[expr {$x_linestart}]\_$xdir" 
    $a.textframe.text insert end "[set x_linestore [string range $xout $x [expr {$x+$info(align_linewidth)-1}]]]" [list $align_ref_seq\_reftag $lstag noalignhighlight]
    if {($info(align_copy_highlight)) && ([string first .abi_window $align_ref_seq] == -1) && ($xchars > 0)} {
      copy_tags $align_ref_seq.textarea [list [bp2ix $align_ref_seq.textarea [expr {$x_linestart-1}]] [bp2ix $align_ref_seq.textarea [expr {$x_linestart-1 +$xdir * ( $xchars- (($xchars>0)?1:0))}]]] $a.textframe.text $dnastarts [expr {($xdir==1)?"forward":"reverse"}] 
    }


    $a.textframe.text insert end "[format "[expr {$xdir>0?">":"<"}]%-[expr {$left_margin -1}]u" [expr {$x_linestart +$xdir*( $xchars- (($xchars>0)?1:0))}]]\n"
    #add live link bindings 
    $a.textframe.text tag bind $align_ref_seq\_reftag <Double-Button-1> "$a.textframe.text tag add sel @%x,%y; alignlink2 $a.textframe.text $align_ref_seq \[$a.textframe.text index @%x,%y\] goto 1; break"
    lappend info($align_ref_seq,linked_events) [list $a.textframe.text $align_ref_seq\_reftag <Double-Button-1>]
    $a.textframe.text tag bind $align_ref_seq\_reftag <Shift-Double-Button-1> "$a.textframe.text tag add sel @%x,%y; alignlink2 $a.textframe.text $align_ref_seq \[$a.textframe.text index @%x,%y\] select 1; break"
    lappend info($align_ref_seq,linked_events) [list $a.textframe.text $align_ref_seq\_reftag <Shift-Double-Button-1>]
    $a.textframe.text tag bind $align_ref_seq\_reftag <Button-1> "alignlink2 $a.textframe.text $align_ref_seq \[$a.textframe.text index @%x,%y\] goto 0; break"
    lappend info($align_ref_seq,linked_events) [list $a.textframe.text $align_ref_seq\_reftag <Button-1>]
    $a.textframe.text tag bind $align_ref_seq\_reftag <Shift-Button-1> "alignlink2 $a.textframe.text $align_ref_seq \[$a.textframe.text index @%x,%y\] select 0; break"
    lappend info($align_ref_seq,linked_events) [list $a.textframe.text $align_ref_seq\_reftag <Shift-Button-1>]
    $a.textframe.text tag bind $align_ref_seq\_reftag <Any-Leave> {%W tag remove highlite 1.0 end}
    $a.textframe.text tag bind $align_ref_seq\_reftag <Any-Motion> {%W tag remove highlite 1.0 end; %W tag add highlite current}


    set x_linestore [string toupper $x_linestore]

    #insert all of the yout lines
    set y_line_count 0
    foreach yout $yout_list ydir $ydir_list yfirst $yfirst_list ystart $ystart_list yend $yend_list ywindow $align_windows_list lout $lout_list {
      if {![regexp {[^~]} $yout]} {continue}
      incr y_line_count
      set ychars [regexp -all  {[^- ~]} [string range $yout $x [expr {$x+$info(align_linewidth)-1}]]]
      #** skip the line if $ychars == 0?
#sputs ychars $ychars $yfirst $ydir [regexp -all  {[^- ~]} [string range $yout 0 $x-1]]
      set y_linestart [expr {$yfirst+ $ydir*([regexp -all  {[^- ~]} [string range $yout 0 $x-1]] + (($ychars>0)?1:0))}]
       ## for wrapping, need to mod by the end index
      set y_linestart [expr {($y_linestart-$ystart-1) % ($yend-$ystart) + $ystart+1}]
      ## mm line out if only one sequence?
      set l_linestore [string range $lout $x [expr {$x+$info(align_linewidth)-1}]]
      ## output the mm line if only one match
      if {[llength $align_windows_list] == 1} {
        $a.textframe.text insert end [format "%[expr {$left_margin -1}]u[expr {$ydir>0?">":"<"}]" $y_linestart]
        $a.textframe.text insert end "$l_linestore\n"
        incr y_line_count
      }
      if {$info(align_show_seq_names)} {
        $a.textframe.text insert end [format "%$title_spacing\s%[expr {$left_margin - $title_spacing -1}]u[expr {$ydir>0?">":"<"}]" [file rootname [wm title $ywindow]] $y_linestart]
      } else {
        $a.textframe.text insert end [format "%[expr {$left_margin -1}]u[expr {$ydir>0?">":"<"}]" $y_linestart]
      }
      set dnastarts [$a.textframe.text index end-1char]
### work here- need to add the start and end if the line contains an origin
      set y_lineend [expr {$y_linestart +$ydir*( $ychars- (($ychars>0)?1:0))}]
       ## for wrapping, need to mod by the end index
      if {$circular_reference_seq} {
        set y_lineend_mod [expr {($y_lineend-$ystart-1) % ($yend-$ystart) + $ystart+1}]
      } else {
        set y_lineend_mod $y_lineend
      }

      if {$y_lineend != $y_lineend_mod} {
        set line_contains_origin 1
        set lstag "ls[expr {$y_linestart}]\_$ydir\_#_$ystart\_$yend"
      } else {
        set line_contains_origin 0
        set lstag "ls[expr {$y_linestart}]\_$ydir"
      }

      $a.textframe.text insert end "[set y_linestore [string range $yout $x [expr {$x+$info(align_linewidth)-1}]]]" [list $ywindow\_tag $lstag]
      #copy tags
### work here- need to add two tag regions if the line contains an origin
      if {($info(align_copy_highlight)) && ([string first .abi_window $ywindow] == -1) && ($ychars > 0)} {
        if {$line_contains_origin} {
          if {$ydir == 1} {
            copy_tags $ywindow.textarea [list [bp2ix $ywindow.textarea [expr {$y_linestart-1}]] [bp2ix $ywindow.textarea $yend]] $a.textframe.text $dnastarts "forward" $ywindow
            if {[set orig_reg [regexp -inline -indices   "(?:\[^-\]-*)\{[expr {$yend-$y_linestart+1}]\}" $y_linestore]] ne {}} {
              set orig_char [lindex $orig_reg 0 1]
              incr orig_char
              copy_tags $ywindow.textarea [list [bp2ix $ywindow.textarea $ystart] [bp2ix $ywindow.textarea [expr {$y_lineend_mod-1}]]] $a.textframe.text "$dnastarts+$orig_char\c" "forward" $ywindow
            }
          } else {
            copy_tags $ywindow.textarea [list [bp2ix $ywindow.textarea [expr {$y_linestart-1}]] [bp2ix $ywindow.textarea [expr {$ystart-1}]]] $a.textframe.text $dnastarts-2c "reverse" $ywindow
            if {[set orig_reg [regexp -inline -indices   "(?:\[^-\]-*)\{[expr {$y_linestart-$ystart}]\}" $y_linestore]] ne {}} {
              set orig_char [lindex $orig_reg 0 1]
              incr orig_char
              copy_tags $ywindow.textarea [list [bp2ix $ywindow.textarea $yend] [bp2ix $ywindow.textarea [expr {$y_lineend_mod-1}]]] $a.textframe.text "$dnastarts+$orig_char\c" "forward" $ywindow
            }
         }
        } else {
          copy_tags $ywindow.textarea [list [bp2ix $ywindow.textarea [expr {$y_linestart-1}]] [bp2ix $ywindow.textarea [expr {$y_linestart-1 +$ydir * ( $ychars- (($ychars>0)?1:0))}]]] $a.textframe.text $dnastarts [expr {($ydir==1)?"forward":"reverse"}] $ywindow
        }
      }
      #add mmtag
      if {$ychars > 0} {
        $a.textframe.text tag remove noalignhighlight [$a.textframe.text index $dnastarts-$y_line_count\lines] [$a.textframe.text index $dnastarts+[string length $y_linestore]\chars-$y_line_count\lines]
        for {set i 0} {$i < [string length $y_linestore]} {incr i} {
          if {([string index $y_linestore $i] ne "~")  && ([string toupper [string index $y_linestore $i]] eq [string toupper [string index $x_linestore $i]])} {
              $a.textframe.text tag add matchhighlite [$a.textframe.text index $dnastarts+$i\chars-$y_line_count\lines]
          }
        }
      }
      if {([set y_linestore [string toupper $y_linestore]] ne $x_linestore) && ([regexp {[^- ~]} $y_linestore]) && (1 ||($ychars > [expr {[string length $y_linestore] / 2}]))} {
        for {set i 0} {$i < [string length $y_linestore]} {incr i} {
          if {([string index $y_linestore $i] ne "~") && ([string index $x_linestore $i] ne "~")} {
            if {([string index $l_linestore $i] eq ".")} {
              $a.textframe.text tag add unattemptedhighlite [$a.textframe.text index $dnastarts+$i\chars]
              if {[llength $align_windows_list] == 1} {
                $a.textframe.text tag add unattemptedhighlite [$a.textframe.text index $dnastarts-1line+$i\chars]
              }
            }
            if {([string index $y_linestore $i] ne [string index $x_linestore $i])} {
              if {[string first [string index $y_linestore $i]  [string map {B CGTBSKY D AGDTKRW H ACTHRYW K GTK M ACM N NBDHVKMRYWSACGT R AGR S CGS V ACGVMRS W ATW Y CTY} [string index $x_linestore $i]]] ==-1} {
                $a.textframe.text tag add mmhighlite [$a.textframe.text index $dnastarts+$i\chars]
                if {[llength $align_windows_list] == 1} {
                  $a.textframe.text tag add mmhighlite [$a.textframe.text index $dnastarts-1line+$i\chars]
                }
              }
              if {[string index $y_linestore $i] eq "-"} {
                $a.textframe.text tag add delhighlite [$a.textframe.text index $dnastarts+$i\chars]
                if {[llength $align_windows_list] == 1} {
                  $a.textframe.text tag add delhighlite [$a.textframe.text index $dnastarts-1line+$i\chars]
                }
              }
              if {[string index $x_linestore $i] eq "-"} {
                $a.textframe.text tag add inshighlite [$a.textframe.text index $dnastarts+$i\chars]
                if {[llength $align_windows_list] == 1} {
                  $a.textframe.text tag add inshighlite [$a.textframe.text index $dnastarts-1line+$i\chars]
                }
              }
            } else {
             # $a.textframe.text tag add matchhighlite [$a.textframe.text index $dnastarts+$i\chars]
             # $a.textframe.text tag add matchhighlite [$a.textframe.text index $dnastarts+$i\chars-$y_line_count\lines]
            }
          }
        }
      } elseif {$y_linestore eq $x_linestore} {
        #$a.textframe.text tag add matchhighlite [$a.textframe.text index $dnastarts] [$a.textframe.text index $dnastarts+[string length $y_linestore]\chars]
        $a.textframe.text tag remove noalignhighlight [$a.textframe.text index $dnastarts-$y_line_count\lines] [$a.textframe.text index $dnastarts+[string length $y_linestore]\chars-$y_line_count\lines]
        $a.textframe.text tag add matchhighlite [$a.textframe.text index $dnastarts-$y_line_count\lines] [$a.textframe.text index $dnastarts+[string length $y_linestore]\chars-$y_line_count\lines]
      }
      #** add mmhigligth to index numbers at start and end of the line too?

      #add live link bindings 
      $a.textframe.text tag bind $ywindow\_tag <Double-Button-1> "$a.textframe.text tag add sel @%x,%y; alignlink2 $a.textframe.text $ywindow \[$a.textframe.text index @%x,%y\] goto 1; break"
      lappend info($ywindow,linked_events) [list $a.textframe.text $ywindow\_tag <Double-Button-1>]
      $a.textframe.text tag bind $ywindow\_tag <Shift-Double-Button-1> "$a.textframe.text tag add sel @%x,%y; alignlink2 $a.textframe.text $ywindow \[$a.textframe.text index @%x,%y\] select 1; break"
      lappend info($ywindow,linked_events) [list $a.textframe.text $ywindow\_tag <Shift-Double-Button-1>]
      $a.textframe.text tag bind $ywindow\_tag <Button-1> "alignlink2 $a.textframe.text $ywindow \[$a.textframe.text index @%x,%y\] goto 0; break"
      lappend info($ywindow,linked_events) [list $a.textframe.text $ywindow\_tag <Button-1>]
      $a.textframe.text tag bind $ywindow\_tag <Shift-Button-1> "alignlink2 $a.textframe.text $ywindow \[$a.textframe.text index @%x,%y\] select 0; break"
      lappend info($ywindow,linked_events) [list $a.textframe.text $ywindow\_tag <Shift-Button-1>]
      $a.textframe.text tag bind $ywindow\_tag <Any-Leave> "%W tag remove highlite 1.0 end; catch {after cancel \[bind $a.textframe.text  <<abi_tooltip_after>>\]}; catch {wm withdraw .abitooltip2}"
      $a.textframe.text tag bind $ywindow\_tag <Any-Motion> "%W tag remove highlite 1.0 end; %W tag add highlite current; abi_tooltip_post $a.textframe.text $ywindow %x %y"
      $a.textframe.text tag bind $ywindow\_tag <Any-Enter> " abi_tooltip_post $a.textframe.text $ywindow %x %y; break"

      #$a.textframe.text tag bind $ywindow\_tag <Any-Motion> "+;abi_tooltip_post $a.textframe.text $ywindow %x %y"
      #lappend info($ywindow,linked_events) [list $a.textframe.text $ywindow\_tag <Any-Motion>]
      #lappend info($ywindow,linked_events) [list $a.textframe.text $ywindow\_tag <Any-Enter>]
      #$a.textframe.text tag bind $ywindow\_tag <Any-Leave> "+;destroy .abitooltip2"
      #lappend info($ywindow,linked_events) [list $a.textframe.text $ywindow\_tag <Any-Leave>]
#bind $a.textframe <FocusOut> "destroy .abitooltip2"
      #**ctrl mouseover to generate tooltip of window name


      $a.textframe.text insert end "[format "[expr {$ydir>0?">":"<"}]%-[expr {$left_margin -1}]u" $y_lineend_mod]\n"
    }
    $a.textframe.text insert end \n
  }
  #reorder the tags
  if {[winfo exists $align_ref_seq.textarea]} {
    foreach tag [$align_ref_seq.textarea tag names] {
      if {![regexp {fn[0-9]+#} $tag]} {
        catch {$a.textframe.text tag raise [regsub fn $tag f]}
      }
    }
  }
  foreach win2 $align_windows_list {
    if {[winfo exists $win2.textarea]} {
      foreach tag [$win2.textarea tag names] {
        if {![regexp {fn[0-9]+#} $tag]} {
          catch {$a.textframe.text tag raise "[regsub fn $tag f]$win2"}
        }
      }
    }
  }
  $a.textframe.text tag configure mmhighlite -background red -foreground black
  $a.textframe.text tag raise mmhighlite 
  $a.textframe.text tag configure unattemptedhighlite -background gray20 -foreground gray60
  $a.textframe.text tag raise unattemptedhighlite
  $a.textframe.text tag configure matchhighlite -underline 1
  $a.textframe.text tag configure noalignhighlight -foreground gray50
  $a.textframe.text tag configure highlite -background $info(text_select_bg_color) -foreground white
  $a.textframe.text tag configure sel -background $info(text_select_bg_color) -foreground white
  $a.textframe.text tag raise sel

  #add popup menu
  set outputmenu [add_output_menu $a.textframe.text "Text" text $align_ref_seq]
  #raise parent is linked to the reference sequence
  $outputmenu entryconfigure [mc "Raise Parent"] -label [mc "Raise Reference sequence"]
  if {$window_type1 eq "abi"} {
    bind $a.textframe.text <<Return>> "wm deiconify $align_ref_seq; raise $align_ref_seq; focus $align_ref_seq.c"
  }

  #configure raise parent events for aligned sequences
  if {[llength $align_windows_list] > 0} {
    $outputmenu insert  [expr {1+[$outputmenu index [mc "Raise Reference sequence"]]}] cascade -menu [menu $outputmenu.subwindowcascade] -label [mc "Raise Window"]
    foreach ywindow $align_windows_list {
      $outputmenu.subwindowcascade add command -label [mc {Raise %1$s} [wm title $ywindow]] -command "event generate $a.textframe.text <<Return_$ywindow>>"
      if {[string first .abi_window $ywindow] == -1} {
        bind $a.textframe.text <<Return_$ywindow>> "wm deiconify $ywindow; raise $ywindow; focus $ywindow.textarea"
      } else {
        bind $a.textframe.text <<Return_$ywindow>> "wm deiconify $ywindow; raise $ywindow; focus $ywindow.c"
      }
      lappend info($ywindow,linked_events) [list $a.textframe.text <<Return_$ywindow>>]
    } 
    $outputmenu insert  end separator
    $outputmenu insert  end command  -label [mc "Save Alignment as FASTA"] -command "alignment_to_fasta $a.textframe.text"
  }

  
  bind $a <Button-1> "focus $a.textframe.text"
  bind $a.textframe.text <Double-Button> break
  bind $a.textframe.text <Shift-Double-Button> break
  bind $a.textframe.text <Double-Button-1> ""
  bind $a.textframe.text <<abi_tooltip>> 1
  bind $a.textframe.text <KeyPress-space> "if {\[bind $a.textframe.text <<abi_tooltip>>\] != 1} {bind $a.textframe.text <<abi_tooltip>> 1} else {bind $a.textframe.text <<abi_tooltip>> 0; catch {wm withdraw .abitooltip2}}"
  bindtags $a.textframe.text [list $a.textframe.text AnalysisText $a . all]
  $a.textframe.text configure -state disabled
  wm deiconify $a
  if {[info exists info(last_analysis_xy)]} {
    wm geometry [winfo toplevel $a] [textbox_geometry $a.textframe.text {*}$info(last_analysis_xy)]
  } else {
    scan [wm geometry [winfo toplevel $a]] "%dx%d+%d+%d" w h x y
    wm geometry [winfo toplevel $a] [textbox_geometry $a.textframe.text $x $y]
  }

  foreach key [dict keys $alignment_parameters_dict] {
    set info($key) [dict get $parameter_store $key]
  }
  #window_on_screen $a
    focus $a.textframe.text

  if {$unattempted_warning} {
    tk_messageBox -message [mc "Some windows had unattempted regions due to the NW_max setting.\nIncrease this value if you want to do a compete alignment of these sequences."] -type ok -icon warning -default ok   
  }

  return $a.textframe.text
}

############
## subroutine of output alignment2
## look for "Best" direction
## check 15 blocks of ydna against xdna for forward and reverse matches return forward or reverse
############
proc get_best_align_dir {xdna ydna} {
  if {[string length $ydna] < [string length $xdna]} { 
    set text1 [string toupper $xdna]
    set text2 [string toupper $ydna]
  } else {
    set text2 [string toupper $xdna]
    set text1 [string toupper $ydna]
  }
  set result 0
  set len [expr {max(1,[string length $text2]-15)}]
  for {set i 0} {$i <  20} {incr i} {
    set j [expr {int(rand()*$len)}]
    set search_string [string range $text2 $j [expr {$j+14}]] 
    if {[regexp $search_string $text1]} {
      incr result 1
    }
    if {[regexp [revcom $search_string] $text1]} {
      incr result -1
    }
  }
  if {$result == 0} {
  set len [expr {max(1,[string length $text2]-10)}]
    for {set i 0} {$i <  50} {incr i} {
      set j [expr {int(rand()*$len)}]
      set search_string [string range $text2 $j [expr {$j+9}]] 
      if {[regexp $search_string $text1]} {
        incr result 1
      }
      if {[regexp [revcom $search_string] $text1]} {
        incr result -1
      }
    }
  }

  if {$result < 0} {
    return "Reverse"
  } else {
    return "Forward"
  }
}


############
## subroutine of output alignment2
## make all alignments have the same reference sequence (ref seq list, align seq list)
############
proc align_master_match {m_list s_list {l_list {}}} {

  if {($m_list == [list]) || ($s_list == [list])} {return [list]}
  set count 0
  for {set count 0} {$count < [llength $m_list]} {incr count} {
    set i($count) 0
    set s_out($count) ""
    set l_out($count) ""
  }
  set m_out ""

  set cont 1
  while {$cont} {
   #scan all elements of m_list for a dash at the index position
   #if any index positions are past the end, break
    set dash 0
    for {set count 0} {$count < [llength $m_list]} {incr count} {
      if {[set char [string index [lindex $m_list $count] $i($count)]] eq ""} {
        set cont 0
        break
      } elseif {$char eq "-"} {
        set dash 1
      }
    }

    #break while loop if any are past their ends
    if {!$cont} break
    #if any m_list index characters are dash, add dash to the m_out and put char out for m_lists with dashes, dash for those without (don't incr index for those)
    if {$dash} {
      append m_out "-"
      for {set count 0} {$count < [llength $m_list]} {incr count} {
        if {[string index [lindex $m_list $count] $i($count)] eq "-"} {
          append s_out($count) [string index [lindex $s_list $count] $i($count)]
          append l_out($count) [string index [lindex $l_list $count] $i($count)]
          incr i($count)
        } else {
          append s_out($count) "-"
          append l_out($count) "-"
        }
      }
    } else {
      append m_out [string index [lindex $m_list 0] $i(0)]
      for {set count 0} {$count < [llength $m_list]} {incr count} {
        append s_out($count) [string index [lindex $s_list $count] $i($count)]
        append l_out($count) [string index [lindex $l_list $count] $i($count)]
        incr i($count)
      }
    }
  }

  set len_max 0
  for {set count 0} {$count < [llength $m_list]} {incr count} {
    append s_out($count) [string range [lindex $s_list $count] $i($count) end]
    append l_out($count) [string range [lindex $l_list $count] $i($count) end]
    set len_max [expr {max ($len_max, [string length $s_out($count)])}]
  }
  append m_out [string repeat "-" [expr {$len_max - [string length $m_out]}]] 
  set s_out_list [list]
  set l_out_list [list]
  for {set count 0} {$count < [llength $m_list]} {incr count} {
    append s_out($count) [string repeat "-" [expr {$len_max - [string length $s_out($count)]}]]
    append l_out($count) [string repeat "-" [expr {$len_max - [string length $l_out($count)]}]]
    lappend s_out_list $s_out($count)  
    lappend l_out_list $l_out($count) 
  }
  return [list $m_out $s_out_list $l_out_list]
}


##################
## block align2 algorithm that takes each block in xdna and finds all matches in ydna, keeps running list of lists of possible alignments
##################
## NOT USED
proc block_align2 {xdna ydna} {
  global info
    set xseq [string toupper $xdna]
    set yseq [string toupper $ydna]
    set res_list [list [list]]
    for {set i 0} {[expr {$i+$info(align_blocksize)-1}] < [string length $xseq]} {incr i $info(align_blocksize)} {
      set found 0
      set foundlist [list]
      set lastfound [expr {-$info(align_blocksize) -2}]
      #find all blocks in ydna that align to the current block in xdna
      while {([set found [string first [string range $xseq $i [expr {$i+$info(align_blocksize)-1}]] $yseq $found]] > -1)} {
        if { (([expr {$found-$lastfound}] < $info(align_blocksize)) || ([llength $foundlist] > 4))} {
          set foundlist [list]
          break
        } else {
          lappend foundlist $found
          set lastfound $found
          incr found
        }
      }

      #add this block to all possible alignments
      if {[llength $res_list] < 40000} {
        set res_list [blockalign_result_insert $res_list [list $i $foundlist] $info(align_blocksize)]
      } else {
        break
      }
    }



    #find longest result list
    set maxlen 0
    set new_res [list]
    foreach res $res_list {
      if {[llength $res] > $maxlen} {
        set new_res $res
        set maxlen [llength $res]
      }
    }

    #take result list and generate alignment
    set x1 0
    set y1 0
    set xout ""
    set yout ""
    set lineout ""

    foreach res $new_res {
      set x2 [expr {[lindex $res 0]}]
      set y2 [expr {[lindex $res 1]}]
      if {($x2 > $x1) || ($y2 > $y1)} {
        set alignlist [finealign [string range $xdna $x1 [expr {$x2-1}]] [string range $ydna $y1 [expr {$y2 - 1}]]]
        append xout [lindex $alignlist 0]
        append yout [lindex $alignlist 1]
        append lineout [lindex $alignlist 2]
      }
      append xout [string range $xdna $x2 [expr {$x2+$info(align_blocksize)-1}]]
      append yout [string range $ydna $y2 [expr {$y2+$info(align_blocksize)-1}]]
      append lineout [string repeat "|" $info(align_blocksize)]
      set x1 [expr {$x2+$info(align_blocksize)}]
      set y1 [expr {$y2+$info(align_blocksize)}]
    }
    set alignlist [finealign [string range $xdna $x1 end] [string range $ydna $y1 end]]
    append xout [lindex $alignlist 0]
    append yout [lindex $alignlist 1]
    append lineout [lindex $alignlist 2]
    return [list $xout $yout $lineout]
}

############
## subroutine of blockalign2
## feed a list of prior blockalign alignment paths, list of new hit positions, return all possible alignment paths up to that point
############
proc blockalign_result_insert {res_lists pos_list align_blocksize} {


#loop through pos_list append to output_list the possible result lists for each one
  if {[lindex $pos_list 1] == [list]} {
    return $res_lists
  }
  set output_list [list]
  foreach pos [lindex $pos_list 1] {
    foreach proto_list $res_lists {
      if {($proto_list == [list]) || ([expr {$pos - $align_blocksize +1}] >= [lindex [lindex $proto_list end] 1])} {
        lappend proto_list [list [lindex $pos_list 0] $pos]

      } else {
        set new_list [list]
        foreach element $proto_list {
          if {[lindex $element 1] < [expr {$pos - $align_blocksize +1}]} {
            lappend new_list $element
          } else {
            break
          }
        }
        lappend new_list [list [lindex $pos_list 0] $pos]
        lappend output_list $new_list
      }
      lappend output_list $proto_list
    }
  }
  return $output_list
}


##################
## block align algorithm that takes each block in xdna and finds all matches in ydna, keeps running list of lists of possible alignments
##################
## NOT USED
proc block_align3b {xdna ydna} {
  global info

    set xseq [string toupper $xdna]
    set yseq [string toupper $ydna]
    set res_list ""

    for {set i 0} {[expr {$i+$info(align_blocksize)-1}] < [string length $xseq]} {incr i $info(align_blocksize)} {
      set found 0
      set foundlist [list]
      set search_string [string range $xseq $i [expr {$i+$info(align_blocksize)-1}]]
      #find all blocks in ydna that align to the current block in xdna
      if {[string range $search_string 0 end-1] != [string range $search_string 1 end]} {
        while {([set found [string first $search_string $yseq $found]] > -1)} {
          lappend res_list [list $i $found]
          incr found
        }
      } else {
      }
    }
   set new_res [blockalign_combine_blocks $res_list] 

    #take result list and generate alignment
    set x1 0
    set y1 0
    set xout ""
    set yout ""
    set lineout ""

    foreach res $new_res {
      set x2 [expr {[lindex $res 0]}]
      set y2 [expr {[lindex $res 1]}]
      set align_blocksize [lindex $res 2]
      if {($x2 > $x1) || ($y2 > $y1)} {
        set alignlist [finealign [string range $xdna $x1 [expr {$x2-1}]] [string range $ydna $y1 [expr {$y2 - 1}]]]
        append xout [lindex $alignlist 0]
        append yout [lindex $alignlist 1]
        append lineout [lindex $alignlist 2]
      }
      append xout [string range $xdna $x2 [expr {$x2+$align_blocksize-1}]]
      append yout [string range $ydna $y2 [expr {$y2+$align_blocksize-1}]]
      append lineout [string repeat "|" $align_blocksize]
      set x1 [expr {$x2+$align_blocksize}]
      set y1 [expr {$y2+$align_blocksize}]
    }
    set alignlist [finealign [string range $xdna $x1 end] [string range $ydna $y1 end]]
    append xout [lindex $alignlist 0]
    append yout [lindex $alignlist 1]
    append lineout [lindex $alignlist 2]
    return [list $xout $yout $lineout]
}

############
## subroutine of block_align3b
############
proc blockalign_combine_blocks {blockslist} {
  global info okgo

  set align_blocksize $info(align_blocksize)
  if {$blockslist == {}} {return}
  set a([lindex $blockslist 0]) [lindex $blockslist 0]
  

  foreach block [lrange $blockslist 1 end] {
    set i 0
    foreach line [array names a] {
      if {([expr {[lindex $a($line) 0] + $align_blocksize}] == [lindex $block 0]) && ([expr {[lindex $a($line) 1] + $align_blocksize}] == [lindex $block 1])} {
        set a($line) $block
        set i 1
        break
      }
    }
    if {!$i} {
      set a($block) $block
    }
  }
  foreach res [lsort -integer -index 1 [array names a]] {
    lappend reslist [concat $res [expr {[lindex $a($res) 0] -[lindex $res 0] + $align_blocksize}]]
  }


  ##need to take out all lines that are a complete subset of another line here
  for {set k 0} {$k < [llength $reslist]} {incr k} {
    for {set j [expr {$k +1}]} {$j < [llength $reslist]} {incr j} {
      set kel [lindex $reslist $k]
      set jel [lindex $reslist $j]
      if {([lindex $jel 0] >= [lindex $kel 0]) && ([lindex $jel 0] <= [expr {[lindex $kel 0] + [lindex $kel 2]}]) && ([lindex $jel 1] >= [lindex $kel 1]) && ([lindex $jel 1] <= [expr {[lindex $kel 1] + [lindex $kel 2]}]) && ([expr {[lindex $jel 0] +[lindex $jel 2]}] >= [lindex $kel 0]) && ([expr {[lindex $jel 0] +[lindex $jel 2]}] <= [expr {[lindex $kel 0] + [lindex $kel 2]}]) && ([expr {[lindex $jel 1] +[lindex $jel 2]}] >= [lindex $kel 1]) && ([expr {[lindex $jel 1] +[lindex $jel 2]}] <= [expr {[lindex $kel 1] + [lindex $kel 2]}])} {
        set reslist [lreplace [K $reslist [set reslist {}]] $j $j]
        incr j -1
      }
      if {([lindex $jel 0] <= [lindex $kel 0]) && ([lindex $jel 0] >= [expr {[lindex $kel 0] + [lindex $kel 2]}]) && ([lindex $jel 1] <= [lindex $kel 1]) && ([lindex $jel 1] >= [expr {[lindex $kel 1] + [lindex $kel 2]}]) && ([expr {[lindex $jel 0] +[lindex $jel 2]}] <= [lindex $kel 0]) && ([expr {[lindex $jel 0] +[lindex $jel 2]}] >= [expr {[lindex $kel 0] + [lindex $kel 2]}]) && ([expr {[lindex $jel 1] +[lindex $jel 2]}] <= [lindex $kel 1]) && ([expr {[lindex $jel 1] +[lindex $jel 2]}] >= [expr {[lindex $kel 1] + [lindex $kel 2]}])} {
        set reslist [lreplace [K $reslist [set reslist {}]] $k $k]
        incr k -1
        break
      }
    }
  }



  ####need to use the blockalign_result_insert algorithm to find the longest full alignment from the combined blocks 
  ##start with single blank list as out_list
  ##foreach reslist
  ## foreach out_list
  ## if current_reslist adds smoothly to current_out_list, add it on
  ## else add new out_list that is the longest list that can be made with current_outlist that ends with current_reslist
  ## make new out list by looping through blocks of current_outlist until index 0 of the block+ block length > index 0 of current_reslist (don't need to check index 1, since those are in inceasing order)
  ## if index 0 of the block is > index 0 current_reslist, just add the current_reslist as the last block, else change the length of the last block to be difference in the two inxex 0, then add the current_reslist block.


  set outlist [list [list [lindex $reslist 0]]]
  set new_outlist ""
  foreach current_reslist [lrange $reslist 1 end] {
    set new_outlist ""
    foreach current_outlist $outlist {
      if {(([expr {[lindex [lindex $current_outlist end] 0] + [lindex [lindex $current_outlist end] 2]}] < [lindex $current_reslist 0]) && ([lindex [lindex $current_outlist end] 1] < [lindex $current_reslist 1]))} {
         lappend new_outlist [concat $current_outlist [list $current_reslist]]
       } else {
         lappend new_outlist $current_outlist
         ##need to make new list by adding current_reslist to end of current_outlist
         set newlist ""
         foreach block $current_outlist {
           if {([expr {[lindex $block 0] + [lindex $block 2]}] >= [lindex $current_reslist 0]) || ([lindex $block 1] >= [lindex $current_reslist 1])} {
             if {([lindex $block 0] < [lindex $current_reslist 0]) && ([lindex $block 1] < [lindex $current_reslist 1])} {
               ##**add in the partial block here
             }
             break
           }
           lappend newlist $block
         } 
         if {[lsearch $new_outlist [set newlist [concat $newlist [list $current_reslist]]]] == -1} {
           lappend new_outlist $newlist
         }
       }
    }
    set outlist $new_outlist
  }

  set longest_list ""
  set longest_sum 0
  foreach list $outlist {
    set sum 0
    foreach block $list {
      incr sum [lindex $block 2]
    }
    if {$sum > $longest_sum} {
      set longest_sum $sum
      set longest_list $list
    }
  }

  return $longest_list
}


##################
## block align4 algorithm that takes each block in xdna and finds all matches in ydna, keeps running list of lists of possible alignments
##################
## NOT USED
proc block_align4 {xdna ydna} {
  global info
    set xseq [string toupper $xdna]
    set yseq [string toupper $ydna]
    set block_start_list [list]
    set block_end_list [list]
    for {set i 0} {[expr {$i+$info(align_blocksize)-1}] < [string length $xseq]} {incr i $info(align_blocksize)} {
      set found 0
      set foundlist [list]
      set lastfound [expr {-$info(align_blocksize) -2}]
      #find all blocks in ydna that align to the current block in xdna
      while {([set found [string first [string range $xseq $i [expr {$i+$info(align_blocksize)-1}]] $yseq $found]] > -1)} {
        if {(([expr {$found-$lastfound}] < $info(align_blocksize)) || ([llength $foundlist] > 4))} {
          set foundlist [list]
          break
        } else {
          lappend foundlist $found
          set lastfound $found
          incr found
        }
      }

      #add this block to block lists
      foreach found $foundlist {
        if {[set extend [lsearch -exact $block_end_list [list [expr {$i}] [expr {$found}]]]] > -1} {
          lset block_end_list $extend [list [expr {$i+$info(align_blocksize)}] [expr {$found+$info(align_blocksize)}]]
        } else {
sputs ext $block_end_list [list [expr {$i}] [expr {$found}]]
          lappend block_start_list [list $i $found]
          lappend block_end_list [list [expr {$i+$info(align_blocksize)}] [expr {$found+$info(align_blocksize)}]]
        }
      }
    }

  #sputs $block_start_list
  #sputs $block_end_list
    return [list "" "" ""]
}

##########################
#blockalign Dec 2011- currently in use
########################## 
proc block_align3 {xdna ydna blocksize} {
global text1 text2
  set text1 [string toupper $xdna]
  set text2 [string toupper $ydna]
  set result [list]

  #find blocks that are present only once in each sequence (ignore anything repeated)
  set i 0
  set lastlen 0
  foreach a [regexp -all -inline [string repeat . $blocksize] $text1] {
    if {([regexp -all $a $text1] == 1) &&  ([llength [set r1list [regexp -all -inline -indices $a $text2]]] == 1)  && ([regexp -all -start [expr {[lindex [lindex $r1list 0] 0]+1}] $a $text2] == 0)} {

      if {($lastlen > 0) && ([lindex [lindex $r1list 0] 0] == [expr {[lindex [lindex $result end] 1] + $lastlen}]) } {
        incr lastlen $blocksize
        #add len to last block
        lset result end end $lastlen
      } else {
        lappend result [list $i  [lindex [lindex $r1list 0] 0] $blocksize]
        set lastlen $blocksize
      }
    } else {
      set lastlen 0
    }
    incr i $blocksize
  }

#bug {{0 1 15} {15 15 60}} shouldn't be added together
  #add together adjacent blocks connected by identical sequence that was filtered by the repeat masking
  set res2 [list [lindex $result 0]]
  foreach b [lrange $result 1 end] {
    foreach {a1 a2 a3} [lindex $res2 end] {}
    foreach {b1 b2 b3} $b {}
    if {([string range $text1 [expr {$a1+$a3}] [expr {$b1-1}]] == [string range $text2 [expr {$a2+$a3}] [expr {$b2-1}]]) && ([expr {$a1+$a3}] <= $b1) && ([expr {$a2+$a3}] <= $b2)} {
      lset res2 end end [expr {$b1 -$a1 +$b3}]
    } else {
      lappend res2 $b
    }
  }

 
  #sort by size, then adjust or take out any block inconsistent with a larger block
  if {[llength [lindex $res2 0]] > 0} {
  set rlist [list]
  set res3 [lsort -index 2 -decreasing -integer $res2]
  for {set i 0} {$i < [llength $res3]} {incr i} {
    foreach {ax1 ay1 al} [lindex $res3 $i] {}
    if {$ax1 == -1} continue
    set ax2 [expr {$ax1 + $al}]
    set ay2 [expr {$ay1 + $al}]
    for {set j [expr {$i+1}]} {$j < [llength $res3]} {incr j} {
      foreach {bx1 by1 bl} [lindex $res3 $j] {} 
      if {$bx1 == -1} continue
      set bx2 [expr {$bx1 + $bl}]
      set by2 [expr {$by1 + $bl}]  
      if {($bx1 < $ax1) && ($by1 < $ay1)}  {
        if {($bx2 > $ax1) || ($by2 > $ay1)} {
          #shorten b to be upper left of a
          set newl [expr {min(($ax1-$bx1-1),($ay1-$by1-1))}]
          lset res3 $j [list $bx1 $by1 $newl]
        }
      } elseif {($bx2 > $ax2) && ($by2 > $ay2)} {
        if {($bx1 < $ax2) || ($by1 < $ay2)} {
          #shorten b to be lower right of a
          set newl [expr {min(($bx2-$ax2-1),($by2-$ay2-1))}]
          lset res3 $j [list [expr {$bx2-$newl}] [expr {$by2-$newl}] $newl]
        }
      } else {
        # b is inconsistent with a- delete it
        # if a is circular, it is possible that rotating b (set bx1 [expr {($bx1 - $r) % [string length $text2]}]) would make it consistent- store as possible r: $by2
        #lappend rlist $by2
        lset res3 $j [list -1 -1 0]
      }
    }
  }
  #take out the -1 -1 0 elements and sort by first index
  set res3 [lsort -index 0 -increasing -integer $res3]
  set res3 [lrange $res3 [lsearch -not -integer -index 0 $res3 -1] end]
  } else {
    set res3 $res2
  }

  # use finealign xdna ydna to put together the full alignment
  if {[llength [lindex $res3 0]] > 0} {
    set xout ""
    set yout ""
    set lout ""
    set ax2 -1
    set ay2 -1
    set start -1
    foreach resitem $res3 {
      foreach {ax1 ay1 al} $resitem {}
      set rlist1 [finealign [string range $xdna [expr {$ax2+1}] [expr {$ax1-1}]] [string range $ydna [expr {$ay2+1}] [expr {$ay1-1}]] $start]
      set start 0
      set ax2 [expr {$ax1 + $al -1}]
      set ay2 [expr {$ay1 + $al -1}]
      append xout [lindex $rlist1 0] [string range $xdna $ax1 $ax2]
      append yout [lindex $rlist1 1] [string range $ydna $ay1 $ay2]
      append lout [lindex $rlist1 2] [string repeat | $al]
    }
    set rlist1 [finealign [string range $xdna [expr {$ax2+1}] end] [string range $ydna [expr {$ay2+1}] end] 1]
    append xout [lindex $rlist1 0]
    append yout [lindex $rlist1 1]
    append lout [lindex $rlist1 2]
  } else {
    return [finealign $xdna $ydna 2]
  }

  

  return [list $xout $yout $lout]
}


################
## Find and highlight the next mismatch
################
proc align_dialog_highlight_mismatch {a type} {
  global info
  set mm_window $info($a,search_window)
  set t "$a.textframe.text"
  if {[$t tag ranges mmhighlite] eq {}} {
    set info($a,search_result) "No mismatches in the alignment."
    return 
  }
  if {[$t tag ranges sel] ne [list]} {
    set first_char [lindex [$t tag ranges sel] end]
  } else {
    set first_char 1.0
  }
  set wrap 0
  set found 0
  set last_char $first_char
  set result ""
  while {!$found} {
    if {"mmhighlite" ni [$t tag names $last_char]} {
      lassign [$t tag nextrange mmhighlite $last_char] c1 c2
    } else {
      set c1 [$t index $last_char]
      set c2 [$t index $c1+1char]
      while {"mmhighlite" in [$t tag names $c2] && [$t compare $c2 < end]} {
        set c2 [$t index $c2+1char]
      }
    }
    if {$c1 eq {}} {
      if {!$wrap} {
        set wrap 1
        set last_char 1.0
      } else {
        set found 1
        break
      }
      continue
    } elseif {$wrap && [$t compare $c1 > $first_char]} {
      set found 1
      break
    } else {
      set last_char $c2
    }
    set current_c $c1
    while {!$found && [$t compare $current_c < $c2]} {
      set tag_list [$t tag names $current_c]
      if {$mm_window == "" || "$mm_window\_tag" in $tag_list} {
        switch $type {
          "mm" {
            if {"delhighlite" ni $tag_list && "inshighlite" ni $tag_list} {
              set found 1
              set result $current_c
            }
          }
          "ins" {
            if { "inshighlite" in $tag_list} {
              set found 1
              set result $current_c
            }
          }
          "del" {
            if {"delhighlite" in $tag_list} {
              set found 1
              set result $current_c
            }
          }
          default {
              set found 1
              set result $current_c
          }
        }
      }
      set current_c [$t index $current_c+1char]
    }
  }
  if {$result eq ""} {
    set info($a,search_result) "Search not found in the alignment."
  } else {
    $t tag remove sel 1.0 end
    $t tag remove highlite 1.0 end
    $t tag add sel $result
    $t tag add highlite $result
    $t see $result
    set info($a,search_result)  ""
    lassign [$t bbox $result] x0 y0 w1 h1
    set x1 [winfo rootx $t]
    set y1 [winfo rooty $t]
    after cancel "destroy .mmtooltip"
    if {![winfo exists .mmtooltip]} {
      toplevel .mmtooltip  -borderwidth 0 -background black
      wm overrideredirect .mmtooltip 1
      catch {wm attributes .mmtooltip -alpha .7}
      grid [canvas .mmtooltip.c -background red] -row 0 -column 0 -sticky nswe
   }
    wm geometry .mmtooltip "[expr {$w1+50}]x[expr {$h1+50}]+[expr {$x0+$x1-25}]+[expr {$y0+$y1-25}]"
    for {set i 0} {$i < 10} {incr i} {
      after [expr {$i*50}] "catch {wm geometry .mmtooltip \"[expr {$w1+100-10*$i}]x[expr {$h1+100-$i*10}]+[expr {$x0+$x1-50+$i*5}]+[expr {$y0+$y1-50+$i*5}]\"}"
    }
    after [expr {$i*50}] "destroy .mmtooltip"
### do tooltip or show in parent here
    if {[set ytag_element [lsearch -regexp $tag_list {.abi_window[0-9]+_tag}]] > -1 && [regexp {(.*)_tag} [lindex $tag_list $ytag_element] -- y_window]} {
     # after 300 "abi_tooltip_post $t $y_window $x0 $y0"
      after 300 "lower $y_window [winfo toplevel $t]; alignlink2 $t $y_window $result goto 0"
    }
  }
}

################
## Output an alignment as a FASTA file
################
proc alignment_to_fasta {t} {

  set result ""
  if {[set reftags [lsearch -regexp -inline -all  [$t tag names] {.*_reftag}]] ne [list]} {
    foreach reftag $reftags {
      if {[regexp {(.*)_reftag} $reftag -- window]} {
        append result ">[file rootname [wm title $window]]\n"
        set seq ""
        foreach {i0 i1} [$t tag ranges $reftag] {
          append seq [$t get $i0 $i1]
        }
        regsub -- {-} $seq "" seq
        append result $seq \n \n
      }
    }
  }

  if {[set ytags [lsearch -regexp -inline -all  [$t tag names] {.*_tag}]] ne [list]} {
    foreach ytag $ytags {
      if {[regexp {(.*)_tag} $ytag -- window]} {
        append result ">[file rootname [wm title $window]]\n"
        set seq ""
        foreach {i0 i1} [$t tag ranges $ytag] {
          append seq [$t get $i0 $i1]
        }
        regsub -all -- {-} $seq "" seq
        append result $seq \n \n
      }
    }
  }
  if {$result ne {}} {
    set filename [tk_getSaveFile -title [mc "Save Alignment as a FASTA file"]  -defaultextension ".fasta" -confirmoverwrite 1 -filetypes {{"Fasa File" ".fasta"}}]
    if {$filename ne {}} {
      if {[catch {set text_file [open $filename w]}]} {
        catch {close $text_file}
        tk_messageBox -title [mc "Text File not Writable"] -message [mc "The file %s is not writable. It may be locked." $filename] -type ok -icon warning -default ok
      } else {
        puts $text_file $result
        close $text_file
      }  
    }
  }
}

################
## OLD DNA alignment dialog- align two sequences
################
proc align_dialog {w} {
  global info  
  global align_select_window1
  global align_select_window2
  global ok dialogblock
  if {$dialogblock == 1} {return}

  set s [new_dialog $w "Align DNA" "ALIGN"]
  bind $s <<Cancel>> "set ok -1"
  bind $s <<OK>> "set ok 1"

  grid [label $s.label1 -text [mc "Window"]] -row 1 -column 1 -sticky ne
  menubutton $s.win_button1
    menu $s.win_button1.menu
    foreach window [dnawindows_list 1] {
      $s.win_button1.menu add radiobutton -command "$s.win_button1 configure -text \{[wm title $window]\}" -label [wm title $window] -variable align_select_window1 -value $window 
    }
    set abi_list [lsort -unique [lsearch -all -inline -regexp [winfo children .] {.abi_window[0-9]+$}]]
    if {[llength $abi_list] > 0} {
      $s.win_button1.menu add separator
      foreach window $abi_list {
        $s.win_button1.menu add radiobutton -command "$s.win_button1 configure -text \{[wm title $window]\}" -label [wm title $window] -variable align_select_window1 -value $window 
      }
    }
  $s.win_button1 configure -text [wm title $w] -menu $s.win_button1.menu -indicatoron 1 -relief raised -width 60 
  bind $s.win_button1.menu <<MenuSelect>> "focus $s"
  set align_select_window1 $w
  grid $s.win_button1 -row 1 -column 2 -columnspan 3

  #grid [checkbutton $s.local1 -selectcolor $info(bg_color) -width 10 -variable info(align_select_region1) -textvariable info(align_select_region1) -onvalue "selection" -offvalue "all" -indicator off] -row 1 -column 5
  #grid [checkbutton $s.rc1 -selectcolor $info(bg_color) -width 8 -variable info(align_select_rc1) -textvariable info(align_select_rc1) -offvalue "forward" -onvalue "rev/com" -indicator off] -row 1 -column 6
  grid [checkbutton $s.local1 -width 10 -variable info(align_select_region1) -text [mc "Selection Only"] -onvalue "selection" -offvalue "all" -indicator on -selectcolor white] -row 1 -column 5
  grid [checkbutton $s.rc1 -width 10 -variable info(align_select_rc1) -text [mc "Rev-Com"] -offvalue "forward" -onvalue "rev/com" -indicator on -selectcolor white] -row 1 -column 6
  grid [label $s.label2 -text [mc "Window"]] -row 2 -column 1 -sticky ne
  menubutton $s.win_button2
    menu $s.win_button2.menu
    foreach window [dnawindows_list 1] {
      $s.win_button2.menu add radiobutton -command "$s.win_button2 configure -text \{[wm title $window]\}" -label [wm title $window] -variable align_select_window2 -value $window 
    }
    if {[llength $abi_list] > 0} {
      $s.win_button2.menu add separator
      foreach window $abi_list {
        $s.win_button2.menu add radiobutton -command "$s.win_button2 configure -text \{[wm title $window]\}" -label [wm title $window] -variable align_select_window2 -value $window 
      }
    }
  bind $s.win_button2.menu <<MenuSelect>> "focus $s"
  if {[winfo exists $info(align_select_window2)]} {
    set align_select_window2 $info(align_select_window2)
  } else {
    set align_select_window2 $w
  }
  $s.win_button2 configure -text [wm title $align_select_window2] -menu $s.win_button2.menu -indicatoron 1 -relief raised -width 60 
  grid $s.win_button2 -row 2 -column 2 -columnspan 3

  #grid [checkbutton $s.local2 -selectcolor $info(bg_color) -width 10 -variable info(align_select_region2) -textvariable info(align_select_region2) -onvalue "selection" -offvalue "all" -indicator off -selectcolor white] -row 2 -column 5
  #grid [checkbutton $s.rc2 -selectcolor $info(bg_color) -width 8 -variable info(align_select_rc2) -textvariable info(align_select_rc2) -offvalue "forward" -onvalue "rev/com" -indicator off -selectcolor white] -row 2 -column 6

  grid [checkbutton $s.local2 -width 10 -variable info(align_select_region2) -text [mc "Selection Only"]  -onvalue "selection" -offvalue "all" -indicator on -selectcolor white] -row 2 -column 5
  grid [checkbutton $s.rc2 -width 10 -variable info(align_select_rc2) -text [mc "Rev-Com"] -offvalue "forward" -onvalue "rev/com" -indicator on -selectcolor white] -row 2 -column 6

  grid [label $s.blockslabel -text [mc "Blocks:"]] -row 4 -column 1 -sticky ne
  menubutton $s.blocksbut -width 10 -textvariable info(align_blocksize)
  menu $s.blocksbut.blocks
    $s.blocksbut.blocks add radiobutton -label "20" -value 20 -variable info(align_blocksize) -command "if { !\$info(ignore_NWmax)} {$s.nwframe.nwmaxentry configure -state normal}"
    $s.blocksbut.blocks add radiobutton -label "15" -value 15 -variable info(align_blocksize) -command "if { !\$info(ignore_NWmax)} {$s.nwframe.nwmaxentry configure -state normal}"
    $s.blocksbut.blocks add radiobutton -label "10" -value 10 -variable info(align_blocksize) -command "if { !\$info(ignore_NWmax)} {$s.nwframe.nwmaxentry configure -state normal}"
    $s.blocksbut.blocks add radiobutton -label [mc "N-W align all"] -value "N-W align all" -variable info(align_blocksize) -command "$s.nwframe.nwmaxentry configure -state disabled"
  $s.blocksbut configure -menu $s.blocksbut.blocks
  bind $s.blocksbut <<MenuSelect>> "focus $s"

  grid $s.blocksbut -row 4 -column 2 -sticky nw

  grid [frame $s.nwframe] -row 4 -column 3 -columnspan 3 -sticky nw
  grid [label $s.nwframe.nwmaxlabel -text [mc "N-W max:"]] -row 4 -column 3 -sticky ne
  grid [entry $s.nwframe.nwmaxentry -validate key -width 4 -vcmd "check_char %S" -textvariable info(NWmax)] -row 4 -column 4 -sticky nw
  if {$info(ignore_NWmax) || $info(align_blocksize) eq "N-W align all"} {
    $s.nwframe.nwmaxentry configure -state disabled
  } else {
    $s.nwframe.nwmaxentry configure -state normal
  }
  grid [checkbutton $s.nwframe.ignorenw -text [mc "Always do Alignment"] -onvalue 1 -offvalue 0 -variable info(ignore_NWmax) -command "if { \$info(ignore_NWmax) || \$info(align_blocksize) eq \"N-W align all\"} {$s.nwframe.nwmaxentry configure -state disabled} else {$s.nwframe.nwmaxentry configure -state normal}"] -row 4 -column 5 


  grid [label $s.mmplabel -text [mc "Mismatch Penalty:"]] -row 5 -column 1 -sticky nw
  menubutton $s.mmpbut -width 10 -textvariable info(mm_penalty)
  menu $s.mmpbut.mmpmenu
    foreach val {0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 -0.8 -0.9 -1 -1.1 -1.2 -1.3 -1.4 -1.5 -1.6 -1.7 -1.8 -1.9 -2} {
       $s.mmpbut.mmpmenu add radiobutton -label " $val" -value $val -variable info(mm_penalty)
    }
  $s.mmpbut configure -menu $s.mmpbut.mmpmenu
  bind $s.mmpbut.mmpmenu <<MenuSelect>> "focus $s"
  grid $s.mmpbut -row 5 -column 2 -sticky nw

  grid [label $s.gapplabel -text [mc "Gap Penalty:"]] -row 5 -column 3 -sticky ne
  menubutton $s.gappbut -indicatoron 1 -relief raised -width 10 -textvariable info(gap_penalty)
  menu $s.gappbut.gapp
    foreach val {0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 -0.8 -0.9 -1 -1.1 -1.2 -1.3 -1.4 -1.5 -1.6 -1.7 -1.8 -1.9 -2} {
       $s.gappbut.gapp add radiobutton -label " $val" -value $val -variable info(gap_penalty)
    }
  $s.gappbut configure -menu $s.gappbut.gapp
  bind $s.gappbut.gapp <<MenuSelect>> "focus $s"
  grid $s.gappbut -row 5 -column 4 -sticky nw

  grid [label $s.gapeplabel -text [mc "Gap Ext. Penalty:"]] -row 5 -column 5 -sticky ne
  menubutton $s.gapepbut -indicatoron 1 -relief raised -width 10 -textvariable info(gap_extension_penalty)
  menu $s.gapepbut.gapep
    foreach val {0 -0.1 -0.2 -0.3 -0.4 -0.5 -0.6 -0.7 -0.8 -0.9 -1} {
      $s.gapepbut.gapep add radiobutton -label " $val" -value $val -variable info(gap_extension_penalty)
    }
  $s.gapepbut configure -menu $s.gapepbut.gapep
  bind $s.gapepbut.gapep <<MenuSelect>> "focus $s"
  grid $s.gapepbut -row 5 -column 6 -sticky nw

  grid [label $s.widthentrylabel -text [mc "Line Width:"]] -row 6 -column 1 -sticky ne
  grid [entry $s.widthentry -width 5 -validate key -vcmd "check_char %S" -textvariable info(align_linewidth)] -row 6 -column 2 -sticky nw
  grid [checkbutton $s.highlight -selectcolor white -text [mc "Copy Highlighting from Sequence"] -onvalue 1 -offvalue 0 -variable info(align_copy_highlight)] -row 6 -column 3 -columnspan 2

  grid [label $s.phredtrimlabel -text [mc "Trim ends with Phred <:"]] -row 7 -column 1 -sticky ne
  grid [entry $s.phredtrim -width 5 -validate key -vcmd "check_char %S" -textvariable info(align_phredtrim)] -row 7 -column 2 -sticky nw

  if {!$info(android)} {
    grid [button $s.ok -text [mc "OK"] -command "set ok 1" -default active] -row 8 -column 1 -columnspan 2 -padx 10 -pady 3
    bind $s <Key-Return> "set ok 1"
    grid [button $s.cancel -text [mc "Cancel"] -command "set ok -1"] -row 8 -column 2 -columnspan 2 -padx 10 -pady 3
    #grab $s
  }
  focus $s

  update idletasks
  #regexp {([0-9]*)x([0-9]*)\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $s] wgeom winw winh winx winy
  #if {[expr {$winx+$winw}] > [winfo screenwidth .]} {set winx [expr {[winfo screenwidth .]-$winw}]}
  #if {$winx < 0} {set winx 0}
  #if {[expr {$winy+$winh}] > [winfo screenheight .]} {set winy [expr {[winfo screenheight .]-$winh}]}
  #if {$winy < 0} {set winy 0}
  #wm geometry $s "+$winx+$winy"

  vwait ok
  set dialogblock 0
  if {$info(NWmax) == ""} {set info(NWmax) 5000;set info(ignore_NWmax) 1}
  if {$info(align_linewidth) == ""} {set info(align_linewidth) 100}
  set info(align_select_window2) $align_select_window2
  #grab release $s
  destroy $s
  bind . <<RaiseDialogs>> ""
  if {$ok == 1} {output_alignment}
  unset ok 
}

################
## align DNA sequences and make a window with the output- used for align two sequences
################
proc output_alignment {} {
  global align_select_window1
  global align_select_window2
  global info abi_info
  global modifier
  global modstring

  $align_select_window1 configure -cursor watch
  $align_select_window2 configure -cursor watch
  set xdir 1; set ydir 1

  if {[string first .abi_window $align_select_window1] == -1} {
    ###window1 is a sequence window
    #$align_select_window1.textarea configure -cursor watch
    set window_type1 "sequence"
    if {($info(align_select_region1) == "selection") && ([$align_select_window1.textarea tag nextrange sel 1.0] != "")} {
      set xdna [textarea_get $align_select_window1.textarea sel.first sel.last]
#selection used here 
      if {$info(align_select_rc1) == "rev/com"} {
        set xfirst [expr {1+[ix2bp $align_select_window1.textarea [$align_select_window1.textarea index sel.last]]}]
#selection used here 
        set xdna [revcom $xdna]
        set xdir -1
      } else {
        set xfirst [ix2bp $align_select_window1.textarea [$align_select_window1.textarea index sel.first]]
#selection used here 
      }
    } else {
      set xdna [textarea_get $align_select_window1.textarea 1.0 [end_ix $w.textarea]]
      if {$info(align_select_rc1) == "rev/com"} {
        set xfirst [expr {1+[ix2bp $align_select_window1.textarea end]}]
        set xdna [revcom $xdna]
        set xdir -1
      } else {
        set xfirst 0
      }
    }
  } else {
    ###window1 is an abi window
    #$align_select_window1.c configure -cursor watch
    set window_type1 "abi"
    if {($info(align_select_region1) == "selection")} {
      set abi_seq [abi_get_seq $align_select_window1 sel.first sel.last]
      if {$abi_seq == ""} {
        set abi_seq [abi_get_seq $align_select_window1 start end]
      }
    } else {
      set abi_seq [abi_get_seq $align_select_window1 start end]
    }
    if {$info(align_select_rc1) == "rev/com"} {
      set xdna [revcom [lindex $abi_seq 1]]
      if {!$abi_info($align_select_window1,rev_com)} {
        set xdir -1
        set xfirst [expr {1+[lindex $abi_seq 0]+[string length [lindex $abi_seq 1]]}]
      } else {
        set xfirst [expr {[llength [$align_select_window1.c find withtag basecall]]-[lindex $abi_seq 0]-[string length [lindex $abi_seq 1]]}]
      }
    } else {
      set xdna [lindex $abi_seq 1]
      if {$abi_info($align_select_window1,rev_com)} {
        set xdir -1
        set xfirst [expr {1+[llength [$align_select_window1.c find withtag basecall]]-[lindex $abi_seq 0]}]
      } else  {
        set xfirst [expr {[lindex $abi_seq 0]}]
      }
    }
  }
  regsub -all {[^ABCDGHKMNRSTVWYabcdghkmnrstvwy]} $xdna N xdna

  if {[string first .abi_window $align_select_window2] == -1} {
    ###window2 is a sequence window
    #$align_select_window2.textarea configure -cursor watch
    set window_type2 "sequence"
    if {($info(align_select_region2) == "selection") && ([$align_select_window2.textarea tag nextrange sel 1.0] != "")} {
      set ydna [textarea_get $align_select_window2.textarea sel.first sel.last]
#selection used here 
      if {$info(align_select_rc2) == "rev/com"} {
        set yfirst [expr {1+[ix2bp $align_select_window2.textarea [$align_select_window2.textarea index sel.last]]}]
#selection used here 
        set ydna [revcom $ydna]
        set ydir -1
      } else {
        set yfirst [ix2bp $align_select_window2.textarea [$align_select_window2.textarea index sel.first]]
#selection used here 
      }
    } else {
      set ydna [textarea_get $align_select_window2.textarea 1.0 [end_ix $w.textarea]]
      if {$info(align_select_rc2) == "rev/com"} {
        set yfirst [expr {1+[ix2bp $align_select_window2.textarea end]}]
        set ydna [revcom $ydna]
        set ydir -1
      } else {
        set yfirst 0
      }
    }
  } else {
    ###window2 is an abi window
    #$align_select_window2.c configure -cursor watch
    set window_type2 "abi"
    if {($info(align_select_region2) == "selection")} {
      set abi_seq [abi_get_seq $align_select_window2 sel.first sel.last]
#selection used here 
      if {$abi_seq == ""} {
        set abi_seq [abi_get_seq $align_select_window2 start end]
      }
    } else {
      set abi_seq [abi_get_seq $align_select_window2 start end]
    }
    if {$info(align_select_rc2) == "rev/com"} {
      set ydna [revcom [lindex $abi_seq 1]]
      if {!$abi_info($align_select_window2,rev_com)} {
        set ydir -1
        set yfirst [expr {1+[lindex $abi_seq 0]+[string length [lindex $abi_seq 1]]}]
      } else {
        set yfirst [expr {[llength [$align_select_window2.c find withtag basecall]]-[lindex $abi_seq 0]-[string length [lindex $abi_seq 1]]}]
      }
    } else {
      set ydna [lindex $abi_seq 1]
      if {$abi_info($align_select_window2,rev_com)} {
        set ydir -1
        set yfirst [expr {1+[llength [$align_select_window2.c find withtag basecall]]-[lindex $abi_seq 0]}]
      } else  {
        set yfirst [expr {[lindex $abi_seq 0]}]
      }
    }
  }
  regsub -all {[^ABCDGHKMNRSTVWYabcdghkmnrstvwy]} $ydna N ydna

  update idletasks

  if {$info(align_blocksize) != "N-W align all"} {
    #set resultlist [block_align $xdna $ydna]
    set resultlist [block_align3 $xdna $ydna $info(align_blocksize)]
  } else {
    set resultlist [NW_affine_align $xdna $ydna 1]
  }

  set xout [lindex $resultlist 0]
  set yout [lindex $resultlist 1]
  set lineout [lindex $resultlist 2]

  ###make the top index line
  set spacing [expr {($xdir==-1)? (1 + ($xfirst-1) % 10) : (10 - ($xfirst % 10))}]
  #sputs "$xfirst $spacing"
  set dot 0
  set x 0
  set xdots ""
  while {[set dot [string length [regexp -inline "(?:-*\[^-\]){$spacing}" [string range $xout $x end]]]] != 0} {
    set xdots "$xdots[string repeat " " [expr {$dot-1}]]*"
    set spacing 10
    incr x $dot
  }
  set spacing [expr {($ydir == -1) ? (1 + ($yfirst-1) % 10) : (10 - $yfirst%10)}]
  set dot 0
  set x 0
  set ydots ""
  while {[set dot [string length [regexp -inline "(?:-*\[^-\]){$spacing}" [string range $yout $x end]]]] != 0} {
    set ydots "$ydots[string repeat " " [expr {$dot-1}]]*"
    set spacing 10
    incr x $dot
  }
  if {$align_select_window1 != $align_select_window2} {
    set winlist [list $align_select_window1 $align_select_window2]
  } else {
    set winlist [list $align_select_window1]
  }
  set a [new_analysis_window $winlist "[mc {Alignment to}] [wm title $align_select_window2]" double_alignment]

  ##make output
  create_textframe $a [expr {$info(align_linewidth)+15}]
  #summary info
  catch {$a.textframe.text insert end "[clock format [clock seconds] -format $info(clock_format)]\n"}
  $a.textframe.text insert end "[wm title $align_select_window1] from [expr {$xfirst + $xdir}] to [expr {$xfirst + $xdir*[string length $xdna]}]\n"
  $a.textframe.text insert end "[mc {Alignment to}]\n"
  $a.textframe.text insert end "[wm title $align_select_window2] from [expr {$yfirst + $ydir}] to [expr {$yfirst + $ydir*[string length $ydna]}]\n\n"
  $a.textframe.text insert end "[mc Matches](|):[string length [string map {" " "" # "" . ""} $lineout]] \n"
  $a.textframe.text insert end "[mc Mismatches](#):[string length [string map {" " "" | "" . ""} $lineout]] \n"
  $a.textframe.text insert end "[mc Gaps]( ):[string length [string map {"|" "" # "" . ""} $lineout]] \n"
  $a.textframe.text insert end "[mc Unattempted](.):[string length [string map {" " "" # "" | ""} $lineout]] \n\n"

  ##replace leading and trailing -'s
  regexp {(^-*)(.*?)(-*$)} $xout fill leading body trailing
  set xout "[string repeat "~" [string length $leading]]$body[string repeat "~" [string length $trailing]]"
  regexp {(^-*)(.*?)(-*$)} $yout fill leading body trailing
  set yout "[string repeat "~" [string length $leading]]$body[string repeat "~" [string length $trailing]]"

  set xdnastarted 0
  set ydnastarted 0

  for {set x 0} {$x < [expr {[string length $xout]}]} {incr x $info(align_linewidth)} {
    set linelength [expr {[string length $xout]-$x-1}]
    if {$linelength > [expr {$info(align_linewidth)-1}]} {set linelength [expr {$info(align_linewidth)-1}]}
    set xchars [regexp -all  {[^- ~]} [string range $xout $x [expr {$x+$linelength}]]]
    set ychars [regexp -all  {[^- ~]} [string range $yout $x [expr {$x+$linelength}]]]
    if {$xchars > 0} {
      set xdnastarted 1
      $a.textframe.text insert end "[string repeat { } 7][string range $xdots $x [expr {$x+$linelength}]]\n"
      $a.textframe.text insert end "[format {%6u } [incr xfirst $xdir]]"
      set dnastarts [$a.textframe.text index end-1char]
      $a.textframe.text insert end "[string range $xout $x [expr {$x+$linelength}]]" w1tag
      if {($info(align_copy_highlight)) && ($window_type1 eq "sequence")} {
        copy_tags $align_select_window1.textarea [list [bp2ix $align_select_window1.textarea [expr {$xfirst-1}]] [bp2ix $align_select_window1.textarea [expr {$xfirst-1+$xdir*($xchars-1)}]]] $a.textframe.text $dnastarts [expr {($xdir==1)?"forward":"reverse"}] "w1"
      }
      $a.textframe.text insert end "[format { %-6u} [incr xfirst [expr {$xdir*($xchars-1)}]]]\n"
    } else {
      #for lines that are all gap
      if {$xdnastarted && ([string index $xout $x] == "~")} {
        $a.textframe.text insert end "[format {%6u } [expr {$xfirst}]]" {} "[string range $xout $x [expr {$x+$linelength}]]" w1tag "[format { %-6u} [expr {$xfirst}]]\n" {}
      } else {
        $a.textframe.text insert end "[format {%6u } [expr {$xfirst+$xdir}]]" {} "[string range $xout $x [expr {$x+$linelength}]]" w1tag "[format { %-6u} [expr {$xfirst+$xdir}]]\n" {}
      }
    }
    set lineout_sub [string range $lineout $x [expr {$x+$linelength}]]
    $a.textframe.text insert end "[string repeat { } 7]$lineout_sub[string repeat { } 7]\n"
    ##add highlight tag to mismatches and gaps
    if {[regexp {[^\.\ ]} $lineout_sub]} {
      set ls [$a.textframe.text index "end-2char linestart"]
      foreach highliterange [regexp -inline -indices -all {[^|]+} $lineout_sub] {
        $a.textframe.text tag add mmhighlite [$a.textframe.text index $ls+[expr {7+[lindex $highliterange 0]}]chars] [$a.textframe.text index $ls+[expr {[lindex $highliterange 1]+8}]chars]
      }
    }
    if {$ychars > 0} {
      set ydnastarted 1
      $a.textframe.text insert end "[format {%6u } [incr yfirst $ydir]]"
      set dnastarts [$a.textframe.text index end-1char]
      $a.textframe.text insert end "[string range $yout $x [expr {$x+$linelength}]]" w2tag
      if {($info(align_copy_highlight)) && ($window_type2 eq "sequence")} {
        copy_tags $align_select_window2.textarea [list [bp2ix $align_select_window2.textarea [expr {$yfirst-1}]] [bp2ix $align_select_window2.textarea [expr {$yfirst-1+$ydir*($ychars-1)}]]] $a.textframe.text $dnastarts [expr {($ydir==1)?"forward":"reverse"}] "w2"
      }
      $a.textframe.text insert end "[format { %-6u} [incr yfirst [expr {$ydir*($ychars-1)}]]]\n"
      $a.textframe.text insert end "[string repeat { } 7][string range $ydots $x [expr {$x+$linelength}]]\n\n"
    } else {
      if {$ydnastarted && ([string index $yout $x] == "~")} {
        $a.textframe.text insert end "[format {%6u } [expr {$yfirst}]]" {} "[string range $yout $x [expr {$x+$linelength}]]" w2tag "[format { %-6u} [expr {$yfirst}]]\n\n"
      } else {
        $a.textframe.text insert end "[format {%6u } [expr {$yfirst+$ydir}]]" {} "[string range $yout $x [expr {$x+$linelength}]]" w2tag "[format { %-6u} [expr {$yfirst+$ydir}]]\n\n"
      }

    }
  }

  if {$window_type2 eq "sequence"} {
    foreach tag [$align_select_window2.textarea tag names] {
      if {[$a.textframe.text tag ranges "$tag\w2"] != "" } {
        $a.textframe.text tag raise "$tag\w2"
      }
    }
  }

  if {$window_type1 eq "sequence"} {
    foreach tag [$align_select_window1.textarea tag names] {
      if {[$a.textframe.text tag ranges "$tag\w1"] != "" } {
        $a.textframe.text tag raise "$tag\w1"
      }
    }
  }

  $a.textframe.text tag bind w1tag <Double-Button-1> "$a.textframe.text tag add sel @%x,%y; alignlink $a.textframe.text $align_select_window1 \[$a.textframe.text index @%x,%y\] $xdir goto 1; break"
  $a.textframe.text tag bind w2tag <Double-Button-1> "$a.textframe.text tag add sel @%x,%y; alignlink $a.textframe.text $align_select_window2 \[$a.textframe.text index @%x,%y\] $ydir goto 1; break"
  $a.textframe.text tag bind w1tag <Shift-Double-Button-1> "$a.textframe.text tag add sel @%x,%y; alignlink $a.textframe.text $align_select_window1 \[$a.textframe.text index @%x,%y\] $xdir select 1; break"
  $a.textframe.text tag bind w2tag <Shift-Double-Button-1> "$a.textframe.text tag add sel @%x,%y; alignlink $a.textframe.text $align_select_window2 \[$a.textframe.text index @%x,%y\] $ydir select 1; break"
  $a.textframe.text tag bind w1tag <$modifier-Button-1> "alignlink $a.textframe.text $align_select_window1 \[$a.textframe.text index @%x,%y\] $xdir goto 0; break"
  $a.textframe.text tag bind w2tag <$modifier-Button-1> "alignlink $a.textframe.text $align_select_window2 \[$a.textframe.text index @%x,%y\] $ydir goto 0; break"
  $a.textframe.text tag bind w1tag <Shift-$modifier-Button-1> "alignlink $a.textframe.text $align_select_window1 \[$a.textframe.text index @%x,%y\] $xdir select 0; break"
  $a.textframe.text tag bind w2tag <Shift-$modifier-Button-1> "alignlink $a.textframe.text $align_select_window2 \[$a.textframe.text index @%x,%y\] $ydir select 0; break"
  lappend info($align_select_window1,linked_events) [list $a.textframe.text w1tag <Double-Button-1>]
  lappend info($align_select_window2,linked_events) [list $a.textframe.text w2tag <Double-Button-1>]
  lappend info($align_select_window1,linked_events) [list $a.textframe.text w1tag <Shift-Double-Button-1>]
  lappend info($align_select_window2,linked_events) [list $a.textframe.text w2tag <Shift-Double-Button-1>]
  lappend info($align_select_window1,linked_events) [list $a.textframe.text w1tag <$modifier-Button-1>]
  lappend info($align_select_window2,linked_events) [list $a.textframe.text w2tag <$modifier-Button-1>]
  lappend info($align_select_window1,linked_events) [list $a.textframe.text w1tag <Shift-$modifier-Button-1>]
  lappend info($align_select_window2,linked_events) [list $a.textframe.text w2tag <Shift-$modifier-Button-1>]
  $a.textframe.text tag bind w1tag <Any-Leave> {%W tag remove highlite 1.0 end}
  $a.textframe.text tag bind w1tag <Any-Motion> {%W tag remove highlite 1.0 end; %W tag add highlite current}
  $a.textframe.text tag bind w2tag <Any-Leave> {%W tag remove highlite 1.0 end}
  $a.textframe.text tag bind w2tag <Any-Motion> {%W tag remove highlite 1.0 end; %W tag add highlite current}
  $a.textframe.text tag configure highlite -background red -foreground white
  $a.textframe.text tag configure mmhighlite -background red -foreground white

  bind $a.textframe.text <Double-Button-1> break
  bind $a.textframe.text <Shift-Double-Button-1> break

  bind $a <Button-1> "focus $a.textframe.text"
  set outputmenu [add_output_menu $a.textframe.text "Text" text $align_select_window1]
  bind $a.textframe.text <Double-Button-1> ""
  $outputmenu entryconfigure [mc "Raise Parent"] -label [mc "Raise Window 1"]
  $outputmenu insert [expr {1+[$outputmenu index [mc "Raise Window 1"]]}] command -label [mc "Raise Window 2"] -accelerator "$modstring+Shift+Space" -command "event generate $a.textframe.text <<Return2>>"
  bind $a.textframe.text <Shift-$modifier-KeyPress-space> "event generate $a.textframe.text <<Return2>>"
  if {$window_type1 eq "abi"} {
    bind $a.textframe.text <<Return>> "wm deiconify $align_select_window1; raise $align_select_window1; focus $align_select_window1.c"
  }
  if {$window_type2 eq "sequence"} {
    bind $a.textframe.text <<Return2>> "wm deiconify $align_select_window2; raise $align_select_window2; focus $align_select_window2.textarea"
  } else {
    bind $a.textframe.text <<Return2>> "wm deiconify $align_select_window2; raise $align_select_window2; focus $align_select_window2.c"
  }
  lappend info($align_select_window2,linked_events) [list $a.textframe.text <<Return2>>]
  bindtags $a.textframe.text [list $a.textframe.text AnalysisText $a . all]
  wm deiconify $a
  if {[info exists info(last_analysis_xy)]} {
    wm geometry [winfo toplevel $a] [textbox_geometry $a.textframe.text {*}$info(last_analysis_xy)]
  } else {
    scan [wm geometry [winfo toplevel $a]] "%dx%d+%d+%d" w h x y
    wm geometry [winfo toplevel $a] [textbox_geometry $a.textframe.text $x $y]
  }
  window_on_screen $a
  focus $a.textframe.text
  $a.textframe.text configure -state disabled

  $align_select_window1 configure -cursor arrow
  #$align_select_window1.textarea configure -cursor xterm
  $align_select_window2 configure -cursor arrow
  #$align_select_window2.textarea configure -cursor xterm
}

################
## align dna sequences starting with blocks, then NW align
################
## NOT USED
proc block_align {xdna ydna} {
  global info
    set xseq [string toupper $xdna]
    set yseq [string toupper $ydna]
    set i 0
    set j 0
    set xout ""
    set yout ""
    set xend [expr {[string length $xseq]-$info(align_blocksize)+1}]
    while {$i < [string length $xseq]} {
      set xun ""
      set yun ""
    #find a match
      while {($i < $xend) && ([set found [string first [string range $xseq $i [expr {$i+$info(align_blocksize)-1}]] $yseq $j]] == -1)} {
        append xun [string range $xdna $i [expr {$i+$info(align_blocksize)-1}]]
        incr i $info(align_blocksize)
      }
      if {($i >= $xend)} {
        set found [string length $ydna]
        append xun [string range $xdna $i end]
      }
      set yun [string range $ydna $j [expr {$found-1}]]
 ###align the unaligned regions between matches: xun and yun here
      if {($xun != "") || ($yun != "")} {
        set alignlist [finealign $xun $yun]
        append xout [lindex $alignlist 0]
        append yout [lindex $alignlist 1]
        append lineout [lindex $alignlist 2]
      }
##now add in the match
      if {($i < $xend)} {
        append xout [string range $xdna $i [expr {$i+$info(align_blocksize)-1}]]
        append yout [string range $ydna $found [expr {$found+$info(align_blocksize)-1}]]
        append lineout [string repeat "|" $info(align_blocksize)]
        set j [expr {$found+$info(align_blocksize)}]
      }
      incr i $info(align_blocksize)
    }
    if {$i == [string length $xseq]} {
        set yextra [string range $ydna $j end]
        append xout [string repeat "-" [string length $yextra]]
        append yout $yextra
        append lineout [string repeat " " [string length $yextra]]
    }
  return [list $xout $yout $lineout]
}

################
## sub-procedure of blockalign- expand the blocks and then N-W align the unaligned
################
# start -1 is lft end, 0 is middle fragment, 1 is right end, 2 is both left and right
proc finealign {xdna ydna {start 0}} {
  set xseq [string toupper $xdna]
  set yseq [string toupper $ydna]
  set i 0
  set j 0
  if {[string length $xseq] > [string length $yseq]} {
    set max [string length $yseq]
  } else {
    set max [string length $xseq]
  }
  if {$start ==0 || $start ==1} {
    while {([string index $xseq $i] == [string index $yseq $i]) && ($i < $max)} {incr i}
  }
  incr i -1
  set maxj [expr $max - $i -2]
  if {$start ==-1 || $start ==0} {
    while {([string index $xseq end-$j] == [string index $yseq end-$j]) && ($j <= $maxj)} {incr j}
  }
  incr j -1
  switch $start {
    -1 {
      set NWlist [NW_affine_align_left [string range $xdna [expr $i+1] end-[expr $j +1]] [string range $ydna [expr $i+1] end-[expr $j +1]]]
    }
    0 {
      set NWlist [NW_affine_align [string range $xdna [expr $i+1] end-[expr $j +1]] [string range $ydna [expr $i+1] end-[expr $j +1]]]
    }
    1 {
      set NWlist [NW_affine_align_right [string range $xdna [expr $i+1] end-[expr $j +1]] [string range $ydna [expr $i+1] end-[expr $j +1]]]
    }
    2 {
      set NWlist [NW_affine_align_both_ends [string range $xdna [expr $i+1] end-[expr $j +1]] [string range $ydna [expr $i+1] end-[expr $j +1]]]
    }
  }
  append xout [string range $xdna 0 $i] [lindex $NWlist 0] [string range $xdna end-$j end]
  append yout [string range $ydna 0 $i] [lindex $NWlist 1] [string range $ydna end-$j end]
  append lineout [string repeat | [expr $i+1]] [lindex $NWlist 2] [string repeat | [expr $j+1]]
  return [list $xout $yout $lineout]
}

################
## sub-procedure of finealing or blockalign - Needleman-Wunsch Alignment (affine gap penalty)
################
#Needleman-Wunsch Alignment
#n*m/320 ms
proc NW_affine_align {xdna ydna {ignoremax 0}} {
  set atime [clock clicks]
  global info
  if {(!$ignoremax) && !$info(ignore_NWmax) && ([expr {sqrt([string length $xdna]* [string length $ydna])}] > $info(NWmax))} {
    if {[set diff [expr {[string length $xdna] - [string length $ydna]}]] > 0} {
      return [list $xdna "[string repeat - $diff]$ydna" [string repeat . [string length $xdna]]]
    } else {
      return [list "[string repeat - [expr {-$diff}]]$xdna" $ydna [string repeat . [string length $ydna]]]
    }
  }

  set d $info(gap_penalty)
  set e $info(gap_extension_penalty)
  set mm $info(mm_penalty)

  set seqx [string toupper $xdna]
  set seqy [string toupper $ydna]

  #mttable list of strings mtlist
  #ittable list of strings itlist
  #same level
  #  6 2
  # 4-\|
  #switch level
  #  7 3
  # 5-\|
  ###test with NW_affine_align AAA AA
  ###test with NW_affine_align ATA AA

  #initialize 0,0 
  set mlist [list [expr {[string index $seqx 0] eq [string index $seqy 0]?1:$mm}]]
  set mtlist 7
  set ilist [list -10000000]
  set itlist 4
  #rest of row 0
  for {set i 1} {$i < [string length $seqx]} {incr i} {
    set s [expr {[string index $seqx $i] eq [string index $seqy 0]?1:$mm}]
    lappend mlist [expr {$s+$d+$e*($i-1)}] 
    append mtlist 7
    if {[lindex $mlist [expr {$i-1}]] > [lindex $ilist [expr {$i-1}]]} {
      lappend ilist [expr {[lindex $mlist [expr {$i-1}]]+$d}]
      append itlist 5
    } else {
      lappend ilist [expr {[lindex $ilist [expr {$i-1}]]+$e}]
      append itlist 4
    }
  } 
  set mttable [list $mtlist]
  set ittable [list $itlist]
  set mstor $mlist
  set istor $ilist
#sputs m:$mstor
#sputs i:$istor
  #do rows 1 through end
  for {set j 1} {$j < [string length $seqy]} {incr j} {
    #initialize 0,j
    set mlist [list [expr {([string index $seqx 0] eq [string index $seqy $j]?1:$mm) + $d + $e* ($j -1)}]]
    set mtlist 7
    if {[lindex $mstor 0] >= [lindex $istor 0]} {
      set ilist [list [expr {[lindex $mstor 0] + $d}]]
      set itlist 3
    } else {
      set ilist [list [expr {[lindex $istor 0] + $e}]]
      set itlist 2
    }
    for {set i 1} {$i < [string length $seqx]} {incr i} {
      #lappend mlist [max [lindex mstor ($i-1)] [lindex istor ($i-1)]]
      #lappend itlist 6 7
      set s [expr {[string index $seqx $i] eq [string index $seqy $j]?1:$mm}]
      if {[lindex $mstor [expr {$i-1}]] >= [lindex $istor [expr {$i-1}]]} {
        lappend mlist [expr {[lindex $mstor [expr {$i-1}]] + $s}]
        append mtlist 6
      } else {
        lappend mlist [expr {[lindex $istor [expr {$i-1}]] + $s}]
        append mtlist 7
      }
      #lappend ilist [max [lindex mlist ($i-1)] [lindex ilist ($i-1)] [lindex mstor $i] [lindex istor $i]]
      #lappend itlist 5 4 3 2
      if {[set mleft [lindex $mlist end-1]] > [set mup [lindex $mstor $i]]} {
        if {[set ileft [lindex $ilist end]] > [set iup [lindex $istor $i]]} {
          if {[expr {$mleft + $d}] > [expr {$ileft + $e}]} {
            lappend ilist [expr {$mleft + $d}]
            append itlist 5
          } else {
            lappend ilist [expr {$ileft + $e}]
            append itlist 4
          }
        } else {
          if {[expr {$mleft + $d}] > [expr {$iup + $e}]} {
            lappend ilist [expr {$mleft + $d}]
            append itlist 5
          } else {
            lappend ilist [expr {$iup + $e}]
            append itlist 2
          }
        }
      } else {
        if {[set ileft [lindex $ilist end]] > [set iup [lindex $istor $i]]} {
          if {[expr {$mup + $d}] > [expr {$ileft + $e}]} {
            lappend ilist [expr {$mup + $d}]
            append itlist 3
          } else {
            lappend ilist [expr {$ileft + $e}]
            append itlist 4
          }
        } else {
          if {[expr {$mup + $d}] > [expr {$iup + $e}]} {
            lappend ilist [expr {$mup + $d}]
            append itlist 3
          } else {
            lappend ilist [expr {$iup + $e}]
            append itlist 2
          }
        }
      }
    }
    lappend mttable $mtlist
    lappend ittable $itlist
    set mstor $mlist
    set istor $ilist
#sputs m:$mstor
#sputs i:$istor
  }

  #sputs mttable:
  #foreach row $mttable {
  #  sputs $row
  #}
  #sputs ittable:
  #foreach row $ittable {
  #  sputs $row
  #}
  ### do traceback
  set x [expr {[string length $xdna]-1}] 
  set y [expr {[string length $ydna]-1}] 
  set yout ""
  set xout ""
  set lineout ""
  if {[lindex $mstor end] >= [lindex $istor end]} {
    set z 0
  } else {
    set z 1
  }
  while {($x > -1) && ($y > -1)} {
    if {$z} {
      set v [string index [lindex $ittable $y] $x]
    } else {
      set v [string index [lindex $mttable $y] $x]
    }
    switch $v {
      4  {
        set yout "-$yout"
        set xout "[string index $xdna $x]$xout"
        set lineout " $lineout"
        incr x -1 
        set z 1
      }
      5 {
        set yout "-$yout"
        set xout "[string index $xdna $x]$xout"
        set lineout " $lineout"
        incr x -1 
        set z 0
      }
      6 {
        set yout "[string index $ydna $y]$yout"
        set xout "[string index $xdna $x]$xout"
        if {[string toupper [string index $ydna $y]] eq [string toupper [string index $xdna $x]]} {
          set lineout "|$lineout"
        } else {
          set lineout "#$lineout"
        }
        incr x -1 
        incr y -1
        set z 0
      }
      7 {
        set yout "[string index $ydna $y]$yout"
        set xout "[string index $xdna $x]$xout"
        if {[string toupper [string index $ydna $y]] eq [string toupper [string index $xdna $x]]} {
          set lineout "|$lineout"
        } else {
          set lineout "#$lineout"
        }
        incr x -1 
        incr y -1
        set z 1
      }
      3 {
        set yout "[string index $ydna $y]$yout"
        set xout "-$xout" 
        set lineout " $lineout"
        incr y -1
        set z 0
      }
      2 {
        set yout "[string index $ydna $y]$yout"
        set xout "-$xout" 
        set lineout " $lineout"
        incr y -1
        set z 1
      }
    }
  }
  if {$x > -1} {
    set yout "[string repeat - [expr {1+$x}]]$yout"
    set xout "[string range $xdna 0 $x]$xout"
    set lineout "[string repeat " " [expr {1+$x}]]$lineout"
  } else {
    set xout "[string repeat - [expr {1+$y}]]$xout"
    set yout "[string range $ydna 0 $y]$yout"
    set lineout "[string repeat " " [expr {1+$y}]]$lineout"
  }
  set ctime [clock clicks]

  return [list $xout $yout $lineout]
}

#############
#Needleman-Wunsch Alignment
## no left side penalty- for getting compressed on the left of a linear sequence
##############
proc NW_affine_align_left {xdna ydna {ignoremax 0}} {
  set atime [clock clicks]
  global info
  if {(!$ignoremax) && !$info(ignore_NWmax) && ([expr {sqrt([string length $xdna]* [string length $ydna])}] > $info(NWmax))} {
    if {[set diff [expr {[string length $xdna] - [string length $ydna]}]] > 0} {
      return [list $xdna "[string repeat - $diff]$ydna" [string repeat . [string length $xdna]]]
    } else {
      return [list "[string repeat - [expr {-$diff}]]$xdna" $ydna [string repeat . [string length $ydna]]]
    }
  }

  set d $info(gap_penalty)
  set e $info(gap_extension_penalty)
  set mm $info(mm_penalty)

  set seqx [string toupper $xdna]
  set seqy [string toupper $ydna]

  #mttable list of strings mtlist
  #ittable list of strings itlist
  #same level
  #  6 2
  # 4-\|
  #switch level
  #  7 3
  # 5-\|
  ###test with NW_affine_align AAA AA
  ###test with NW_affine_align ATA AA

  #initialize 0,0 
  set mlist [list [expr {[string index $seqx 0] eq [string index $seqy 0]?1:$mm}]]
  set mtlist 7
  set ilist [list -10000000]
  set itlist 4
  #rest of row 0
  for {set i 1} {$i < [string length $seqx]} {incr i} {
    set s [expr {[string index $seqx $i] eq [string index $seqy 0]?1:$mm}]
    ###lappend mlist [expr {$s+$d+$e*($i-1)}] 
    lappend mlist [expr {$s}] 
    append mtlist 7
    if {[lindex $mlist [expr {$i-1}]] > [lindex $ilist [expr {$i-1}]]} {
      ###lappend ilist [expr {[lindex $mlist [expr {$i-1}]+$d]}]
      lappend ilist [expr {[lindex $mlist [expr {$i-1}]]}]
      append itlist 5
    } else {
      ###lappend ilist [expr {[lindex $ilist [expr {$i-1}]]+$e}]
      lappend ilist [expr {[lindex $ilist [expr {$i-1}]]}]
      append itlist 4
    }
  } 
  set mttable [list $mtlist]
  set ittable [list $itlist]
  set mstor $mlist
  set istor $ilist
#sputs m:$mstor
#sputs i:$istor
  #do rows 1 through end
  for {set j 1} {$j < [string length $seqy]} {incr j} {
    #initialize 0,j
    ###set mlist [list [expr {([string index $seqx 0] eq [string index $seqy $j]?1:$mm) + $d + $e* ($j -1)}]]
    set mlist [list [expr {([string index $seqx 0] eq [string index $seqy $j]?1:$mm)}]]
    set mtlist 7
    if {[lindex $mstor 0] >= [lindex $istor 0]} {
      ###set ilist [list [expr {[lindex $mstor 0] + $d}]]
      set ilist [list [expr {[lindex $mstor 0] }]]
      set itlist 5
    } else {
      ###set ilist [list [expr {[lindex $istor 0] + $e}]]
      set ilist [list [expr {[lindex $istor 0] }]]
      set itlist 5
    }
    for {set i 1} {$i < [string length $seqx]} {incr i} {
      #lappend mlist [max [lindex mstor ($i-1)] [lindex istor ($i-1)]]
      #lappend itlist 6 7
      set s [expr {[string index $seqx $i] eq [string index $seqy $j]?1:$mm}]
      if {[lindex $mstor [expr {$i-1}]] >= [lindex $istor [expr {$i-1}]]} {
        lappend mlist [expr {[lindex $mstor [expr {$i-1}]] + $s}]
        append mtlist 6
      } else {
        lappend mlist [expr {[lindex $istor [expr {$i-1}]] + $s}]
        append mtlist 7
      }
      #lappend ilist [max [lindex mlist ($i-1)] [lindex ilist ($i-1)] [lindex mstor $i] [lindex istor $i]]
      #lappend itlist 5 4 3 2
      if {[set mleft [lindex $mlist end-1]] > [set mup [lindex $mstor $i]]} {
        if {[set ileft [lindex $ilist end]] > [set iup [lindex $istor $i]]} {
          if {[expr {$mleft + $d}] > [expr {$ileft + $e}]} {
            lappend ilist [expr {$mleft + $d}]
            append itlist 5
          } else {
            lappend ilist [expr {$ileft + $e}]
            append itlist 4
          }
        } else {
          if {[expr {$mleft + $d}] > [expr {$iup + $e}]} {
            lappend ilist [expr {$mleft + $d}]
            append itlist 5
          } else {
            lappend ilist [expr {$iup + $e}]
            append itlist 2
          }
        }
      } else {
        if {[set ileft [lindex $ilist end]] > [set iup [lindex $istor $i]]} {
          if {[expr {$mup + $d}] > [expr {$ileft + $e}]} {
            lappend ilist [expr {$mup + $d}]
            append itlist 3
          } else {
            lappend ilist [expr {$ileft + $e}]
            append itlist 4
          }
        } else {
          if {[expr {$mup + $d}] > [expr {$iup + $e}]} {
            lappend ilist [expr {$mup + $d}]
            append itlist 3
          } else {
            lappend ilist [expr {$iup + $e}]
            append itlist 2
          }
        }
      }
    }
    lappend mttable $mtlist
    lappend ittable $itlist
    set mstor $mlist
    set istor $ilist
#sputs m:$mstor
#sputs i:$istor
  }

  #sputs mttable:
  #foreach row $mttable {
  #  sputs $row
  #}
  #sputs ittable:
  #foreach row $ittable {
  #  sputs $row
  #}
  ### do traceback
  set x [expr {[string length $xdna]-1}] 
  set y [expr {[string length $ydna]-1}] 
  set yout ""
  set xout ""
  set lineout ""
  if {[lindex $mstor end] >= [lindex $istor end]} {
    set z 0
  } else {
    set z 1
  }
  while {($x > -1) && ($y > -1)} {
    if {$z} {
      set v [string index [lindex $ittable $y] $x]
    } else {
      set v [string index [lindex $mttable $y] $x]
    }
    switch $v {
      4  {
        set yout "-$yout"
        set xout "[string index $xdna $x]$xout"
        set lineout " $lineout"
        incr x -1 
        set z 1
      }
      5 {
        set yout "-$yout"
        set xout "[string index $xdna $x]$xout"
        set lineout " $lineout"
        incr x -1 
        set z 0
      }
      6 {
        set yout "[string index $ydna $y]$yout"
        set xout "[string index $xdna $x]$xout"
        if {[string toupper [string index $ydna $y]] eq [string toupper [string index $xdna $x]]} {
          set lineout "|$lineout"
        } else {
          set lineout "#$lineout"
        }
        incr x -1 
        incr y -1
        set z 0
      }
      7 {
        set yout "[string index $ydna $y]$yout"
        set xout "[string index $xdna $x]$xout"
        if {[string toupper [string index $ydna $y]] eq [string toupper [string index $xdna $x]]} {
          set lineout "|$lineout"
        } else {
          set lineout "#$lineout"
        }
        incr x -1 
        incr y -1
        set z 1
      }
      3 {
        set yout "[string index $ydna $y]$yout"
        set xout "-$xout" 
        set lineout " $lineout"
        incr y -1
        set z 0
      }
      2 {
        set yout "[string index $ydna $y]$yout"
        set xout "-$xout" 
        set lineout " $lineout"
        incr y -1
        set z 1
      }
    }
  }
  if {$x > -1} {
    set yout "[string repeat - [expr {1+$x}]]$yout"
    set xout "[string range $xdna 0 $x]$xout"
    set lineout "[string repeat " " [expr {1+$x}]]$lineout"
  } else {
    set xout "[string repeat - [expr {1+$y}]]$xout"
    set yout "[string range $ydna 0 $y]$yout"
    set lineout "[string repeat " " [expr {1+$y}]]$lineout"
  }
  set ctime [clock clicks]

  return [list $xout $yout $lineout]
}

#############
#Needleman-Wunsch Alignment
## no right side penalty- for getting compressed on the right of a linear sequence
##############
proc NW_affine_align_right {xdna ydna {ignoremax 0}} {
  set atime [clock clicks]
  global info
  if {(!$ignoremax) && !$info(ignore_NWmax) && ([expr {sqrt([string length $xdna]* [string length $ydna])}] > $info(NWmax))} {
    if {[set diff [expr {[string length $xdna] - [string length $ydna]}]] > 0} {
      return [list $xdna "[string repeat - $diff]$ydna" [string repeat . [string length $xdna]]]
    } else {
      return [list "[string repeat - [expr {-$diff}]]$xdna" $ydna [string repeat . [string length $ydna]]]
    }
  }

  set d $info(gap_penalty)
  set e $info(gap_extension_penalty)
  set mm $info(mm_penalty)

  set seqx [string toupper $xdna]
  set seqy [string toupper $ydna]

  #mttable list of strings mtlist
  #ittable list of strings itlist
  #same level
  #  6 2
  # 4-\|
  #switch level
  #  7 3
  # 5-\|
  ###test with NW_affine_align AAA AA
  ###test with NW_affine_align ATA AA

  #initialize 0,0 
  set mlist [list [expr {[string index $seqx 0] eq [string index $seqy 0]?1:$mm}]]
  set mtlist 7
  set ilist [list -10000000]
  set itlist 4
  #rest of row 0
  for {set i 1} {$i < [string length $seqx]} {incr i} {
    set s [expr {[string index $seqx $i] eq [string index $seqy 0]?1:$mm}]
    lappend mlist [expr {$s+$d+$e*($i-1)}] 
    append mtlist 7
    if {[lindex $mlist [expr {$i-1}]] > [lindex $ilist [expr {$i-1}]]} {
      lappend ilist [expr {[lindex $mlist [expr {$i-1}]]+$d}]
      append itlist 5
    } else {
      lappend ilist [expr {[lindex $ilist [expr {$i-1}]]+$e}]
      append itlist 4
    }
  } 
  set mttable [list $mtlist]
  set ittable [list $itlist]
  set mstor $mlist
  set istor $ilist
#sputs m:$mstor
#sputs i:$istor
  #do rows 1 through end
  for {set j 1} {$j < [string length $seqy]} {incr j} {
    #initialize 0,j
    set mlist [list [expr {([string index $seqx 0] eq [string index $seqy $j]?1:$mm) + $d + $e* ($j -1)}]]
    set mtlist 7
    if {[lindex $mstor 0] >= [lindex $istor 0]} {
      set ilist [list [expr {[lindex $mstor 0] + $d}]]
      set itlist 3
    } else {
      set ilist [list [expr {[lindex $istor 0] + $e}]]
      set itlist 2
    }
    set d $info(gap_penalty)
    set e $info(gap_extension_penalty)
    for {set i 1} {$i < [string length $seqx]} {incr i} {
      #lappend mlist [max [lindex mstor ($i-1)] [lindex istor ($i-1)]]
      #lappend itlist 6 7
      if { [expr {1 +$i}] == [string length $seqx]} {
         # set d 0
          set e 0
      }
      set s [expr {[string index $seqx $i] eq [string index $seqy $j]?1:$mm}]
      if {[lindex $mstor [expr {$i-1}]] >= [lindex $istor [expr {$i-1}]]} {
        lappend mlist [expr {[lindex $mstor [expr {$i-1}]] + $s}]
        append mtlist 6
      } else {
        lappend mlist [expr {[lindex $istor [expr {$i-1}]] + $s}]
        append mtlist 7
      }
      #lappend ilist [max [lindex mlist ($i-1)] [lindex ilist ($i-1)] [lindex mstor $i] [lindex istor $i]]
      #lappend itlist 5 4 3 2
      if {([set mleft [lindex $mlist end-1]] > [set mup [lindex $mstor $i]]) } {
        if {[set ileft [lindex $ilist end]] > [set iup [lindex $istor $i]]} {
          if {[expr {$mleft + $d}] > [expr {$ileft + $e}]} {
            lappend ilist [expr {$mleft + $d}]
            append itlist 5
          } else {
            lappend ilist [expr {$ileft + $e}]
            append itlist 4
          }
        } else {
          if {[expr {$mleft + $d}] > [expr {$iup + $e}]} {
            lappend ilist [expr {$mleft + $d}]
            append itlist 5
          } else {
            lappend ilist [expr {$iup + $e}]
            append itlist 2
          }
        }
      } else {
        if {[set ileft [lindex $ilist end]] > [set iup [lindex $istor $i]]} {
          if {[expr {$mup + $d}] > [expr {$ileft + $e}]} {
            lappend ilist [expr {$mup + $d}]
            append itlist 3
          } else {
            lappend ilist [expr {$ileft + $e}]
            append itlist 4
          }
        } else {
          if {[expr {$mup + $d}] > [expr {$iup + $e}]} {
            lappend ilist [expr {$mup + $d}]
            append itlist 3
          } else {
            lappend ilist [expr {$iup + $e}]
            append itlist 2
          }
        }
      }
    }
    lappend mttable $mtlist
    lappend ittable $itlist
    set mstor $mlist
    set istor $ilist
#sputs m:$mstor
#sputs i:$istor
  }

  #sputs mttable:
  #foreach row $mttable {
  #  sputs $row
  #}
  #sputs ittable:
  #foreach row $ittable {
  #  sputs $row
  #}
  ### do traceback
  set x [expr {[string length $xdna]-1}] 
  set y [expr {[string length $ydna]-1}] 
  set yout ""
  set xout ""
  set lineout ""
  if {[lindex $mstor end] >= [lindex $istor end]} {
    set z 0
  } else {
    set z 1
  }
  while {($x > -1) && ($y > -1)} {
    if {$z} {
      set v [string index [lindex $ittable $y] $x]
    } else {
      set v [string index [lindex $mttable $y] $x]
    }
    switch $v {
      4  {
        set yout "-$yout"
        set xout "[string index $xdna $x]$xout"
        set lineout " $lineout"
        incr x -1 
        set z 1
      }
      5 {
        set yout "-$yout"
        set xout "[string index $xdna $x]$xout"
        set lineout " $lineout"
        incr x -1 
        set z 0
      }
      6 {
        set yout "[string index $ydna $y]$yout"
        set xout "[string index $xdna $x]$xout"
        if {[string toupper [string index $ydna $y]] eq [string toupper [string index $xdna $x]]} {
          set lineout "|$lineout"
        } else {
          set lineout "#$lineout"
        }
        incr x -1 
        incr y -1
        set z 0
      }
      7 {
        set yout "[string index $ydna $y]$yout"
        set xout "[string index $xdna $x]$xout"
        if {[string toupper [string index $ydna $y]] eq [string toupper [string index $xdna $x]]} {
          set lineout "|$lineout"
        } else {
          set lineout "#$lineout"
        }
        incr x -1 
        incr y -1
        set z 1
      }
      3 {
        set yout "[string index $ydna $y]$yout"
        set xout "-$xout" 
        set lineout " $lineout"
        incr y -1
        set z 0
      }
      2 {
        set yout "[string index $ydna $y]$yout"
        set xout "-$xout" 
        set lineout " $lineout"
        incr y -1
        set z 1
      }
    }
  }
  if {$x > -1} {
    set yout "[string repeat - [expr {1+$x}]]$yout"
    set xout "[string range $xdna 0 $x]$xout"
    set lineout "[string repeat " " [expr {1+$x}]]$lineout"
  } else {
    set xout "[string repeat - [expr {1+$y}]]$xout"
    set yout "[string range $ydna 0 $y]$yout"
    set lineout "[string repeat " " [expr {1+$y}]]$lineout"
  }
  set ctime [clock clicks]

  return [list $xout $yout $lineout]
}

###############
#Needleman-Wunsch Alignment
## no  outside penalty- for no compression on the ends of a linear sequence
##############
proc NW_affine_align_both_ends {xdna ydna {ignoremax 0}} {
  set atime [clock clicks]
  global info
  if {(!$ignoremax) && !$info(ignore_NWmax) && ([expr {sqrt([string length $xdna]* [string length $ydna])}] > $info(NWmax))} {
    if {[set diff [expr {[string length $xdna] - [string length $ydna]}]] > 0} {
      return [list $xdna "[string repeat - $diff]$ydna" [string repeat . [string length $xdna]]]
    } else {
      return [list "[string repeat - [expr {-$diff}]]$xdna" $ydna [string repeat . [string length $ydna]]]
    }
  }

  set d $info(gap_penalty)
  set e $info(gap_extension_penalty)
  set mm $info(mm_penalty)

  set seqx [string toupper $xdna]
  set seqy [string toupper $ydna]

  #mttable list of strings mtlist
  #ittable list of strings itlist
  #same level
  #  6 2
  # 4-\|
  #switch level
  #  7 3
  # 5-\|
  ###test with NW_affine_align AAA AA
  ###test with NW_affine_align ATA AA

  #initialize 0,0 
  set mlist [list [expr {[string index $seqx 0] eq [string index $seqy 0]?1:$mm}]]
  set mtlist 7
  set ilist [list -10000000]
  set itlist 4
  #rest of row 0
  for {set i 1} {$i < [string length $seqx]} {incr i} {
    set s [expr {[string index $seqx $i] eq [string index $seqy 0]?1:$mm}]
    ###lappend mlist [expr {$s+$d+$e*($i-1)}] 
    lappend mlist [expr {$s}] 
    append mtlist 7
    if {[lindex $mlist [expr {$i-1}]] > [lindex $ilist [expr {$i-1}]]} {
      ###lappend ilist [expr {[lindex $mlist [expr {$i-1}]+$d]}]
      lappend ilist [expr {[lindex $mlist [expr {$i-1}]]}]
      append itlist 5
    } else {
      ###lappend ilist [expr {[lindex $ilist [expr {$i-1}]]+$e}]
      lappend ilist [expr {[lindex $ilist [expr {$i-1}]]}]
      append itlist 4
    }
  } 
  set mttable [list $mtlist]
  set ittable [list $itlist]
  set mstor $mlist
  set istor $ilist
#sputs m:$mstor
#sputs i:$istor
  #do rows 1 through end
  for {set j 1} {$j < [string length $seqy]} {incr j} {
    #initialize 0,j
    #set mlist [list [expr {([string index $seqx 0] eq [string index $seqy $j]?1:$mm) + $d + $e* ($j -1)}]]
    set mlist [list [expr {([string index $seqx 0] eq [string index $seqy $j]?1:$mm) + 0 + 0* ($j -1)}]]
    set mtlist 7
    if {[lindex $mstor 0] >= [lindex $istor 0]} {
      ###set ilist [list [expr {[lindex $mstor 0] + $d}]]
      set ilist [list [expr {[lindex $mstor 0] + 0}]]
      set itlist 3
    } else {
      ###set ilist [list [expr {[lindex $istor 0] + $e}]]
      set ilist [list [expr {[lindex $istor 0] + 0}]]
      set itlist 2
    }
    set d $info(gap_penalty)
    set e $info(gap_extension_penalty)
    for {set i 1} {$i < [string length $seqx]} {incr i} {
      #lappend mlist [max [lindex mstor ($i-1)] [lindex istor ($i-1)]]
      #lappend itlist 6 7
      if { [expr {1 +$i}] == [string length $seqx]} {
         # set d 0
          set e 0
      }
      set s [expr {[string index $seqx $i] eq [string index $seqy $j]?1:$mm}]
      if {[lindex $mstor [expr {$i-1}]] >= [lindex $istor [expr {$i-1}]]} {
        lappend mlist [expr {[lindex $mstor [expr {$i-1}]] + $s}]
        append mtlist 6
      } else {
        lappend mlist [expr {[lindex $istor [expr {$i-1}]] + $s}]
        append mtlist 7
      }
      #lappend ilist [max [lindex mlist ($i-1)] [lindex ilist ($i-1)] [lindex mstor $i] [lindex istor $i]]
      #lappend itlist 5 4 3 2
      if {([set mleft [lindex $mlist end-1]] > [set mup [lindex $mstor $i]]) } {
        if {[set ileft [lindex $ilist end]] > [set iup [lindex $istor $i]]} {
          if {[expr {$mleft + $d}] > [expr {$ileft + $e}]} {
            lappend ilist [expr {$mleft + $d}]
            append itlist 5
          } else {
            lappend ilist [expr {$ileft + $e}]
            append itlist 4
          }
        } else {
          if {[expr {$mleft + $d}] > [expr {$iup + $e}]} {
            lappend ilist [expr {$mleft + $d}]
            append itlist 5
          } else {
            lappend ilist [expr {$iup + $e}]
            append itlist 2
          }
        }
      } else {
        if {[set ileft [lindex $ilist end]] > [set iup [lindex $istor $i]]} {
          if {[expr {$mup + $d}] > [expr {$ileft + $e}]} {
            lappend ilist [expr {$mup + $d}]
            append itlist 3
          } else {
            lappend ilist [expr {$ileft + $e}]
            append itlist 4
          }
        } else {
          if {[expr {$mup + $d}] > [expr {$iup + $e}]} {
            lappend ilist [expr {$mup + $d}]
            append itlist 3
          } else {
            lappend ilist [expr {$iup + $e}]
            append itlist 2
          }
        }
      }
    }
    lappend mttable $mtlist
    lappend ittable $itlist
    set mstor $mlist
    set istor $ilist
#sputs m:$mstor
#sputs i:$istor
  }

  #sputs mttable:
  #foreach row $mttable {
  #  sputs $row
  #}
  #sputs ittable:
  #foreach row $ittable {
  #  sputs $row
  #}
  ### do traceback
  set x [expr {[string length $xdna]-1}] 
  set y [expr {[string length $ydna]-1}] 
  set yout ""
  set xout ""
  set lineout ""
  if {[lindex $mstor end] >= [lindex $istor end]} {
    set z 0
  } else {
    set z 1
  }
  while {($x > -1) && ($y > -1)} {
    if {$z} {
      set v [string index [lindex $ittable $y] $x]
    } else {
      set v [string index [lindex $mttable $y] $x]
    }
    switch $v {
      4  {
        set yout "-$yout"
        set xout "[string index $xdna $x]$xout"
        set lineout " $lineout"
        incr x -1 
        set z 1
      }
      5 {
        set yout "-$yout"
        set xout "[string index $xdna $x]$xout"
        set lineout " $lineout"
        incr x -1 
        set z 0
      }
      6 {
        set yout "[string index $ydna $y]$yout"
        set xout "[string index $xdna $x]$xout"
        if {[string toupper [string index $ydna $y]] eq [string toupper [string index $xdna $x]]} {
          set lineout "|$lineout"
        } else {
          set lineout "#$lineout"
        }
        incr x -1 
        incr y -1
        set z 0
      }
      7 {
        set yout "[string index $ydna $y]$yout"
        set xout "[string index $xdna $x]$xout"
        if {[string toupper [string index $ydna $y]] eq [string toupper [string index $xdna $x]]} {
          set lineout "|$lineout"
        } else {
          set lineout "#$lineout"
        }
        incr x -1 
        incr y -1
        set z 1
      }
      3 {
        set yout "[string index $ydna $y]$yout"
        set xout "-$xout" 
        set lineout " $lineout"
        incr y -1
        set z 0
      }
      2 {
        set yout "[string index $ydna $y]$yout"
        set xout "-$xout" 
        set lineout " $lineout"
        incr y -1
        set z 1
      }
    }
  }
  if {$x > -1} {
    set yout "[string repeat - [expr {1+$x}]]$yout"
    set xout "[string range $xdna 0 $x]$xout"
    set lineout "[string repeat " " [expr {1+$x}]]$lineout"
  } else {
    set xout "[string repeat - [expr {1+$y}]]$xout"
    set yout "[string range $ydna 0 $y]$yout"
    set lineout "[string repeat " " [expr {1+$y}]]$lineout"
  }
  set ctime [clock clicks]

  return [list $xout $yout $lineout]
}

################
## sub-procedure of finealing or blockalign - Needleman-Wunsch Alignment
################
#Needleman-Wunsch Alignment
#for comparisons:
#g f
#m ?
# for veclist: 0=left 1=diag 2=up 3=diag,mismatch
#time= 56usec * len(x) * len(y)
proc NWalign {xdna ydna {ignoremax 0}} {
  set atime [clock clicks]
  global info

  if {(!$ignoremax)  && !$info(ignore_NWmax) && ([expr {sqrt([string length $xdna]* [string length $ydna])}] > $info(NWmax))} {
    if {[set diff [expr {[string length $xdna] - [string length $ydna]}]] > 0} {
      return [list $xdna "[string repeat - $diff]$ydna" [string repeat . [string length $xdna]]]
    } else {
      return [list "[string repeat - [expr {-$diff}]]$xdna" $ydna [string repeat . [string length $ydna]]]
    }
  }

  set gp $info(gap_penalty)
  set mp $info(mm_penalty)
  set scorelist1 [list]

  for {set i 1} {$i <= [string length $xdna]} {incr i} {lappend scorelist1 [expr {$i*$gp}]}
  set i 0
  set allvecs [list]
  set ylist [split [string toupper $ydna] ""]
  set xlist [split [string toupper $xdna] ""]
  foreach ychar $ylist {
    set veclist [list]
    set scorelist [list]
    set g $i
    set m [incr i $gp]
    foreach xchar $xlist f $scorelist1 {
      if {$xchar == $ychar} {
        set s [expr {$g+1}]
        set v 1
      } else {
        set s [expr {$g+$mp}]
        set v 3
      }
      if {[expr {$f+$gp}] > $s} {
        set s [expr {$f+$gp}]
        set v 2
      }
      if {[expr {$m+$gp}] > $s} {
        set m [expr {$m+$gp}]
        lappend veclist 0
      } else {
        set m $s
        lappend veclist $v
      }
      lappend scorelist $m
      set g $f

    } 
    set scorelist1 $scorelist
    lappend allvecs $veclist
  }
  set btime [clock clicks]
  set x [expr {[string length $xdna]-1}] 
  set y [expr {[string length $ydna]-1}] 
  set yout ""
  set xout ""
  set lineout ""
  while {($x >-1) && ($y > -1)} {
    switch [lindex [lindex $allvecs $y] $x] {
      0 {
        set yout "-$yout"
        set xout "[string index $xdna $x]$xout"
        set lineout " $lineout"
        incr x -1 
      }
      1 {
        set yout "[string index $ydna $y]$yout"
        set xout "[string index $xdna $x]$xout"
        set lineout "|$lineout"
        incr x -1 
        incr y -1
      }
      3 {
        set yout "[string index $ydna $y]$yout"
        set xout "[string index $xdna $x]$xout"
        set lineout "#$lineout"
        incr x -1 
        incr y -1
      }
      2 {
        set yout "[string index $ydna $y]$yout"
        set xout "-$xout" 
        set lineout " $lineout"
        incr y -1
      }
    }
  }
  if {$x > -1} {
    set yout "[string repeat - [expr {1+$x}]]$yout"
    set xout "[string range $xdna 0 $x]$xout"
    set lineout "[string repeat " " [expr {1+$x}]]$lineout"
  } else {
    set xout "[string repeat - [expr {1+$y}]]$xout"
    set yout "[string range $ydna 0 $y]$yout"
    set lineout "[string repeat " " [expr {1+$y}]]$lineout"
  }
  set ctime [clock clicks]
  return [list $xout $yout $lineout]
}


################
## link a double click in an analysis window to the original wndow
################
proc alignlink {textbox window index dir mode {raise 1}} {
  #set text [split [$textbox get [$textbox index "$index linestart"] [$textbox index $index]] "\t"]
  #set linestart [lindex $text 0]
  #set chars [regexp -all {[^-]} [lindex $text 1]]

  if {[regexp {([0-9]+)(?:[[:blank:]~]*)(.*)} [$textbox get [$textbox index "$index linestart"] [$textbox index $index]] line linestart text]} {
    set chars [regexp -all {[^-\~\ ]} $text]

    if {[string first ".abi_window" $window] == -1} {
      #####sequence window
      if {([$textbox get $index] == "-") || ([$textbox get $index] == " ")} {
        if {$mode == "select"} {
          select_region $window [$window.textarea index insert] [bp2ix $window.textarea [expr {$linestart-1+$dir*$chars}]]
        } else {
          select_region $window [bp2ix $window.textarea [expr {$linestart-1+$dir*$chars}]] [bp2ix $window.textarea [expr {$linestart-1+$dir*$chars}]]
        }
      } else {
        if {$mode == "select"} {
          if {[$window.textarea compare [$window.textarea index insert] > [bp2ix $window.textarea [expr {$linestart+$dir*$chars}]]]} {
            select_region $window [$window.textarea index insert] [bp2ix $window.textarea [expr {$linestart-1+$dir*$chars}]]
          } else {
            select_region $window [$window.textarea index insert] [bp2ix $window.textarea [expr {$linestart+$dir*$chars}]]
          }
        } else {
          select_region $window [bp2ix $window.textarea [expr {$linestart-1+$dir*$chars}]] [bp2ix $window.textarea [expr {$linestart-1+$dir*$chars}]]
        }
      }
      if {$raise} {
        wm deiconify $window
        raise $window
        focus $window.textarea
      }
    } else {
      ####abi window
      if {$mode == "select"} {
        abi_select_region $window [expr {$linestart-1+$dir*$chars}] select
      } else {
        abi_select_region $window [expr {$linestart-1+$dir*$chars}] [expr {$linestart-1+$dir*$chars}]
      }
      if {$raise} {
        wm deiconify $window
        raise $window
        focus $window.c
      }
    }
  } else {
    bell
  }
}

#############
##align ling that uses lsxx_yy tag to find line start index(xx) and spacing(yy) for linking translated sequences, or DNA without indexes 
##wrapping lines are lsxx_yy_#_aa_bb seq_start(aa) and seq_end(bb)
#############
proc alignlink2 {textbox window index mode {raise 1}} {
 if {([set lstag [lsearch -inline  [$textbox tag names $index] ls*]] != "") && [regexp  {ls(-?[0-9]+)_(-?[0-9]+)(?:_#_(-?[0-9]+)_(-?[0-9]+))?} $lstag -- linestart spacing seqstart seqend]} {
     if {[set dnastart [lindex [$textbox tag nextrange $lstag "$index linestart"] 0]] ne {}} {
      set text [$textbox get [$textbox index $dnastart] [$textbox index $index]]
     } else {
      set text [$textbox get [$textbox index "$index linestart"] [$textbox index $index]]
     }

    regsub -all {[0-9]+|[[:blank:]~]|<|>} $text "" text
    set chars [regexp -all {[^-]} $text]
    if {[string first ".abi_window" $window] == -1} {
      #sequence window
      if {$seqstart eq {}} {
        set seqstart 0
        set seqend [ix2bp $window.textarea end]
        incr seqend 1
      }
      if {[$textbox get $index] == "-"} {
        if {$mode == "select"} {
            select_region $window [$window.textarea index insert] [bp2ix $window.textarea [expr {($linestart+$spacing*($chars) -$seqstart) % ($seqend-$seqstart) + $seqstart}]]
        } else {
            select_region $window [bp2ix $window.textarea [expr {($linestart+$spacing*($chars-1)  - $seqstart) % ($seqend-$seqstart) + $seqstart}]] [bp2ix $window.textarea [expr {($linestart+1+$spacing*($chars) - $seqstart) % ($seqend-$seqstart) + $seqstart}]]
        }
      } else {
        if {$mode == "select"} {
          if {[$window.textarea compare [$window.textarea index insert] > [bp2ix $window.textarea [expr {($linestart+$spacing*($chars) - $seqstart) % ($seqend-$seqstart) + $seqstart}]]]} {
            select_region $window [$window.textarea index insert] [bp2ix $window.textarea [expr {($linestart-1+$spacing*($chars) - $seqstart) % ($seqend-$seqstart) + $seqstart}]]
          } else {
            select_region $window [$window.textarea index insert] [bp2ix $window.textarea [expr {($linestart+$spacing*($chars) - $seqstart) % ($seqend-$seqstart) + $seqstart}]]
          }
        } else {
            select_region $window [bp2ix $window.textarea [expr {($linestart-1+$spacing*($chars) - $seqstart) % ($seqend-$seqstart) + $seqstart}]] [bp2ix $window.textarea [expr {1+($linestart-1+$spacing*($chars) - $seqstart) % ($seqend-$seqstart) + $seqstart}]]
        }
      }
    } else {
      #abi window
      global abi_info
      if {$seqstart eq {}} {
        set seqstart 0
        set seqend [string length $abi_info($window,basecall,edited)]
        incr seqend 1
      }
      if {$mode == "select"} {
        abi_select_region $window [expr {($linestart-1+$spacing*($chars) - $seqstart) % ($seqend-$seqstart) + $seqstart}] select
      } else {
        abi_select_region $window [expr {($linestart-1+$spacing*($chars) - $seqstart) % ($seqend-$seqstart) + $seqstart}] [expr {($linestart-1+$spacing*($chars) - $seqstart) % ($seqend-$seqstart) + $seqstart}]
      }
    }
    if {$raise} {
      wm deiconify $window
      raise $window
      if {[string first ".abi_window" $window] == -1} {
        focus $window.textarea
      } else {
        focus $window.c
      }
    }
  } else {
    sputs cant get lstag info from $textbox $window $mode $index $lstag
  }
}


################
## alignment window, create abi tooltip window
################
proc abi_tooltip_create {} {
  if {[winfo exists .abitooltip2]} {
    return
  }
  global info
  toplevel .abitooltip2  -borderwidth 1 -background black

  if {(0 && [tk windowingsystem] == "aqua")} {
    tk::unsupported::MacWindowStyle style .abitooltip2 help {}; after 40  "if {\[winfo exists .abitooltip2\]} {raise .abitooltip2}"
  } else { 
    wm overrideredirect .abitooltip2 1
  }
  catch {wm attributes .abitooltip2 -alpha .7}
  grid [canvas .abitooltip2.c -background $info(graphic_bg_color)] -row 0 -column 0 -sticky nswe

  foreach color [list blue red green black] {
    .abitooltip2.c create line 0 0 0 0 -tags trace
  }
  .abitooltip2.c create text 0 0  -fill $info(graphic_fg_color) -tags label -anchor n
  .abitooltip2.c create text 0 0 -fill $info(graphic_fg_color) -tags [list seq1 seq] -anchor n -text A
  .abitooltip2.c create text 0 0 -fill $info(graphic_fg_color) -tags [list seq2 seq] -anchor n  -text B
  .abitooltip2.c create text 0 0 -fill $info(graphic_fg_color) -tags [list seq3 seq] -anchor n  -text C
  .abitooltip2.c create text 0 0 -fill $info(graphic_fg_color) -tags trans -anchor n  -text trans
  .abitooltip2.c create text 0 0 -fill $info(graphic_fg_color) -tags rc_trans -anchor n  -text rc_trans
   raise .abitooltip2
}

################
## alignment window, copy data into abi tooltip window
################
proc abi_tooltip_update {abi_window from_base to_base to_canvas} {
  global abi_info info

  set abi_canvas "$abi_window.c"
  set rev 1
  if { $from_base > $to_base} {
    set t $from_base
    set from_base $to_base
    set to_base $t
    set rev -1
  }

  set mid_base [expr {$from_base+ int(($to_base-$from_base)/2) }]

  #abi coordinates are 0 based, indexes passed in are 1 based
  incr mid_base -1

  set range 1

  while {$mid_base >=[expr {[llength $abi_info($abi_window,basecall_loc,edited)]- $range}]} {
    incr mid_base  -1
  }
  if {$mid_base <= [expr {$range-1}]} {
    set mid_base $range
  }  

  set from_index [lindex $abi_info($abi_window,basecall_loc,edited) [expr {$mid_base- $range}]]
  set to_index [lindex $abi_info($abi_window,basecall_loc,edited) [expr {$mid_base+ $range}]]

  set coord_length [llength [$abi_canvas coords 1]]
  foreach base [list 1 2 3 4] {
    set coords [lrange [$abi_canvas coords $base] [expr {$from_index * 2}] [expr {$to_index * 2 + 1}]]
    $to_canvas coords $base $coords
    if {$abi_info($abi_window,rev_com)} {
      $to_canvas move $base [expr {-[lindex $coords end-1]}] 0
    } else {
      $to_canvas move $base [expr {-[lindex $coords 0]}] 0
    }
    if {$rev == -1} {
      if {!$abi_info($abi_window,rev_com)} {
        $to_canvas scale $base 0 0 -1 1
      }
      $to_canvas itemconfigure $base -fill $abi_info(colors,[revcom [string index $abi_info($abi_window,filter_wheel) [expr {$base-1}]]]) 
      set left_x [lindex $coords end-1]
    } else {
      if {$abi_info($abi_window,rev_com)} {
         $to_canvas scale $base 0 0 -1 1
      }
      set left_x [lindex $coords 0]
      $to_canvas itemconfigure $base -fill $abi_info(colors,[string index $abi_info($abi_window,filter_wheel) [expr {$base-1}]]) 
    }
  }



  $to_canvas itemconfigure label -state normal
  $to_canvas itemconfigure seq -state normal
  $to_canvas itemconfigure trace -state normal
  $to_canvas itemconfigure trans -state normal
  $to_canvas itemconfigure rc_trans -state normal

  if {$abi_info($abi_window,rev_com)} {
    set canvas_right [lindex [$abi_canvas bbox all] 2]
    set ix [expr {min($mid_base+ $range, [llength $abi_info($abi_window,basecall_loc,edited)]-1)}]
    $to_canvas coords seq1 [expr {$canvas_right - [lindex $abi_info($abi_window,basecall_loc,edited) $ix]*$abi_info($abi_window,horiz_scale) -$left_x}] [lindex [$to_canvas bbox 1] 3]
    $to_canvas coords seq2 [expr {$canvas_right - [lindex $abi_info($abi_window,basecall_loc,edited) [expr {$mid_base}]]*$abi_info($abi_window,horiz_scale) -$left_x}] [lindex [$to_canvas bbox 1] 3]
    set ix [expr {min($mid_base- $range, [llength $abi_info($abi_window,basecall_loc,edited)]-1)}]
    $to_canvas coords seq3 [expr {$canvas_right - [lindex $abi_info($abi_window,basecall_loc,edited) $ix]*$abi_info($abi_window,horiz_scale)  -$left_x}] [lindex [$to_canvas bbox 1] 3]
    $to_canvas coords trans [expr {$canvas_right - [lindex $abi_info($abi_window,basecall_loc,edited) [expr {min($mid_base,[llength $abi_info($abi_window,basecall_loc,edited)]-1)}]]*$abi_info($abi_window,horiz_scale) -$left_x}] [lindex [$to_canvas bbox seq] 3]
    $to_canvas coords rc_trans [expr {$canvas_right - [lindex $abi_info($abi_window,basecall_loc,edited) [expr {min($mid_base,[llength $abi_info($abi_window,basecall_loc,edited)]-1)}]]*$abi_info($abi_window,horiz_scale) -$left_x}] [lindex [$to_canvas bbox trans] 3]
    $to_canvas coords label [expr {$canvas_right - [lindex $abi_info($abi_window,basecall_loc,edited) [expr {min($mid_base,[llength $abi_info($abi_window,basecall_loc,edited)]-1)}]]*$abi_info($abi_window,horiz_scale) -$left_x}] [lindex [$to_canvas bbox rc_trans] 3]
  } else {
    set ix [expr {min($mid_base-$range, [llength $abi_info($abi_window,basecall_loc,edited)]-1)}]
    $to_canvas coords seq1 [expr {[lindex $abi_info($abi_window,basecall_loc,edited) $ix]*$abi_info($abi_window,horiz_scale) -$left_x}] [lindex [$to_canvas bbox 1] 3]
    $to_canvas coords seq2 [expr {[lindex $abi_info($abi_window,basecall_loc,edited) [expr {$mid_base}]]*$abi_info($abi_window,horiz_scale) -$left_x}] [lindex [$to_canvas bbox 1] 3]
    set ix [expr {min($mid_base+$range, [llength $abi_info($abi_window,basecall_loc,edited)]-1)}]
    $to_canvas coords seq3 [expr {[lindex $abi_info($abi_window,basecall_loc,edited) $ix]*$abi_info($abi_window,horiz_scale)  -$left_x}] [lindex [$to_canvas bbox 1] 3]
    $to_canvas coords trans [expr {[lindex $abi_info($abi_window,basecall_loc,edited) [expr {min($mid_base,[llength $abi_info($abi_window,basecall_loc,edited)]-1)}]]*$abi_info($abi_window,horiz_scale) -$left_x}] [lindex [$to_canvas bbox seq] 3]
    $to_canvas coords rc_trans [expr {[lindex $abi_info($abi_window,basecall_loc,edited) [expr {min($mid_base,[llength $abi_info($abi_window,basecall_loc,edited)]-1)}]]*$abi_info($abi_window,horiz_scale) -$left_x}] [lindex [$to_canvas bbox trans] 3]
    $to_canvas coords label [expr {[lindex $abi_info($abi_window,basecall_loc,edited) [expr {min($mid_base,[llength $abi_info($abi_window,basecall_loc,edited)]-1)}]]*$abi_info($abi_window,horiz_scale) -$left_x}] [lindex [$to_canvas bbox rc_trans] 3]   
  }
  set seq [string toupper [string range $abi_info($abi_window,basecall,edited) [expr {$mid_base-1}] [expr {$mid_base+1}]]]
  if {$rev == -1} {
    set seq [revcom $seq]
    $to_canvas itemconfigure trans -text [translate $seq]
  }
  
  $to_canvas itemconfigure seq1 -text [string index $seq 0]
  $to_canvas itemconfigure seq2 -text [string index $seq 1]
  $to_canvas itemconfigure seq3 -text [string index $seq 2]
  $to_canvas itemconfigure trans -text ">[translate $seq]>"
  $to_canvas itemconfigure rc_trans -text "<[translate [revcom $seq]]<"
  $to_canvas itemconfigure label -text "[wm title $abi_window]"
  
  set bbox [$to_canvas bbox all]
  $to_canvas configure -scrollregion [$to_canvas bbox all] -width [expr {[lindex $bbox 2]-[lindex $bbox 0]}] -height [expr {[lindex $bbox 3]-[lindex $bbox 1]}]
  return [expr {[lindex $bbox 3]-[lindex $bbox 1]}]
}

################
##
################
proc abi_tooltip_seq_update {window base mouse_char to_canvas} {
  global info
  if {[info exists info($window,phred_string)] && $info($window,phred_string) ne {}} {
    if {$mouse_char ne "-" && $mouse_char ne "~"} {
      set label_data "[wm title $window]\nBase:$base\nPhred: [expr {[scan [string index $info($window,phred_string) $base-1] %c] -33}]"
    } else {
      set label_data "[wm title $window]\nBase:-"
    }
  } else {
    if {$mouse_char ne "-" && $mouse_char ne "~"} {
      set label_data "[wm title $window]\nBase:$base"
    } else {
      set label_data "[wm title $window]\nBase:-"
    }
  }
  $to_canvas itemconfigure label -state normal -text $label_data
  $to_canvas itemconfigure seq -state hidden
  $to_canvas itemconfigure trace -state hidden
  $to_canvas itemconfigure trans -state hidden
  $to_canvas itemconfigure rc_trans -state hidden
  set bbox [$to_canvas bbox all]
  $to_canvas configure -scrollregion [$to_canvas bbox all] -width [expr {[lindex $bbox 2]-[lindex $bbox 0]}] -height [expr {[lindex $bbox 3]-[lindex $bbox 1]}]
  return [expr {[lindex $bbox 3]-[lindex $bbox 1]}]
#need to scale and move the items to fit in canvas
}

################
##
################
proc abi_tooltip_post {textbox window x y} {
  if { [bind $textbox <<abi_tooltip_index>>] == [$textbox index @$x,$y]  }  {return}
  ###### ONLY post tooltip on mismatch bases
  if {0 && "mmhighlite" ni  [$textbox tag names [$textbox index @$x,$y] ]} {return}
  if {[bind $textbox <<abi_tooltip>>] == 1} {
    if {[bind $textbox <<abi_tooltip_after>>] ne ""} {
      catch {after cancel [bind $textbox <<abi_tooltip_after>>]}
    }

    bind $textbox <<abi_tooltip_after>> [after 300 "abi_tooltip_do_post $textbox $window $x $y"]
  }
  catch {wm withdraw .abitooltip2}
}

################
##
################
#$a.textframe.text tag bind $ywindow\_tag <Motion> "+;abi_tooltip_post $a.textframe.text $ywindow %x %y"
#$a.textframe.text tag bind $ywindow\_tag <Enter> "+;abi_tooltip_post $a.textframe.text $ywindow %x %y"
#$a.textframe.text tag bind $ywindow\_tag <Leave> "+;destroy .abitooltip2"
#bind $a.textframe <FocusOut> "destroy .abitooltip2"
#needs to deal with rev-com abi window and rev-com alignment
proc abi_tooltip_do_post {textbox window x y} {
  if {![winfo exists $window] || ![winfo exists $textbox]} return
  set index [$textbox index @$x,$y]  
  if {([set lstag [lsearch -inline  [$textbox tag names $index] ls*]] != "") && [regexp  {ls(-?[0-9]+)_(-?[0-9]+)(?:_#_(-?[0-9]+)_(-?[0-9]+))?} $lstag -- linestart spacing seqstart seqend]} {
     if {[set dnastart [lindex [$textbox tag nextrange $lstag "$index linestart"] 0]] ne {}} {
      set text [$textbox get [$textbox index $dnastart] [$textbox index $index]]
     } else {
      set text [$textbox get [$textbox index "$index linestart"] [$textbox index $index]]
     }
    regsub -all {[0-9]|[[:blank:]~]|<|>} $text "" text
    set chars [regexp -all {[^-]} $text]
    bind $textbox <<abi_tooltip_index>> $index
    if {[string first ".abi_window" $window] == -1} {
      #seq window
      if {$seqstart eq {}} {
        set seqstart 0
        set seqend [ix2bp $window.textarea end]
      }
      incr seqstart
      incr seqend 
      abi_tooltip_create
      set mouse_char [$textbox get $index $index+1c] 
      set tt_height [abi_tooltip_seq_update $window [expr {($linestart+$spacing*($chars) - $seqstart) % ($seqend-$seqstart) + $seqstart}] $mouse_char .abitooltip2.c]
      wm geometry .abitooltip2 "+[expr {[winfo rootx $textbox]+$x- ([winfo width .abitooltip2]/2)+7 }]+[expr {[winfo rooty $textbox]+$y- $tt_height-19}]"
      wm deiconify .abitooltip2
      raise .abitooltip2
      return
    } else {
      #abi window
      if {$seqstart eq {}} {
        global abi_info
        set seqstart 0
        set seqend [string length $abi_info($window,basecall,edited)]
      }
      incr seqstart
      incr seqend 
      abi_tooltip_create
      set tt_height [abi_tooltip_update $window [expr {($linestart+$spacing*($chars-1) - $seqstart) % ($seqend-$seqstart) + $seqstart}] [expr {($linestart+$spacing*($chars+1) - $seqstart) % ($seqend-$seqstart) + $seqstart}] .abitooltip2.c]
      wm geometry .abitooltip2 "+[expr {[winfo rootx $textbox]+$x- ([winfo reqwidth .abitooltip2]/2)}]+[expr {[winfo rooty $textbox]+$y- $tt_height-19}]"
      wm deiconify .abitooltip2
      raise .abitooltip2
    }
  } else {
    #sputs abi_tooltip_post cant get lstag info from $textbox $window $index
  }
}





################
## Send DNA to the NCBI BLAST server and open results in a browser
################
proc NCBI_Blast {w} {
  ####http://www.ncbi.nlm.nih.gov/BLAST/Doc/urlapi.html
  #####http://blast.ncbi.nlm.nih.gov/Blast.cgi?CMD=Web&PAGE_TYPE=BlastDocs&DOC_TYPE=DeveloperInfo
  global ok
  global info dialogblock ncbi_select_window
  if {$dialogblock == 1} {return}
  set dialogblock 1



  if {1} {
    set dialog [new_dialog $w "BLAST DNA at NCBI..." "BLAST"]
    bind $dialog <<Cancel>> "set ok -1"
    bind $dialog <<OK>> "set ok 1"
    set ok 0

    grid [frame $dialog.frame1] -row 1 -column 0
    grid [label $dialog.frame1.label -text [mc "Window:"] -font boldlabelfont] -row 0 -column 0 -sticky ens
    menubutton $dialog.frame1.win_button
    menu $dialog.frame1.win_button.menu 
    foreach window [dnawindows_list 1] {
      $dialog.frame1.win_button.menu add radiobutton -label [wm title $window] -variable ncbi_select_window -value $window  -command "$dialog.frame1.win_button configure -text \{[wm title $window]\}"
    }
    $dialog.frame1.win_button configure -text [wm title $w] -menu $dialog.frame1.win_button.menu -indicatoron 1 -relief raised -width 25
    bind $dialog.frame1.win_button <<MenuSelect>> "focus $dialog"
    set ncbi_select_window $w
    grid $dialog.frame1.win_button -row 0 -column 1 -sticky wens

    grid [checkbutton $dialog.frame1.local -height 1 -variable info(analyze_selection) -text [mc "Selection Only"] -onvalue "selection" -offvalue "all" -indicator on -selectcolor white] -row 0 -column 2 -sticky wns 



    grid [label $dialog.frame1.proglabel -text [mc "BLAST Program:"] -font boldlabelfont] -row 1 -column 0 -sticky nse
    grid [menubutton $dialog.frame1.prog -textvariable info(ncbi_blast,program) -menu $dialog.frame1.prog.menu -indicatoron 1 -relief raised] -row 1 -column 1 -sticky w
    menu $dialog.frame1.prog.menu
     foreach bprog [list blastn blastp blastx tblastn tblastx] {
      $dialog.frame1.prog.menu add radiobutton -label $bprog -indicatoron 1 -value $bprog -variable info(ncbi_blast,program)
    }
    bind $dialog.frame1.prog.menu <<MenuSelect>> "focus $dialog"
    grid [label $dialog.frame1.expectlabel -text [mc "Expect:"] -font boldlabelfont] -row 2 -column 0 -sticky nse
    grid [entry $dialog.frame1.expect -textvariable info(ncbi_blast,expect)] -row 2 -column 1 -sticky w
    grid [checkbutton $dialog.frame1.filter -text [mc "Low Complexity Filter"] -font boldlabelfont -onvalue 1 -offvalue 0 -variable info(ncbi_blast,low_filter)] -row 3 -column 0 -columnspan 2

    if {!$info(android)} {
      grid [frame $dialog.frame2] -row 2 -column 0
      grid [button $dialog.frame2.ok -text [mc "OK"] -command "set ok 1" -default active] -row 1 -column 0 -sticky ns -padx 10 -pady 3
      bind $dialog <Key-Return> "set ok 1"
      grid [button $dialog.frame2.cancel -text [mc "Cancel"] -command "set ok -1"] -row 1 -column 1 -sticky ns -padx 10 -pady 3
    }

    grid columnconfigure $dialog 0 -weight 1
    grid rowconfigure $dialog 1 -weight 1
    grid rowconfigure $dialog 2 -weight 0

    regexp {([0-9]*)x([0-9]*)\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry [winfo toplevel $dialog] ] wgeom winw winh winx winy
    if {[expr {$winx+$winw}] > [winfo screenwidth .]} {set winx [expr {[winfo screenwidth .]-$winw}]}
    if {$winx < 0} {set winx 0}
    if {[expr {$winy+$winh}] > [winfo screenheight .]} {set winy [expr {[winfo screenheight .]-$winh}]}
    if {$winy < 0} {set winy 0}
    wm geometry [winfo toplevel $dialog]  "+$winx+$winy"
    update idletasks

    focus $dialog
    vwait ok 
    set dialogblock 0
    destroy $dialog
    bind . <<RaiseDialogs>> ""
    if {$ok == 1} {
      if {([$ncbi_select_window.textarea tag ranges sel] == "") || ($info(analyze_selection) == "all")} {
        set first 1.0
        set last [end_ix $w.textarea]
      } else {
        set first [$w.textarea index sel.first]
        set last [$w.textarea index sel.last]
#selection used here 
      }
      set text [textarea_get $w.textarea $first $last]
      if {($info(ncbi_blast,program) == "blastp") || ($info(ncbi_blast,program) == "tblastn")} {
        set text [translate $text]
      }
      if {[string length $text] > 15} {
        set url "https://www.ncbi.nlm.nih.gov/blast/Blast.cgi"
        set query [::http::formatQuery QUERY $text DATABASE $info(ncbi_blast,database) EXPECT $info(ncbi_blast,expect) PROGRAM $info(ncbi_blast,program) SERVICE plain CMD Put]
        if {$info(ncbi_blast,low_filter)} {append query "&FILTER=L"}
        #sputs here $url
        if {$info(tls) eq "tls"} {
          #sputs get-URL
          set x [::http::geturl $url -blocksize 4096 -timeout 20000 -method POST -headers [list content_type application/x-www-form-urlencoded] -command blast_callback -query $query]
          set html  [::http::data $x]
          ::http::cleanup $x
        } else {
          ## use cURL if tls isn't available
          #sputs curl
          if {[catch {exec curl -s -S $url -d $query} html err]} {
            tk_messageBox -message [mc "Error opening URL:\n %s" $err] -type ok -icon warning -default ok
          }
        }
        if {[regexp {.*RID = (.*?)\n.*} $html -- RID]} {
          set url "https://www.ncbi.nlm.nih.gov/blast/Blast.cgi?[::http::formatQuery CMD Get RID $RID FORMAT_OBJECT Alignment FORMAT_TYPE HTML DESCRIPTIONS 100 ALIGNMENTS 200 ALIGNMENT_TYPE Pairwise SHOW_OVERVIEW yes]"
          if {[set error [open_url $url]] != ""} {
            tk_messageBox -icon error -message [mc "Error:\n%1\$s\nYour RID is:%2\$s" $error  $RID]
          }
        }
      } else {
        tk_messageBox -message [mc "Not enough sequence selected for BLASTing"] -type ok -icon warning -default ok
      }
    }
  }
  unset ncbi_select_window
}

## get text version of the blast alignments: http://blast.ncbi.nlm.nih.gov/Blast.cgi?CMD=Get&RID=2ZJSXWM8014&FORMAT_OBJECT=Alignment&FORMAT_TYPE=Text&ALIGNMENTS=200&ALIGNMENT_TYPE=Pairwise
################
## called by blast to open the browser to display results
################
proc blast_callback {token} {
  global info


  if {[::http::status $token] == "timeout"} {
    warning_dialog "Command timed out- possibly a firewall issue?"
  } else {
    set html  [::http::data $token]
    #get the RID:
    if {[regexp {.*RID = (.*?)\n.*} $html fill RID]} {
     #set the web page URL
      set url "https://www.ncbi.nlm.nih.gov/blast/Blast.cgi?[::http::formatQuery CMD Get RID $RID FORMAT_OBJECT Alignment FORMAT_TYPE HTML DESCRIPTIONS 100 ALIGNMENTS 200 ALIGNMENT_TYPE Pairwise SHOW_OVERVIEW yes]"
      #sputs $RID
      #sputs $url
      #open browser and display

      if {[set error [open_url $url]] != ""} {
        tk_messageBox -icon error -message [mc "Error:\n%1\$s\nYour RID is:%2\$s" $error  $RID]
      }
    } else {
      sputs html error: $html
      if {[regexp {<title>(.*)</title>} $html x title]} {
        tk_messageBox -icon error -message [mc "Server returned:\n%s" $title]
      } else {
        tk_messageBox -icon error -message [mc "There was an unknown error with the server.\n%s" [::http::error $token]]
      }
    }
  }  
  ::http::cleanup $token
}

################
## Align two sequences using NCBI blast2seq
################
## not currently used
## needs to use curl
proc NCBI_align {t1 t2} {

  set url "https://www.ncbi.nlm.nih.gov/blast/BlastAlign.cgi?[::http::formatQuery QUERY $t1 SUBJECTS $t2 BL2SEQ checked PROGRAM blastn FILTER no SERVICE plain CMD Put]"

  lassign [get_html $url] error html
  if {$error ne "ok" || $html eq {}} {
    warning_dialog "Error opening URL: $error"
  } else {
    set html  [::http::data $token]

    #get the RID:
    if {[regexp {.*RID = (.*?)\n.*} $html fill RID]} {
     #set the web page URL
      set url "https://www.ncbi.nlm.nih.gov/blast/Blast.cgi?[::http::formatQuery CMD Get RID $RID FORMAT_OBJECT Alignment FORMAT_TYPE Text DESCRIPTIONS 0 ALIGNMENTS 2 ALIGNMENT_VIEW PairwiseWithIdentities SHOW_OVERVIEW no]"
        #ALIGNMENT_VIEW: Pairwise PairwiseWithIdentities QueryAnchored QueryAnchoredNoIdentities FlatQueryAnchored FlatQueryAnchoredNoIdentities
      set i 0
      set status "WAITING"
      while {$status == "WAITING" && $i < 20} {
        set token2 [::http::geturl $url -blocksize 4096 -timeout 4000]
        if {[::http::status $token2] == "timeout"} {
          warning_dialog "Command timed out- possibly a firewall issue?"
        } else {
          set html2  [::http::data $token2]
        }
        if {[regexp {.*Status=(.*?)\n.*} $html2 fill status]} {
          sputs $status
          incr i
        } else {
          set i 20
        }
      }
    }  
  }  
  ::http::cleanup $token2
  return $html2
}



################
## Generic function to get info from a web post operation
################
## not currently used
proc URL_Post {base_url function vars_list} {
  global info

      if {[tk windowingsystem] == "win32" } {
        set htmlfile [open [file join [tempdir] "last_$function.html"] w]
        puts $htmlfile "<form name=\"myform\" method=\"post\" action=\"$base_url\" enctype=\"application/x-www-form-urlencoded\">"
        foreach name $vars_list {
          puts $htmlfile "<input type=\"hidden\" name=\"$name\" value=\"$info($function,$name)\">"
        }
        puts $htmlfile "<h1>If Javascript is disabled, click here</h1>"
        puts $htmlfile "<INPUT TYPE=SUBMIT VALUE=\"Get results\"> "
        puts $htmlfile "</form>" 
        puts $htmlfile "<SCRIPT language=\"JavaScript1.2\">"
        puts $htmlfile " document.myform.submit();"
        puts $htmlfile "</SCRIPT>"

        close $htmlfile
        after 500
        set htmlfile "[file join [tempdir] "last_$function.html"]"
#sputs $htmlfile

        if {($info(browser) != "")} {
          if {[catch {dde request $info(browser) WWW_OpenURL \"file://$htmlfile\",,0x0}]} {
            sputs "No dde, using exec"
            if {[string first %1 $info(appCmd)] > -1} {
              eval exec [regsub {"%1"} $info(appCmd) \"file://$htmlfile\"] &
            } else {
              eval exec $info(appCmd) \"file://$htmlfile\" &
            }
          }
        } else {
          warning_dialog "Sorry, I don't know how to open your browser."
        }
      } elseif {[tk windowingsystem] == "aqua"} {
        set url "$base_url"
        set div "?"
        foreach name $vars_list {
          set url "$url$div$name=$info($function,$name)"
          set div "&"
        }
        exec open $url
      } elseif {[tk windowingsystem] == "x11"} {
        foreach name $vars_list {
          set url "$url$div$name=$info($function,$name)"
          set div "&"
        }
        foreach executable {sensible-browser mozilla netscape iexplorer opera lynx w3m links galeon konquerer mosaic firefox chrome amaya browsex elinks} {
          set executable [auto_execok $executable]
          if [string length $executable] {
            set command [list $executable $url &]
            break
          }
        }
        if [info exists command] {
          if [catch {eval exec $command} err] {
            tk_messageBox -icon error -message [mc "Error:\n%s\nCommand:\n%s" $err $command]
          }
        } else {
          warning_dialog "Sorry, I don't know how to open a browser in your OS."
        }
      } else {
        warning_dialog "Sorry, I don't know how to open a browser in your OS."
      }

}

################
## open a given URL in a browser window
################
proc open_url {url} {
  global info
  #sputs $url
  #open browser and display
  set error ""
  if {[tk windowingsystem] == "win32" } {
    #regsub -all {&} $url {^&} url
     exec cmd /c start "" $url
  } elseif {[tk windowingsystem] == "aqua"} {
    exec open $url
  } elseif {[tk windowingsystem] == "x11"} {
    if {$info(android)} {
      borg activity android.intent.action.VIEW $url text/html
    } else {
      foreach executable {xdg-open x-www-browser sensible-browser mozilla netscape iexplorer opera lynx w3m links galeon konquerer mosaic firefox chrome amaya browsex elinks} {
        set executable [auto_execok $executable]
        if {[string length $executable]} {
          set command [list $executable $url &]
          break
        }
      }
      if {[info exists command]} {
        if {[catch {eval exec $command} err]} {
          set error "error '$err' with '$command'"
        }
      } else {
        set error "Sorry, I don't know how to open a browser in your OS."
      }
    }
  } else {
     set error "Sorry, I don't know how to open a browser in your OS."
  }
  return $error
}

################
## Get the html from a URL. Returns a two element list- error and html
################
proc get_html {url} {
  global info
  if {$info(tls) eq "tls"} {
    set http_token [::http::geturl $url -timeout 4000]
    if {[set err [::http::status $http_token]] == "ok"} {
      set html  [::http::data $http_token]
    } else {
      set html ""
    }
    ::http::cleanup $http_token
  } else {
    if {[catch {exec curl -s -S $url} html err]} {
      set html ""
    } else {
      set err "ok"
    }
  }
  return [list $err $html]
}

################
## Save png data from a png URL
################
proc save_png_from_url {url} {
  set pngfilename [file join [tempdir] "ape_png_file.png"]
  if {[catch {exec curl -s -S $url -o $pngfilename } html]} {
    set pngfilename ""
  } 
  return $pngfilename
}

################
## Query the Entrez nucleotide database
################
proc entrez_dialog {w} {
  global info modifier ok dialogblock field bool query
  if {$dialogblock == 1} {return}



  set a [new_dialog $w "Entrez Query..." "DONE"]
  bind $a <<Cancel>> "set ok -1"
  bind $a <<OK>> "set ok 1"
  set ok 0

  set term_map [list {[ALL]} {All Fields} {[AUTH]} {Author Name} {[ECNO]} {EC/RN Number} {[FKEY]} {Feature Key} {[GENE]} {Gene Name} {[JOUR]} {Journal Name} {[KYWD]} Keyword {[MDAT]} {Modification Date} {[ORGN]} Organism {[PACC]} {Primary Accession} {[PROP]} Properties {[PDAT]} {Publication Date} {[SQID]} {SeqID String} {[SLEN]} {Sequence Length} {[WORD]} {Text Word} {[TITL]} {Title Word}]
  set menu_list [list]
  foreach {x y} $term_map {
    lappend menu_list $y
  }

  grid [labelframe $a.queryframe -text [mc "Query"] -relief ridge] -row 1 -column 1 -sticky nswe
  grid [entry $a.queryframe.query0 -textvariable query(0) -width 20] -row 0 -column 0 -columnspan 2 -sticky we

  tk_optionMenu $a.queryframe.field0 field(0) {*}$menu_list "Advanced Query"
  set field(0) [lindex $menu_list 0]
  grid $a.queryframe.field0 -row 0 -column 2
  for {set i 1} {$i < 5} {incr i} {
    tk_optionMenu $a.queryframe.bool$i bool($i) "AND" "OR" "NOT"
    set bool($i) "AND"
    grid $a.queryframe.bool$i -row $i -column 0
    grid [entry $a.queryframe.query$i  -textvariable query($i) -width 15] -row $i -column 1 -sticky we
    tk_optionMenu $a.queryframe.field$i field($i) {*}$menu_list
    set field($i) [lindex $menu_list 0]
    grid $a.queryframe.field$i -row $i -column 2
  }
  grid [frame $a.queryframe.butonframe -relief flat] -row $i -column 0 -columnspan 3
  grid [button $a.queryframe.butonframe.run -text [mc "Run Query"] -command "entrez_do_query $a" -default active] -row 0 -column 1 -padx 10 -pady 3
  bind $a <Key-Return> "$a.queryframe.butonframe.run invoke"
  grid [label $a.queryframe.butonframe.max_label -text [mc "Max hits:"]] -row 0 -column 2
  grid [entry $a.queryframe.butonframe.max_hits -width 4 -textvariable info(entrez,max_hits) -validate key -vcmd "check_char %S"] -row 0 -column 3
  grid columnconfigure $a.queryframe 1 -weight 1

  grid [labelframe $a.resultframe -text [mc "Query Result"] -relief ridge -height 200] -row 2 -column 1 -sticky nswe
  grid [text $a.resultframe.result -xscrollcommand "optionscrollbar $a.resultframe.scrollx" -yscrollcommand "optionscrollbar $a.resultframe.scrolly" -height 20 -background white -foreground black -font labelfont -wrap none] -row 0 -column 0 -sticky nswe
  grid [scrollbar $a.resultframe.scrollx -orient horizontal -command "$a.resultframe.result xview"] -row 1 -column 0 -sticky we
  grid [scrollbar $a.resultframe.scrolly -orient vertical -command "$a.resultframe.result yview"] -row 0 -column 1 -sticky ns
  grid [frame $a.resultframe.spacer -width 1 -height 17] -row 1 -column 1
  grid columnconfigure $a.resultframe 0 -weight 1
  grid rowconfigure $a.resultframe 0 -weight 1

  grid [frame $a.buttonframe -relief ridge] -row 3 -column 1 -sticky nswe

  grid [frame $a.buttonframe.okframe] -row 2 -column 1 -columnspan 2 -sticky we

  grid [button $a.buttonframe.okframe.ok -text [mc "Done"] -command "set ok 1"] -row 0 -column 1
  grid columnconfigure $a.buttonframe.okframe 1 -weight 1
  grid columnconfigure $a.buttonframe 2 -weight 1
  
  grid columnconfigure $a 1 -weight 1
  grid rowconfigure $a 2 -weight 1
  focus $a.queryframe.query0

  vwait ok

  destroy .dialog
  set dialogblock 0
  bind . <<RaiseDialogs>> ""
  unset ok query field bool

}

################
## Fill in the Entrez query text box 
################
proc entrez_do_query {a} {
  global info query field bool
  if {![string is integer $info(entrez,max_hits)]} {
    set info(entrez,max_hits) 25
  }
  if {$field(0) == {Advanced Query}} {
    set query_string $query(0)
  } else {
    set query_string "$query(0)[string map {{All Fields} {[ALL]} {Author Name} {[AUTH]} {EC/RN Number} {[ECNO]} {Feature Key} {[FKEY]} {Gene Name} {[GENE]} {Journal Name} {[JOUR]} Keyword {[KYWD]} {Modification Date} {[MDAT]} Organism {[ORGN]} {Primary Accession} {[PACC]} Properties {[PROP]} {Publication Date} {[PDAT]} {SeqID String} {[SQID]} {Sequence Length} {[SLEN]} {Text Word} {[WORD]} {Title Word} {[TITL]}} $field(0)]"
    for {set i 1} {$i < 5} {incr i} {
      if {$query($i) != ""} {
        append query_string " $bool($i) " "$query($i)[string map {{All Fields} {[ALL]} {Author Name} {[AUTH]} {EC/RN Number} {[ECNO]} {Feature Key} {[FKEY]} {Gene Name} {[GENE]} {Journal Name} {[JOUR]} Keyword {[KYWD]} {Modification Date} {[MDAT]} Organism {[ORGN]} {Primary Accession} {[PACC]} Properties {[PROP]} {Publication Date} {[PDAT]} {SeqID String} {[SQID]} {Sequence Length} {[SLEN]} {Text Word} {[WORD]} {Title Word} {[TITL]}} $field($i)]"
      }
    }
  }
  $a.resultframe.result delete 1.0 end
  foreach tag [$a.resultframe.result tag names] {
    if {[regexp {REF[0-9]*} $tag]} {
      $a.resultframe.result tag delete $tag
    }
  }
  $a.resultframe.result insert 1.0 "Query: $query_string\n"
  
  #get the query from NCBI
  set url "https://eutils.ncbi.nlm.nih.gov/entrez/eutils/esearch.fcgi?[http::formatQuery tool ApE db nucleotide term $query_string retmax $info(entrez,max_hits)]"

  lassign [get_html $url] error html
  if {$error ne "ok" || $html eq {}} {
    return {}
  }

  #parse result
  set count_list [list]
  foreach termset [regexp -inline -all "<TermSet>.*?</TermSet>" $html] {
    if {[regexp ".*<Term>(.*?)</Term>.*<Count>(.*?)</Count>.*" $termset termset term count]} { 
      lappend count_list [list $term $count]
    } elseif {[regexp ".*<Count>(.*?)</Count>.*<Term>(.*?)</Term>.*" $termset termset count term]} { 
      lappend count_list [list $term $count]
    }
  }
  foreach {line term} [regexp -inline -all "<PhraseNotFound>(.*?)</PhraseNotFound>" $html] {
      lappend count_list [list $term 0]
  }

  foreach count $count_list {
    $a.resultframe.result insert end "[lindex $count 0] : [lindex $count 1] hits.\n"
  }
  set id_list [list]
  foreach {id_line id} [regexp -inline -all "<Id>(.*?)</Id>" $html] { 
      lappend id_list $id
  }
  $a.resultframe.result insert end "[llength $id_list] references returned."
  if {[llength $id_list] == $info(entrez,max_hits)} {
    $a.resultframe.result insert end " (Max Hits limit reached)\n"
  } else {
    $a.resultframe.result insert end "\n" 
  }
    $a.resultframe.result insert end "-------------------\n"
  foreach ref $id_list {
    foreach field_name {ID Caption Title Extra CreateDate UpdateDate Gi TaxId Flags} {
      set j($field_name) ""
    }
    foreach sum_item [entrez_summary $ref] {
      set j([lindex $sum_item 0]) [lindex $sum_item 2]
    }

    $a.resultframe.result insert end "$j(Gi):$j(Title)\n" "REF$ref"
    $a.resultframe.result tag configure "REF$ref" -foreground blue
    if {[tk windowingsystem] != "aqua"} {
    $a.resultframe.result tag bind "REF$ref" <Any-Enter> "$a.resultframe.result tag configure REF$ref -underline 1; $a.resultframe.result configure -cursor hand2"
     } else {
    $a.resultframe.result tag bind "REF$ref" <Any-Enter> "$a.resultframe.result tag configure REF$ref -underline 1; $a.resultframe.result configure -cursor pointinghand"
    }
    $a.resultframe.result tag bind "REF$ref" <Any-Leave> "$a.resultframe.result tag configure REF$ref -underline 0; $a.resultframe.result configure -cursor xterm" 
    $a.resultframe.result tag bind "REF$ref" <Button-1> "entrez_download $ref {$j(Title)}"

    array unset j
  }
  $a.resultframe.result tag raise sel
}

################
## Utility function to query NCBI for summary info about a nucleotide record
################
proc entrez_summary {id_list} {
  set url "https://eutils.ncbi.nlm.nih.gov/entrez/eutils/esummary.fcgi?[http::formatQuery tool ApE db nucleotide id [join $id_list ","]]"

  lassign [get_html $url] error html
  if {$error ne "ok" || $html eq {}} {
    return {}
  }
  #sputs $html
  set data_list [list]
  foreach {doc_data} [regexp -inline -all "<DocSum>.*?</DocSum>" $html] { 
    set data_list [list]
    if {[regexp "<Id>(.*?)</Id>" $doc_data id_line id]} {
      set data_list [list [list ID Integer $id]]
      foreach {data_line name type data} [regexp -inline -all {<Item Name="(.*?)"[\n ]Type="(.*?)">(.*?)</Item>} $doc_data] { 
        lappend data_list [list $name $type [regsub \n $data " "]]
      }
    }
  }
  return $data_list
}

################
## Utility function to download a file using Entrez id number
################
proc entrez_download {id title} {
  global info

  while { (![file isdirectory $info(default_dnadir)])} {
    set info(default_dnadir) [file dirname $info(default_dnadir)]
    if {[file dirname $info(default_dnadir)] == $info(default_dnadir)} {
      set info(default_dnadir) [valid_default_dir]
    }
  }

  if {[winfo exists .dialog]} {
    set filename [tk_getSaveFile -title [mc "Save %s" $title] -parent .dialog  -initialfile "$id$info(default_file_extension)" -initialdir $info(default_dnadir) -filetypes {{"ApE" {.ape .str .dna .seq .gb}} {"All files" {"*"}}}]
  } else {
    set filename [tk_getSaveFile -title ["Save %s" $title]  -initialfile "$id$info(default_file_extension)" -initialdir $info(default_dnadir) -filetypes {{"ApE" {.ape .str .dna .seq .gb}} {"All files" {"*"}}}]
  }


  while {([file isfile $filename] && ![file writable $filename]) && ($filename != "") } {
    set response [tk_messageBox -title [mc "File is not writable."] -message [mc "%s\nFile is locked. Do you want to unlock it (Yes), save it with a different name (No) or cancel save (Cancel?)" $filename] -type "yesnocancel"  -icon warning -default no]
    if {$response == "yes"} {
      set info($w,filename) $filename
      toggle_locked $w
      if {![file writable $filename]} {
        if {[winfo exists .dialog]} {
          set filename [tk_getSaveFile -title [mc "Sorry, couldn't unlock. Save File As..."] -initialdir $info(default_dnadir) -parent .dialog  -filetypes {{"ApE" {.ape .str .dna .seq .gb}} {"All files" {"*"}}}]
        } else {
          set filename [tk_getSaveFile -title [mc "Sorry, couldn't unlock. Save File As..."] -initialdir $info(default_dnadir)  -filetypes {{"ApE" {.ape .str .dna .seq .gb}} {"All files" {"*"}}}]
        }
        set info($w,filename) $filename
      }
    } elseif {$response == "no"} {
      if {[winfo exists .dialog]} {
        set filename [tk_getSaveFile -title [mc "Save File As..."] -initialdir $info(default_dnadir) -parent .dialog -filetypes {{"ApE" {.ape .str .dna .seq .gb}} {"All files" {"*"}}}]
      } else {
        set filename [tk_getSaveFile -title [mc "Save File As..."] -initialdir $info(default_dnadir) -filetypes {{"ApE" {.ape .str .dna .seq .gb}} {"All files" {"*"}}}]
      }
    } else {
      set filename ""
    }
  }
  if {[file extension $filename] == "."} {set filename "[file rootname $filename]$info(default_file_extension)"}
  if {([file extension $filename] == "") && ($filename != "")} {set filename "$filename$info(default_file_extension)"}

  if {$filename == ""} {return}
  if {$info(dnadir_follows_open)} {
    set info(default_dnadir) [file dirname $filename]
  }
  set url "https://eutils.ncbi.nlm.nih.gov/entrez/eutils/efetch.fcgi?[http::formatQuery tool ApE db nucleotide id $id retmode text rettype gb]"
  lassign [get_html $url] error html

  if {$error ne "ok" } {
    tk_messageBox -message [mc "Error opening NCBI connection: %s.\nTry again." $status] -type ok
  } elseif {$html =={}} {
    tk_messageBox -message [mc "No Data returned."] -type ok
  } else {
    set fid [open $filename w]
    puts $fid $html
    close $fid
    catch {open_file $filename}
  }
}

################
## recombination reaction window
################
#prototypes:
# name of prototype
# 2 element list of labels and sites
# labels list of labels foreach incomming fragment
# sites is a list of site names and directions for each site in the final product
# use the site name "end" if the final product is linear (this only has to be put as the first site, NOT first and last
# site names have to be found in the following info(recomb,sites) list
set info(recomb,prototypes) [list \
"BP Reaction (1-2)" [list [list "Insert" "Backbone"] [list attL1 0 attL2 1]] \
"Single-site LR Reaction (1-2)" [list [list "Insert" "Backbone"] [list attB1 0 attB2 1]] \
"BP Reaction (4-1)" [list [list "Insert" "Backbone"] [list attL4 0 attR1 0]] \
"BP Reaction (2-3)" [list [list "Insert" "Backbone"] [list attR2 1 attL3 1]] \
"Multi-site LR Reaction (4-1-2-3)" [list [list "Promoter" "Gene" "UTR" "Backbone"] [list attB4 0 attB1 0 attB2 1 attB3 1]] \
"BP Reaction (1-5)" [list [list "Insert" "Backbone"] [list attL1 0 attR5 0]] \
"BP Reaction (5-2)" [list [list "Insert" "Backbone"] [list attL5 0 attL2 1]] \
"Multi-site Pro LR Reaction (1-5-2)" {{"Fragment 1" "Fragment 2" Backbone} {attB1 0 attB5 0 attB2 1}} \
"BP Reaction (1-4)" [list [list "Insert" "Backbone"] [list attL1 0 attL4 1]] \
"BP Reaction (4-3)" [list [list "Insert" "Backbone"] [list attR4 1 attR3 0]] \
"BP Reaction (3-2)" [list [list "Insert" "Backbone"] [list attL3 0 attL2 1]] \
"Multi-site Pro LR Reaction (1-4-3-2)" {{"Fragment 1" "Fragment 2" "Fragment 3" Backbone} {attB1 0 attB4 1 attB3 0 attB2 1}} \
"BP Reaction (5-4)" [list [list "Insert" "Backbone"] [list attL5 0 attL4 1]] \
"Multi-site Pro LR Reaction (1-5-4-3-2)" {{"Fragment 1" "Fragment 2" "Fragment 3"  "Fragment 4" Backbone} {attB1 0 attB5 0 attB4 1 attB3 0 attB2 1}} \
"Multi-site LR Reaction (4-1-2)" {{Promoter Gene Backbone} {attB4 0 attB1 0 attB2 1}}\
"BP Reaction (1-2-2-1)" {{Insert Intron Insert(rev) Backbone} {attL1 0 attL2 1 attL2 0 attL1 1}}\
"Two part LoxP" [list [list "Acceptor" "Donor"] [list loxP 0 loxP 0]] \
]

set info(recomb,prototypes,default) $info(recomb,prototypes)
set info(recomb,circularize) 0


## recombination sites list
# list of left, overlapping and right side of the recombination site, then the left and right sides of the site that it recombines with (ex. these will be the left and right sides of the attP1 site for an attB1 site)
set info(recomb,sites) [list attP1 [list AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT GTACAAA AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG CMASTWT AAAGYWG]]
lappend info(recomb,sites) attP2 [list AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT GTACAAG AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG CMASTWT AAAGYWG]
lappend info(recomb,sites) attP3 [list AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT GTATAAT AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG CMASTWT AAAGYWG]
lappend info(recomb,sites) attP4 [list AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT GTATAGA AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG CMASTWT AAAGYWG]
lappend info(recomb,sites) attP5 [list AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT GTATACA AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG CMASTWT AAAGYWG]
lappend info(recomb,sites) attP6 [list AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT GTATTAA AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG CMASTWT AAAGYWG]

lappend info(recomb,sites) attB1 [list CMASTWT GTACAAA AAAGYWG AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG]
lappend info(recomb,sites) attB2 [list CMASTWT GTACAAG AAAGYWG AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG]
lappend info(recomb,sites) attB3 [list CMASTWT GTATAAT AAAGYWG AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG]
lappend info(recomb,sites) attB4 [list CMASTWT GTATAGA AAAGYWG AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG]
lappend info(recomb,sites) attB5 [list CMASTWT GTATACA AAAGYWG AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG]
lappend info(recomb,sites) attB6 [list CMASTWT GTATTAA AAAGYWG AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG]

lappend info(recomb,sites) attR1 [list CMASTWT GTACAAA AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT AAAGYWG]
lappend info(recomb,sites) attR2 [list CMASTWT GTACAAG AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT AAAGYWG]
lappend info(recomb,sites) attR3 [list CMASTWT GTATAAT AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT AAAGYWG]
lappend info(recomb,sites) attR4 [list CMASTWT GTATAGA AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT AAAGYWG]
lappend info(recomb,sites) attR5 [list CMASTWT GTATACA AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT AAAGYWG]
lappend info(recomb,sites) attR6 [list CMASTWT GTATTAA AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT AAAGYWG]

lappend info(recomb,sites) attL1 [list AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT GTACAAA AAAGYWG CMASTWT AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG]
lappend info(recomb,sites) attL2 [list AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT GTACAAG AAAGYWG CMASTWT AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG]
lappend info(recomb,sites) attL3 [list AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT GTATAAT AAAGYWG CMASTWT AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG]
lappend info(recomb,sites) attL4 [list AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT GTATAGA AAAGYWG CMASTWT AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG]
lappend info(recomb,sites) attL5 [list AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT GTATACA AAAGYWG CMASTWT AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG]
lappend info(recomb,sites) attL6 [list AAATAATGATTTTATTTTGACTGATAGTGACCTGTTCGTTGCAACAMATTGATRAGCAATKMTTTYTTATAATGCCMASTTT GTATTAA AAAGYWG CMASTWT AAAGYWGAACGAGAAACGTAAAATGATATAAATATCAATATATTAAATTAGATTTTGCATAAAAAACAGACTACATAATRCTGTAAAACACAACATATSCAGTCAYWWTG]

lappend info(recomb,sites) {FRT3} {GAAGTTCCTATTC TTCAAATA GTATAGGAACTTC GAAGTTCCTATTC GTATAGGAACTTC}
lappend info(recomb,sites) {FRT5} {GAAGTTCCTATTC CTTTTGAA GTATAGGAACTTC GAAGTTCCTATTC GTATAGGAACTTC}
lappend info(recomb,sites) {lox2272} {ATAACTTCGTATA GGATACTT TATACGAAGTTAT ATAACTTCGTATA TATACGAAGTTAT}
lappend info(recomb,sites) {loxN} {ATAACTTCGTATA GTATACCT TATACGAAGTTAT ATAACTTCGTATA TATACGAAGTTAT}
lappend info(recomb,sites) {lox511} {ATAACTTCGTATA ATGTATAC TATACGAAGTTAT ATAACTTCGTATA TATACGAAGTTAT}
lappend info(recomb,sites) {lox5171} {ATAACTTCGTATA ATGTGTAC TATACGAAGTTAT ATAACTTCGTATA TATACGAAGTTAT}
#lappend info(recomb,sites) {lox71} {TACCGTTCGTATA GCATACAT TATACGAAGTTAT TACCGTTCGTATA  TATACGAAGTTAT}
#lappend info(recomb,sites) {lox66} {ATAACTTCGTATA GCATACAT TATACGAACGGTA ATAACTTCGTATA TATACGAACGGTA}
lappend info(recomb,sites) {lox71/66} {TACCGTTCGTATA GCATACAT TATACGAACGGTA ATAACTTCGTATA TATACGAAGTTAT}
lappend info(recomb,sites) {loxP(wt from 71/66)} {ATAACTTCGTATA GCATACAT TATACGAAGTTAT TACCGTTCGTATA TATACGAACGGTA}
lappend info(recomb,sites) {D6Rox} {TAACTTTAAATA ATGCCAAT TATTTAAAGTTA TAACTTTAAATA TATTTAAAGTTA}
lappend info(recomb,sites) {Vox} {AATAGGTCTGAGA ACGCCCAT TCTCAGACGTATT AATAGGTCTGAGA TCTCAGACGTATT}
lappend info(recomb,sites) {B3RT} {GGTTGCTTAAGAAT AAGTA ATTCTTAAGCAACC GGTTGCTTAAGAAT ATTCTTAAGCAACC}

if {0} {
{ApE recombination site:} {attB1_PhiC31} {TGCGGGTGCCAGGGCGTGCCC TT GGGCTCCCCGGGCGCGTACTCC GTGCCCCAACTGGGGTAACCT GAGTTCTCTCAGTTGGGGG}
{ApE recombination site:} {attP1_PhiC31} {GTGCCCCAACTGGGGTAACCT TT GAGTTCTCTCAGTTGGGGG TGCGGGTGCCAGGGCGTGCCC GGGCTCCCCGGGCGCGTACTCC}
{ApE recombination site:} {attL1_PhiC31} {TGCGGGTGCCAGGGCGTGCCC TT GAGTTCTCTCAGTTGGGGG GTGCCCCAACTGGGGTAACCT GGGCTCCCCGGGCGCGTACTCC}
{ApE recombination site:} {attR1_PhiC31} {GTGCCCCAACTGGGGTAACCT TT  GGGCTCCCCGGGCGCGTACTCC TGCGGGTGCCAGGGCGTGCCC GAGTTCTCTCAGTTGGGGG}
## Adam's PhiC31 att sites
{ApE recombination site:} {attB1_PhiC31} {GGGTGCCAGGGCGTGCCC TT GGGCTCCCCGGGCGCGTA CCCCAACTGGGGTAACCT GAGTTCTCTCAGTTGGGGGCG}
{ApE recombination site:} {attP1_PhiC31} {CCCCAACTGGGGTAACCT TT GAGTTCTCTCAGTTGGGGGCG GGGTGCCAGGGCGTGCCC GGGCTCCCCGGGCGCGTA}
{ApE recombination site:} {attL1_PhiC31} {GGGTGCCAGGGCGTGCCC TT GAGTTCTCTCAGTTGGGGGCG CCCCAACTGGGGTAACCT GGGCTCCCCGGGCGCGTA}
{ApE recombination site:} {attR1_PhiC31} {CCCCAACTGGGGTAACCT TT  GGGCTCCCCGGGCGCGTA GGGTGCCAGGGCGTGCCC GAGTTCTCTCAGTTGGGGGCG}

{ApE recombination site:} {FRT} {GAAGTTCCTATTC TCTAGAAA GTATAGGAACTTC GAAGTTCCTATTC GTATAGGAACTTC}
{ApE recombination site:} {FRT3} {GAAGTTCCTATTC TTCAAATA GTATAGGAACTTC GAAGTTCCTATTC GTATAGGAACTTC}
{ApE recombination site:} {FRT5} {GAAGTTCCTATTC CTTTTGAA GTATAGGAACTTC GAAGTTCCTATTC GTATAGGAACTTC}
{ApE recombination site:} {loxP} {ATAACTTCGTATA GCATACAT TATACGAAGTTAT ATAACTTCGTATA TATACGAAGTTAT}
{ApE recombination site:} {lox2272} {ATAACTTCGTATA GGATACTT TATACGAAGTTAT ATAACTTCGTATA TATACGAAGTTAT}
{ApE recombination site:} {loxN} {ATAACTTCGTATA GTATACCT TATACGAAGTTAT ATAACTTCGTATA TATACGAAGTTAT}
{ApE recombination site:} {lox511} {ATAACTTCGTATA ATGTATAC TATACGAAGTTAT ATAACTTCGTATA TATACGAAGTTAT}
{ApE recombination site:} {lox5171} {ATAACTTCGTATA ATGTGTAC TATACGAAGTTAT ATAACTTCGTATA TATACGAAGTTAT}
{ApE recombination site:} {lox71} {TACCGTTCGTATA GCATACAT TATACGAAGTTAT TACCGTTCGTATA  TATACGAAGTTAT}
{ApE recombination site:} {lox66} {ATAACTTCGTATA GCATACAT TATACGAACGGTA ATAACTTCGTATA TATACGAACGGTA}
{ApE recombination site:} {lox71/66} {TACCGTTCGTATA GCATACAT TATACGAACGGTA ATAACTTCGTATA TATACGAAGTTAT}
{ApE recombination site:} {loxP(wt from 71/66)} {ATAACTTCGTATA GCATACAT TATACGAAGTTAT TACCGTTCGTATA TATACGAACGGTA}
{ApE recombination site:} {D6Rox} {TAACTTTAAATA ATGCCAAT TATTTAAAGTTA TAACTTTAAATA TATTTAAAGTTA}
{ApE recombination site:} {Vox} {AATAGGTCTGAGA ACGCCCAT TCTCAGACGTATT AATAGGTCTGAGA TCTCAGACGTATT}
{ApE recombination site:} {B3RT} {GGTTGCTTAAGAAT AAGTA ATTCTTAAGCAACC GGTTGCTTAAGAAT ATTCTTAAGCAACC}
{ApE recombination site:} {B3RT2} {GGTTGCTTAAGATA ATGAA ATTCTTAAGCAACC GGTTGCTTAAGATA ATTCTTAAGCAACC}
}

#lappend info(recomb,sites) attB1_PhiC31 [list TGCGGGTGCCAGGGCGTGCCC TT GGGCTCCCCGGGCGCGTACTCC GTGCCCCAACTGGGGTAACCT GAGTTCTCTCAGTTGGGGG]
#lappend info(recomb,sites) attP1_PhiC31 [list GTGCCCCAACTGGGGTAACCT TT GAGTTCTCTCAGTTGGGGG TGCGGGTGCCAGGGCGTGCCC GGGCTCCCCGGGCGCGTACTCC]
#lappend info(recomb,sites) attL1_PhiC31 [list TGCGGGTGCCAGGGCGTGCCC TT GAGTTCTCTCAGTTGGGGG GTGCCCCAACTGGGGTAACCT GGGCTCCCCGGGCGCGTACTCC]
#lappend info(recomb,sites) attR1_PhiC31 [list GTGCCCCAACTGGGGTAACCT TT  GGGCTCCCCGGGCGCGTACTCC TGCGGGTGCCAGGGCGTGCCC GAGTTCTCTCAGTTGGGGG]

lappend info(recomb,sites) FRT [list GAAGTTCCTATTC TCTAGAAA GTATAGGAACTTC GAAGTTCCTATTC GTATAGGAACTTC]
lappend info(recomb,sites) FRT3 [list GAAGTTCCTATTC TTCAAATA GTATAGGAACTTC GAAGTTCCTATTC GTATAGGAACTTC]
#lappend info(recomb,sites) FRT5 [list GAAGTTCCTATTC CTTTTGAA GTATAGGAACTTC GAAGTTCCTATTC GTATAGGAACTTC]
lappend info(recomb,sites) loxP [list ATAACTTCGTATA GCATACAT TATACGAAGTTAT ATAACTTCGTATA TATACGAAGTTAT]
#lappend info(recomb,sites) lox2272 [list ATAACTTCGTATA GGATACTT TATACGAAGTTAT ATAACTTCGTATA TATACGAAGTTAT]
#lappend info(recomb,sites) loxN [list ATAACTTCGTATA GTATACCT TATACGAAGTTAT ATAACTTCGTATA TATACGAAGTTAT]
#lappend info(recomb,sites) lox511 [list ATAACTTCGTATA ATGTATAC TATACGAAGTTAT ATAACTTCGTATA TATACGAAGTTAT]
#lappend info(recomb,sites) lox5171 [list ATAACTTCGTATA ATGTGTAC TATACGAAGTTAT ATAACTTCGTATA TATACGAAGTTAT]

#lappend info(recomb,sites) D6Rox [list TAACTTTAAATA ATGCCAAT TATTTAAAGTTA TAACTTTAAATA TATTTAAAGTTA]
#lappend info(recomb,sites) Vox [list AATAGGTCTGAGA ACGCCCAT TCTCAGACGTATT AATAGGTCTGAGA TCTCAGACGTATT]
#lappend info(recomb,sites) B3RT [list GGTTGCTTAAGAAT AAGTA ATTCTTAAGCAACC GGTTGCTTAAGAAT ATTCTTAAGCAACC]

lappend info(recomb,sites) end [list]
set info(recomb,sites,default) $info(recomb,sites)

###################
##
####################
proc recomb_dialog {w} {
  global info recomb_temp ok dialogblock

  if {$dialogblock ==  1} {return}
  set t [new_dialog $w "Recombination Reaction..." "DONE"]
  bind $t <<Cancel>> "set ok -1"
  bind $t <<OK>> "set ok 1"
  set ok 0



  grid [frame $t.listframe -width 70] -row 1 -column 1 -rowspan 3 -sticky nswe
  grid [set tv [ttk::treeview $t.listframe.tv -yscrollcommand "optionscrollbar $t.listframe.sc" -selectmode browse]] -row 1 -column 1 -stick nswe
  grid [scrollbar $t.listframe.sc -orient vertical -command "if {\[winfo exists $t.listframe.entry] && (\[place configure $t.listframe.entry] != {})} {place forget $t.listframe.entry}; $t.listframe.tv yview"] -row 1 -column 2 -stick nswe
  grid rowconfigure $t.listframe 1 -weight 1
  grid columnconfigure $t.listframe 1 -weight 1

  grid [frame $t.mainframe -width 500 -height 450] -row 1 -column 2 -sticky nswe
  grid [frame $t.frame2 -width 500 -height 1] -row 2 -column 2 -sticky nswe
  grid [frame $t.frame3] -row 3 -column 2 -stick nswe

  grid [frame $t.reactionframe -relief ridge -borderwidth 2] -row 4 -column 1 -columnspan 2 -sticky nswe
  grid [button $t.reactionframe.new -text [mc "New Reaction"] -command "recomb_dialog_add_reaction $tv new"] -row 1 -column 0 -sticky ns
  grid [button $t.reactionframe.new_dup -text [mc "Duplicate Reaction"] -command "recomb_dialog_add_reaction $tv duplicate"] -row 1 -column 1 -sticky ns
  grid [button $t.reactionframe.new_del -text [mc "Remove Reaction"] -command "recomb_dialog_delete_reaction $tv"] -row 1 -column 2 -sticky ns
  tooltip_install $t.reactionframe.new_del [mc "Backspace or Delete key will also delete a reaction"]
  grid [button $t.reactionframe.reset -text [mc "Reset to Default"] -command "recomb_dialog_reset_defaults $tv"] -row 1 -column 3 -sticky ns
  grid [button $t.reactionframe.new_clip -text [mc "New Reaction From Clipboard"] -command "recomb_dialog_add_reaction $tv new_fromclip"] -row 2 -column 0 -sticky ns
  grid [button $t.reactionframe.cop_to_clip -text [mc "Copy Reaction To Clipboard"] -command "recomb_dialog_reaction_to_clipboard $tv "] -row 2 -column 1 -sticky ns
  grid [button $t.reactionframe.new_heading -text [mc "New Heading"] -command "recomb_dialog_add_reaction $tv new_heading"] -row 2 -column 2 -sticky ns

  grid [frame $t.editsitesframe -relief ridge -borderwidth 2] -row 5 -column 1 -columnspan 2 -sticky nswe
  #grid [button $t.editsitesframe.edit_sites -text [mc "Edit Sites"] -command "recomb_dialog_edit_sites $t.editsitesframe"] -row 0 -column 0 -sticky ns
  grid [menubutton $t.editsitesframe.menubutton -menu $t.editsitesframe.menubutton.menu -textvariable recomb_temp(menu_site_name)] -row 0 -column 0 -sticky nw
  menu $t.editsitesframe.menubutton.menu -postcommand "recomb_dialog_edit_sites_fill_menu $t.editsitesframe"
  set recomb_temp(menu_site_name) "Edit Site..."
  
  grid [frame $t.okframe  -relief ridge  -borderwidth 2] -row 6 -column 1 -columnspan 2 -sticky nswe
  grid [button $t.okframe.ok -text [mc "OK"] -command "set ok 1"] -row 4 -column 0 -sticky nswe
  grid rowconfigure $t 1 -weight 1
  grid columnconfigure $t 1 -weight 1
  grid columnconfigure $t 2 -weight 1


  bind $tv <<OldSelection>> {}
  bind $tv <B1-Motion> "treeview_move $tv %x %y"
  bind $tv <Key-Delete> "recomb_dialog_delete_reaction $tv"
  bind $tv <Key-BackSpace> "recomb_dialog_delete_reaction $tv"
  bind $tv <ButtonRelease-1> "treeview_release $tv %x %y"
  bind $tv <Double-ButtonPress-1> "treeview_edit_item $t.listframe.tv \[$t.listframe.tv identify item %x %y\] \[$t.listframe.tv identify column %x %y\]"
  bind $tv <MouseWheel> "if {\[winfo exists $t.listframe.entry] && (\[place configure $t.listframe.entry] != {})} {place forget $t.listframe.entry}"
  bind $tv <<TreeviewSelect>> "recomb_dialog_fill_mainframe $t.mainframe \[$tv set \[lindex \[$tv selection\] 0\] data\]"
  bind $t.mainframe <<Tv>> $tv
  $tv configure -columns {data} -displaycolumns {}
  $tv tag configure heading -background gray70 -foreground gray30
  $tv heading #0 -text [mc "Reaction"] -command ""
  $tv column #0 -width [font measure labelfont "Multi-site Pro LR Reaction (1-5-4-3-2)XXXXX"] -anchor e
  $tv heading data -text data
  $tv delete [$tv children {}]
  foreach {name data} $info(recomb,prototypes) {
    if {$data == ""} {set tags heading} else {set tags ""}
    catch {$tv insert {} end -text $name -values [list $data] -tags $tags} 
  }
  $tv selection set [list [lindex [$tv children {}] 0]]

  vwait ok

  if {$ok == 1} {
    ## store the last edits in the sites, if exists
    recomb_dialog_edit_sites_do_entry $t.editsitesframe
    recomb_dialog_tv_to_prototypes $tv
  }

  destroy $t
  set dialogblock 0
  bind . <<RaiseDialogs>> ""

  unset ok
  array unset recomb_temp
}

###################
##
####################
proc recomb_dialog_delete_reaction {tv} {
  if {[llength [$tv children {}]] >1} {
    set ix [$tv index [lindex [$tv selection] 0]]
    if {[lindex [$tv children {}] end] == [lindex [$tv selection] 0]} {
      incr ix -1
    }
    $tv delete [$tv selection]
     $tv selection set [list [lindex [$tv children {}] $ix]]
  }
}

###################
##
####################
proc recomb_dialog_reaction_to_clipboard {tv} {
  if {[llength [$tv children {}]] >1} {
    set temp [list "ApE recombination reaction:"]
    set ix [lindex [$tv selection] 0]
    set data [$tv set $ix data]
    lappend temp [$tv item $ix -text] $data
    clipboard clear 
    clipboard_append -displayof [winfo toplevel $tv] $temp
    selection own -selection CUT_BUFFER0 [winfo toplevel $tv]
  }
}

###################
##
####################
proc recomb_dialog_reset_defaults {tv} {
  global info
  set info(recomb,prototypes) $info(recomb,prototypes,default)
  $tv delete [$tv children {}]
  foreach {name data} $info(recomb,prototypes) {
    if {$data == ""} {set tags heading} else {set tags ""}
    catch {$tv insert {} end -text $name -values [list $data] -tags $tags} 
  }
  $tv selection set [list [lindex [$tv children {}] 0]]
}

###################
##
####################
proc recomb_dialog_add_reaction {tv {mode new}} {
  global info tcl_platform
  switch $mode {
    new {
      set data [list [list Insert Backbone] [list [lindex $info(recomb,sites) 0] 0 [lindex $info(recomb,sites) 0] 0]]
      set name "New Reaction"
      set tags ""
    }
    new_fromclip {

      if {($tcl_platform(platform) == "unix") && ([tk windowingsystem] != "aqua")} {
        if {[catch {selection get -displayof [winfo toplevel $tv] -selection CLIPBOARD} clip_data]} {sputs error clip_data $clip_data;return}
      } else {
        if {[catch {clipboard get} clip_data]} {sputs error clip_data $clip_data;return}
      }
sputs clip_data $clip_data
      if {[lindex $clip_data 0] == "ApE recombination reaction:" && ([llength $clip_data] == 3)} {
        set data [lindex $clip_data 2]
        set name [lindex $clip_data 1]
        set tags ""
      } else {
        tk_messageBox -message [mc "The clipboard doesn't contain a recombination reaction."] -type ok
        return
      }
    }
    new_heading {
      set data ""
      set name "New Heading"
      set tags "heading"
    }
    duplicate  {
      set data [$tv set [lindex [$tv selection] 0] data]
      set name [$tv item [lindex [$tv selection] 0] -text]
      set tags ""
    }
  }
  set i [$tv index [lindex [$tv selection] 0]]

  set id [$tv insert {} $i -text $name -tags $tags -values [list $data]]
  $tv selection set [list $id]
}

###################
##
####################
proc recomb_dialog_fill_mainframe {f data} {
  global recomb_temp info
  set i 0
  if {$data == ""} {grid remove $f; return} else {grid configure $f} 
  trace remove variable recomb_temp write "recomb_dialog_mainframe_to_tv $f;#"
  foreach name [lindex $data 0] {site dir} [lindex $data 1] {
    if {![winfo exists $f.frame$i]} {
      frame $f.frame$i
      grid $f.frame$i -row $i -column 0 -sticky nwe
      #grid [label $f.frame$i.dir] -row 0 -column 0 -sticky nw
      grid [menubutton $f.frame$i.dir -textvariable recomb_temp(dir_t$i) -menu $f.frame$i.dir.menu -indicatoron 1 -relief raised -width 12] -row 0 -column 0 -sticky nw
        menu $f.frame$i.dir.menu
        foreach dir_t [list  "Forward" "Reverse"] dir_n [list 0 1] {
          $f.frame$i.dir.menu add radiobutton -label $dir_t -indicatoron 1 -value $dir_n -variable recomb_temp(dir$i) -command "set recomb_temp(dir_t$i) $dir_t"
        }
      #grid [label $f.frame$i.site] -row 0 -column 1 -sticky nw
      grid [menubutton $f.frame$i.site -textvariable recomb_temp(site$i) -menu $f.frame$i.site.menu -indicatoron 1 -relief raised -width 12] -row 0 -column 1 -sticky nw
        menu $f.frame$i.site.menu
        foreach {site_t sdata} $info(recomb,sites) {
          if {$i > 0 && $site_t eq "end" && $sdata eq {}} {
            continue
          }
          $f.frame$i.site.menu add radiobutton -label $site_t -indicatoron 1 -value $site_t -variable recomb_temp(site$i)
        }
      grid [entry $f.frame$i.name -textvariable recomb_temp(name$i)] -row 0 -column 2 -sticky nw
      grid [label $f.frame$i.site2 -width 5] -row 0 -column 3 -sticky nw
      grid [button $f.frame$i.new_below -text [mc "New Fragment Below"] -command "recomb_dialog_new_frag [expr {$i+1}] $f" ] -row 0 -column 4 -sticky ne
      if {$i >0} {
        grid [button $f.frame$i.delete -text [mc "Delete"] -command "recomb_dialog_delete_frag $i $f"] -row 0 -column 5 -sticky ne
      } else {
        grid [button $f.frame$i.new_above -text [mc "New Fragment Above"] -command "recomb_dialog_new_frag 0 $f"] -row 0 -column 5 -sticky ne
      }
    }
    $f.frame$i.dir configure -text $dir
    $f.frame$i.site configure -text $site
    set recomb_temp(name$i) $name
    set recomb_temp(dir$i) $dir
    set recomb_temp(dir_t$i) [expr {$dir?"Reverse":"Forward"}]
    set recomb_temp(site$i) $site
    incr i
  }
  while {[winfo exists $f.frame$i]} {
    destroy $f.frame$i
    array unset recomb_temp name$i
    array unset recomb_temp dir$i
    array unset recomb_temp dir_t$i
    array unset recomb_temp site$i
    incr i
  }
  for {set i 0} {[winfo exists $f.frame[expr {$i+1}].site2]} {incr i} {
    $f.frame$i.site2 configure -textvariable recomb_temp(site[expr {$i+1}])
  }
  $f.frame$i.site2 configure -textvariable recomb_temp(site0)
  trace add variable recomb_temp write "recomb_dialog_mainframe_to_tv $f;#"
}

###################
##
####################
proc recomb_dialog_delete_frag {frag f} {
  global recomb_temp
  trace remove variable recomb_temp write "recomb_dialog_mainframe_to_tv $f;#"
  for {set i $frag} {[info exists recomb_temp(name[expr {$i+1}])]} {incr i} {
    set recomb_temp(name$i) $recomb_temp(name[expr {$i+1}])
    set recomb_temp(dir$i) $recomb_temp(dir[expr {$i+1}])
    set recomb_temp(dir_t$i) $recomb_temp(dir_t[expr {$i+1}])
    set recomb_temp(site$i) $recomb_temp(site[expr {$i+1}])
  }
  destroy $f.frame$i
  unset recomb_temp(name$i)
  unset recomb_temp(dir$i)
  unset recomb_temp(dir_t$i)
  unset recomb_temp(site$i)
  recomb_dialog_mainframe_to_tv $f
  for {set i 0} {[winfo exists $f.frame[expr {$i+1}].site2]} {incr i} {
    $f.frame$i.site2 configure -textvariable recomb_temp(site[expr {$i+1}])
  }
  $f.frame$i.site2 configure -textvariable recomb_temp(site0)
  trace add variable recomb_temp write "recomb_dialog_mainframe_to_tv $f;#"
}

###################
##
####################
proc recomb_dialog_new_frag {frag f} {
  global recomb_temp info
  trace remove variable recomb_temp write "recomb_dialog_mainframe_to_tv $f;#"
  set i 0
  while {[info exists recomb_temp(name$i)]} {
    incr i
  }

  frame $f.frame$i
  grid $f.frame$i -row $i -column 0 -sticky nwe
  #grid [label $f.frame$i.dir] -row 0 -column 0 -sticky nw
  grid [menubutton $f.frame$i.dir -textvariable recomb_temp(dir_t$i) -menu $f.frame$i.dir.menu -indicatoron 1 -relief raised -width 12] -row 0 -column 0 -sticky nw
    menu $f.frame$i.dir.menu
    foreach dir_t [list "Forward"  "Reverse"] dir_n [list 0 1] {
      $f.frame$i.dir.menu add radiobutton -label $dir_t -indicatoron 1 -value $dir_n -variable recomb_temp(dir$i) -command "set recomb_temp(dir_t$i) $dir_t"
    }
  #grid [label $f.frame$i.site] -row 0 -column 1 -sticky nw
   grid [menubutton $f.frame$i.site -textvariable recomb_temp(site$i) -menu $f.frame$i.site.menu -indicatoron 1 -relief raised -width 12] -row 0 -column 1 -sticky nw
      menu $f.frame$i.site.menu
      foreach {site_t sdata} $info(recomb,sites) {
        $f.frame$i.site.menu add radiobutton -label $site_t -indicatoron 1 -value $site_t -variable recomb_temp(site$i)
      }
      if {$i == 0} {
        $f.frame$i.site.menu add radiobutton -label [mc "end"] -indicatoron 1 -value "end" -variable recomb_temp(site$i)
      }
  grid [entry $f.frame$i.name -textvariable recomb_temp(name$i)] -row 0 -column 2 -sticky nw
  grid [label $f.frame$i.site2 -textvariable recomb_temp(site0) -width 5] -row 0 -column 3 -sticky nw
  grid [button $f.frame$i.new_below -text [mc "New Fragment Below"] -command "recomb_dialog_new_frag [expr {$i+1}] $f"] -row 0 -column 4 -sticky ne
  grid [button $f.frame$i.delete -text [mc "Delete"] -command "recomb_dialog_delete_frag $i $f"] -row 0 -column 5 -sticky ne
  $f.frame$i.dir configure -text "temp$i"
  $f.frame$i.site configure -text "temp$i"

  for {set j $i} {$j > $frag} {incr j -1} {
    set recomb_temp(name$j) $recomb_temp(name[expr {$j-1}])
    set recomb_temp(dir$j) $recomb_temp(dir[expr {$j-1}])
    set recomb_temp(dir_t$j) $recomb_temp(dir_t[expr {$j-1}])
    if {$recomb_temp(site[expr {$j-1}]) ne "end"} {
      set recomb_temp(site$j) $recomb_temp(site[expr {$j-1}])
    } else {
      set recomb_temp(site$j) [lindex $info(recomb,sites) 0]
    }
  }
  set recomb_temp(name$frag) "New Fragment $frag"
  set recomb_temp(dir$frag) 0
  set recomb_temp(dir_t$frag)  "Forward"
  set recomb_temp(site$frag) [lindex $info(recomb,sites) 0]
  recomb_dialog_mainframe_to_tv $f
  for {set i 0} {[winfo exists $f.frame[expr {$i+1}].site2]} {incr i} {
    $f.frame$i.site2 configure -textvariable recomb_temp(site[expr {$i+1}])
  }
  $f.frame$i.site2 configure -textvariable recomb_temp(site0)
  trace add variable recomb_temp write "recomb_dialog_mainframe_to_tv $f;#"
}

###################
##
####################
proc recomb_dialog_mainframe_to_tv {f} {
  global recomb_temp
  set name_list [list]
  set sites_list [list]
  for {set i 0} {[info exists recomb_temp(name$i)]} {incr i} {
    lappend name_list $recomb_temp(name$i)
    lappend sites_list $recomb_temp(site$i) $recomb_temp(dir$i)
  }
  set tv [bind $f <<Tv>>]
  $tv set [lindex [$tv selection] 0] data [list $name_list $sites_list]
}

###################
##
####################
proc recomb_dialog_tv_to_prototypes {tv} {
  global info
  set temp [list]
  foreach p [$tv children {}] {
    set data [$tv set $p data]
    lappend temp [$tv item $p -text] $data
  }
  set info(recomb,prototypes) $temp
}

###################
##
####################
proc recomb_dialog_edit_sites {f} {
  global info recomb_temp
  grid [frame $f.menuframe] -row 0 -column 0 -sticky nswe
  grid [entry $f.menuframe.sitename -width 15 -textvariable recomb_temp(entry_site_name)] -row 0 -column 1 -sticky nw
  grid [button $f.menuframe.site_do -text [mc "OK"] -command "recomb_dialog_edit_sites_do_entry $f"] -row 0 -column 2 -sticky nw

  grid [button $f.menuframe.site_del -text [mc "Delete this Site"] -command "set recomb_temp(entry_site_name) {}; recomb_dialog_edit_sites_do_entry $f"] -row 0 -column 3 -sticky nw
  grid [frame $f.siteframe] -row 1 -column 0 -sticky nswe
  grid [entry $f.siteframe.site0 -width 50 -textvariable recomb_temp(entry_site0) -justify right] -row 0 -column 0 -sticky nswe
  grid [entry $f.siteframe.site1 -width 10 -textvariable recomb_temp(entry_site1)] -row 0 -column 1 -sticky ns
  grid [entry $f.siteframe.site2 -width 50 -textvariable recomb_temp(entry_site2)] -row 0 -column 2 -sticky nswe
  grid [label $f.siteframe.x -text "X"] -row 1 -column 1 -sticky ns
  grid [entry $f.siteframe.site3 -width 50 -textvariable recomb_temp(entry_site3) -justify right] -row 2 -column 0 -sticky nswe
  grid [entry $f.siteframe.site4 -width 50 -textvariable recomb_temp(entry_site4)] -row 2 -column 2 -sticky nswe
  grid [checkbutton $f.siteframe.same -text [mc "Same"] -variable recomb_temp(entry_same) -onvalue 1 -offvalue 0 -command "recomb_dialog_edit_sites_process_same $f"] -row 2 -column 3 -sticky ns
  
  grid columnconfigure $f.siteframe 0 -weight 1
  grid columnconfigure $f.siteframe 2 -weight 1
  grid columnconfigure $f 0 -weight 1
  
  set recomb_temp(entry_same) 0
  #set recomb_temp(menu_site_name) [lindex [dict keys $info(recomb,sites)] 0]
  recomb_dialog_edit_sites_fill_sites $f $recomb_temp(menu_site_name)
}

###################
##
####################
proc recomb_dialog_edit_sites_do_entry {f} {
  global info recomb_temp
  if {![info exists recomb_temp(menu_site_name)] ||![info exists recomb_temp(entry_site_name)] } {return}
  if {($recomb_temp(menu_site_name) eq $recomb_temp(entry_site_name))} {
    dict set info(recomb,sites) $recomb_temp(entry_site_name) [list $recomb_temp(entry_site0) $recomb_temp(entry_site1) $recomb_temp(entry_site2) $recomb_temp(entry_site3) $recomb_temp(entry_site4)]
  } elseif {$recomb_temp(entry_site_name) eq ""} {
    dict unset info(recomb,sites) $recomb_temp(menu_site_name)
    #recomb_dialog_edit_sites_fill_sites $f [lindex [dict keys $info(recomb,sites)] 0]
  } else {
    dict unset info(recomb,sites) $recomb_temp(menu_site_name)
    dict set info(recomb,sites) $recomb_temp(entry_site_name) [list $recomb_temp(entry_site0) $recomb_temp(entry_site1) $recomb_temp(entry_site2) $recomb_temp(entry_site3) $recomb_temp(entry_site4)]
  }

  destroy $f.menuframe
  destroy $f.siteframe
  set recomb_temp(menu_site_name) "Edit Site..."
}

###################
##
####################
proc recomb_dialog_edit_sites_fill_menu {f} {
  global info
  $f.menubutton.menu delete 0 end
  foreach site [dict keys $info(recomb,sites)] {
    if {$site ne "end"} {
      $f.menubutton.menu add radiobutton -label $site -variable recomb_temp(menu_site_name) -value $site -command "recomb_dialog_edit_sites $f"
    }
  }
  $f.menubutton.menu add separator
  $f.menubutton.menu add command -label [mc "New Site..."]  -command "recomb_dialog_edit_sites_new_site $f"
  $f.menubutton.menu add command -label [mc "New Site From Clipboard..."]  -command "recomb_dialog_new_site_from_clip"
  $f.menubutton.menu add command -label [mc "Reset all sites to default"]  -command "set info(recomb,sites) \$info(recomb,sites,default)"

  # update sites menus in reactions
  set t [winfo toplevel $f]
  for {set i 0} {[winfo exists $t.mainframe.frame$i.site.menu]} {incr i} {
    $t.mainframe.frame$i.site.menu delete 0 end
    foreach {site_t sdata} $info(recomb,sites) {
      if {$i > 0 && $site_t eq "end" && $sdata eq {}} {
        continue
      }
      $t.mainframe.frame$i.site.menu add radiobutton -label $site_t -indicatoron 1 -value $site_t -variable recomb_temp(site$i)
    }
  }
 
}

###################
##
####################
proc recomb_dialog_edit_sites_new_site {f} {
  global recomb_temp info
  set recomb_temp(menu_site_name) "New Site"
  if {[dict exists $info(recomb,sites) $recomb_temp(menu_site_name)]} {
    set i 1
    while {[dict exists $info(recomb,sites) "New Site$i"]} {
      incr i
    }
    set recomb_temp(menu_site_name) "New Site$i"
  }
  dict set info(recomb,sites) $recomb_temp(menu_site_name) [list A A A T T]
  recomb_dialog_edit_sites $f
}

###################
##
####################
proc recomb_dialog_edit_sites_process_same {f} {
  global recomb_temp
  if {$recomb_temp(entry_same)} {
    grid remove $f.siteframe.site3
    grid remove $f.siteframe.site4
  } else {
    grid configure $f.siteframe.site3
    grid configure $f.siteframe.site4
  }
}

###################
##
####################
proc recomb_dialog_new_site_from_clip {} {
  global info recomb_temp tcl_platform
  ## try getting from clipboard
  if {($tcl_platform(platform) == "unix") && ([tk windowingsystem] != "aqua")} {
    if {[catch {selection get -displayof [winfo toplevel $tv] -selection CLIPBOARD} clip_data]} {sputs error clip_data $clip_data;return}
  } else {
    if {[catch {clipboard get} clip_data]} {sputs error clip_data $clip_data;return}
  }

  if {[lindex $clip_data 0] == "ApE recombination site:" && ([llength $clip_data] == 3)} {
    set site_list [lindex $clip_data 2]
    if {[llength $site_list] != 5} {
      tk_messageBox -message [mc "The clipboard data doesn't have the correct format."] -type ok
      return
    }
    set site [lindex $clip_data 1]
  } else {
    tk_messageBox -message [mc "The clipboard doesn't contain a recombination site."] -type ok
    return
  } 
  dict set info(recomb,sites) $site $site_list
  set recomb_temp(menu_site_name) "Edit Site..."
}

###################
##
####################
proc recomb_dialog_edit_sites_fill_sites {f site} {
  global info recomb_temp
  if {[dict exists $info(recomb,sites) $site]} {
    set site_list [dict get $info(recomb,sites) $site]
    set recomb_temp(entry_site_name) $site
  } else {
    set site [lindex [dict keys $info(recomb,sites)] 0]
    set site_list [dict get $info(recomb,sites) $site]
    set recomb_temp(entry_site_name) $site
  }
  
  for {set i 0} {$i < 5} {incr i} {
    set recomb_temp(entry_site$i) [lindex $site_list $i]
  }
  if {($recomb_temp(entry_site0) == $recomb_temp(entry_site3)) && ($recomb_temp(entry_site2) == $recomb_temp(entry_site4))} {
    set recomb_temp(entry_same) 1
  } else {
    set recomb_temp(entry_same) 0
  }
  if {[winfo exists $f.siteframe.site3] } {
    recomb_dialog_edit_sites_process_same $f
  }
}

###################
##
####################
proc recombination_window {w} {
  global info modifier dialogblock 
  global ok recomb_prototype recomb_window recomb_data toolbar_images

  if {$dialogblock == 1} {return}
  set a [new_dialog $w "Recombination Reaction..." "NEW DNA"]
  bind $a <<Cancel>> "set ok -1"
  bind $a <<OK>> "set ok 1"
  set ok 0

  grid [frame $a.typeframe -relief ridge -borderwidth 2] -row 1 -column 1 -sticky nswe
  grid [menubutton $a.typeframe.menubutton -textvariable recomb_prototype -menu $a.typeframe.menubutton.menu -indicator on -relief raised] -row 1 -column 1
  set recomb_prototype [mc "Choose a Recombination Prototype"]
  menu $a.typeframe.menubutton.menu
  set maxwidth 15
  set mi 0
  foreach {name proto_info} $info(recomb,prototypes) {
    if {$proto_info == {}} {
      if {$mi > 0} {
        $a.typeframe.menubutton.menu add separator
      }
      $a.typeframe.menubutton.menu add command -label [mc $name] -state disabled
    } else {
      $a.typeframe.menubutton.menu add radiobutton -label [mc $name] -variable recomb_prototype -value $name -command "fill_recomb_reation_frame $a"
    }
    incr mi
    if {[string length $name] > $maxwidth} {set maxwidth [string length $name]}   
  }
  incr maxwidth 3
  if {$maxwidth > 200} {set maxwidth 200}
  $a.typeframe.menubutton configure -width $maxwidth
  
  grid [labelframe $a.reactionframe -relief ridge -borderwidth 2 -text [mc "Recombination Reaction Product"]] -row 2 -column 1 -sticky nswe

  grid [frame $a.okframe] -row 3 -column 1 -sticky nswe
  grid [button $a.okframe.cancel -text [mc "Cancel"] -command "set ok -1"] -row 1 -column 0 -sticky nw -padx 10 -pady 3
  grid [button $a.okframe.ok -text [mc "OK"] -command "set ok 1" -default active] -row 1 -column 1 -sticky nw -padx 10 -pady 3
  grid [checkbutton $a.okframe.circularize -text [mc "Treat All Sequences as Circular"] -command "if {\$recomb_prototype ne \[mc {Choose a Recombination Prototype}\]} {fill_recomb_reation_frame $a}" -variable info(recomb,circularize)] -row 2 -column 0 -columnspan 2 -sticky w
  grid [checkbutton $a.okframe.keep_open -text [mc "Keep Recombination Dialog Open"] -variable info(recomb_keep_open)] -row 3 -column 0 -columnspan 2 -sticky w
  if {$info(android)} {
    grid remove $a.okframe
  }
  set info(recomb_keep_open) 0

  set continue 1
  while  {$continue} {

    vwait ok

    if {$recomb_prototype == [mc "Choose a Recombination Prototype"]} {
      set ok -1
    }
    if {$ok == 1} {
      set continue $info(recomb_keep_open)
    } else {
      set continue 0
    }



    if {!($info(recomb_keep_open) && ($ok==1))} {
      destroy $a
      set dialogblock 0
      bind . <<RaiseDialogs>> ""
    }
  if {$ok == 1} {
    set w1 [create_window]
    array set proto_list $info(recomb,prototypes)
    set label_list [lindex $proto_list($recomb_prototype) 0]
    set sites_list [lindex $proto_list($recomb_prototype) 1]
    if {[lindex [lindex $proto_list($recomb_prototype) 1] 0] != "end"} {
      set info($w1,circular) "circular"
      $w1.menubar.edit  entryconfigure [mc "Set Origin"] -state normal
      $w1.menubar.edit  entryconfigure [mc "Linearize @ insert site"] -state normal
      #$w1.infoframe.circular configure -image $toolbar_images(circular)
      set info($w1,circular_text) [mc $info($w1,circular)]
    }
    set comment_text ""

    foreach fragment [lsort -integer [array names recomb_data]] label $label_list {site_name site_direction} $sites_list {
###bug: need to generate dna and tags to pass to create window, NOT create window and add dna and tags
      set rev_com [lindex $recomb_data($fragment) 0]
      set source [lindex $recomb_data($fragment) 1]
      set start [lindex $recomb_data($fragment) 2]
      set end [lindex $recomb_data($fragment) 3]
      set prev_end [end_ix $w1.textarea]
      if {($info($source,filename) ne "")} {
        append comment_text "$label from [file root [file tail $info($source,filename)]] [expr {$start+1}] to [expr {$end+1}]\n"
      }
      incr end
      if {$fragment ==0} {
        set final_site_name $site_name
        set final_site_direction $site_direction
        set site_name ""
        set site_direction 0
      }
      if {$start < $end} {
        if {!$rev_com} {
          textarea_insert $w1.textarea [end_ix $w1.textarea] [set new_text [textarea_get $source.textarea [bp2ix $source.textarea $start] [bp2ix $source.textarea $end]]]
          put_tags $w1.textarea [list $prev_end [end_ix $w1.textarea]] [recomb_extract_recomb_site_tags [list 0 [string length $new_text]] [get_tags $source.textarea [list [bp2ix $source.textarea $start] [bp2ix $source.textarea $end]]]]
        } else {
          textarea_insert $w1.textarea [end_ix $w1.textarea] [set new_text [revcom [textarea_get $source.textarea [bp2ix $source.textarea $start] [bp2ix $source.textarea $end]]]]
          put_tags $w1.textarea [list $prev_end [end_ix $w1.textarea]] [recomb_extract_recomb_site_tags [list 0 [string length $new_text]]  [get_tags $source.textarea [list [bp2ix $source.textarea $start] [bp2ix $source.textarea $end]] reverse]]
        }
recomb_add_new_site_tags $w1.textarea $prev_end  $site_name $site_direction
      } else {
        if {($fragment == [lindex [lsort -integer [array names recomb_data]] end]) && ($info(recomb,circularize) || $info($w1,circular) == "circular")} {
          #if last fragment && circular product, put the fragment 1.0-end at the beginning of the file, not the end
          if {!$rev_com} {
            textarea_insert $w1.textarea [end_ix $w1.textarea] [set new_text [textarea_get $source.textarea [bp2ix $source.textarea $start] [end_ix $source.textarea]]]
            put_tags $w1.textarea [list $prev_end [end_ix $w1.textarea]] [recomb_extract_recomb_site_tags [list 0 {}]  [get_tags $source.textarea [list [bp2ix $source.textarea $start] [end_ix $source.textarea]]]]

recomb_add_new_site_tags $w1.textarea $prev_end $site_name $site_direction
            textarea_insert $w1.textarea [$w1.textarea index 1.0] [set new_text [textarea_get $source.textarea 1.0 [bp2ix $source.textarea $end]]]
            put_tags $w1.textarea [list 1.0 [bp2ix $w1.textarea [string length $new_text]]] [recomb_extract_recomb_site_tags [list {} [string length $new_text]]  [get_tags $source.textarea [list 1.0 [bp2ix $source.textarea $end]]]]
recomb_add_new_site_tags $w1.textarea [bp2ix $w1.textarea $end] $final_site_name $final_site_direction
set final_site_name ""
          } else {
            textarea_insert $w1.textarea [end_ix $w1.textarea] [set new_text [revcom [textarea_get $source.textarea 1.0 [bp2ix $source.textarea $end]]]]
            put_tags $w1.textarea [list $prev_end [end_ix $w1.textarea]] [recomb_extract_recomb_site_tags [list 0 {}]  [get_tags $source.textarea [list 1.0 [bp2ix $source.textarea $end]] reverse]]
recomb_add_new_site_tags $w1.textarea $prev_end $site_name $site_direction
            textarea_insert $w1.textarea [$w1.textarea index 1.0] [set new_text [revcom [textarea_get $source.textarea [bp2ix $source.textarea $start] [end_ix $source.textarea]]]]
            put_tags $w1.textarea [list 1.0 [bp2ix $w1.textarea [string length $new_text]]] [recomb_extract_recomb_site_tags [list {} [string length $new_text]]  [get_tags $source.textarea [list [bp2ix $source.textarea $start] [end_ix $source.textarea]] reverse]]
recomb_add_new_site_tags $w1.textarea [bp2ix $w1.textarea [string length $new_text]] $final_site_name $final_site_direction
set final_site_name ""
          }
        } else {
          if {!$rev_com} {
            textarea_insert $w1.textarea [end_ix $w1.textarea] [set new_text [textarea_get $source.textarea [bp2ix $source.textarea $start] [end_ix $source.textarea]]]
            put_tags $w1.textarea [list $prev_end [end_ix $w1.textarea]] [recomb_extract_recomb_site_tags [list 0 {}]  [get_tags $source.textarea [list [bp2ix $source.textarea $start] [end_ix $source.textarea]]]]
recomb_add_new_site_tags $w1.textarea $prev_end $site_name $site_direction
            set prev_end [end_ix $w1.textarea]
            textarea_insert $w1.textarea [end_ix $w1.textarea] [set new_text [textarea_get $source.textarea 1.0 [bp2ix $source.textarea $end]]]
            put_tags $w1.textarea [list $prev_end [end_ix $w1.textarea]] [recomb_extract_recomb_site_tags [list {} [string length $new_text]]  [get_tags $source.textarea [list 1.0 [bp2ix $source.textarea $end]]]]
          } else {
            textarea_insert $w1.textarea [end_ix $w1.textarea] [set new_text [revcom [textarea_get $source.textarea 1.0 [bp2ix $source.textarea $end]]]]
            put_tags $w1.textarea [list $prev_end [end_ix $w1.textarea]] [recomb_extract_recomb_site_tags [list 0 {}]  [get_tags $source.textarea [list 1.0 [bp2ix $source.textarea $end]] reverse]]
recomb_add_new_site_tags $w1.textarea $prev_end $site_name $site_direction
            set prev_end [end_ix $w1.textarea]
            textarea_insert $w1.textarea [end_ix $w1.textarea] [set new_text [revcom [textarea_get $source.textarea [bp2ix $source.textarea $start] [end_ix $source.textarea]]]]
            put_tags $w1.textarea [list $prev_end [end_ix $w1.textarea]] [recomb_extract_recomb_site_tags [list {} [string length $new_text]]  [get_tags $source.textarea [list [bp2ix $source.textarea $start] [end_ix $source.textarea]] reverse]]
          }
        }
      }
    }
    recomb_add_new_site_tags $w1.textarea $prev_end $final_site_name $final_site_direction

    $w1.comframe.comtextframe.text insert 1.0 $comment_text
    set info($w1,scanned) 0
    initialize_undo $w1
    $w1.textarea tag remove sel 1.0 [end_ix $w1.textarea]
    $w1.textarea tag remove tempsel 1.0 [end_ix $w1.textarea]
    vertindexbalancer $w1
    selection_manager $w1
  }
  } ;# while keep open
  array unset recomb_data
  array unset recomb_window 
  unset ok recomb_prototype
}

################
## utility function of recombination_window to remove old recombination sites from the ends of fragments
################
proc recomb_extract_recomb_site_tags {ends_list tag_list} {
  set result [list]
  lassign $ends_list start end
  foreach {tag data} $tag_list {
    set meta_index [lsearch [lindex $data 2] <<Metadata>>]
    set type [lindex $data 3 $meta_index 2]
    if {$start != {} && [lindex $data 0 0] == 0 && ($type in [list misc_recomb protein_bind])} {
      continue
    } elseif {$end != {} && [lindex $data 0 1] == $end && ($type in [list misc_recomb protein_bind])} {
      continue
    }
    lappend result $tag $data 
  }
  return $result
}

################
## utility function of recombination_window to add fragments
################
proc recomb_add_new_site_tags {textarea loc_index  site_name site_direction} {
  global info
  if {$site_name eq {} || $site_name eq "end"} {return}
  if {[dict exists $info(feature_default_type_colors) protein_bind]} {
    set rev_colors [dict get $info(feature_default_type_colors) protein_bind]
  } else {
    set rev_colors [list $info(feature_default_fcolor) $info(feature_default_rcolor)]
  }
  if {[dict exists $info(feature_default_type_gformat) protein_bind]} {
    set tag_gformat [dict get $info(feature_default_type_gformat) protein_bind]
  } else {
    set tag_gformat $info(feature_default_gformat)
  }

  lassign [dict get $info(recomb,sites) $site_name] s1 s2 s3 s4 s5
  set loc0 [ix2bp $textarea $loc_index] 
  if {$site_direction} {
    set coords [list [bp2ix $textarea [expr {$loc0- [string length $s3]}]] [bp2ix $textarea [expr {$loc0+ [string length $s1]+ [string length $s2]}]]]
    set site_length [expr {[string length $s1]+[string length $s2]+[string length $s3]}]
  } else {
    set coords [list [bp2ix $textarea [expr {$loc0- [string length $s1]}]] [bp2ix $textarea [expr {$loc0+ [string length $s2]+ [string length $s3]}]]]
    set site_length [expr {[string length $s1]+[string length $s2]+[string length $s3]}]
  }

  set bg_color [lindex $rev_colors $site_direction]
  set tag_qualifiers [list]
  set metadata [list $site_name $tag_gformat protein_bind $site_direction $tag_qualifiers [list]]
  lappend new_tags f0# [list [list 0 $site_length] [list $bg_color {} {} {}] [list <<Revcolors>> <<Metadata>>] [list $rev_colors $metadata]]
  put_tags $textarea $coords $new_tags
#sputs add site  [textarea_get $textarea {*}$coords] $site_name $site_direction [dict get $info(recomb,sites) $site_name]

}

################
## utility function of recombination_window
################
proc fill_recomb_reation_frame {a} {
  global info recomb_prototype recomb_window recomb_data

  array set proto_list $info(recomb,prototypes)
  array set all_sites_list $info(recomb,sites) 

  set label_list [lindex $proto_list($recomb_prototype) 0]
  set sites_list [lindex $proto_list($recomb_prototype) 1]
  set site_count 0
  foreach element [winfo children $a.reactionframe] {
    destroy $element
  }
  array unset recomb_window

  lappend sites_list [lindex $sites_list 0] [lindex $sites_list 1]

  set found_all 1
  for {set i 0} {$i < [expr {[llength $sites_list]-2}]} {incr i 2} {
    set name [lindex $label_list [expr {$i/2}]] 
    set site1 [lindex $sites_list $i]
    set dir1 [lindex $sites_list [expr {$i+1}]]
    set site2 [lindex $sites_list [expr {$i+2}]]
    set dir2 [lindex $sites_list [expr {$i+3}]]
    #label for the fragment type
    grid [label $a.reactionframe.l0$site_count -text $name] -row $site_count -column 0 
    grid [menubutton $a.reactionframe.mb$site_count -menu $a.reactionframe.mb$site_count.menu -textvariable recomb_window($site_count) -indicator on -relief raised -width 50] -row $site_count -column 2 
    set recomb_window($site_count) ""
    menu $a.reactionframe.mb$site_count.menu
    #fill the menu with radiobutton items sequences between sites
    if {$dir1} {
      set site_reg1 [regsubpattern "[lindex $all_sites_list($site1) 0]([lindex $all_sites_list($site1) 1])[lindex $all_sites_list($site1) 4]"]
      set site_rc_reg1 $site_reg1
      set site_reg1 [revcom_regexp $site_reg1]
    } else {
      set site_reg1 [regsubpattern "[lindex $all_sites_list($site1) 3]([lindex $all_sites_list($site1) 1])[lindex $all_sites_list($site1) 2]"]
      set site_rc_reg1 [revcom_regexp $site_reg1]
    }
    if {$dir2} {
      set site_reg2 [regsubpattern "[lindex $all_sites_list($site2) 3]([lindex $all_sites_list($site2) 1])[lindex $all_sites_list($site2) 2]"]
      set site_rc_reg2 $site_reg2
      set site_reg2 [revcom_regexp $site_reg2]
    } else {
      set site_reg2 [regsubpattern "[lindex $all_sites_list($site2) 0]([lindex $all_sites_list($site2) 1])[lindex $all_sites_list($site2) 4]"]
      set site_rc_reg2 [revcom_regexp $site_reg2]
    }

    foreach window [dnawindows_list 1] {
      set text [textarea_get $window.textarea 1.0 [end_ix $window.textarea]]
      set len [string length $text]
      if {$len ==0} {continue}
      if {$info($window,circular) == "circular" || $info(recomb,circularize)} {
        append text $text
      }

      # find forward fragments and fill in .reactionframe.mb$site_count.menu
      if {$site1 eq "end"} {
        if {$info($window,circular) == "circular"} {
          set index_list1 [list]
        } else {
          set index_list1 [list [list 0 0] [list 0 0]]
        }
      } else {
        set index_list1 [regexp -all -indices -nocase -inline $site_reg1 $text]
      }
      set sl [list]
      foreach {ends_list1 core_list1} $index_list1 {
        if {[lindex $ends_list1 0] >= $len} {break}
        set index1 [expr {[lindex $core_list1 0] % $len}]
        lappend sl [list 1 $index1]
      }
      if {$site2 eq "end"} {
        if {$info($window,circular) == "circular"} {
          set index_list2 [list]
        } else {
          set index_list2  [list [list $len $len] [list $len $len]]
        }
      } else {
        set index_list2 [regexp -all -indices -nocase -inline $site_reg2 $text]
      }
      foreach {ends_list2 core_list2} $index_list2 {
        set index2 [expr {([lindex $core_list2 0]-1)}]
        #if { $index2> $index1 && [lindex $core_list2 0] > $len} {break}
        lappend sl [list 2 $index2]
      }

      set sl [lsort -unique -integer -index 1 $sl]
      for {set ix 0} {$ix < [expr {[llength $sl]-1}]} {incr ix} {
        if {[lindex $sl $ix 0] == 1 && [lindex $sl [expr {1+$ix}] 0] == 2} {
           set index1 [lindex $sl $ix 1] 
           set index2 [expr {[lindex $sl [expr {1+$ix}] 1] %$len}]
          $a.reactionframe.mb$site_count.menu add radiobutton -label "[wm title $window] [expr {$index1+1}] -[expr {$index2+1}]" -variable recomb_window($site_count) -value "[wm title $window] [expr {$index1+1}] -[expr {$index2+1}]"  -command "set recomb_data($site_count) {0 $window $index1 $index2}"
        }
      }


      # find reverse fragments and fill in .reactionframe.mb$site_count.menu
      set sl [list]
      if {$site2 eq "end"} {
        if {$info($window,circular) == "circular"} {
          set index_list1 [list]
        } else {
          set index_list1 [list [list 0 0] [list 0 0]]
          lappend sl [list 1 0]
        }
      } else {
        set index_list1 [regexp -all -indices -nocase -inline $site_rc_reg2 $text]
        foreach {ends_list1 core_list1} $index_list1 {
          if {[lindex $ends_list1 0] >= $len} {break}
          set index1 [expr {[lindex $core_list1 1]+1 % $len}]
          lappend sl [list 1 $index1]
        }
      }

      if {$site1 eq "end"} {
        if {$info($window,circular) == "circular"} {
          set index_list2 [list]
        } else {
          set index_list2  [list [list $len $len] [list $len $len]]
          lappend sl [list 2 $len]
        }
      } else {
        set index_list2 [regexp -all -indices -nocase -inline $site_rc_reg1 $text]
        foreach {ends_list2 core_list2} $index_list2 {
          set index2 [expr {([lindex $core_list2 1])}]
          #if {$index2 > $index1 && [lindex $core_list2 1] >=$len} {break}
          lappend sl [list 2 $index2]
        }
      }

      set sl [lsort -unique -integer -index 1 $sl]
      for {set ix 0} {$ix < [expr {[llength $sl]-1}]} {incr ix} {
        if {[lindex $sl $ix 0] == 1 && [lindex $sl [expr {1+$ix}] 0] == 2} {
           set index2 [lindex $sl $ix 1] 
           set index1 [expr {[lindex $sl [expr {1+$ix}] 1] % $len}]
          $a.reactionframe.mb$site_count.menu add radiobutton -label "[wm title $window] revcom([expr {$index2+1}] -[expr {$index1+1}])" -variable recomb_window($site_count) -value "[wm title $window] revcom([expr {$index2+1}] -[expr {$index1+1}])" -command "set recomb_data($site_count) {1 $window $index2 $index1}"
        }
      }
    }
    if {[$a.reactionframe.mb$site_count.menu index end] == "" || [$a.reactionframe.mb$site_count.menu index end] == "none"} {
      set recomb_window($site_count) [mc "None Found"]
      set found_all 0
    } else {
      $a.reactionframe.mb$site_count.menu invoke 0
    }
    incr site_count
  }
  if {!$found_all} {
    $a.okframe.ok configure -state disabled -default disabled
    #tk_messageBox -message [mc "Some sequences required for this prototype were not found. Check all of your sequences that you think are circular, some might be linear. ApE can only recombine sequences in open files."] -type ok -icon info
    #while {[lindex [time {tk_messageBox -message [mc "Some sequences required for this prototype were not found. Check all of your sequences that you think are circular, some might be linear. ApE can only recombine sequences in open files."] -type ok -icon info}] 0] < 15} {
    #  tk_messageBox -message [mc "Read the dialogs, you'll learn something."] -type ok -icon info
    #}
  } else {
    $a.okframe.ok configure -state normal -default active
  }
}

##################
## Find the shortest rotation of a string
##################
proc short_rot {s} {
  set bsf $s ;#best so far
  set len [string length $s]; # length of string
  set end $len
  append s $s; # duplicate string - makes rotations easier
  for {set i 1} {$i < $len} {incr i} {
    if {[string compare [string range $s $i $end] $bsf] < 0} { 
      set bsf [string range $s $i $end]
    } 
    incr end
  }
  # return best-so-far
    return $bsf 
}

##################
## Find SEGUID for window w
##################
proc seguid {w} {
  global info
  return [calculate_seguid [string toupper [textarea_get $w.textarea 1.0 end]] [expr {$info($w,circular)== "circular"}]]
}

##################
## Find ldseguid for linear or cdseguid for circular
##################
proc calculate_seguid {text circular} {
  global info
  if {$circular} {
    set prefix "cdseguid="
    set a [short_rot $text]
    set b [short_rot [revcom $text]]
    if {[string compare $a $b] < 0} {
      set text "$a;[revcom $a]"
    } else {
      set text "$b;[revcom $b]"
    }
  } else {
    set prefix "ldseguid="
    if {[string compare [set rc [revcom $text]] $text] < 0} {
      set text "$rc;$text"
    } else {
      set text "$text;$rc"

    }
  }
  # puts $text
  return $prefix[string range [string map {+ -  / _} [::base64::encode [binary format H* [::sha1::sha1 $text]]]] 0 26]
}

################
##virtual Golden Gate tool
################
#proc: search all enzymes for external overhang
proc golden_gate_enzymes {} {

#ggtctc 1/5 BsaI Bso31I Eco31I
#cgtctc 1/5 BsmBI Esp3I
#ctcttc 1/4 EarI
#gctcttc 1/4 SapI
#gcaatg 2/0 BsrDI
#gcagtg 2/0 BtsI 500u
#gaagac 2/6 BbsI BpiI BpuAI BstV2I
#cacctgc 4/8 AarI
#acctgc 4/8 Acc36I BfuAI BspMI BveI
#gcgatg 10/14 BtgZI
#ggcgga 11/9 EciI
#gaccga 11/9 TaqII
#ctgaag 16/14 AcuI
#ctggag 16/14 BpmI
#cttgag 16/14 BpuEI
#gtgcag 16/14 BsgI
#gaggag 10/8 BseRI

  global enzymes enzinfo
  set result [list]
  foreach enzyme $enzymes {
    set pattern $enzinfo(flatpat,$enzyme)
    set cs $enzinfo(enz_cut_sites,$enzyme)
    if {([lindex $cs 0] > [string length $pattern]) && ([lindex $cs 1] >= [string length $pattern]) && ([expr {abs([lindex $cs 0] -[lindex $cs 1])}] >= 3) && ([expr {abs([lindex $cs 0] -[lindex $cs 1])}] <= 4) && ([string length $pattern] > 5) && ![regexp {[^ACGT]} $pattern]} {
      lappend result $enzyme
    }
  }
  return $result
}

################
### return all gg fragment possibilities, window, first index, both overhangs
################
proc golden_gate_fragments {enzyme_list  {treat_circular 0}} {
  global enzinfo info
  set result [list]

  foreach w [dnawindows_list 1] {
    set frag_list_result [list]
    findenzymes $w
    set frag_list [list]
    foreach enz $enzyme_list {
      foreach site $info($w,$enz) dir $info($w,enzdir,$enz) {
        lappend frag_list [list $enz $site $dir]
      }
    }
    set frag_list [lsort -integer -index 1 $frag_list]
    for {set i 0} {$i < [expr {[llength $frag_list] - 1}] } {incr i} {
      if {[lindex $frag_list $i 2] == 0 && [lindex $frag_list [expr {$i +1}] 2] == 1} {
        set t [golden_gate_fragment $w {*}[lindex $frag_list $i] {*}[lindex $frag_list [expr {$i +1}]]]
        lappend frag_list_result [list $w [list [lindex $frag_list $i] [lindex $frag_list [expr {$i +1}]]] [string length [lindex $t 0]] [lindex $t 1]]
      }
    }

    ## add end fragments or fragments through the origin
    if {$info($w,circular) eq "circular" || $treat_circular} {
      if {[lindex $frag_list $i 2] == 0 && [lindex $frag_list 0 2] == 1} {
        set t [golden_gate_fragment $w {*}[lindex $frag_list $i] {*}[lindex $frag_list 0]]
        lappend frag_list_result [list $w [list [lindex $frag_list $i] [lindex $frag_list 0]] [string length [lindex $t 0]] [lindex $t 1]]
      }
    } else {
      #add linear end fragments
      if  {[lindex $frag_list 0 2] == 1} {
        set t [golden_gate_fragment $w end 1 0 {*}[lindex $frag_list 0]]
        lappend frag_list_result [list $w [list [list end 0 0] [lindex $frag_list 0]] [string length [lindex $t 0]] [lindex $t 1]]
      }
      if {[lindex $frag_list $i 2] == 0} {
        set len [ix2bp $w.textarea end]
        set t [golden_gate_fragment $w {*}[lindex $frag_list $i] end $len 1]
        lappend frag_list_result [list $w [list [lindex $frag_list $i] [list end $len 1]] [string length [lindex $t 0]] [lindex $t 1]]
      }
    }

    set result [concat $result [lsort -index 2 $frag_list_result]]
  }
  return $result
}

################
### return all gg fragment possibilities, window, first index, both overhangs
################
proc golden_gate_oligo_fragments {enzyme_list frag_list} {
  global enzinfo info
  set result [list]

  foreach enz $enzyme_list {
    lappend oh_len_list [expr {[lindex $enzinfo(enz_cut_sites,$enz) 1] -[lindex $enzinfo(enz_cut_sites,$enz) 0]}]
  } 
  set oh_len_list [lsort -integer -unique $oh_len_list]
  foreach frag $frag_list {
    if {[string length [lindex $frag 3 0]] in $oh_len_list  && [string length [lindex $frag 3 1]] in $oh_len_list} {
      lappend result $frag
    }
  }
  return $result
}




################
##proc: given window, enzyme and index of site1 and site2, return: site1 overhang, site1->site2 sequence (as list of 2 if split), site2 overhang 
################
proc golden_gate_fragment {w enzyme1 site1 dir1 enzyme2 site2 dir2} {
  global info enzinfo
  findenzymes $w
  set text [textarea_get $w.textarea 1.0 [end_ix $w.textarea]]
  set text0 $text
  set len [string length $text]
  set coff 0
  if {$info($w,circular) eq "circular"} {
    set text [string range $text end-24 end]$text[string range $text 0 24]
    set coff [expr {min(25, [string length [string range $text end-24 end]])}]
  }
  set ilist [list]
  set ohlist [list]
  foreach site [list $site1 $site2] enzyme [list $enzyme1 $enzyme2] dir [list $dir1 $dir2] {
    if {$enzyme eq "end"} {
      lappend ilist $site
      lappend ohlist "XXX"
      continue
    }
    if {$dir} {
      #site is in reverse
      set i [expr {$site+ $coff + [string length $enzinfo(flatpat,$enzyme)] - [lindex $enzinfo(enz_cut_sites,$enzyme) 1] -1}]
    } else {
      #site is forward
      set i [expr {($site+ $coff + [lindex $enzinfo(enz_cut_sites,$enzyme) 0] -1)}]
    }
    lappend ilist [expr {($i - $coff) % $len}]
    if {[lindex $enzinfo(enz_cut_sites,$enzyme) 0] > [lindex $enzinfo(enz_cut_sites,$enzyme) 1]} {
      set oh [string range $text [expr {$i % ($len)}] [expr {$i % ($len)+[lindex $enzinfo(enz_cut_sites,$enzyme) 0]-[lindex $enzinfo(enz_cut_sites,$enzyme) 1] - 1}]]
    } else {
      set oh [string range $text [expr {$i % ($len)}] [expr {$i % ($len)+[lindex $enzinfo(enz_cut_sites,$enzyme) 1]-[lindex $enzinfo(enz_cut_sites,$enzyme) 0] - 1}]]
    }
    lappend ohlist [string toupper $oh]
  }
  if {$dir1} {
    if {[lindex $ilist 0] > [lindex $ilist 1]} {
      return [list [list [string range $text0 [lindex $ilist 1] [lindex $ilist 0]]] $ohlist]
    } else {
      return [list [list [string range $text0 0 [lindex $ilist 0]] [string range $text0 [lindex $ilist 1] end]] $ohlist]
    }
  } else {
    if {[lindex $ilist 0] < [lindex $ilist 1]} {
      return [list [list [string range $text0 [lindex $ilist 0] [lindex $ilist 1]]] $ohlist]
    } else {
      return [list [list [string range $text0 [lindex $ilist 0] end] [string range $text0 0 [lindex $ilist 1]]] $ohlist]
    }
  }
}

################
## golden gate dialog
################
proc golden_gate_dialog {w} {
  global info modifier dialogblock modstring
  global gg_enz gg_info gg_enz1 gg_enz2

  if {$dialogblock == 1} {return}

  set s [new_dialog $w "Golden Gate Assembler..." "NEW DNA"]
  bind $s <<Cancel>>  "dialog_cancel $s;   unset -nocomplain gg_enz gg_info"
  bind $s <<OK>> "golden_gate_generate_product; if {!\$info(golden_gate_assembler_keep_open)} {event generate $s <<Cancel>>}"
  
  grid [frame $s.enzframe] -row 0 -column 0 -sticky nswe
  if {$info(use_tile)} {
    grid [ttk::separator $s.sep] -row 1 -column 0 -sticky nwe
  } else {
    $s.enzfram configure -relief ridge -borderwidth 2
  }
  grid [menubutton $s.enzframe.menub -menu $s.enzframe.menub.m -textvariable gg_enz] -row 0 -column 1 -sticky nsew
  grid [menubutton $s.enzframe.menub1 -menu $s.enzframe.menub1.m1 -textvariable gg_enz1] -row 0 -column 2 -sticky nsew
  grid [menubutton $s.enzframe.menub2 -menu $s.enzframe.menub2.m2 -textvariable gg_enz2] -row 0 -column 3 -sticky nsew
  grid remove $s.enzframe.menub1
  grid remove $s.enzframe.menub2
  menu $s.enzframe.menub.m
  menu $s.enzframe.menub1.m1
  menu $s.enzframe.menub2.m2
  set gg_info(enz) ""
  set gg_info(enz1) ""
  set gg_info(enz2) ""

  set enz_list [golden_gate_enzymes]
  if {[llength $enz_list] == 0} {
    set gg_enz [mc "No Suitable Enzymes Available"]
  } elseif {[llength $enz_list] == 1} {
    set gg_enz [lindex $enz_list 0]
    set gg_info(enz) [lindex $enz_list 0]
  } else {
    set gg_enz [mc "Choose an Enzyme..."]
    foreach enz [golden_gate_enzymes] {
      $s.enzframe.menub.m add command -label "$enz" -command "set gg_enz $enz; set gg_info(enz) $enz; golden_gate_fill_dialog $s 0"
    }
    $s.enzframe.menub.m add separator
    $s.enzframe.menub.m add command -label [mc "Edit Current Enzymes"] -command "event generate $s <<Cancel>>; enz_edit_curent_enzymes $w"
    $s.enzframe.menub.m add separator
    $s.enzframe.menub.m add command -label [mc "Add Oligos From File"] -command "golden_gate_read_oligo_data $s file add; golden_gate_fill_dialog $s 0"
    $s.enzframe.menub.m add command -label [mc "Add Oligos From Open Sequence Files"] -command "golden_gate_read_oligo_data $s sequence_file add; golden_gate_fill_dialog $s 0"
    $s.enzframe.menub.m add command -label [mc "Add Oligos From Clipboard"] -command "golden_gate_read_oligo_data $s clipboard add; golden_gate_fill_dialog $s 0"
    $s.enzframe.menub.m add command -label [mc "Clear Oligos"] -command "set gg_info(oligos_list) [list]; golden_gate_fill_dialog $s 0"
    $s.enzframe.menub.m add separator
    $s.enzframe.menub.m add command -label [mc "Add Second Enzyme"] -command "grid configure $s.enzframe.menub1"
    set gg_enz1 [mc "(Optional) Second Enzyme..."]
    foreach enz [golden_gate_enzymes] {
      $s.enzframe.menub1.m1 add command -label "$enz" -command "set gg_enz1 $enz; set gg_info(enz1) $enz; golden_gate_fill_dialog $s 0"
    }
    $s.enzframe.menub1.m1 add command -label [mc "No Enzyme"] -command "set gg_enz1 \[mc \"(Optional) Second Enzyme...\"\]; set gg_info(enz1) {};  grid remove $s.enzframe.menub2; golden_gate_fill_dialog $s 0"
    if {[llength $enz_list] > 2} {
      $s.enzframe.menub1.m1 add separator
      $s.enzframe.menub1.m1 add command -label [mc "Add Third Enzyme"] -command "grid configure $s.enzframe.menub2"
      set gg_enz2 [mc "(Optional) Third Enzyme..."]
      foreach enz [golden_gate_enzymes] {
        $s.enzframe.menub2.m2 add command -label "$enz" -command "set gg_enz2 $enz; set gg_info(enz2) $enz; golden_gate_fill_dialog $s 0"
      }
      $s.enzframe.menub2.m2 add command -label "No Enzyme" -command "set gg_enz2 \[mc \"(Optional) Third Enzyme...\"\]; set gg_info(enz2) {}; golden_gate_fill_dialog $s 0"
    }
  }

  grid [frame $s.seqsframe] -row 2 -column 0 -sticky nswe
  for {set i 0} {$i <20} {incr i} {
    grid [frame $s.seqsframe.seqframe$i] -row $i -column 0 -sticky nswe
    grid [label $s.seqsframe.seqframe$i.label -textvariable gg_info(seq,$i)] -row 0 -column 0 -sticky nsw
    grid [menubutton $s.seqsframe.seqframe$i.menub -menu $s.seqsframe.seqframe$i.menub.m -textvariable gg_info(seq,$i)] -row 0 -column 0 -sticky nsw
    grid [label $s.seqsframe.seqframe$i.label2 -textvariable gg_info(status,$i)] -row 0 -column 1 -sticky nsw
    set gg_info(seq,$i) ""
    set gg_info(w,$i) ""
    set gg_info(oh3,$i) ""
    set gg_info(oh5,$i) ""
    set gg_info(frag_info,$i) ""
    set gg_info(status,$i) ""
    set gg_info(dir,$i) ""
    menu $s.seqsframe.seqframe$i.menub.m
    $s.seqsframe.seqframe$i.menub.m add command -label "test $i"
    grid remove $s.seqsframe.seqframe$i.label
    grid remove $s.seqsframe.seqframe$i
  }

  grid [frame $s.okframe] -row 3 -column 0 -sticky nswe
  grid [label $s.okframe.message -text ""] -row 0 -column 0 -sticky nw -columnspan 3
  grid [button $s.okframe.cancel -text [mc "Close"] -command "event generate $s <<Cancel>>"] -row 1 -column 0 -sticky nw -padx 10 -pady 3
  grid [button $s.okframe.ok -text [mc "OK"] -command "event generate $s <<OK>>" -default active -state disabled] -row 1 -column 1 -sticky nw -padx 10 -pady 3
  grid [button $s.okframe.calc -text [mc "With Calculator"] -command "golden_gate_fill_calculator; event generate $s <<OK>>" -default active -state disabled] -row 1 -column 2 -sticky nw -padx 10 -pady 3
  ##grid [checkbutton $s.okframe.allow_linear -text [mc "Allow Linear Products"] -variable info(golden_gate_assembler_allow_linear)] -row 2 -column 0 -columnspan 2 -sticky w
  grid [checkbutton $s.okframe.allow_linear -text [mc "Treat All Sequences as Circular"] -variable info(golden_gate_assembler_treat_circular)] -row 2 -column 0 -columnspan 2 -sticky w
  grid [checkbutton $s.okframe.keep_open -text [mc "Keep Assembler Dialog Open"] -variable info(golden_gate_assembler_keep_open)] -row 3 -column 0 -columnspan 2 -sticky w

  if {[llength $enz_list] == 1} {
    golden_gate_fill_dialog $s 0
  }


}

################
## fill dialog golden gate
################
proc golden_gate_fill_dialog {s pos} {
  global gg_info info
  #set s .dialog

  set gg_enz_list [list {*}$gg_info(enz) {*}$gg_info(enz1) {*}$gg_info(enz2)]
  if {[llength $gg_enz_list] == 0} return
  if {($pos > 0) && ([golden_gate_overhangs_compatible $gg_info(oh5,0)  $gg_info(oh3,[expr {$pos-1}]) ] )} {
    #check pos-1 3' end for closing the circle- set ok to active and grid remove from pos to end then return
    if {$gg_info(oh3,[expr {$pos-1}]) eq "XXX"} {
      set gg_info(status,[expr {$pos-1}]) "**Linear product"
    } elseif {[golden_gate_overhangs_compatible [revcom $gg_info(oh3,[expr {$pos-1}])]  $gg_info(oh3,[expr {$pos-1}]) ] } {
      set gg_info(status,[expr {$pos-1}]) "$gg_info(oh3,[expr {$pos-1}]) **Warning: Self-compatible (palindromic) overhang**"
    } elseif {[golden_gate_overhangs_compatible [revcom $gg_info(oh5,[expr {$pos-1}])] $gg_info(oh3,[expr {$pos-1}]) ] } {
       set gg_info(status,[expr {$pos-1}]) "[golden_gate_resolve_overhangs [revcom $gg_info(oh5,[expr {$pos-1}])] $gg_info(oh3,[expr {$pos-1}])] **Warning: Fragment ends are identical overhangs**"
    } else {
       set gg_info(status,[expr {$pos-1}]) "[golden_gate_resolve_overhangs $gg_info(oh3,[expr {$pos-1}]) $gg_info(oh5,0)]"
    }
    for {set i [expr {$pos}]} {$i <20} {incr i} {
      grid remove $s.seqsframe.seqframe$i
      set gg_info(oh3,$i) ""
      set gg_info(oh5,$i) ""
      set gg_info(seq,$i) ""
      set gg_info(w,$i) ""
      set gg_info(frag_info,$i) ""
      set gg_info(status,$i) ""
      set gg_info(dir,$i) ""
    }
    set oh_e [list]
    for {set i 0} {$i < $pos} {incr i} {
      lappend oh_e [golden_gate_resolve_overhangs $gg_info(oh3,$i)  $gg_info(oh5,[expr {($i+1)%$pos}])]
    }

    set efficiency [golden_gate_efficiency $oh_e]
    if {$efficiency ne {}} {
      $s.okframe.message configure -text [mc "Efficiency: %s%%" [expr {round($efficiency*100)}]]
    }
    $s.okframe.ok configure -state normal
    $s.okframe.calc configure -state normal
    set gg_info(linear_product) 0
    return
  }


  set frag_list [golden_gate_fragments $gg_enz_list $info(golden_gate_assembler_treat_circular)]

  lappend frag_list {*}[golden_gate_oligo_fragments $gg_enz_list $info(golden_gate_assembler_oligos_frags)]

  if {($pos > 0)} {
    set oh3 $gg_info(oh3,[expr {$pos-1}])
  } else {
    set oh3 ""
  }
  set new_frag_list [list]
  set new_frag_match 1;# make 0 if 3' ends don't all match
  set last_oh3 ""
  foreach frag $frag_list {
    set oh_list [lindex $frag 3]
    if {($pos ==0) } {
      ## add all valid fragments as the first fragment, or compatible fragments as non-first
      if {  [lindex $oh_list 1] eq "XXX"} {
        ## add fragments that have a blunt end at the right side only at the begining list as revcom
        lappend new_frag_list [list [lindex $frag 0] [revcom [lindex $oh_list 1]] [revcom [lindex $oh_list 0]] [lindex $frag 1] 1]
        set next_oh3 [revcom [lindex $oh_list 0]]
      } else {
       ## add all valid fragments with left end blunt or left end overhang
        lappend new_frag_list [list [lindex $frag 0] [lindex $oh_list 0] [lindex $oh_list 1] [lindex $frag 1] 0]
        set next_oh3 [lindex $oh_list 1]
      }
    } elseif { ([golden_gate_overhangs_compatible [lindex $oh_list 0]  $oh3]) && ( $gg_info(oh5,0) eq "XXX" || [lindex $oh_list 1] ne "XXX")} {
      lappend new_frag_list [list [lindex $frag 0] [lindex $oh_list 0] [lindex $oh_list 1] [lindex $frag 1] 0]
      set next_oh3 [lindex $oh_list 1]
    } elseif {[golden_gate_overhangs_compatible [revcom [lindex $oh_list 1]] $oh3] && ([lindex $frag 1 0 0] ne "oligo") && ( $gg_info(oh5,0) eq "XXX" || [lindex $oh_list 0] ne "XXX")} {
      ## add right end compatible as revcom
      lappend new_frag_list [list [lindex $frag 0] [revcom [lindex $oh_list 1]] [revcom [lindex $oh_list 0]] [lindex $frag 1] 1]
      set next_oh3 [revcom [lindex $oh_list 0]]
    }
    if {[info exists next_oh3]} {
      if {$last_oh3 == "" } {
        set last_oh3 $next_oh3
      } elseif {![golden_gate_overhangs_compatible $last_oh3 $next_oh3]} {
        set new_frag_match 0
      }
    }
      ##needs to save list elements: window, oh5, oh3, index0, dir
  }

#find all fragments that are compatible with pos-1 3' end, add them to menubutton (or label, if only 1)
#for all new 3' ends, check if they are all the same- if so, check if they match pos+1 5' ends, if so stop, if not fill pos+1, if not the same grid remove pos+1 to end and reset ends 
# new_frag_list is - window0, left overhang  (revcom and reversed if needed), right overhang (revcom and reversed if needed), cut site / oligo2 data list, dir
  grid configure $s.seqsframe.seqframe$pos
  if {([llength $new_frag_list] > 0) && ($pos < 19)} {
    if {[llength $new_frag_list] > 1} {
      $s.seqsframe.seqframe$pos.menub.m delete 0 end
      grid configure $s.seqsframe.seqframe$pos.menub
      grid remove $s.seqsframe.seqframe0.label
      if {$new_frag_match} {
        foreach frag $new_frag_list {
          if {[lindex $frag 4]} {
            set enz1_pos [lindex $frag 3 1 1]  
            set enz2_pos [lindex $frag 3 0 1]  
          } else {
            set enz1_pos [lindex $frag 3 0 1]  
            set enz2_pos [lindex $frag 3 1 1]  
          }
           if {[lindex $frag 3 0 0]  eq "oligo"} {
            $s.seqsframe.seqframe$pos.menub.m add command -label "oligo:  [lindex $frag 0 0] /  [lindex $frag 3 1 0]" -command "set gg_info(seq,$pos) \{[lindex $frag 0 0]\}; set gg_info(w,$pos) [list [lindex $frag 0]]; set gg_info(oh3,$pos) [lindex $frag 2]; set gg_info(frag_info,$pos) [list [lindex $frag 3]]; set gg_info(dir,$pos) [lindex $frag 4]"
          } else {
            $s.seqsframe.seqframe$pos.menub.m add command -label "$enz1_pos - $enz2_pos\: [file rootname [wm title [lindex $frag 0]]]" -command "set gg_info(seq,$pos) \{[file rootname [wm title [lindex $frag 0]]]\}; set gg_info(w,$pos) [lindex $frag 0]; set gg_info(oh3,$pos) [lindex $frag 2]; set gg_info(frag_info,$pos) [list [lindex $frag 3]]; set gg_info(dir,$pos) [lindex $frag 4]"
          }
        }
        if {[lindex $new_frag_list 0 3 0 0]  eq "oligo"} {
          set gg_info(seq,$pos)  [lindex $new_frag_list 0 0 0]
          set gg_info(w,$pos) [lindex  $new_frag_list 0 0]
        } else {
          set gg_info(seq,$pos)  [file rootname [wm title [lindex $new_frag_list 0 0]]]
          set gg_info(w,$pos) [lindex  $new_frag_list 0 0]
        }
        set gg_info(oh3,$pos) [lindex $new_frag_list 0 2]
        set gg_info(oh5,$pos)  [lindex $new_frag_list 0 1]
        set gg_info(frag_info,$pos) [lindex $new_frag_list 0 3]
        set gg_info(dir,$pos) [lindex $new_frag_list 0 4]
        set gg_info(status,$pos) ""
        if {![golden_gate_overhangs_compatible $gg_info(oh3,$pos) $gg_info(oh5,[expr {$pos+1}]) ]} {
          golden_gate_fill_dialog $s [expr {$pos +1}]
        } 
      } else {
        foreach frag $new_frag_list {
          set enz1_pos [lindex $frag 3 0 1]  
          set enz2_pos [lindex $frag 3 1 1] 
          if {[lindex $frag 3 0 0]  eq "oligo"} {
            $s.seqsframe.seqframe$pos.menub.m add command -label "oligo:  [lindex $frag 0 0] /   [lindex $frag 3 1 0]" -command "set gg_info(seq,$pos) \{ [lindex $frag 0 0]\}; set gg_info(w,$pos) [list [lindex $frag 0]]; set gg_info(oh5,$pos) [lindex $frag 1]; set gg_info(oh3,$pos) [lindex $frag 2]; set gg_info(frag_info,$pos) [list [lindex $frag 3]]; set gg_info(dir,$pos) [lindex $frag 4]; golden_gate_fill_dialog $s [expr {$pos+1}]"
          } else {
            $s.seqsframe.seqframe$pos.menub.m add command -label "$enz1_pos - $enz2_pos\:  [file rootname [wm title [lindex $frag 0]]]" -command "set gg_info(seq,$pos) \{ [file rootname [wm title [lindex $frag 0]]]\}; set gg_info(w,$pos) [lindex $frag 0]; set gg_info(oh5,$pos) [lindex $frag 1]; set gg_info(oh3,$pos) [lindex $frag 2]; set gg_info(frag_info,$pos) [list [lindex $frag 3]]; set gg_info(dir,$pos) [lindex $frag 4]; golden_gate_fill_dialog $s [expr {$pos+1}]"
          }
        }
        set gg_info(seq,$pos) [mc "Choose a Fragment"]
        set gg_info(w,$pos) ""
        set gg_info(oh3,$pos) ""
        set gg_info(frag_info,$pos) ""
        set gg_info(dir,$pos) ""
        set gg_info(status,$pos) ""
        for {set i [expr {$pos +1}]} {$i <20} {incr i} {
          grid remove $s.seqsframe.seqframe$i
          set gg_info(oh3,$i) ""
          set gg_info(oh5,$i) ""
          set gg_info(seq,$i) ""
          set gg_info(w,$i) ""
          set gg_info(frag_info,$i) ""
          set gg_info(dir,$i) ""
          set gg_info(status,$i) ""
        }
        $s.okframe.message configure -text ""
        $s.okframe.ok configure -state disabled
        $s.okframe.calc configure -state disabled
      }
    } else {
      #single match
      if {[lindex $new_frag_list 0 3 0 0]  eq "oligo"} {
        set gg_info(seq,$pos)  [lindex $new_frag_list 0 0 0]
        set gg_info(w,$pos) [lindex  $new_frag_list 0 0]
      } else {
        set gg_info(seq,$pos)  [file rootname [wm title [lindex $new_frag_list 0 0]]]
        set gg_info(w,$pos) [lindex  $new_frag_list 0 0]
      }
      set gg_info(oh5,$pos)  [lindex $new_frag_list 0 1]
      set gg_info(oh3,$pos) [lindex $new_frag_list 0 2]
      set gg_info(frag_info,$pos)  [lindex $new_frag_list 0 3]
      set gg_info(dir,$pos) [lindex $new_frag_list 0 4]
      set gg_info(status,$pos) ""
      grid remove $s.seqsframe.seqframe$pos.menub
      grid configure $s.seqsframe.seqframe$pos.label
      if {![golden_gate_overhangs_compatible $gg_info(oh3,$pos) $gg_info(oh5,[expr {$pos+1}]) ] } {
        golden_gate_fill_dialog $s [expr {$pos +1}]
      }
    }
  } else {
    #no fragments match the 3' end
    if {0 && [info exists info(golden_gate_assembler_allow_linear)] && $info(golden_gate_assembler_allow_linear) && $pos <= 19 && $pos > 0} {
      ## linear fragments allowed- finish the match and set gg_info(linear_product)
      for {set i [expr {$pos}]} {$i <20} {incr i} {
        grid remove $s.seqsframe.seqframe$i
        set gg_info(oh3,$i) ""
        set gg_info(oh5,$i) ""
        set gg_info(seq,$i) ""
        set gg_info(w,$i) ""
        set gg_info(frag_info,$i) ""
        set gg_info(status,$i) ""
        set gg_info(dir,$i) ""
      }
      set oh_e [list]
      for {set i 1} {$i < [expr {$pos-1}]} {incr i} {
       lappend oh_e [golden_gate_resolve_overhangs $gg_info(oh3,$i)  $gg_info(oh5,[expr {($i+1)%$pos}])]
      }

      set efficiency [golden_gate_efficiency $oh_e]
      if {$efficiency ne {}} {
        $s.okframe.message configure -text [mc "Efficiency: %s%%" [expr {round($efficiency*100)}]]
      }
      $s.okframe.ok configure -state normal
      $s.okframe.calc configure -state normal
      set gg_info(linear_product) 1
      return
    } else {
      ## no linears allowed or no fragments provided- no circular products formed
      grid remove $s.seqsframe.seqframe$pos.menub
      grid configure $s.seqsframe.seqframe$pos.label
      if {($pos <= 19)} {
        set gg_info(seq,$pos) [mc "No Product Possible"]
      } else {
        set gg_info(seq,$pos) [mc "Too Many Fragments (Infinite Loop?)"]
      }
      set gg_info(w,$pos) ""
      set gg_info(status,$pos) ""
      for {set i [expr {$pos +1}]} {$i <20} {incr i} {
        grid remove $s.seqsframe.seqframe$i
        set gg_info(oh3,$i) ""
        set gg_info(oh5,$i) ""
        set gg_info(seq,$i) ""
        set gg_info(w,$i) ""
        set gg_info(frag_info,$i) ""
        set gg_info(dir,$i) ""
        set gg_info(status,$i) ""
      }
      $s.okframe.message configure -text ""
      $s.okframe.ok configure -state disabled
      $s.okframe.calc configure -state disabled
    }
  }
  if { $pos> 0} {
    if {[golden_gate_overhangs_compatible [revcom $gg_info(oh3,[expr {$pos-1}])]  $gg_info(oh3,[expr {$pos-1}]) ] } {
      set gg_info(status,[expr {$pos-1}]) "$gg_info(oh3,[expr {$pos-1}])**Warning: Self-compatible (palindromic) overhang**"
    } elseif { [golden_gate_overhangs_compatible [revcom $gg_info(oh5,[expr {$pos-1}])]  $gg_info(oh3,[expr {$pos-1}]) ] } {
      set gg_info(status,[expr {$pos-1}]) "[golden_gate_resolve_overhangs [revcom $gg_info(oh5,[expr {$pos-1}])] $gg_info(oh3,[expr {$pos-1}])] **Warning: Fragment ends are identical overhangs**"
    } else {
       set gg_info(status,[expr {$pos-1}]) "[golden_gate_resolve_overhangs $gg_info(oh3,[expr {$pos-1}]) $gg_info(oh5,[expr {$pos}])]"
    }
  }

}


################
## Get oligos from files, clipboard and/or text file
################
proc golden_gate_read_oligo_data {win source action} {
  global  gg_info info enzinfo tcl_platform

  if {$action eq "set" || ![info exists gg_info(oligos_list)]} {
    set oligos_list [list]
  } else {
    set oligos_list $gg_info(oligos_list)
  }
  set text {}

  if {$source eq "clipboard"} {
    if {($tcl_platform(platform) == "unix") && ([tk windowingsystem] != "aqua")} {
      if {[catch {set text [selection get -displayof $w -selection CLIPBOARD]}]} {return}
    } else {
      if {[catch {set text [clipboard get]}]} {return}
    }
    set text [split $text \n]
  } elseif {$source eq "file"} {
    set filename [tk_getOpenFile -title [mc {Open Golden Gate Oligos File}] -filetypes {{{Text Files} {.txt}} {{All Files} *}}]
    if {$filename != {}} { 
      if {![catch {open $filename r} fileid err]} {
        while {[eof $fileid] != 1} {
          lappend text [gets $fileid]
        }
        close $fileid
      } else {
        tk_messageBox -title [mc "Text File not Readable"] -message [mc "The file %s is not readable." $filename] -type ok -icon warning -default ok
        return
      }
    }
  } elseif {$source eq "sequence_file"} {
	foreach w [dnawindows_list 1] {
      set len [ix2bp $w.textarea end] 
      if { $len <= 250 && $len >= 25} {
        set seq [textarea_get $w.textarea 1.0 end]
        lappend oligos_list [list [file rootname [wm title $w]]  $seq {} [string toupper $seq] [revcom [string toupper $seq]]]
      } 
    }
  }

  set bad_lines 0
  set bad_text {}
  set log_file_list [list]
  foreach line $text {
    set seq {}
    set name {Unnamed Oligo}
    set note {}
    set qualifiers {}
    if {$line eq {} || [string index $line 0] eq "#"} {lappend log_file_list "$line";continue}
    if {[regexp -nocase {^[\s]*((?:(?:/.?/)|(?:\*)|[NBDHVKMRYWSACGT]){5,})[\s]*$} $line - seq]} {
    } elseif {[regexp -nocase {^([^\t,]+)[\t,][\s]*((?:(?:/.?/)|(?:\*)|[NBDHVKMRYWSACGT]){5,})[\s]*$} $line - name seq]} {
    } elseif {[regexp -nocase {^(?:[0-9]+)[\t,][\s]*([^\t,]+)[\t,][\s]*((?:(?:/.?/)|(?:\*)|[NBDHVKMRYWSACGT\s]){5,})[\s]*$} $line - name seq] || [regexp -nocase {^(?:[0-9]+)[\t,][\s]*([^\t]+)[\t\s]+([^\t]{5,})[\s]*$} $line - name seq] || [regexp -nocase {^(?:[0-9]+)[\t,][\s]*([^\t,]+)[\t,][\s]*((?:(?:/.?/)|(?:\*)|[NBDHVKMRYWSACGT\s]){5,})[\s]*[\t,]([^\t]*)$} $line - name seq note] || [regexp -nocase {^(?:[0-9]+)[\t,][\s]*([^\t]+)[\t\s]+([^\t]{5,})[\s]*[\t,]([^\t]*)$} $line - name seq note]} {
    } elseif {[regexp -nocase {^([^\t,]+)[\t,][\s]*((?:(?:/.?/)|(?:\*)|[NBDHVKMRYWSACGT\s]){5,})[\s]*$} $line - name seq] || [regexp -nocase {^([^\t]+)[\t\s]+([^\t]{5,})[\s]*$} $line - name seq] || [regexp -nocase {^([^\t,]+)[\t,][\s]*((?:(?:/.?/)|(?:\*)|[NBDHVKMRYWSACGT\s]){5,})[\s]*[\t,]([^\t]*)$} $line - name seq note] || [regexp -nocase {^([^\t]+)[\t\s]+([^\t]{5,})[\s]*[\t,]([^\t]*)$} $line - name seq note]} {
    } elseif {[regexp -nocase {^([^\t,]+)[\t,][\s]*([^\t,]{5,})*$} $line - name seq]} {
      regsub -all {\s+} $seq "" seq
    } elseif {[regexp -nocase {^([^\t,]+)[\t,][\s]*((?:(?:/.?/)|(?:\*)|[NBDHVKMRYWSACGT]){5,})[\s]*[\t,]([^\t]*)$} $line - name seq note]} {
    } elseif {[regexp -nocase {^([^\t]+)[\t][\s]*((?:(?:/.?/)|(?:\*)|[NBDHVKMRYWSACGT]){5,})[\s]*[\t]([\s]*primer_bind[\s]*)[\t]([^\t]*)[\t]([^\t]*)$} $line - name seq type fwd_color rev_color]} {
    } elseif {[regexp -nocase {^([^\t]+)[\t][\s]*((?:(?:/.?/)|(?:\*)|[NBDHVKMRYWSACGT]){5,})[\s]*[\t]([\s]*primer_bind[\s]*)[\t]([^\t]*)[\t]([^\t]*)[\t]([^\t]*)[\t]([^\t]*)$} $line - name seq type fwd_color rev_color bold ital]} {
    } elseif {[regexp -nocase {^([^\t]+)[\t][\s]*((?:(?:/.?/)|(?:\*)|[NBDHVKMRYWSACGT]){5,})[\s]*[\t]([\s]*primer_bind[\s]*)[\t]([^\t]*)[\t]([^\t]*)[\t]([^\t]*)[\t]([^\t]*)[\t]([^\t]*)(.*)$} $line - name seq type fwd_color rev_color bold ital qualifiers more]} {
      set note_list [list]
      foreach {qtype value} $qualifiers {
        if {$qtype eq "note"} {
          lappend note_list $value
        }
      }
      set note [join $note_list \u00B6]
    } else {
      set bad_text $line
      lappend log_file_list "#$line"
      incr bad_lines
      #sputs bad line $line
      continue
    }
    regsub -all {\s+} $seq "" seq
    regsub -all {\\[^\\]*\\} $seq "" seq
    regsub -all {/[^/]*/} $seq "" seq
    regsub -all {\*} $seq "" seq
    if {[regexp -nocase {[^NBDHVKMRYWSACGT]} $seq] || [string length $seq] < 5} {
      set bad_text $line
      lappend log_file_list "#$line"
      set seq {}
      incr bad_lines
      #sputs bad line $line
      continue
    }
    if {[lsearch -index 3 $oligos_list  [string toupper $seq]] == -1} {
      set toupper_seq [string toupper $seq]
      set revcom_toupper_seq [revcom $toupper_seq]
      lappend oligos_list [list $name $seq $note $toupper_seq $revcom_toupper_seq]
      lappend log_file_list "$line"
    }
  }
  if {$bad_text ne {}} {
    if {[string length $bad_text] > 53} {
      set bad_text" [string  range $bad_text 0 24]...[string  range $bad_text end-24 end]"
    }
    if {$bad_lines > 1} {
      set response [tk_messageBox -message [mc "Couldn't parse %1\$s lines.\nLast bad line:\n%2\$s\nDo you want to save a repair file?"  $bad_lines $bad_text] -icon warning -type yesno]
    } else {
      set response [tk_messageBox -message [mc "Couldn't parse line:\n%s\nDo you want to save a repair file?" $bad_text] -icon warning -type yesno]
    }
    if {$response eq "yes"} {
       set filename [tk_getSaveFile -title [mc "Save Oligos Repair File"] -defaultextension ".txt"  -filetypes {{"Text File" ".txt"}}]
       while {($filename != "") && ([catch {set save_file [open $filename w]}])} {
        catch {close $save_file}
        tk_messageBox -title [mc "Repair File not Writable"] -message [mc "The file %s is not writable. It may be locked." $filename] -type ok -icon warning -default ok
        set filename [tk_getSaveFile -title [mc "Save Oligos Repair File"] -defaultextension ".txt"  -filetypes {{"Text File" ".txt"}}]
      }

      if {$filename != ""} {
        foreach line $log_file_list {
          puts $save_file $line
        }
        close $save_file
      }
    }
  }


  set gg_info(oligos_list) $oligos_list

  set oligo_i 0
  array unset search
  set frag_list_result [list]
  foreach oligo2 $oligos_list {
    lassign $oligo2 name2 seq2 note2 text2 rc_text2
    set oligo_len [string length $text2]
    foreach oh_left [list 0 3 4] {
      foreach oh_right [list 0 3 4] {
        if {$oh_left == 0 && $oh_right == 0} {continue}
        if { [info exists search($oh_left,[expr {$oligo_len+$oh_left-$oh_right}])]} {
          foreach ry [lsearch -all $search($oh_left,[expr {$oligo_len+$oh_left-$oh_right}]) [string range $rc_text2 0 end-$oh_right]] {
            set oligo1 [lindex $oligos_list [lindex $search(i,[expr {$oligo_len+$oh_left-$oh_right}]) $ry]]
            lassign $oligo1 name1 seq1 note1 text1 rc_text1
            if {$oh_left eq 0} {
              lappend frag_list_result [list [list $name1 $seq1 $note1] [list [list oligo 1 0] [list $name2 $seq2 $note2]] [string length $seq1] [list "XXX" [string range $rc_text2 end-[expr {$oh_right-1}] end]]]
              lappend frag_list_result [list [list $name2 $seq2 $note2] [list [list oligo 1 0] [list $name1 $seq1 $note1]] [string length $seq1] [list [string range $text2 0 [expr {$oh_right-1}]] "XXX"]]
            } elseif {$oh_right eq 0} {
             lappend frag_list_result [list [list $name1 $seq1 $note1] [list [list oligo 1 0] [list $name2 $seq2 $note2]] [string length $seq1] [list [string range $text1 0 [expr {$oh_left-1}]] "XXX"]]
             lappend frag_list_result [list [list $name2 $seq2 $note2] [list [list oligo 1 0] [list $name1 $seq1 $note1]] [string length $seq1] [list "XXX" [string range $rc_text1 end-[expr {$oh_left-1}] end]]]
            } else {
              lappend frag_list_result [list [list $name1 $seq1 $note1] [list [list oligo 1 0] [list $name2 $seq2 $note2]] [string length $seq1] [list [string range $text1 0 [expr {$oh_left-1}]] [string range $rc_text2 end-[expr {$oh_right-1}] end]]]
              lappend frag_list_result [list [list $name2 $seq2 $note2] [list [list oligo 1 0] [list $name1 $seq1 $note1]] [string length $seq1] [list [string range $text2 0 [expr {$oh_right-1}]] [string range $rc_text1 end-[expr {$oh_left-1}] end]]]
            }
          }
        }
      }
    }
    lappend search(0,$oligo_len) $text2
    lappend search(3,$oligo_len) [string range $text2 3 end]
    lappend search(4,$oligo_len) [string range $text2 4 end]
    lappend search(i,$oligo_len) $oligo_i
    incr oligo_i
  }
  set info(golden_gate_assembler_oligos_frags) $frag_list_result

### start: long, slow algorithm- don't use
if {0} {
  set oh_search [lsort -decreasing -unique $oh_search]
  set frag_list_result [list]
  set i 0
  if {[winfo exists $win] && [llength $oligos_list] >200} {
    catch {destroy $win.progress_bar_frame}
    global iset
    place [frame $win.progress_bar_frame] -x [expr {[winfo width $win]/2}] -y [expr {[winfo height $win]/2}] -anchor c
    pack [ttk::progressbar $win.progress_bar_frame.progress -orient horizontal  -mode determinate -length 100 -maximum [llength $oligos_list] -variable iset] -padx 10 -pady 10
    #pack [ttk::progressbar $win.progress_bar_frame.progress -orient horizontal -length 100 -mode indeterminate ] -padx 10 -pady 10
    update idletasks
  }
  foreach oligo1 $oligos_list {
    incr i
    lassign $oligo1 name1 seq1 note1 text1 rc_text1
    if {[expr {$i %10} ==0]} {set iset $i; update idletasks}
   # if {[expr {$i %10} ==0]} {$win.progress_bar_frame.progress step; update idletasks}
    foreach oligo2 [lrange $oligos_list $i end] {
      lassign $oligo2 name2 seq2 note2 text2 rc_text2
      #if {$text1 eq $text2} {continue}
      foreach oh_left $oh_search {
        foreach oh_right $oh_search {
          if {$oh_left == 0 && $oh_right ==0} {continue}
          if {[string range $text1 $oh_left end] eq [string range $rc_text2 0 end-$oh_right]} {
            if {$oh_left eq 0} {
              lappend frag_list_result [list [list $name1 $seq1 $note1] [list [list oligo 1 0] [list $name2 $seq2 $note2]] [string length $seq1] [list "XXX" [string range $rc_text2 end-[expr {$oh_right-1}] end]]]
              lappend frag_list_result [list [list $name2 $seq2 $note2] [list [list oligo 1 0] [list $name1 $seq1 $note1]] [string length $seq1] [list [string range $text2 0 [expr {$oh_right-1}]] "XXX"]]
            } elseif {$oh_right eq 0} {
              lappend frag_list_result [list [list $name1 $seq1 $note1] [list [list oligo 1 0] [list $name2 $seq2 $note2]] [string length $seq1] [list [string range $text1 0 [expr {$oh_left-1}]] "XXX"]]
              lappend frag_list_result [list [list $name2 $seq2 $note2] [list [list oligo 1 0] [list $name1 $seq1 $note1]] [string length $seq1] [list "XXX" [string range $rc_text1 end-[expr {$oh_left-1}] end]]]
            } else {
              lappend frag_list_result [list [list $name1 $seq1 $note1] [list [list oligo 1 0] [list $name2 $seq2 $note2]] [string length $seq1] [list [string range $text1 0 [expr {$oh_left-1}]] [string range $rc_text2 end-[expr {$oh_right-1}] end]]]
              lappend frag_list_result [list [list $name2 $seq2 $note2] [list [list oligo 1 0] [list $name1 $seq1 $note1]] [string length $seq1] [list [string range $text2 0 [expr {$oh_right-1}]] [string range $rc_text1 end-[expr {$oh_left-1}] end]]]
            }
          }
        }
      }
    }
  }
  catch {destroy $win.progress_bar_frame; unset iset}
  set info(golden_gate_assembler_oligos_frags) $frag_list_result
}
### end: long, slow algorithm- don't use

  return 0
}

################
## Test two overhangs for compatibility, including degenerate bases
################
proc golden_gate_overhangs_compatible {oh1 oh2} {
  ## overhangs should already all be upprecase
  if {$oh1 eq $oh2} {return 1}
  if {$oh1 eq {} || $oh2 eq {} || $oh1 eq "XXX" || $oh2 eq "XXX"} {return 0}
  set v "0x[string map {A 8 B 7 C 4 D b G 2 H d K 3 M c N f * f R a S 6 T 1 V e W 9 Y 5} $oh1]"
  set w "0x[string map {A 8 B 7 C 4 D b G 2 H d K 3 M c N f * f R a S 6 T 1 V e W 9 Y 5} $oh2]"
  set x [format %0[string length $oh1]X [expr {$v & $w}]]
  if {[regexp {0} $x]} {
    return 0
  } else {
    return 1
#[string map {8 A 7 B 4 C b D 2 G d H 3 K c M f N f * a R 6 S 1 T e V 9 W 5 Y} $x]
  }
}

################
## Resolve degenerate bases between overhangs
################
proc golden_gate_resolve_overhangs {oh1 oh2} {
  ## overhangs should already all be upprecase
  if {$oh1 eq $oh2} {return $oh1}
  if {$oh1 eq {} || $oh1 eq "XXX" || $oh2 eq "XXX"} {return {}}
  if {$oh2 eq {}} {return $oh1}
  set v "0x[string map {A 8 B 7 C 4 D b G 2 H d K 3 M c N f * f R a S 6 T 1 V e W 9 Y 5} $oh1]"
  set w "0x[string map {A 8 B 7 C 4 D b G 2 H d K 3 M c N f * f R a S 6 T 1 V e W 9 Y 5} $oh2]"
  set x [format "%0[string length $oh1]X" [expr {$v & $w}]]
  if {[regexp {0} $x]} {
    return {}
  } else {
    return [string map {8 A 7 B 4 C b D 2 G d H 3 K c M f N f * a R 6 S 1 T e V 9 W 5 Y} $x]
  }
}


################
## generate golden gate product - uses get_tags2
################
proc golden_gate_generate_product {} {
  global enzinfo  gg_info info

  set dna ""
  set tags [list]
  set filecomment "Golden Gate reaction:\n"
  set cirular "circular"
  set text_0 ""


  for {set i 0} {($gg_info(w,$i) ne "") && ($i < 20)} {incr i} {
    set dir $gg_info(dir,$i)
    set end [string length $dna]
    if {[lindex $gg_info(frag_info,$i) 0 0] ne "oligo"} {
      set w $gg_info(w,$i)
      set text [textarea_get $w.textarea 1.0 end]
      set len [string length $text]
      set site_info $gg_info(frag_info,$i)
      if {[lindex $site_info 0 0] eq "end" || [lindex $site_info 1 0] eq "end"} {
        ## linear product
        set cirular "linear"
      }

       ## circular product
      if {[info exists enzinfo(enz_cut_sites,[lindex $site_info 0 0])]} {
        set site0 $enzinfo(enz_cut_sites,[lindex $site_info 0 0])
        set site1 $enzinfo(enz_cut_sites,[lindex $site_info 1 0])
        set patlen [string length $enzinfo(flatpat,[lindex $site_info 1 0])]
      } else {
        set site0 {0 0}
        set site1 {0 0}
        set patlen 1
      }
      set first [expr {([lindex $site_info 0 1]+ [lindex $site0 $dir] -1) % $len}]
      set last [expr {(([lindex $site_info 1 1] -1) + $patlen - [lindex $site1 [expr {!$dir}]] -1) % $len}]
    
      append filecomment "[file rootname [wm title $w]] from $first ([lindex $site_info 0 0]) to $last ([lindex $site_info 1 0]) [expr {$dir ? "(rev-com)": ""}]\n"

      if {$first < $last} {
        if {$dir} {
          append dna [revcom [string range $text $first $last]]
        } else {
          # forward
          append dna [string range $text $first $last]
        }
      } elseif {$i > 0} {
        # not first fragment, split through origin
        if {$dir} {
          append dna  [revcom [string range $text 0 $last]] [revcom [string range $text $first end]]
        } else {
          # forward
          append dna [string range $text $first end]  [string range $text 0 $last]
        }
      } else {
       ## first fragment, split through origin
        if {$dir} {
          ## shouldn't get to here
        } else {
          # forward
          append dna  [string range $text 0 $last]
          set new_tags [get_tags2 $w.textarea 0 [expr {$last +1}] $dir $end]
          set text_0 [string range $text $first end]
          set tags_0 [get_tags2 $w.textarea $first [string length $text] $dir 0]
        }
      }

      if {$i > 0 || $text_0 ==""} {
        set new_tags [get_tags2 $w.textarea $first [expr {$last +1}] $dir $end]
      }
      lappend_tags tags {*}$new_tags
    } else {
      ## oligo fragment
      #sputs oligo $dir $gg_info(frag_info,$i) $gg_info(w,$i) $gg_info(seq,$i)
      if {[dict exists $info(feature_default_type_colors) misc_feature]} {
      set rev_colors [dict get $info(feature_default_type_colors) misc_feature]
      } else {
        set rev_colors [list $info(feature_default_fcolor) $info(feature_default_rcolor)]
      }
      if {[dict exists $info(feature_default_type_gformat) misc_feature]} {
        set tag_gformat [dict get $info(feature_default_type_gformat) misc_feature]
      } else {
        set tag_gformat $info(feature_default_gformat)
      }
      if {$dir} {
        append dna [lindex $gg_info(frag_info,$i) 1 1]
        set metadata [list [lindex $gg_info(frag_info,$i) 1 0] $tag_gformat misc_feature 0 [list] [list]]
        set new_tags [list f0# [list [list [expr {$end }]  [expr {$end  + [string length [lindex $gg_info(frag_info,$i) 1 1]]}]] [list [lindex $rev_colors 0] {} {} {}] [list <<Revcolors>> <<Metadata>>] [list $rev_colors $metadata]]]
        set metadata [list $gg_info(seq,$i)  $tag_gformat misc_feature 1 [list] [list]]
        lappend new_tags {*}[list f1# [list [list [expr {$end  + [string length $gg_info(oh5,$i)]}]  [expr {$end  + [string length $gg_info(oh3,$i)] + [string length [lindex $gg_info(frag_info,$i) 1 1]]}]] [list [lindex $rev_colors 1] {} {} {}] [list <<Revcolors>> <<Metadata>>] [list $rev_colors $metadata]] ]
        append filecomment "oligo pair: [lindex $gg_info(frag_info,$i) 1 0] / $gg_info(seq,$i)   [lindex $gg_info(frag_info,$i) 1 1]  [lindex $gg_info(w,$i) 1]  \n"
      } else {
        append dna [lindex $gg_info(w,$i) 1]
        set metadata [list $gg_info(seq,$i) $tag_gformat misc_feature 0 [list] [list]]
        set new_tags [list f0# [list [list [expr {$end }]  [expr {$end  + [string length [lindex $gg_info(w,$i) 1]]}]] [list [lindex $rev_colors 0] {} {} {}] [list <<Revcolors>> <<Metadata>>] [list $rev_colors $metadata]]]
        set metadata [list [lindex $gg_info(frag_info,$i) 1 0]  $tag_gformat misc_feature 1 [list] [list]]
        lappend new_tags {*}[list f1# [list [list [expr {$end  + [string length $gg_info(oh5,$i)]}]  [expr {$end  + [string length $gg_info(oh3,$i)] + [string length [lindex $gg_info(w,$i) 1]]}]] [list [lindex $rev_colors 1] {} {} {}] [list <<Revcolors>> <<Metadata>>] [list $rev_colors $metadata]] ]
        append filecomment "oligo pair: $gg_info(seq,$i) / [lindex $gg_info(frag_info,$i) 1 0]   [lindex $gg_info(w,$i) 1]     [lindex $gg_info(frag_info,$i) 1 1] \n"
      }
      lappend_tags tags {*}$new_tags
    }
  }

  if {$text_0 ne ""} {
    set end_0 [string length $dna]
    append dna $text_0
    set end [string length $dna]
    set new_tags2 [list]
    foreach {tag data} $tags_0 {
      set newcoords [list]  
      foreach {a b} [lindex $data 0] {
	    set a [expr {$a +$end_0}]
        set b [expr {$b +$end_0}]
        if {$b <= $end} {
          lappend newcoords $a $b
        } elseif {$a >= $end} {
          lappend newcoords [expr {$a-$end}] [expr {$b-$end}]
        } elseif {$b > $end} {
          lappend newcoords $a [expr {$end}]
          lappend newcoords 0 [expr {$b-$end}]
        } 
      }
      if {$newcoords != [list]} {
        lset data 0 $newcoords
        lappend new_tags2 $tag $data
      }
    }
    lappend_tags tags {*}$new_tags2
  }
    
  create_window $dna "" $filecomment $cirular 1 0 New_Golden_Gate $tags {} GenBank
}

################
## Fill molar calulator with GG fragment info
################
proc golden_gate_fill_calculator {} {
  global enzinfo  gg_info

  set result [list]
  for {set i 0} {($gg_info(w,$i) ne "") && ($i < 20)} {incr i} {
    if {[lindex $gg_info(frag_info,$i) 0 0] ne "oligo"} {
      set w $gg_info(w,$i)
      set dir $gg_info(dir,$i)
      set len [ix2bp $w.textarea end]
      set site_info $gg_info(frag_info,$i)
      if {[info exists enzinfo(enz_cut_sites,[lindex $site_info 0 0])]} {
        set site0 $enzinfo(enz_cut_sites,[lindex $site_info 0 0])
        set site1 $enzinfo(enz_cut_sites,[lindex $site_info 1 0])
        set patlen [string length $enzinfo(flatpat,[lindex $site_info 1 0])]
      } else {
        set site0 {0 0}
        set site1 {0 0}
        set patlen 1
      }
      set first [expr {([lindex $site_info 0 1]+ [lindex $site0 $dir] -1) % $len}]
      set last [expr {(([lindex $site_info 1 1] -1) + $patlen - [lindex $site1 [expr {!$dir}]] -1) % $len}]
      if {$first < $last} {
        set frag_len [expr {$last-$first}]
      } else {
        set frag_len [expr {$len+$last-$first}]
      }
      ## don't use the fragments- use the full sequence length
      #lappend result [list "[file rootname [wm title $w]] from $first ([lindex $site_info 0 0]) to $last ([lindex $site_info 1 0])" $frag_len]
      lappend result [list "[file rootname [wm title $w]] from 1 to $len" $len]
    } else {
      if {$gg_info(dir,$i)} {
        lappend result [list "oligo pair:  [lindex $gg_info(frag_info,$i) 1 0] / $gg_info(seq,$i)" [string length [lindex $gg_info(frag_info,$i) 1 0] ]]
      } else {
        lappend result [list "oligo pair: $gg_info(seq,$i) / [lindex $gg_info(frag_info,$i) 1 0]" [string length $gg_info(seq,$i) ]]
      }
    }
  }
  calc_molar_reaction_fill   molar_ratio $result "golden"
}


################
## Calculate a total efficiency from overhangs list
################
proc golden_gate_efficiency {oh_seqs_list} {
  global gg_calc

  if {![info exists gg_calc] || [llength $gg_calc(data_4)] == 0} {
    initialize_gg_data_tables
  }

  set  oh_list  [list]
  set numerators_list [list]
  set oh_list_half [list]

  foreach seq $oh_seqs_list {
    set oh_len [string length $seq]
    if {![dict exists $gg_calc(b2n) [string tolower $seq]]} {return ""}
    lappend oh_list [set a [dict get $gg_calc(b2n) [string tolower $seq]]] $oh_len
    lappend oh_list_half $a $oh_len
    if {$oh_len == 4} {
      lappend numerators_list [lindex $gg_calc(data_4) $a $a]
    } else {
      lappend numerators_list [lindex $gg_calc(data_3) $a $a]
    }
  }

  foreach {oh oh_len} $oh_list {
    if {$oh_len == 4} {
      lappend oh_list [set a [dict get $gg_calc(n2rc_4) $oh]] $oh_len
      lappend numerators_list [lindex $gg_calc(data_4) $a $a]
    } else {
      lappend oh_list [set a [dict get $gg_calc(n2rc_3) $oh]] $oh_len
      lappend numerators_list [lindex $gg_calc(data_3) $a $a]
    }
  }

  set current_eff 1.0
  foreach {a a_len} $oh_list num $numerators_list {
    set den 0
    foreach {oh oh_len} $oh_list_half {
      if {$oh_len != $a_len} {continue}
      if {$oh_len == 4} {
        incr den [lindex $gg_calc(data_4_double) $a $oh]
      } else {
        incr den [lindex $gg_calc(data_3_double) $a $oh]
      }
    }
    if {$den > 0} {
      set current_eff [expr {$current_eff*$num/$den}]
    }
  }
  return $current_eff

}

################
## NOT USED reverse_golden_gate_dialog
################
proc reverse_golden_gate_dialog {w} { 
  global info modifier dialogblock modstring enzinfo
  global ok gg_enz gg_seq gg_nparam gg_info

  if {$dialogblock == 1} {return}
  set s [new_dialog $w "Reverse Golden Gate Reaction..." "NEW DNAS"]
  bind $s <<Cancel>> "set ok -1"
  bind $s <<OK>> "set ok 1"
  set ok 0
  

  grid [frame $s.seqframe] -row 0 -column 0 -sticky nswe
  grid [menubutton $s.seqframe.menub -menu $s.seqframe.menub.m -textvariable gg_seq] -row 0 -column 1 -sticky nsew
  menu $s.seqframe.menub.m
  set gg_info(seq) $w
  set gg_seq [wm title $w]
  foreach {win} [dnawindows_list 1] {
    $s.seqframe.menub.m add radiobutton -label [wm title $win] -value $win -variable gg_info(seq) -command "set gg_seq \"[wm title $win]\"; rev_golden_gate_fill_dialog $s"
  }

  grid [frame $s.enzframe] -row 1 -column 0 -sticky nswe
  grid [menubutton $s.enzframe.menub -menu $s.enzframe.menub.m -textvariable gg_enz] -row 0 -column 1 -sticky nsw
  menu $s.enzframe.menub.m
  set gg_info(enz) ""
  set enz_list [golden_gate_enzymes]
  if {[llength $enz_list] == 0} {
    set gg_enz [mc "No Suitable Enzymes Available"]
  } elseif {[llength $enz_list] == 1} {
    set gg_enz [lindex $enz_list 0]
    set gg_info(enz) [lindex $enz_list 0]
  } else {
    set gg_enz [mc "Choose an Enzyme..."]
    foreach enz [golden_gate_enzymes] {
      $s.enzframe.menub.m add radiobutton -label "$enz" -variable gg_info(enz) -value $enz -command "set gg_enz $enz; set gg_info(enz) $enz; rev_golden_gate_fill_dialog $s"
    }
  }




  grid [frame $s.overlapsframe] -row 2 -column 0 -sticky nswe
  #grid [label $s.overlapsframe.l1 -text [mc "Overlap features:"]] -row 1 -column 0 -columnspan 3 -sticky nw
  #grid [label $s.overlapsframe.l2 -text [mc "Name:"]] -row 2 -column 0 -sticky nw
  grid [menubutton $s.overlapsframe.nameparam -menu $s.overlapsframe.nameparam.m -textvariable gg_nparam] -row 2 -column 1 -sticky nw
    set gg_nparam [mc "Feature Name Contains:"]
    menu $s.overlapsframe.nameparam.m
    $s.overlapsframe.nameparam.m add radiobutton -label [mc "Feature Name Contains:"] -variable gg_info(nparam) -value contains -command "set gg_nparam \"[mc "Feature Name Contains:"]\"; rev_golden_gate_fill_dialog  $s"
    $s.overlapsframe.nameparam.m add radiobutton -label [mc "Feature Name Starts With:"] -variable gg_info(nparam) -value starts -command "set gg_nparam \"[mc "Feature Name Starts With:"]\"; rev_golden_gate_fill_dialog $s"
    $s.overlapsframe.nameparam.m add radiobutton -label [mc "Feature Name Ends With:"] -variable gg_info(nparam) -value ends -command "set gg_nparam \"[mc "Feature Name Ends With:"]\"; rev_golden_gate_fill_dialog $s"
    $s.overlapsframe.nameparam.m add radiobutton -label [mc "Feature Name Is Exactly:"] -variable gg_info(nparam) -value exact -command "set gg_nparam \"[mc "Feature Name Is Exactly:"]\"; rev_golden_gate_fill_dialog $s"
    set gg_info(nparam) "contains"
  grid [entry $s.overlapsframe.nameentry -textvariable gg_info(gg_name)] -row 2 -column 2 -sticky nw
  bind $s.overlapsframe.nameentry <FocusOut> "sputs here \$gg_info(gg_name);rev_golden_gate_fill_dialog $s"
  bind $s.overlapsframe.nameentry <Key-Return> "focus $s"
  bind $s.overlapsframe.nameentry <Key-Tab> "focus $s"

  #grid [label $s.overlapsframe.l3 -text [mc "Type:"]] -row 3 -column 0 -sticky nw
  #grid [menubutton $s.overlapsframe.typeparam -menu $s.overlapsframe.typeparam.m -textvariable gg_tparam] -row 3 -column 1 -sticky nw
  #menu $s.overlapsframe.typeparam.m

  grid [frame $s.fragmentsframe] -row 3 -column 0 -sticky nswe

  grid [frame $s.mismatchframe] -row 4 -column 0 -sticky nsew
  grid [label $s.mismatchframe.l1 -text [mc "Show mismatches at most:"]] -row 0 -column 0 -sticky ne
  grid [menubutton $s.mismatchframe.menub1 -menu $s.mismatchframe.menub1.m -textvariable info(rev_gg_max_mismatch)] -row 0 -column 1 -sticky nsw
  menu $s.mismatchframe.menub1.m
  grid [label $s.mismatchframe.l2 -text [mc "Show steric mismatches at most:"]] -row 1 -column 0 -sticky ne
  grid [menubutton $s.mismatchframe.menub2 -menu $s.mismatchframe.menub2.m -textvariable info(rev_gg_max_ry_mismatch)] -row 1 -column 1 -sticky nsw
  menu $s.mismatchframe.menub2.m
  for {set mmi 0} {$mmi <=3} {incr mmi} {
    $s.mismatchframe.menub1.m add radiobutton -label $mmi -variable info(rev_gg_max_mismatch) -value $mmi -command   "rev_golden_gate_fill_dialog $s"
    $s.mismatchframe.menub2.m add radiobutton -label $mmi -variable info(rev_gg_max_ry_mismatch) -value $mmi -command   "rev_golden_gate_fill_dialog $s"
  }
  grid [text $s.mismatchframe.warnings -height 0] -row 2 -column 0 -columnspan 2 -sticky nsew
  grid columnconfigure $s.mismatchframe 1 -weight 1
  grid remove $s.mismatchframe.warnings


    grid [frame $s.okframe] -row 5 -column 0 -sticky nswe
     grid [button $s.okframe.cancel -text [mc "Cancel"] -command "set ok -1"] -row 1 -column 0 -sticky nw -padx 10 -pady 3
    grid [button $s.okframe.ok -text [mc "OK"] -command "set ok 1" -default active -state disabled] -row 1 -column 1 -sticky nw -padx 10 -pady 3
 

  rev_golden_gate_fill_dialog $s
  vwait ok

  destroy $s
  set dialogblock 0
  bind . <<RaiseDialogs>> ""

  if {$ok == 1} {
    # gg_info: seq enz indices gg_oligos$i
    set indices $gg_info(indices)
    set w $gg_info(seq)
    set enzyme $gg_info(enz)
    set cs $enzinfo(enz_cut_sites,$enzyme)
    set overhang [expr {abs([lindex $cs 1]- [lindex $cs 0])}]
    for {set i 0} {$i< [llength $indices]} {incr i} {
      if {$gg_info(gg_skip$i)} {continue}
      if {$gg_info(gg_oligos$i)} {
        # oligos
        set i1 [lindex $indices $i 3]
        set i2 [lindex $indices [expr {($i+1)%[llength $indices]}] 3]
        set i3 0
        if {$i2 <= $i1} {
          set i3 [expr {$i2}]
          set i2 [ix2bp $w.textarea end]
        }
        set dna  [textarea_get $w.textarea [bp2ix $w.textarea $i1] [bp2ix $w.textarea $i2]]
        set tags [get_tags $w.textarea [list [bp2ix $w.textarea $i1] [bp2ix $w.textarea $i2]] "forward"]
        set dna_r  [revcom [textarea_get $w.textarea [bp2ix $w.textarea [expr {$i1 + $overhang}]] [bp2ix $w.textarea [expr {$i2 + $overhang}]]]]
        set tags_r [get_tags $w.textarea [list [bp2ix $w.textarea [expr {$i1+$overhang}]] [bp2ix $w.textarea [expr {$i2+$overhang}]]] "reverse"]
        if {$i3 != 0} {
          set newdna  [textarea_get $w.textarea [bp2ix $w.textarea 0] [bp2ix $w.textarea $i3]]
          set end [string length $dna]
          append dna $newdna
          set new_tags [get_tags $w.textarea [list [bp2ix $w.textarea 0] [bp2ix $w.textarea $i3]] "forward"]
          foreach {tag data} $new_tags {
            set newcoords [list]
            foreach coords [lindex $data 0] {
              lappend newcoords [expr {$end + $coords}]
            }
            lset data 0 $newcoords
            lappend tags $tag $data
          }
          set newdna_r  $dna_r
          set dna_r  [revcom [textarea_get $w.textarea [bp2ix $w.textarea 0] [bp2ix $w.textarea [expr {$i3 + $overhang}]]]]
          set end [string length $dna_r]
          append dna_r $newdna_r
          set new_tags_r $tags_r
          set tags_r [get_tags $w.textarea [list [bp2ix $w.textarea 0] [bp2ix $w.textarea [expr {$i3 + $overhang}]]] "reverse"]
          foreach {tag data} $new_tags_r {
            lset data 0 [list [expr {$end + [lindex $data 0 0]}] [expr {$end + [lindex $data 0 1]}]]
            lappend tags_r $tag $data
          }
        }
        create_window $dna "" "" "linear" 1 0 $gg_info(gg_name$i) $tags {} GenBank
        create_window $dna_r "" "" "linear" 1 0 $gg_info(gg_name$i) $tags_r {} GenBank
      } else {
        # dsDNA
        set tags [list]
        set dna [string range "gtg[string toupper $enzinfo(flatpat,$enzyme)]gggggggggg" 0 [expr {min([lindex $cs 0],[lindex $cs 1])+2}]]
        set i1 [lindex $indices $i 3]
        set i2 [lindex $indices [expr {($i+1)%[llength $indices]}] 3]
        set i3 0
        if {$i2 <= $i1} {
          set i3 [expr {$i2 + $overhang}]
          set i2 [ix2bp $w.textarea end]
        } else {
           set i2 [expr {$i2 + $overhang}]
        }
        set newdna  [textarea_get $w.textarea [bp2ix $w.textarea $i1] [bp2ix $w.textarea $i2]]
        set end [string length $dna]
        append dna $newdna
        set new_tags [get_tags $w.textarea [list [bp2ix $w.textarea $i1] [bp2ix $w.textarea $i2]] "forward"]
        foreach {tag data} $new_tags {
          set newcoords [list]
          foreach coords [lindex $data 0] {
            lappend newcoords [expr {$end + $coords}]
          }
          lset data 0 $newcoords
          lappend tags $tag $data
        }
        if {$i3 != 0} {
          set newdna  [textarea_get $w.textarea [bp2ix $w.textarea 0] [bp2ix $w.textarea $i3]]
          set end [string length $dna]
          append dna $newdna
          set new_tags [get_tags $w.textarea [list [bp2ix $w.textarea 0] [bp2ix $w.textarea $i3]] "forward"]
          foreach {tag data} $new_tags {
            set newcoords [list]
            foreach coords [lindex $data 0] {
              lappend newcoords [expr {$end + $coords}]
            }
            lset data 0 $newcoords
            lappend tags $tag $data
          }
        }
        append dna [revcom [string range "gtg[string toupper $enzinfo(flatpat,$enzyme)]gggggggggg" 0 [expr {min([lindex $cs 0],[lindex $cs 1])+2}]]]
        create_window $dna "" "" "linear" 1 0 $gg_info(gg_name$i) $tags {} GenBank
      }
    }
  }
  unset ok gg_enz gg_seq gg_nparam gg_info
}

################
## NOT USED reverse golden gate accessory routine
################
proc rev_golden_gate_fill_dialog {s} {
  global gg_info enzinfo info
  #set s ".dialog"
  ## fill with fragments bordered by feature names and positions
  ## each fragment has a button for being a dsDNA or oligos
  if {$gg_info(enz) eq ""} {
    grid remove $s.overlapsframe
    grid remove $s.mismatchframe
    $s.okframe.ok configure -state disabled
    return
  } else {
    set w $gg_info(seq)
    set enzyme $gg_info(enz)
    set cs $enzinfo(enz_cut_sites,$enzyme)
    findenzymes $w
    if {[llength $info($w,$enzyme)] > 0} {
      foreach c [winfo children $s.fragmentsframe] {
        destroy $c
      }
      grid [label $s.fragmentsframe.l0 -text [mc "The enzyme %s is present in the sequence, choose another enzyme." $enzyme] -foreground red] -row 0 -column 0
      grid remove $s.overlapsframe
      grid remove $s.mismatchframe
      $s.okframe.ok configure -state disabled
      return
    }

    set overhang [expr {abs([lindex $cs 1]- [lindex $cs 0])}]
    set w $gg_info(seq)
    set indices [list]
    foreach feature [lsearch -all -regexp -inline [$w.textarea tag names] {f[0-9]+#}] {
      set feature_name [lindex [$w.textarea tag bind $feature <<Metadata>>] 0]
      if {$gg_info(gg_name) ne ""} {
        case $gg_info(nparam) {
          "contains" {
             if {[string first $gg_info(gg_name) $feature_name] == -1} {continue}
           }
          "starts" {
             if {[string first $gg_info(gg_name) $feature_name] != 0} {continue}
           }
          "ends" {
             if {[string last $gg_info(gg_name) $feature_name] != [expr {[string length $feature_name] -[string length $gg_info(gg_name)]}]} {continue}
           }
          "exact" {
             if {$gg_info(gg_name) ne $feature_name} {continue}
           }
        }
      }
      if {[llength [$w.textarea tag ranges $feature]] != 2} {continue}
      if {[string length [set oh_sequence [textarea_get $w.textarea {*}[$w.textarea tag ranges $feature]]]] != $overhang} {continue}
      lappend indices [list $feature $feature_name [lindex [$w.textarea tag ranges $feature] 0] [ix2bp $w.textarea [lindex [$w.textarea tag ranges $feature] 0]] $oh_sequence]
    }
    if {[llength $indices] > 0} {  
      set indices [lsort -increasing -integer -index 3 $indices]
      set gg_info(indices) $indices
      $s.okframe.ok configure -state normal
      grid configure $s.overlapsframe
      grid configure $s.mismatchframe
      foreach c [winfo children $s.fragmentsframe] {
        destroy $c
      }
      for {set i 0} {$i< [llength $indices]} {incr i} {
        set gg_info(gg_oligos$i) 0
        #grid [label $s.fragmentsframe.l$i -text "Fragment $i: [lindex $indices $i 1] at [lindex $indices $i 3] to [lindex $indices [expr {($i+1)%[llength $indices]}] 1] at [lindex $indices [expr {($i+1)%[llength $indices]}] 3]"] -row $i -column 0


         ##build fragment names
         set title [file rootname [wm title $w]]
         set name_list [list]
         set c1  [lindex $indices $i 3]
         set c2 [lindex $indices [expr {($i+1)%[llength $indices]}] 3]
         foreach {tag_name tag} [feature_find $w $c1 $c2] {
           set len 0
           foreach pair [get_feature_exons_indexes $w $tag] {
             set len [expr {$len + [$w.textarea count -chars {*}$pair] + [$w.textarea count -lines {*}$pair]}]
           }
           lappend name_list "$title\_$tag_name" $len
         }
         set name_list [lsort -decreasing -stride 2 -index 1 -integer $name_list]
         set name_list [dict keys $name_list]
         if {$name_list == {}} {
           set name_list [list "Fragment $i"]
        }
        set gg_info(gg_name$i) [lindex $name_list 0]
        grid [ttk::combobox $s.fragmentsframe.name$i -textvariable gg_info(gg_name$i) -values $name_list]
        
        grid [label $s.fragmentsframe.l$i -text "[lindex $indices $i 1] at [lindex $indices $i 3] to [lindex $indices [expr {($i+1)%[llength $indices]}] 1] at [lindex $indices [expr {($i+1)%[llength $indices]}] 3]"] -row $i -column 1
        grid [checkbutton $s.fragmentsframe.cb$i -variable gg_info(gg_oligos$i) -text [mc "Oligos"] ] -row $i -column 2
        set gg_info(gg_skip$i) 0
        grid [checkbutton $s.fragmentsframe.skip$i -variable gg_info(gg_skip$i) -text [mc "Skip"] ] -row $i -column 3
      }

      ## Check for matching overhangs
      set gg_info(warnings) [list]
      for {set j 0} {$j < [llength $indices]} {incr j} {
        set oh_j [string toupper [lindex $indices $j 4]]
        set oh_ry_j [ string map {A R G R T Y C Y} $oh_j]
        for {set k [expr {$j}]} {$k < [llength $indices]} {incr k} {
          set oh_k [string toupper [lindex $indices $k 4]]
          set oh_ry_k [ string map {A R G R T Y C Y} $oh_k]
          if {$j != $k } {
            set mm 0
            set mm_ry 0
            for {set n 0} {$n < [string length $oh_k]} {incr n} {
              if {[string index $oh_j $n] != [string index $oh_k $n]} {incr mm}
              if {[string index $oh_ry_j $n] != [string index $oh_ry_k $n]} {incr mm_ry}
            }
            if {$mm <= $info(rev_gg_max_mismatch) && $mm_ry <= $info(rev_gg_max_ry_mismatch)} {
              lappend gg_info(warnings) [list $j $k $mm fwd]
            }
          }
          set oh_k [revcom $oh_k]
          set oh_ry_k [revcom $oh_ry_k]
          set mm 0
          set mm_ry 0
          for {set n 0} {$n < [string length $oh_k]} {incr n} {
            if {[string index $oh_j $n] != [string index $oh_k $n]} {incr mm}
            if {[string index $oh_ry_j $n] != [string index $oh_ry_k $n]} {incr mm_ry}
          }
          if {$mm <= $info(rev_gg_max_mismatch) && $mm_ry <= $info(rev_gg_max_ry_mismatch)} {
            lappend gg_info(warnings) [list $j $k $mm rev]
          }
        }
      }
      #sputs gg warnings $gg_info(warnings)
      if {$gg_info(warnings) != [list]} {
        grid configure $s.mismatchframe.warnings
        $s.mismatchframe.warnings configure -state normal
        $s.mismatchframe.warnings delete 1.0 end
        set text_list [list]
        foreach warning $gg_info(warnings)  {
          if {[lindex $warning 3] == "fwd"} {
            lappend text_list "Potential illegitimate match:  [lindex $indices [lindex $warning 0] 1] at [lindex $indices [lindex $warning 0] 3] ([lindex $indices [lindex $warning 0] 4]---)  with  [lindex $indices [lindex $warning 1] 1] at [lindex $indices [lindex $warning 1] 3] ([revcom [ lindex $indices [lindex $warning 1] 4]]---)"
          } else {
            lappend text_list "Potential illegitimate match:  [lindex $indices [lindex $warning 0] 1] at [lindex $indices [lindex $warning 0] 3] ([lindex $indices [lindex $warning 0] 4]---)  with  [lindex $indices [lindex $warning 1] 1] at [lindex $indices [lindex $warning 1] 3] ([lindex $indices [lindex $warning 1] 4]---)"
           }
        }
        $s.mismatchframe.warnings insert end [join $text_list \n]
        $s.mismatchframe.warnings configure -state disabled -height [expr {2* int([.dialog.mismatchframe.warnings index  end])}]
      } else {
        grid remove $s.mismatchframe.warnings
      }
 
    } else {
      set gg_info(indices) [list]
      $s.okframe.ok configure -state disabled
      grid remove $s.overlapsframe
      grid remove $s.mismatchframe
      foreach c [winfo children $s.fragmentsframe] {
        destroy $c
      }
      grid [label $s.fragmentsframe.l0 -text [mc "There are no matching features with a length of %1\$s (the overhang length of %2\$s)." $overhang $enzyme] -foreground red] -row 0 -column 0

    }  
  }
}


################
## Gibson reaction dialog
################
proc gibson_dialog {w} {
  global info temp_info modifier dialogblock modstring
  global ok 

  if {$dialogblock == 1} {return}

  set s [new_dialog $w "Gibson Designer" "NEW DNA"]
  bind $s <<Cancel>> "set ok -1"
  bind $s <<OK>> "set ok 1"
  set ok 0
  array unset temp_info
  
  grid [frame $s.configframe] -row 0 -column 0 -sticky nswe
  if {$info(use_tile)} {
    grid [ttk::separator $s.sep] -row 1 -column 0 -sticky nwe
  } else {
    $s.configframe configure -relief ridge -borderwidth 2
  }
  grid [frame $s.configframe.min] -row 0 -column 0 -sticky nwe
  grid [label $s.configframe.min.label1 -text [mc "Minimum overlap"]] -row 0 -column 1 -sticky nw
  grid [ttk::spinbox $s.configframe.min.min_value -textvariable info(gib_min_overlap) -from 5 -to 100 -validate all -validatecommand "entry_integer %P %W %V 5 100"]  -row 0 -column 2 -sticky nw 
  grid [ttk::scale $s.configframe.min.min_scale  -orient horizontal -from 5 -to 100 -variable info(gib_min_overlap) -command "set info(gib_min_overlap) \[expr {int(\$info(gib_min_overlap))}\];set info(gib_max_overlap) \[expr {max(\$info(gib_max_overlap), \$info(gib_min_overlap))}\];gibson_fill_frame_first $s.seqsframe $w;#"]  -row 0 -column 3 -sticky nwe -padx {0 8} 
  grid columnconfigure $s.configframe.min 3 -weight 1

  grid [frame $s.configframe.max] -row 1 -column 0 -sticky nwe
  grid [label $s.configframe.max.label1 -text [mc "Maximum overlap"]] -row 0 -column 1 -sticky nw
  grid [ttk::spinbox $s.configframe.max.max_value -textvariable info(gib_max_overlap) -from 10 -to 1000 -validate all -validatecommand "entry_integer %P %W %V 10 1000"]  -row 0 -column 2 -sticky nw 
grid [ttk::scale $s.configframe.max.max_scale  -orient horizontal -from 10 -to 1000 -variable info(gib_max_overlap) -command "set info(gib_max_overlap) \[expr {int(\$info(gib_max_overlap))}\];set info(gib_min_overlap) \[expr {min(\$info(gib_max_overlap), \$info(gib_min_overlap))}\];gibson_fill_frame_first $s.seqsframe $w;#"]  -row 0 -column 3 -sticky nwe -padx {0 8} 
  grid columnconfigure $s.configframe.max 3 -weight 1

  grid [frame $s.configframe.max_nh] -row 2 -column 0 -sticky nwe
  grid [label $s.configframe.max_nh.label1 -text [mc "Maximum Non-homologous end"]] -row 0 -column 1 -sticky nw
  grid [label $s.configframe.max_nh.max_value -textvariable info(gib_max_nonhom) -from 0 -to 20 -validate all -validatecommand "entry_integer %P %W %V 0 20"]  -row 0 -column 2 -sticky nw 
  grid [ttk::scale $s.configframe.max_nh.max_scale  -orient horizontal -from 0 -to 20 -variable info(gib_max_nonhom) -command "set info(gib_max_nonhom) \[expr {int(\$info(gib_max_nonhom))}\]; if {\$info(gib_max_nonhom) > 0} {$s.configframe.allow_double configure -state normal} else {$s.configframe.allow_double configure -state disabled};gibson_fill_frame_first $s.seqsframe $w;#"]  -row 0 -column 3 -sticky nwe -padx {0 8} 
  grid columnconfigure $s.configframe.max_nh 3 -weight 1

  grid [frame $s.configframe.max_frag] -row 3 -column 0 -sticky nwe
  grid [label $s.configframe.max_frag.label1 -text [mc "Maximum Fragments"]] -row 0 -column 1 -sticky nw
  grid [ttk::spinbox $s.configframe.max_frag.max_value -textvariable info(gib_max_fragments) -from 1 -to 100 -validate all -validatecommand "entry_integer %P %W %V 1 100"]  -row 0 -column 2 -sticky nw 
  grid [ttk::scale $s.configframe.max_frag.max_scale  -orient horizontal -from 1 -to 100 -variable info(gib_max_fragments) -command "set info(gib_max_fragments) \[expr {int(\$info(gib_max_fragments))}\];gibson_fill_frame_first $s.seqsframe $w;#"]  -row 0 -column 3 -padx {0 8} -sticky nwe
  grid columnconfigure $s.configframe.max_frag 3 -weight 1

  grid [checkbutton $s.configframe.allow_double -text [mc "Allow double non-homologous ends"] -variable info(gib_double_nonhom) -command "gibson_fill_frame_first $s.seqsframe $w"]  -row 4 -column 0 -sticky w -columnspan 3
  if {$info(gib_max_nonhom) > 0} {
    $s.configframe.allow_double configure -state normal
  } else {
    $s.configframe.allow_double configure -state disabled
  }
  #grid [checkbutton $s.configframe.require_circ -text [mc "Require circular product"] -variable info(gib_require_circ) -command "gibson_fill_frame_first $s.seqsframe $w"]  -row 5 -column 0 -sticky w -columnspan 3
  grid columnconfigure $s.configframe 0 -weight 1


  grid [frame $s.seqsframe] -row 2 -column 0 -sticky nswe

  grid [frame $s.okframe] -row 3 -column 0 -sticky nswe
  grid [button $s.okframe.cancel -text [mc "Cancel"] -command "set ok -1"] -row 1 -column 0 -sticky nw -padx 10 -pady 3
  grid [button $s.okframe.ok -text [mc "OK"] -command "set ok 1" -default active -state normal] -row 1 -column 1 -sticky nw -padx 10 -pady 3
  #update
  grid columnconfigure $s 0 -weight 1 
  gibson_fill_frame_first $s.seqsframe $w

  vwait ok

  destroy $s
  set dialogblock 0
  bind . <<RaiseDialogs>> ""

  if {$ok == 1} {
    set dna ""
    set tags [list]
    set fragments [llength [array names temp_info frag_data,*]]
    for {set i 0} {$i < $fragments} {incr i} {
      set j [expr {($i + 1) % $fragments}]
      set w1 $temp_info(window_mb_window,$i)
      set len [ix2bp $w1.textarea end]
      set dir [expr {!$temp_info(frag_fwd,$i)}]
      set overhang [lindex $temp_info(frag_data,$j) 0]
      set left_skip [lindex $temp_info(frag_data,$i) 2]
      set right_skip [lindex $temp_info(frag_data,$j) 1]

      set new_dna [textarea_get $w1.textarea [bp2ix $w1.textarea $left_skip] [bp2ix $w1.textarea [expr {$len-$right_skip-$overhang}]]]
      if {!$dir} {
        ## forward fragment
        set new_dna [textarea_get $w1.textarea [bp2ix $w1.textarea $left_skip] [bp2ix $w1.textarea [expr {$len-$right_skip-$overhang}]]]
        if {$j == 0} {
          set new_tags [get_tags $w1.textarea [list [bp2ix $w1.textarea $left_skip] [bp2ix $w1.textarea [expr {$len-1-$right_skip-$overhang}]]] [expr {$dir?"reverse":"forward"}]]
        } else {
          set new_tags [get_tags $w1.textarea [list [bp2ix $w1.textarea $left_skip] [bp2ix $w1.textarea [expr {$len-1-$right_skip}]]] [expr {$dir?"reverse":"forward"}]]
        }
      } else {
        ## reverse fragment
        set new_dna [textarea_get $w1.textarea [bp2ix $w1.textarea [expr {$right_skip+$overhang}]] [bp2ix $w1.textarea [expr {$len-$left_skip}]]]
        set new_dna [revcom $new_dna] 
        if {$j == 0} {
          set new_tags [get_tags $w1.textarea [list [bp2ix $w1.textarea [expr {$right_skip+$overhang}]] [bp2ix $w1.textarea [expr {$len-$left_skip}]]] [expr {$dir?"reverse":"forward"}]]
        } else {
          set new_tags [get_tags $w1.textarea [list [bp2ix $w1.textarea [expr {$right_skip}]] [bp2ix $w1.textarea [expr {$len-$left_skip}]]] [expr {$dir?"reverse":"forward"}]]
        }
      }
      set end [string length $dna]
      append dna $new_dna
      foreach {tag data} $new_tags {
        set newcoords [list]
        foreach coords [lindex $data 0] {
          lappend newcoords [expr {$end + $coords}]
        }
        lset data 0 $newcoords
        lappend tags $tag $data
      }
      if {$j == 0} {
        if {!$dir} {
          set new_tags [get_tags $w1.textarea [list [bp2ix $w1.textarea [expr {$len-$right_skip-$overhang}]] [bp2ix $w1.textarea [expr {$len-$right_skip}]]] [expr {$dir?"reverse":"forward"}]]
        } else {
          set new_tags [get_tags $w1.textarea [list [bp2ix $w1.textarea [expr {$right_skip}]] [bp2ix $w1.textarea [expr {$right_skip+$overhang}]]] [expr {$dir?"reverse":"forward"}]]
        }
        lappend tags {*}$new_tags
      }
    }
    create_window $dna "" "" "circular" 1 0 New_Gibson $tags {} GenBank
  }
  unset ok
  array unset temp_info
}



################
## Gibson sub-proc to find overhangng matching ends
################
proc gibson_find_ends {} {
  global info
  set min $info(gib_min_overlap)
  set max $info(gib_max_overlap)
  set max_nh $info(gib_max_nonhom)
  set double_nh $info(gib_double_nonhom)
  set req_circ $info(gib_require_circ)

  #make ends list index 1 is whether the end is a right end, index 2 is the sequence as a right end, index 3 is sequence as a left end
  set ends_list [list]
  foreach w [dnawindows_list 1] {
    if {$info($w,circular) eq "circular" || [string length [set text [textarea_get $w.textarea 1.0 [end_ix $w.textarea]]]] < $min} continue
    lappend ends_list [list $w 0 [revcom [set temp [string toupper [string range $text 0 [expr {$max+$max_nh-1}]]]]] $temp]
    lappend ends_list [list $w 1 [set temp [string toupper [string range $text end-[expr {$max+$max_nh-1}] end]]] [revcom $temp]]
  }
  #sputs $ends_list
  set found_list [list]
  for {set i 0} {$i < [llength $ends_list]} {incr i} {
    for {set j $i} {$j < [llength $ends_list]} {incr j} {
      for {set k 0} {$k <= [expr {$max_nh}]} {incr k} {
        if {[set found_pos [string first [string range [lindex $ends_list $i 2] end-[expr {$min-1+$k}] end-$k]  [lindex $ends_list $j 3]]] > -1} {
          set found_length $min
          while {$found_pos> 0 && [string index [lindex $ends_list $i 2] end-[expr {$found_length+$k}]] eq [string index [lindex $ends_list $j 3] [expr {$found_pos-1}]]} {
            incr found_length
            incr found_pos -1
          }
          if {($found_pos <= $max_nh) && ($info(gib_double_nonhom) || $found_pos == 0 || $k == 0) && $found_length <= $max} {
            lappend found_list [list [list [lindex $ends_list $i 0] [lindex $ends_list $i 1]]  [list [lindex $ends_list $j 0]  [lindex $ends_list $j 1]] $found_length $found_pos $k]
          } else {
            #sputs exclude:$i $j $found_length $found_pos
          }
          break
        }
      }
    }
  }
  return $found_list
}


################
## Gibson sub-proc to find chains of frgments
################
proc gibson_find_chains {frag_num current_chain found_list} {
  global info
  set result [list]
  if {$frag_num > $info(gib_max_fragments)} {
    #return [list [list {*}$current_chain "Max frags"]]
    return [list ]
  }
  if {[lindex $current_chain 0 0 0] eq [lindex $current_chain end 1 0] && [lindex $current_chain 0 0 1] == [expr {![lindex $current_chain end 1 1]}] } {
    return [list $current_chain]
  } 
  set target [list [lindex $current_chain end 1 0] [expr {![lindex $current_chain end 1 1]}]]
  foreach h [lsearch -inline -all -index 1 $found_list $target] {
    set h [list [lindex $h 1] [lindex $h 0] [lindex $h 2] [lindex $h 4] [lindex $h 3]]
    lappend result {*}[gibson_find_chains [expr {$frag_num +1}] [list {*}$current_chain $h] $found_list]
  }
  foreach h [lsearch -inline -all -index 0 $found_list $target] {
    lappend result {*}[gibson_find_chains [expr {$frag_num +1}] [list {*}$current_chain $h] $found_list]
  }
  if {[llength $result] == 0 && [llength $current_chain] > 1} {
    if {$info(gib_require_circ)} {
      return [list]
    } else {
      return [list [list "Linear" {*}$current_chain ]]
    }
  }
  return $result
}


################
## Gibson sub-proc to find first fragment of a linear product
################
proc gibson_find_first_linear {found_list} {
  set result [list]
  foreach e $found_list {
    lappend result [lindex $e 0] [lindex $e 1]
  }
  return [lsort -unique -dictionary $result]
}

################
## Gibson sub-proc to find first fragment of a circular product
################
proc gibson_find_first_circular {found_list} {
  global info
  set info(gib_require_circ) 1
  set result [list]
  foreach e $found_list {
    set f [gibson_find_chains 0 [list $e] $found_list]
    foreach g $f {
      foreach h $g {
        lappend result [list {*}[lindex $h 0] [lindex $h 2] [lindex $h 3] [lindex $h 4]]
        lappend result [list {*}[lindex $h 1] [lindex $h 2] [lindex $h 4] [lindex $h 3]]
      }
    }
  }
  return [lsort -unique $result]
}

################
## Gibson sub-proc to find next fragment that can be added
################
proc gibson_find_next {w1 fwd found_list} {
  global info
  set result [list]
  set target [list $w1 $fwd]
  foreach h [lsearch -inline -all -index 1 $found_list $target] {
    if {($info(gib_require_circ) && [gibson_find_chains 0 [list $h] $found_list] != {} )  || !$info(gib_require_circ)} {
      lappend result [list {*}[lindex $h 0] [lindex $h 2] [lindex $h 3] [lindex $h 4]]
      #lappend result [lindex $h 0]
## need to push the homology data through here
    }
  }
  foreach h [lsearch -inline -all -index 0 $found_list $target] {
    if {($info(gib_require_circ) && [gibson_find_chains 0 [list $h] $found_list] != {} )  || !$info(gib_require_circ)} {
      #lappend result [lindex $h 1]
      lappend result [list {*}[lindex $h 1] [lindex $h 2] [lindex $h 4] [lindex $h 3]]
## need to push the homology data through here
    }
  }
  ##sputs result $result
  return $result
}


################
## Gibson sub-proc to fill the first sequence frame
################
proc gibson_fill_frame_first {frame w} {
  global info temp_info
  if {![winfo exists $frame]} return
  foreach i [winfo children $frame] {
    destroy $i
  }
  set found_list [gibson_find_ends]
  if {$info(gib_require_circ)} {
    ###  circular product
    grid [frame $frame.f0] -row 0 -column 0 -sticky nwe 
    set window_mb [menubutton $frame.f0.window_mb -textvariable temp_info(window_mb_text,0) -menu $frame.f0.window_mb.menu]
    menu $frame.f0.window_mb.menu 
    set i 0
    set set_window -1
    set w_window -1
    set w1 {}
    foreach data  [gibson_find_first_circular $found_list] {
      foreach {w1 fwd1 match_length mismatch1 mismatch2} $data {}
      set fwd1 [expr {!$fwd1}]
      set label1 "[expr {!$fwd1 ? "<<<":">>>"}][file rootname [wm title $w1]]"
      $frame.f0.window_mb.menu  add radiobutton -label $label1 -variable temp_info(window_mb_text,0) -value $label1 -command "set temp_info(window_mb_window,0) $w1; set temp_info(frag_fwd,0) $fwd1;set temp_info(frag_data,0) \[list $match_length $mismatch1 $mismatch2\]; gibson_fill_frame_next $frame 0"
      if {[info exists temp_info(window_mb_window,0)] && $temp_info(window_mb_window,0) eq $w1 && $temp_info(frag_fwd,0) == $fwd1} {
        set set_window $i
      }
      if {[info exists temp_info(window_mb_window,0)] && $temp_info(window_mb_window,0) eq $w && $temp_info(frag_fwd,0) == 1} {
        set w_window $i
      }
      incr i
    }
    if {$w1 != {}} {
        grid $window_mb -row 0 -column 1 -sticky nw 
        if {$set_window > -1} {
          $frame.f0.window_mb.menu invoke $set_window
        } else {
          for {set i 0} {[info exists temp_info(window_mb_text,$i)]} {incr i}  {
            array unset temp_info "*,$i"
          }
          if {$w_window > -1} {
            $frame.f0.window_mb.menu invoke $w_window
          } else {
            set temp_info(window_mb_text,0) "Select First Fragment"
          }
        }
    } else {
      grid [label $frame.f0.label1 -text [mc "No Circular Products From Open Windows"]] -row 0 -column 0 -sticky nw
      grid remove [winfo toplevel $frame].okframe.ok
    }
  } else {
    ### linear products
  }
}


################
## Gibson sub-proc to fill the next frame
################
proc gibson_fill_frame_next {frame last} {
  global info temp_info

  if {![winfo exists $frame]} return

  set next [expr {$last + 1}]
  for {set i $next} {[winfo exists $frame.f$i]} {incr i}  {
    destroy $frame.f$i
  }

  set found_list [gibson_find_ends]

  if {$info(gib_require_circ)} {
    ###  circular product

    grid [frame $frame.f$next] -row $next -column 0 -sticky nwe 

    set window_mb [menubutton $frame.f$next.window_mb -textvariable temp_info(window_mb_text,$next) -menu $frame.f$next.window_mb.menu]
    menu $frame.f$next.window_mb.menu 
    set i 0
    set set_window -1
    set w1 {}
    foreach next_data [gibson_find_next $temp_info(window_mb_window,$last) $temp_info(frag_fwd,$last) $found_list] {
      foreach {w1 fwd1 match_length mismatch1 mismatch2} $next_data {}
      set fwd1 [expr {!$fwd1}]
      set label1 "[expr {!$fwd1 ? "<<<":">>>"}][file rootname [wm title $w1]]"
      $frame.f$next.window_mb.menu  add radiobutton -label $label1 -variable temp_info(window_mb_text,$next) -value $label1 -command "set temp_info(window_mb_window,$next) $w1; set temp_info(frag_fwd,$next) $fwd1;set temp_info(frag_data,$next) \[list $match_length $mismatch1 $mismatch2\]; gibson_fill_frame_next $frame $next"

      if {[info exists temp_info(window_mb_window,$next)] && $temp_info(window_mb_window,$next) eq $w1 && $temp_info(frag_fwd,$next) == $fwd1} {
        set set_window $i
      }
      if {$w1 eq $temp_info(window_mb_window,0) && $fwd1 == [expr {$temp_info(frag_fwd,0)}]} {
        ### circle formed
        #sputs circle formed 
        grid configure [winfo toplevel $frame].okframe.ok
        destroy $frame.f$next
        array unset temp_info "*,$next"
        return
      } 
      incr i
    }

    grid remove [winfo toplevel $frame].okframe.ok

    if {$next >= $info(gib_max_fragments)} {
      grid [label $frame.f$next.label1 -text [mc "No Circular Products after %s fragments." $info(gib_max_fragments)]] -row $next -column 0 -sticky nw
      return
    }

    if {$w1 != {}} {
      if {$i> 1} {
        grid $window_mb -row $next -column 1 -sticky nw 
        if {$set_window > -1} {
          $frame.f$next.window_mb.menu invoke $set_window
        } else {
          for {set i $next} {[info exists temp_info(window_mb_text,$i)]} {incr i}  {
            array unset temp_info "*,$i"
          }
          set temp_info(window_mb_text,$next) "Select Next Fragment"
        }
      } else {
        $frame.f$next.window_mb.menu invoke 0
        grid [label $frame.f$next.window_label -text $temp_info(window_mb_text,$next) ] -row $next -column 1 -sticky nw
        #$frame.f$next.window_mb configure -state disabled
        gibson_fill_frame_next $frame $next
      }
    } else {
      grid [label $frame.f$next.label1 -text [mc "No Circular Products From Open Windows"]] -row $next -column 0 -sticky nw
    }
  } else {
    ### linear products
  }
}


############
##
#############
proc gibson_wizard_dialog {w} {
  global info temp_info modifier dialogblock modstring


  if {$dialogblock == 1} {return}

  set s [new_dialog $w "Gibson Designer" "NEW DNA"]
  wm resizable [winfo toplevel $s] 0 0
  bind $s <<Cancel>> "dialog_cancel $s"
  bind $s <<OK>> "set ok 1"
  array unset temp_info

  grid [frame $s.okframe] -row 2 -column 1 -sticky nwe
  #grid [button $s.okframe.cancel -text [mc "Cancel"] -command "event generate $s <<Cancel>>"] -row 1 -column 1 -sticky n
  grid [button $s.okframe.setdef -text [mc "Set Defaults"] -command "gibson_wizard_set_defaults $s" -state normal] -row 1 -column 2 -sticky n
  grid [button $s.okframe.back -text [mc "Back"] -command "event generate $s <<Back>>" -state normal] -row 1 -column 3 -sticky n
  grid [button $s.okframe.ok -text [mc "Next"] -command "event generate $s <<OK>>" -default active -state normal] -row 1 -column 4 -sticky n


  if {[gibson_wizard_fragments_frame $s] eq "error"} {
    dialog_cancel $s
  } else {
    raise $s
  }
}

############
##
#############
proc dialog_cancel {s} {
  global dialogblock temp_info
  destroy $s
  array unset temp_info *
  set dialogblock 0
  bind . <<RaiseDialogs>> ""
}

############
##
#############
proc gibson_wizard_fragments_frame {s} {
  global info
  if {![winfo exists $s.f]} {
    grid [frame $s.f] -row 1 -column 1 -sticky nswe
    if {[gibson_wizard_add_fragment_frame $s.f] eq "error"} {return error}
  } else {
    grid configure $s.f 
    if {[winfo exists $s.j]} {
      grid remove $s.j
    }
  }
  grid remove $s.okframe.back
  bind $s <<OK>> "gibson_wizard_frame_to_data $s; gibson_wizard_junction_frame $s 0"
  $s.okframe.ok configure -text [mc "Next"]
}

############
##
#############
proc gibson_wizard_add_fragment_frame {s {after_frame {}}} {
  global temp_info

  for {set i 0} {[winfo exists $s.f$i]} {incr i} {}

  if {[winfo exists $after_frame]} {
   set after_i [dict get [grid info $after_frame] -row]
   incr after_i
  } else {
   set after_i 0
  }


  foreach frame [grid slaves $s] {
    if {[set current_row [dict get [grid info $frame] -row]] >= $after_i} {
      grid configure $frame -row [expr {$current_row +1}]
    }
  }

  grid [frame $s.f$i] -row $after_i -column 1 -sticky nswe


  grid [frame $s.f$i.f1] -row 1 -column 1 -sticky nswe

  grid [frame $s.f$i.f1.add_buttons]  -row 1 -column 1 -sticky nsw
  grid [button $s.f$i.f1.add_buttons.add -text "+" -command "gibson_wizard_add_fragment_frame $s $s.f$i" -width 1 ]  -row 1 -column 1 -sticky n
  grid [button $s.f$i.f1.add_buttons.remove -text "-"  -width 1  -command "if {\[llength \[grid slaves $s\]\] > 1} {gibson_wizard_delete_fragment_frame $s $i}"] -row 1 -column 2 -sticky n

  grid [frame $s.f$i.f1.sels] -row 1 -column 2 -sticky nswe 
  menubutton $s.f$i.f1.sels.win_button
    menu $s.f$i.f1.sels.win_button.menu
    set menu_length 0
    foreach window [dnawindows_list 1] {
      if {[ix2bp $window.textarea end] > 20} {
        $s.f$i.f1.sels.win_button.menu add radiobutton -command "$s.f$i.f1.sels.win_button configure -text \{[wm title $window]\}; gibson_wizard_sel_menu $window $s $i; set temp_info(frame_window,$i) $window; set temp_info(frame_rc,$i) 0; set temp_info(frame_skip_primer,$i) 0; set temp_info(frame_tails_zero,$i) 0; $s.f$i.f1.sels.rcframe.skip_primer conf -state normal; set temp_info(frame_tails_display,$i) {PCR with tails}; set temp_info(frame_digest_enz,$i) {}" -label [wm title $window] -variable temp_info(frame_window,$i) -value $window
         incr menu_length
      }
    }

  if {$menu_length == 0} {
    #event generate [winfo toplevel $s] <<Cancel>>
    tk_messageBox -message [mc "No windows available for Gibson cloning"] -type ok -icon warning
    return "error"
  }

  $s.f$i.f1.sels.win_button configure -menu $s.f$i.f1.sels.win_button.menu -indicatoron 1 -relief raised 
  grid $s.f$i.f1.sels.win_button -row 1 -column 2 -sticky nswe   
  grid [menubutton $s.f$i.f1.sels.sel_button] -row 2 -column 2 -sticky n 
  bind $s.f$i.f1.sels.sel_button <Button-1> "gibson_wizard_sel_menu \$temp_info(frame_window,$i) $s $i"
  $s.f$i.f1.sels.sel_button configure -menu [menu $s.f$i.f1.sels.sel_button.menu]

  grid [frame $s.f$i.f1.sels.rcframe] -row 3 -column 2 -sticky nswe 
  grid [checkbutton $s.f$i.f1.sels.rcframe.rc -variable temp_info(frame_rc,$i) -text [mc "Rev-Com"]] -row 1 -column 1 -sticky nw 
  grid [menubutton $s.f$i.f1.sels.rcframe.skip_primer -state normal -textvariable temp_info(frame_tails_display,$i)] -row 1 -column 2 -sticky nwe
  $s.f$i.f1.sels.rcframe.skip_primer configure -menu [menu $s.f$i.f1.sels.rcframe.skip_primer.menu]
  $s.f$i.f1.sels.rcframe.skip_primer.menu add radiobutton -command "set temp_info(frame_tails_display,$i) {PCR with tails}; set temp_info(frame_skip_primer,$i) 0" -label [mc "PCR with tails"] -variable temp_info(frame_tails_zero,$i) -value 0
  $s.f$i.f1.sels.rcframe.skip_primer.menu add radiobutton -command "set temp_info(frame_tails_display,$i) {PCR No Tails}; set temp_info(frame_skip_primer,$i) 0" -label [mc "PCR No Tails"] -variable temp_info(frame_tails_zero,$i) -value 1
  $s.f$i.f1.sels.rcframe.skip_primer.menu add radiobutton -command "set temp_info(frame_tails_display,$i) {No primers}; set temp_info(frame_skip_primer,$i) 1" -label [mc "No primers"] -variable temp_info(frame_tails_zero,$i) -value -1


  
  grid [ttk::separator $s.f$i.separator ] -row 2 -column 1 -sticky nwe

  $s.f$i.f1.sels.win_button.menu invoke 0
  
  bind $s.f$i.f1 <<GelLaneDrop>> "gibson_wizard_gel_lane_drop %d $s $i "
  bind $s.f$i.f1.sels.win_button <<GelLaneDrop>> "gibson_wizard_gel_lane_drop %d $s $i "
  bind $s.f$i.f1.sels.sel_button <<GelLaneDrop>> "gibson_wizard_gel_lane_drop %d $s $i "

}

############
##
#############
proc gibson_wizard_delete_fragment_frame {s i} {
  global temp_info

  array unset temp_info "*,$i"
  destroy $s.f$i
  foreach frame [grid slaves $s] {
    if {[set current_row [dict get [grid info $frame] -row]] > $i} {
      grid configure $frame -row [expr {$current_row -1}]
    }
  }
}

############
##
#############
proc gibson_wizard_gel_lane_drop {data s i} {
  global temp_info info

  if {![winfo exists $s.f$i.f1.sels.sel_button]} {
    return
  }

  set canvas [dict get $data canvas]
  set band [dict get $data band]
  set link_data [$canvas bind $band <<Link>>]
  if {$link_data == {}} {return}
  foreach {window from_top to_top from_bottom to_bottom enz1 e1d enz2 e2d} $link_data {}

  if {$from_top == -1 && $to_bottom== -1} {return}

  if {$info(gibson_wizard_exo_side) == 5} {
    ## 5' exo for Gibson
    #sputs gel_drop  $s.f$i.f1.sels.sel_button.menu $i $window $from_top $to_top $from_bottom $to_bottom
    set first $from_bottom
    set last $to_top
  } elseif {$info(gibson_wizard_exo_side) == 3} {
    ## InFusion needs to be 3' exo
    #sputs gel_drop  $s.f$i.f1.sels.sel_button.menu $i $window $from_top $to_top $from_bottom $to_bottom
    set first $from_top
    set last $to_bottom
  } else {
    ## No exo
    set first [expr {min($from_top, $from_bottom)}]
    set last [expr {max($to_top, $to_bottom)}]
  }


  $s.f$i.f1.sels.sel_button configure -text [mc "Gel band %1\$s - %2\$s" $first $last]
  set temp_info(frame_window,$i) $window
  $s.f$i.f1.sels.win_button configure -text [wm title $window]
  $s.f$i.f1.sels.rcframe.skip_primer conf -state disabled

  if {($to_top == $from_top) && ($last > $first)} {
   ## 3' overhang single cut fragment
    set last [expr {$last - [ix2bp $window.textarea [end_ix $window.textarea]]}]
  }

  set temp_info(frame_first,$i) $first
  set temp_info(frame_last,$i) $last
  set temp_info(frame_skip_primer,$i) 1
  set temp_info(frame_tails_zero,$i) -1
  set temp_info(frame_tails_display,$i) {No primers}
  set temp_info(frame_digest_enz,$i) [list $enz1 $e1d $enz2 $e2d [$canvas bind $band <<Size>>]]
  #$s.f$i.f1.sels.sel_button.menu add radiobutton -command "$s.f$i.f1.sels.sel_button configure -text \[mc \"Gel band %1\$s - %2\$s\" $first $last\] ; set temp_info(frame_first,$i) $first; set temp_info(frame_last,$i) $last" -label [mc "Gel band %s - %s" $first-$last]
  
}

############
##
#############
proc gibson_wizard_sel_menu {w s i} {
  global temp_info info
  if {![winfo exists $s.f$i.f1.sels.sel_button.menu]} {
    return
  }

  $s.f$i.f1.sels.sel_button.menu delete 0 end
  set seq_length [ix2bp $w.textarea end]

  if {$info($w,circular) eq "circular"} {
    if {[$w.textarea tag ranges sel] != {}} {
      # $s.f$i.f1.sels.sel_button.menu delete 0 2
      set sel_first [ix2bp $w.textarea [$w.textarea index sel.first]]
      set sel_last [ix2bp $w.textarea [$w.textarea index sel.last]]
      if {[expr {$sel_last - $sel_first}] > 20} {
        $s.f$i.f1.sels.sel_button.menu insert 0 radiobutton -command "$s.f$i.f1.sels.sel_button configure -text \[mc \"Selected %s - %s\" \[expr {$sel_first+1}\] \[expr {$sel_last}\]\] ; set temp_info(frame_first,$i) $sel_first; set temp_info(frame_last,$i) $sel_last; set temp_info(frame_digest_enz,$i) {}; $s.f$i.f1.sels.rcframe.skip_primer conf -state normal" -label [mc "Selected %s - %s" [expr {$sel_first+1}] [expr {$sel_last}]]
      }
      if {[expr {$seq_length - $sel_last + $sel_first}] > 20} {
        $s.f$i.f1.sels.sel_button.menu insert 1 radiobutton -command "$s.f$i.f1.sels.sel_button configure -text \[mc \"All but Selected %s - %s\"  [expr {(($sel_last+1) % $seq_length)}] [expr {(($sel_first-1) % $seq_length) +1}]\]; set temp_info(frame_first,$i) [expr {(($sel_last+1) % $seq_length) - 1}]; set temp_info(frame_last,$i) [expr {(($sel_first-1) % $seq_length) +1}]; set temp_info(frame_digest_enz,$i) {}; $s.f$i.f1.sels.rcframe.skip_primer conf -state normal" -label [mc "All but Selected %s - %s" [expr {(($sel_last+1) % $seq_length)}] [expr {(($sel_first-1) % $seq_length) +1}]] 
      }
      $s.f$i.f1.sels.sel_button.menu insert 2 radiobutton -command "$s.f$i.f1.sels.sel_button configure -text \[mc \"All- Open at Origin\"\]; set temp_info(frame_first,$i) [ix2bp $w.textarea [$w.textarea index 1.0]]; set temp_info(frame_last,$i) [ix2bp $w.textarea end]; set temp_info(frame_digest_enz,$i) {}; $s.f$i.f1.sels.rcframe.skip_primer conf -state normal" -label [mc "All- Open at Origin"] 
    } else {
      # $s.f$i.f1.sels.sel_button.menu delete 0 1
      set insert_pos [ix2bp $w.textarea [$w.textarea index insert]]
      $s.f$i.f1.sels.sel_button.menu insert 0 radiobutton -command "$s.f$i.f1.sels.sel_button configure -text \[mc \"All- Open at Origin\"\]; set temp_info(frame_first,$i) [ix2bp $w.textarea [$w.textarea index 1.0]]; set temp_info(frame_last,$i) [ix2bp $w.textarea end]; set temp_info(frame_digest_enz,$i) {}; $s.f$i.f1.sels.rcframe.skip_primer conf -state normal" -label [mc "All- Open at Origin"] 
      $s.f$i.f1.sels.sel_button.menu insert 1 radiobutton -command "$s.f$i.f1.sels.sel_button configure -text \[mc \"All- Open at Insert %s \" [expr {$insert_pos + 1}]]; set temp_info(frame_first,$i) [expr {(($insert_pos+1) % $seq_length) -1}]; set temp_info(frame_last,$i) [expr {(($insert_pos-1) % $seq_length) +1}]; set temp_info(frame_digest_enz,$i) {}; $s.f$i.f1.sels.rcframe.skip_primer conf -state normal" -label [mc "All- Open at Insert %s" [expr {$insert_pos + 1}]]
    }
  } else {
      # $s.f$i.f1.sels.sel_button.menu delete 0 2
    if {[$w.textarea tag ranges sel] != {}} {
      set sel_first [ix2bp $w.textarea [$w.textarea index sel.first]]
      set sel_last [ix2bp $w.textarea [$w.textarea index sel.last]]
      $s.f$i.f1.sels.sel_button.menu insert 0 radiobutton -command "$s.f$i.f1.sels.sel_button configure -text \[mc \"All\"\]; set temp_info(frame_first,$i) [ix2bp $w.textarea [$w.textarea index 1.0]]; set temp_info(frame_last,$i) [ix2bp $w.textarea end]; set temp_info(frame_digest_enz,$i) {}; $s.f$i.f1.sels.rcframe.skip_primer conf -state normal" -label [mc "All"]
      if {[expr {$sel_last - $sel_first}] > 20} {
        $s.f$i.f1.sels.sel_button.menu insert 1 radiobutton -command "$s.f$i.f1.sels.sel_button configure -text \[mc \"Selected %s - %s\" \[expr {$sel_first+1}\] \[expr {$sel_last}\]\]; set temp_info(frame_first,$i) $sel_first; set temp_info(frame_last,$i) $sel_last; set temp_info(frame_digest_enz,$i) {}; $s.f$i.f1.sels.rcframe.skip_primer conf -state normal" -label [mc "Selected %s - %s" [expr {$sel_first+1}] [expr {$sel_last}]]
      }
      if {[expr {$seq_length - $sel_last + $sel_first}] > 20} {
        $s.f$i.f1.sels.sel_button.menu insert 2 radiobutton -command "$s.f$i.f1.sels.sel_button configure -text \[mc \"Circularize - All but Selected %s - %s\" [expr {(($sel_last+1) % $seq_length)}] [expr {(($sel_first-1) % $seq_length) +1}]\]; set temp_info(frame_first,$i) [expr {(($sel_last+1) % $seq_length) - 1}]; set temp_info(frame_last,$i) [expr {(($sel_first-1) % $seq_length) +1}]; set temp_info(frame_digest_enz,$i) {}; $s.f$i.f1.sels.rcframe.skip_primer conf -state normal" -label [mc "Circularize - All but Selected %s - %s"  [expr {(($sel_last+1) % $seq_length)}]  [expr {(($sel_first-1) % $seq_length) +1}]]
      }
    } else {
      # $s.f$i.f1.sels.sel_button.menu delete 0 1
      set insert_pos [ix2bp $w.textarea [$w.textarea index insert]]
      $s.f$i.f1.sels.sel_button.menu insert 0 radiobutton -command "$s.f$i.f1.sels.sel_button configure -text \[mc \"All\"\]; set temp_info(frame_first,$i) [ix2bp $w.textarea [$w.textarea index 1.0]]; set temp_info(frame_last,$i) [ix2bp $w.textarea end]; set temp_info(frame_digest_enz,$i) {}; $s.f$i.f1.sels.rcframe.skip_primer conf -state normal" -label [mc "All"]
      $s.f$i.f1.sels.sel_button.menu insert 1 radiobutton -command "$s.f$i.f1.sels.sel_button configure -text \[mc \"Circularize - Open at Insert %s\" [expr {$insert_pos + 1}]\]; set temp_info(frame_first,$i) [expr {(($insert_pos+1) % $seq_length) -1}]; set temp_info(frame_last,$i) [expr {(($insert_pos-1) % $seq_length) +1}]; set temp_info(frame_digest_enz,$i) {}; $s.f$i.f1.sels.rcframe.skip_primer conf -state normal" -label [mc "Circularize - Open at Insert %s" [expr {$insert_pos + 1}]]
    }
  }
  $s.f$i.f1.sels.sel_button.menu insert end command -state disabled -label [mc "Drag and Drop a Gel Band here to use as a fragment"]
  $s.f$i.f1.sels.sel_button.menu invoke 0
}

############
##
#############
proc gibson_wizard_frame_to_data {s} {
  global temp_info
 
  set temp_info(fragment_number) [llength [grid slaves $s.f]]
  for {set i 0} {$i < $temp_info(fragment_number)} {incr i} {
    if {![regexp {[0-9]+$} [grid slaves $s.f -row $i -column 1] index]} {
      sputs can't get index $i $temp_info(fragment_number) [grid slaves $s.f]
      event generate $s <<Cancel>>
      array unset temp_info
      return
    } else {
      set temp_info(window,$i)  $temp_info(frame_window,$index)
      set temp_info(template_seq,$i) ""
      set temp_info(gibson_tm,$i) ""
      set temp_info(template1_tm,$i) ""
      set temp_info(template2_tm,$i) ""
      set temp_info(left_end_deletion,$i) 0
      set temp_info(right_end_deletion,$i) 0
      set temp_info(linker_dict,$i) [dict create gibson_tm_actual2 0 left_overhang_length 0 right_overhang_length 0]
      set temp_info(rc,$i) $temp_info(frame_rc,$index)
      set temp_info(skip_primer,$i) $temp_info(frame_skip_primer,$index)
      set temp_info(digest_enz,$i) $temp_info(frame_digest_enz,$index)
      set temp_info(tails_zero,$i) $temp_info(frame_tails_zero,$index)
      set temp_info(first,$i) $temp_info(frame_first,$index)
      set temp_info(last,$i) $temp_info(frame_last,$index)
    }
  }
}

############
##
#############
proc gibson_wizard_junction_frame {s i} {
  global info temp_info enzymes enzinfo

  set next_i [expr {($i+1) % $temp_info(fragment_number)}]
  if {![info exists temp_info(template1_tm,$i)] || $temp_info(template1_tm,$i)  == ""} {
    set last_i [expr {($i-1) % $temp_info(fragment_number)}]
    if {[info exists temp_info(template2_tm,$last_i)] && $temp_info(template2_tm,$last_i)  != ""} {
      set temp_info(template1_tm,$i) $temp_info(template2_tm,$last_i)
    } else {
      set temp_info(template1_tm,$i) $info(gibson_wizard_default_tm)
    }
  }

  if  {![info exists temp_info(template2_tm,$i)] || $temp_info(template2_tm,$i)  == "" } {
    if {[info exists temp_info(template1_tm,$next_i)] && $temp_info(template1_tm,$next_i)  != ""} {
      set temp_info(template2_tm,$i) $temp_info(template1_tm,$next_i)
    } else {
      set temp_info(template2_tm,$i) $info(gibson_wizard_default_tm)
    }
  }
  if {![info exists temp_info(gibson_tm,$i)] || $temp_info(gibson_tm,$i)  == ""} {
    set temp_info(gibson_tm,$i) $info(gibson_wizard_default_g_tm)
    set temp_info(primer_tail,$i) $info(gibson_wizard_default_tail)
    set temp_info(overlap_len,$i) 0
    set temp_info(overlap_seq,$i) ""
  }

  if {![info exists temp_info(template_seq,$i)] || $temp_info(template_seq,$i)  == ""} {
    set temp_info(template_seq,$i) [gibson_wizard_get_dna $temp_info(window,$i) $temp_info(first,$i) $temp_info(last,$i) $temp_info(rc,$i)]
  }
  if {![info exists temp_info(template_seq,$next_i)] || $temp_info(template_seq,$next_i)  == ""} {
    set temp_info(template_seq,$next_i) [gibson_wizard_get_dna $temp_info(window,$next_i) $temp_info(first,$next_i) $temp_info(last,$next_i) $temp_info(rc,$next_i)]
  }



  if {![winfo exists $s.j]} {
    grid [frame $s.j] -row 1 -column 1 -sticky nswe
    grid [frame $s.j.top] -row 1 -column 1 -sticky nswe
    grid [label $s.j.top.t1 -textvariable temp_info(template1_label) -font dnafont] -row 0 -column 1 -columnspan 2 -sticky e
    
    grid [frame $s.j.top.left] -row 1 -column 1 -sticky nswe

    ## left template
    grid [label $s.j.top.left.s1 -text "" -font dnafont] -row 1 -column 1 -sticky e
    grid [label $s.j.top.left.s2 -text "" -font dnafont] -row 2 -column 1 -sticky e
    # reverse primer
    grid [frame $s.j.top.left.p1f ] -row 3 -column 1 -sticky we
    grid [entry $s.j.top.left.p1f.p1e -font dnafont] -row 1 -column 2 -sticky e
    grid columnconfigure $s.j.top.left.p1f 1 -weight 1
    grid [label $s.j.top.left.ps1 -text "" -font dnafont] -row 4 -column 1 -sticky w
    ## linker oligo entry and spacer
    grid [frame $s.j.top.left.l1f ] -row 5 -column 1 -sticky we
    grid [entry $s.j.top.left.l1f.l1e -font dnafont] -row 1 -column 2 -sticky e
    grid columnconfigure $s.j.top.left.l1f 1 -weight 1
    grid [label $s.j.top.left.ls1 -text "" -font dnafont] -row 6 -column 1 -sticky w
    grid [frame $s.j.top.left.p2f ] -row 7 -column 1 -sticky we
    # forward primer
    grid [entry $s.j.top.left.p2f.p2e -font dnafont] -row 1 -column 1 -sticky e
    grid columnconfigure $s.j.top.left.p2f 1 -weight 1
    ## right template
    grid [label $s.j.top.left.ps2 -text "" -font dnafont] -row 8 -column 1 -sticky e
    #grid [label $s.j.top.left.t2 -textvariable temp_info(template2_label) -font dnafont] -row 9 -column 1 -sticky e

    grid [frame $s.j.top.right] -row 1 -column 2 -sticky nswe
    grid [label $s.j.top.right.t1 -textvariable temp_info(template1_display) -font dnafont] -row 1 -column 1 -sticky w
    grid [label $s.j.top.right.s1 -textvariable temp_info(template1_align_display) -font dnafont] -row 2 -column 1 -sticky w
    grid [label $s.j.top.right.p1 -textvariable temp_info(primer1_display) -font dnafont] -row 3 -column 1 -sticky w
    grid [label $s.j.top.right.ps1 -textvariable temp_info(gibson_align_display) -font dnafont] -row 4 -column 1 -sticky w
    grid [label $s.j.top.right.11 -textvariable temp_info(linker_display) -font dnafont] -row 5 -column 1 -sticky w
    grid [label $s.j.top.right.ls1 -textvariable temp_info(linker_align_display) -font dnafont] -row 6 -column 1 -sticky w
    grid [label $s.j.top.right.p2 -textvariable temp_info(primer2_display) -font dnafont] -row 7 -column 1 -sticky w
    grid [label $s.j.top.right.ps2 -textvariable temp_info(template2_align_display) -font dnafont] -row 8 -column 1 -sticky w
    grid [label $s.j.top.right.t2 -textvariable temp_info(template2_display) -font dnafont] -row 9 -column 1 -sticky w
    
    grid [label $s.j.top.t2 -textvariable temp_info(template2_label) -font dnafont] -row 2 -column 1 -columnspan 2 -sticky e

    grid [ttk::separator $s.j.sep1] -row 2 -column 1 -sticky nswe

    grid [frame $s.j.bottom] -row 3 -column 1 -sticky nswe
    grid [frame $s.j.bottom.f1] -row 1 -column 1 -sticky nswe
    grid [label $s.j.bottom.f1.t1tm -text [mc "Rev primer Tm:"]] -row 1 -column 1 -sticky nw
    #grid [ttk::scale $s.j.bottom.f1.t1tmsc -orient horizontal -length 200] -row 1 -column 3 -sticky nw
    #grid [label $s.j.bottom.f1.t1tmlab1] -row 1 -column 2 -sticky nw
    grid [ttk::spinbox $s.j.bottom.f1.t1tmsc -width 3 -from 45 -to 72 -validate key -validatecommand "string_is_in_range %P 45 72" ] -row 1 -column 3 -sticky nw
    grid [label $s.j.bottom.f1.t1tmlab2] -row 1 -column 4 -sticky nw

    grid [frame $s.j.bottom.f2] -row 2 -column 1 -sticky nswe
    grid [label $s.j.bottom.f2.t2tm -text [mc "Fwd primer Tm:"]] -row 1 -column 1 -sticky nswe
    #grid [ttk::scale $s.j.bottom.f2.t2tmsc -orient horizontal -length 200] -row 1 -column 3 -sticky nswe
    #grid [label $s.j.bottom.f2.t2tmlab1] -row 1 -column 2 -sticky nswe
    grid [ttk::spinbox $s.j.bottom.f2.t2tmsc  -width 3 -from 45 -to 72 -validate key -validatecommand "string_is_in_range %P 45 72" ] -row 1 -column 3 -sticky nswe
    grid [label $s.j.bottom.f2.t2tmlab2] -row 1 -column 4 -sticky nswe

    grid [frame $s.j.bottom.f3] -row 3 -column 1 -sticky nswe
    grid [label $s.j.bottom.f3.overlapl -text [mc "Overlap/ Insertion:"]] -row 1 -column 1 -sticky nw
    grid [menubutton $s.j.bottom.f3.overlap -textvariable temp_info(overlap_len_display)] -row 1 -column 2 -sticky nw
    menu $s.j.bottom.f3.overlap.menu
    $s.j.bottom.f3.overlap configure -menu $s.j.bottom.f3.overlap.menu
    grid [entry $s.j.bottom.f3.overlap_entry -width 30 -textvariable temp_info(overlap_seq,$i) -validate all -validatecommand "if {\[regexp {\[^ATGCatgc\]} %P\]} {return 0} else {set temp_info(overlap_len,$i) \[string length %P\]; after 100 gibson_wizard_calculate $i; return 1}"]  -row 1 -column 3 -sticky nswe

    grid [frame $s.j.bottom.f4] -row 4 -column 1 -sticky nswe
    grid [label $s.j.bottom.f4.t1tm -text [mc "Overlap Tm:"]] -row 1 -column 1 -sticky nswe
    grid [ttk::spinbox $s.j.bottom.f4.gtmsc  -width 3 -from 0 -to 150 -validate key -validatecommand "string_is_in_range %P 0 150" ] -row 1 -column 3 -sticky nswe
    grid [label $s.j.bottom.f4.gtmlab2] -row 1 -column 4 -sticky nswe

    grid [frame $s.j.bottom.f5] -row 5 -column 1 -sticky nswe
    grid [menubutton $s.j.bottom.f5.tail_side] -row 1 -column 1 -sticky nswe
    $s.j.bottom.f5.tail_side configure -menu [menu $s.j.bottom.f5.tail_side.menu]
    grid [label $s.j.bottom.f5.primer_taill -text [mc "Primer Tail:"]] -row 1 -column 2 -sticky nswe
    #grid [ttk::scale $s.j.bottom.f5.primer_tail -orient horizontal -length 200] -row 1 -column 4 -sticky nswe
    #grid [label $s.j.bottom.f5.primer_taillab] -row 1 -column 3 -sticky nswe
    grid [ttk::spinbox $s.j.bottom.f5.primer_tail   -width 3 -from 0 -to 40 -validate key -validatecommand "string_is_in_range %P 0 40" ] -row 1 -column 4 -sticky nswe

    grid [ttk::separator $s.j.sep2] -row 4 -column 1 -sticky nswe
  } else {
    grid configure $s.j 
  }

  ## set textvariable and conmmand values to match $index for all controls
  if {$temp_info(skip_primer,$i)} {
    #set temp_info(template1_tm_scaled) 0
    set temp_info(template1_tm,$i) ""
    set temp_info(rev_primer_name,$i) ""
    #grid remove $s.j.top.left.p1f.p1e
    foreach element [list $s.j.top.left.s2 $s.j.top.left.p1f $s.j.top.right.s1 $s.j.top.right.p1] {
      grid remove $element
    }
  } else {
    #set temp_info(template1_tm_scaled) [expr {($temp_info(template1_tm,$i)-50)/22.0}]
    if {![info exists temp_info(rev_primer_name,$i)] || $temp_info(rev_primer_name,$i)== ""} {
        #primer_generate_name {w number direction five_prime target}
	  set p_count 0
	  for {set pn 0} {$pn< $i} {incr pn} {
		if {!$temp_info(skip_primer,$pn)} {incr p_count}
	  }
      set temp_info(rev_primer_name,$i) [primer_generate_name $temp_info(window,$i) [expr {$info(primer_next_number) +$p_count*2+1}] 1 $temp_info(first,$i) [file rootname [wm title $temp_info(window,$i)]] ]   
      #set temp_info(rev_primer_name,$i) "primer[expr {$i+1}]_rev"
    }
    #grid configure $s.j.top.left.p1f.p1e
    foreach element [list $s.j.top.left.s2 $s.j.top.left.p1f $s.j.top.right.s1 $s.j.top.right.p1] {
      grid configure $element
    }
  }
  $s.j.top.left.p1f.p1e configure -textvariable temp_info(rev_primer_name,$i)

  if {![info exists temp_info(linker_name,$i)] || $temp_info(linker_name,$i)== ""} {
    set temp_info(linker_name,$i) "linker[expr {$i+1}]"
  }
  $s.j.top.left.l1f.l1e configure -textvariable temp_info(linker_name,$i)

  $s.j.bottom.f1.t1tmsc configure -textvariable temp_info(template1_tm,$i) -command "gibson_wizard_calculate $i"
  $s.j.bottom.f1.t1tmlab2 configure -textvariable  temp_info(template1_tm_actual,$i)

  if {$temp_info(skip_primer,$next_i)} {
    #set temp_info(template2_tm_scaled) 0
    set temp_info(template2_tm,$i) ""
    set temp_info(fwd_primer_name,$next_i) ""
    #grid remove $s.j.top.left.p2f.p2e
    foreach element [list $s.j.top.left.p2f $s.j.top.left.ps2 $s.j.top.right.p2 $s.j.top.right.ps2] {
      grid remove $element
    }
  } else {
    if {![info exists temp_info(fwd_primer_name,$next_i)] || $temp_info(fwd_primer_name,$next_i)== ""} {
      set p_count 0
	  for {set pn 0} {$pn< $next_i} {incr pn} {
		if {!$temp_info(skip_primer,$pn)} {incr p_count}
	  }

    #primer_generate_name {w number direction five_prime target}
     set temp_info(fwd_primer_name,$next_i) [primer_generate_name $temp_info(window,$next_i) [expr {$info(primer_next_number) +$p_count*2}]  0 $temp_info(first,$next_i) [file rootname [wm title $temp_info(window,$next_i)]]]   
      #set temp_info(fwd_primer_name,$next_i) "primer[expr {$next_i+1}]_fwd"
    }
    #grid configure $s.j.top.left.p2f.p2e
    foreach element [list $s.j.top.left.p2f $s.j.top.left.ps2 $s.j.top.right.p2 $s.j.top.right.ps2] {
      grid configure $element
    }
  }
  $s.j.top.left.p2f.p2e configure -textvariable temp_info(fwd_primer_name,$next_i)

  $s.j.bottom.f2.t2tmsc configure -textvariable temp_info(template2_tm,$i) -command "gibson_wizard_calculate $i"
  $s.j.bottom.f2.t2tmlab2 configure -textvariable  temp_info(template2_tm_actual,$i)

   ### need to set temp_info(overlap_len,$i) and temp_info(overlap_seq,$i) with menu
  $s.j.bottom.f3.overlap.menu delete 0 end
  $s.j.bottom.f3.overlap.menu add radiobutton -label [mc "None"] -variable temp_info(overlap_len_display) -value {None} -command "set temp_info(overlap_len,$i) 0; set temp_info(overlap_seq,$i) {}; set temp_info(overlap_len_display) {None}; grid remove $s.j.bottom.f3.overlap_entry; gibson_wizard_calculate $i"
  $s.j.bottom.f3.overlap.menu add radiobutton -label [mc "Additional Sequence"]  -variable temp_info(overlap_len_display) -value {Additional Sequence}  -command "set temp_info(overlap_len_display) {Additional Sequence}; grid configure $s.j.bottom.f3.overlap_entry; set temp_info(overlap_len,$i) \[string length \$temp_info(overlap_seq,$i)\]; gibson_wizard_calculate $i"

  ## add RE to menu
  set count 0
  set menu_num 0
  catch {destroy $s.j.bottom.f3.overlap.menu.re}
  $s.j.bottom.f3.overlap.menu add cascade  -label [mc "Restriction Sites"] -menu [menu $s.j.bottom.f3.overlap.menu.re]
  foreach enz $enzymes {
    # skip metylation requiring enzymes
    if {$enz in [list AbaSI AoxI BisI BlsI DpnI FspEI GlaI GluI KroI LpnPI MalI MspJI MteI PcsI PkrI SgeI]} {continue}
    set flatpat $enzinfo(flatpat,$enz)
    if {[regexp {[^ACGT]} $flatpat]} {continue}
    if {[expr {$count % 15}] ==0} {
      if {$count != 0} {
        $s.j.bottom.f3.overlap.menu.re entryconfigure end -label "$first_enz-$last_enz"
      }
      catch {destroy $s.j.bottom.f3.overlap.menu.re.m$menu_num}
      set current_menu [menu $s.j.bottom.f3.overlap.menu.re.m$menu_num]
      incr menu_num
      $s.j.bottom.f3.overlap.menu.re add cascade -menu $current_menu
      set first_enz $enz
    }
    $current_menu add command -label $enz  -command "set temp_info(overlap_len_display) {Additional Sequence}; grid configure $s.j.bottom.f3.overlap_entry; set temp_info(overlap_seq,$i) \"\$temp_info(overlap_seq,$i)$flatpat\"; set temp_info(overlap_len,$i) \[string length \$temp_info(overlap_seq,$i)\]; gibson_wizard_calculate $i"
    set last_enz $enz
    incr count
  }
  $s.j.bottom.f3.overlap.menu.re entryconfigure end -label "$first_enz-$last_enz"


  if {1} {
    ## Original overlap calculation looking just for end overlaps, no internal overlaps allowed
    for {set k [expr {min (200, [string length $temp_info(template_seq,$i)]/2, [string length $temp_info(template_seq,$next_i)]/2)}]} {$k > 0} {incr k -1} {
      if {[string tolower [string range $temp_info(template_seq,$i) end-$k end]] eq [string tolower [string range $temp_info(template_seq,$next_i) 0 $k]]} {
        $s.j.bottom.f3.overlap.menu add radiobutton -label "[expr {$k +1}] bp" -variable  temp_info(overlap_len_display) -value "[expr {$k +1}] bp" -command "set temp_info(overlap_len,$i) [expr {-$k -1}]; set temp_info(overlap_seq,$i) {}; grid remove $s.j.bottom.f3.overlap_entry; gibson_wizard_calculate $i;"
        if {$k >= 12 && $temp_info(overlap_len,$i) == 0} {
          set temp_info(overlap_len,$i) [expr {-$k -1}]
          set temp_info(overlap_len_display) "[expr {$k +1}] bp"
        }
      }
    }
    $s.j.bottom.f3.overlap_entry configure -textvariable temp_info(overlap_seq,$i) -validatecommand "if {\[regexp {\[^ATGCatgc\]} %P\]} {return 0} else {set temp_info(overlap_len,$i) \[string length %P\]; after 100 gibson_wizard_calculate $i; return 1}"
    if {$temp_info(overlap_len,$i) < 0} {
      set temp_info(overlap_len_display) "[expr {-$temp_info(overlap_len,$i)}] bp"
      grid remove $s.j.bottom.f3.overlap_entry
      set temp_info(gibson_tm,$i) ""
      $s.j.bottom.f4.gtmsc configure -state disabled
    } elseif {$temp_info(overlap_len,$i) == 0} {
      set temp_info(overlap_len_display) "None"
      grid remove $s.j.bottom.f3.overlap_entry
      $s.j.bottom.f4.gtmsc configure -state normal
    } else {
      set temp_info(overlap_len_display) "Additional Sequence"
      grid configure $s.j.bottom.f3.overlap_entry
      $s.j.bottom.f4.gtmsc configure -state normal
    }
  } 
  $s.j.bottom.f3.overlap configre -state normal
  set temp_info(right_end_deletion,$i) 0
  set temp_info(left_end_deletion,$next_i) 0
  if {$info(gibson_wizard_default_gibson_deletion)} {
    ##work here for gibson deletion- look for internal overlaps using gibson_wizard_find_overlap and set left_end_deletion, right_end_deletion, overlap_len, overlap_len_display. What to do if multiple overlaps? use longest (warning for multiple overlaps and overlaps between undesired junctions). 
    set overlap_search_range 114
    if {$i == $next_i} {
       set overlap_search_range [expr {min(114, [string length $temp_info(template_seq,$i)]/2)}]
    }
    if { [set del_list [gibson_wizard_find_overlap [string range $temp_info(template_seq,$i) end-$overlap_search_range end] [string range $temp_info(template_seq,$next_i) 0 $overlap_search_range] 15]] ne [list]} {
      set del [lindex $del_list 0]
      set temp_info(overlap_len,$i) [expr {-1 * [lindex $del 2]}]
       set len_display_text "[expr {-$temp_info(overlap_len,$i)}] bp "
      set temp_info(right_end_deletion,$i)  [expr {[string length [string range $temp_info(template_seq,$i) end-114 end]] -[lindex $del 0] -  [lindex $del 2]}]
      if {$temp_info(right_end_deletion,$i) > 0} {
        set len_display_text "$len_display_text (del.$temp_info(right_end_deletion,$i) bp left)"
      }
      set temp_info(left_end_deletion,$next_i) [lindex $del 1]
      if {$temp_info(left_end_deletion,$i) > 0} {
        set len_display_text "$len_display_text (del.$temp_info(left_end_deletion,$i) bp right)"
      }
      set temp_info(overlap_len_display) $len_display_text
      grid remove $s.j.bottom.f3.overlap_entry
      $s.j.bottom.f3.overlap configre -state disabled
      set temp_info(gibson_tm,$i) ""
      $s.j.bottom.f4.gtmsc configure -state disabled
    } 
  }

    ## if no overlap and no tails on either side turn on the linker rows
  if {1 && $temp_info(overlap_len,$i) >= 0 && $temp_info(tails_zero,$i) && $temp_info(tails_zero,$next_i)} {
    foreach element [list  $s.j.top.left.l1f  $s.j.top.left.ls1 $s.j.top.right.11 $s.j.top.right.ls1 ] {
      grid configure $element
    }
  } else { 
    foreach element [list  $s.j.top.left.l1f  $s.j.top.left.ls1 $s.j.top.right.11 $s.j.top.right.ls1 ] {
      grid remove $element
    }
  }

  if {$temp_info(gibson_tm,$i) ne{}} {
    set temp_info(gibson_tm_scaled) [expr {($temp_info(gibson_tm,$i)-37)/35.0}]
    $s.j.bottom.f4.gtmsc configure -textvariable temp_info(gibson_tm,$i) -command "gibson_wizard_calculate $i"
  }
  $s.j.bottom.f4.gtmlab2 configure -textvariable temp_info(gibson_tm_label,$i)


  $s.j.bottom.f5.tail_side.menu delete 0 end
  $s.j.bottom.f5.tail_side.menu add radiobutton -command "$s.j.bottom.f5.tail_side configure -text [mc Forward]; gibson_wizard_calculate $i; #" -label [mc Forward] -variable temp_info(primer_tail_side,$i) -value 1 
  $s.j.bottom.f5.tail_side.menu add radiobutton -command "$s.j.bottom.f5.tail_side configure -text [mc Reverse]; gibson_wizard_calculate $i; #" -label [mc Reverse] -variable temp_info(primer_tail_side,$i) -value 0
  if {![info exists temp_info(primer_tail_side,$i)] || ($temp_info(primer_tail_side,$i) eq "")} {
    set temp_info(primer_tail_side,$i) $info(gibson_wizard_default_tail_side)
  }
  #$s.j.bottom.f5.primer_tail configure -command "set temp_info(primer_tail,$i) \[expr {round(\$temp_info(primer_tail,$i))}\];gibson_wizard_calculate $i; #" -variable temp_info(primer_tail,$i)  -from 0 -to 40
  #$s.j.bottom.f5.primer_taillab configure -textvariable temp_info(primer_tail,$i)
  $s.j.bottom.f5.primer_tail configure -textvariable temp_info(primer_tail,$i) -command "gibson_wizard_calculate $i"

  if {$temp_info(primer_tail_side,$i)} {
    $s.j.bottom.f5.tail_side configure -text [mc Forward]
  } else {
    $s.j.bottom.f5.tail_side configure -text [mc Reverse]
  }


  ## set disabled labels etc. for skipping primer  $s.j.bottom.f3.overlap $s.j.bottom.f4.gtmsc 
  foreach element [list  $s.j.bottom.f5.tail_side $s.j.bottom.f5.primer_taill  $s.j.bottom.f5.primer_tail ] {
    $element configure -state normal
  }
  if {![info exists temp_info(primer_tail_side,$i)]} {
	if {$temp_info(tails_zero,$i) && $temp_info(tails_zero,$next_i)} {
	  $s.j.bottom.f5.tail_side configure -text [mc Both]
	  set temp_info(primer_tail_side,$i) -1
	  set temp_info(primer_tail,$i) 0
	  #set temp_info(gibson_tm,$i) ""
  ### disable overlap Tm scale and tail side here
	  ##work here for gibson deletion- don't turn off overlap Tm when no tails because there will be a linker oligo:  $s.j.bottom.f4.gtmsc  $s.j.bottom.f3.overlap
	  foreach element [list  $s.j.bottom.f5.tail_side $s.j.bottom.f5.primer_taill  $s.j.bottom.f5.primer_tail ] {
		$element configure -state disabled
	  }
	} elseif {$temp_info(tails_zero,$i)} {
	  $s.j.bottom.f5.tail_side configure -text [mc Reverse]
	  set temp_info(primer_tail_side,$i) 0
	  set temp_info(primer_tail,$i) 0
	  foreach element [list $s.j.bottom.f5.tail_side $s.j.bottom.f5.primer_taill  $s.j.bottom.f5.primer_tail] {
		$element configure -state disabled
	  }
	} elseif {$temp_info(tails_zero,$next_i)} {
	  $s.j.bottom.f5.tail_side configure -text [mc Forward]
	  set temp_info(primer_tail_side,$i) 1
	  set temp_info(primer_tail,$i) 0
	  foreach element [list $s.j.bottom.f5.tail_side $s.j.bottom.f5.primer_taill  $s.j.bottom.f5.primer_tail] {
		$element configure -state disabled
	  }
	} else {
	  set temp_info(primer_tail_side,$i) 1
	  foreach element [list $s.j.bottom.f5.tail_side $s.j.bottom.f5.primer_taill  $s.j.bottom.f5.primer_tail] {
		$element configure -state normal
	  }
	}
  }
  foreach element [list $s.j.top.left.p1f.p1e $s.j.bottom.f1.t1tm $s.j.bottom.f1.t1tmsc] {
    if {$temp_info(skip_primer,$i)} {
      $element configure -state disabled
    } else {
      $element configure -state normal
    }
  }

  foreach element [list $s.j.top.left.p2f.p2e $s.j.bottom.f2.t2tm $s.j.bottom.f2.t2tmsc] {
    if {$temp_info(skip_primer,$next_i)} {
      $element configure -state disabled
    } else {
      $element configure -state normal
    }
  }

  grid remove $s.f 
  grid configure $s.okframe.back




  if {$i == 0} {
    bind $s <<Back>> "gibson_wizard_fragments_frame $s"
  } else {
    bind $s <<Back>> "gibson_wizard_junction_frame $s [expr {$i -1}]"
  }

  if {[expr {$i +1}] == $temp_info(fragment_number)} {
    bind $s <<OK>> "gibson_wizard_generate_product"
    $s.okframe.ok configure -text [mc "Finish"]
  } else {
    bind $s <<OK>> "gibson_wizard_junction_frame $s [expr {$i +1}]"
    $s.okframe.ok configure -text [mc "Next"]
  }
  gibson_wizard_calculate $i
}




############
##
#############
proc gibson_wizard_calculate {i} {
  global temp_info info

   set temp_info(linker_dict,$i) [dict create gibson_tm_actual2 0 left_overhang_length 0 right_overhang_length 0]
  # Left Sequence
  
  set seq_length_i [ix2bp $temp_info(window,$i).textarea [end_ix $temp_info(window,$i).textarea]]
  set temp_info(template1_label) "[file rootname [wm title $temp_info(window,$i)]] [expr {1 +$temp_info(first,$i)}]..[expr {$temp_info(last,$i) % $seq_length_i}]"
  set dna_first $temp_info(first,$i)
  set dna_last $temp_info(last,$i)

  if {![info exists temp_info(template_seq,$i)] || $temp_info(template_seq,$i)  == ""} {
    set temp_info(template_seq,$i) [gibson_wizard_get_dna $temp_info(window,$i) $temp_info(first,$i) $temp_info(last,$i) $temp_info(rc,$i)]
  }
##work here for gibson deletion- use left_end_deletion, right_end_deletion, overlap_len to set the sequence
  set new_dna [string range $temp_info(template_seq,$i) 0 end-$temp_info(right_end_deletion,$i)]

  #Right Sequence
  set next_i [expr {($i+1) % $temp_info(fragment_number)}]
  set seq_length_next_i [ix2bp $temp_info(window,$next_i).textarea [end_ix $temp_info(window,$next_i).textarea]]
  set temp_info(template2_label) "[file rootname [wm title $temp_info(window,$next_i)]] [expr {1 +$temp_info(first,$next_i)}]..[expr {$temp_info(last,$next_i) % $seq_length_next_i}]"
  set dna_first $temp_info(first,$next_i)
  set dna_last $temp_info(last,$next_i)
  if {![info exists temp_info(template_seq,$next_i)] || $temp_info(template_seq,$next_i)  == ""} {
    set temp_info(template_seq,$next_i) [gibson_wizard_get_dna $temp_info(window,$next_i) $temp_info(first,$next_i) $temp_info(last,$next_i) $temp_info(rc,$next_i)]
  }
##work here for gibson deletion- use left_end_deletion, right_end_deletion, overlap_len to set the sequence
  set new_dna2 [string range $temp_info(template_seq,$next_i) $temp_info(left_end_deletion,$next_i) end]

  set overlap_seq [expr {$temp_info(overlap_len,$i)> 0 ? $temp_info(overlap_seq,$i) : {}}]

  #1 set fusion_sequence 
##work here for gibson deletion- use left_end_deletion, right_end_deletion, overlap_len to set the sequence
  set fusion_sequence "$new_dna$overlap_seq[string range $new_dna2 [expr {max (0,-$temp_info(overlap_len,$i))}] end]"
  #2 set left_template_length
  set left_template_length [string length $new_dna]
  set fusion_template_length [string length $fusion_sequence]

  #3 rev_primer_base (start at right end of template1 and work left to TmR)
  set tm1 0
  if {$temp_info(skip_primer,$i)} {
    set rev_primer_mid [expr {$left_template_length - 1}]
    set rev_primer_3 [expr {$left_template_length - 1}]
  } else {
    for {set k 9} {$k < $left_template_length && ([set tm1 [Tm [string range $new_dna end-$k end] $info(primer_dna) $info(primer_salt)]] eq "<0" || $tm1 < $temp_info(template1_tm,$i))} {incr k} {}
    set rev_primer_mid [expr {$left_template_length - 1}]
    set rev_primer_3 [expr {$left_template_length - 1 - $k}]
  }

  #4 fwd_primer_base (start at left end of template2 work right to TmF)
  set tm2 0
  if {$temp_info(skip_primer,$next_i)} {
##work here for gibson deletion- use left_end_deletion, right_end_deletion, overlap_len to set the sequence
    set fwd_primer_mid [expr {$left_template_length + $temp_info(overlap_len,$i) }]
    set fwd_primer_3 [expr {$left_template_length + $temp_info(overlap_len,$i) }]
  } else {
##work here for gibson deletion- use left_end_deletion, right_end_deletion, overlap_len to set the sequence
    for {set k 9} {$k < [string length $new_dna2] && ([set tm2 [Tm [string range $new_dna2 0 $k] $info(primer_dna) $info(primer_salt)]] eq "<0" || $tm2 < $temp_info(template2_tm,$i))} {incr k} {}
    set fwd_primer_mid [expr {$left_template_length + $temp_info(overlap_len,$i) }]
    set fwd_primer_3 [expr {$fwd_primer_mid + $k}]
  }

  if {$temp_info(primer_tail_side,$i) == 1} {
    #### Forward tail set
    #5 primer_tail $fwd_primer_mid - $primer_tail_length
    set fwd_primer_5 [expr {$fwd_primer_mid - $temp_info(primer_tail,$i)}]

    #6 rev_primer_tail (start at $fwd_primer_5 coordinate work right until TmG, take greater of this coordinate and $rev_primer_mid (5' of base primer)
    for {set k 9} {$k < 100 && ([set tmg [Tm [string range $fusion_sequence $fwd_primer_5 [expr {$fwd_primer_5 + $k}]] $info(primer_dna) $info(primer_salt)]] eq "<0" || $tmg < $temp_info(gibson_tm,$i)) && [expr {$fwd_primer_5 + $k}] < $fusion_template_length} {incr k} {}
    if {[expr {$fwd_primer_5 + $k}] > [expr {$rev_primer_mid}]} {
      set rev_primer_5 [expr {$fwd_primer_5 + $k}]
    } else {
      set rev_primer_5 $rev_primer_mid
      set tmg  [Tm [string range $fusion_sequence $fwd_primer_5 $rev_primer_5] $info(primer_dna) $info(primer_salt)]
    }
  } elseif {$temp_info(primer_tail_side,$i) == 0}  {
    #### Reverse tail set
    #5 primer_tail $rev_primer_mid + $primer_tail_length
    set rev_primer_5 [expr {$rev_primer_mid + $temp_info(primer_tail,$i)}]

    #6 fwd_primer_tail (start at $rev_primer_5 coordinate work left until TmG, take lesser of this coordinate and $fwd_primer_mid (5' of base primer)
    for {set k 9} {$k < 100 && ([set tmg [Tm [string range $fusion_sequence [expr {$rev_primer_5 - $k}] $rev_primer_5] $info(primer_dna) $info(primer_salt)]] eq "<0" || $tmg < $temp_info(gibson_tm,$i)) && [expr {$rev_primer_5 - $k}] >= 0} {incr k} {}

    if {[expr {$rev_primer_5 - $k}] < [expr {$fwd_primer_mid}]} {
      set fwd_primer_5 [expr {$rev_primer_5 - $k}]
    } else {
      set fwd_primer_5 $fwd_primer_mid
      set tmg  [Tm [string range $fusion_sequence $fwd_primer_5 $rev_primer_5] $info(primer_dna) $info(primer_salt)]
    }
  } else {
    #### Both tails skippped, overlap only (overlap_len < 0) or need to calculate the linker oligo if
    ## work here for Gibson deletion
    set rev_primer_5 $rev_primer_mid
    set fwd_primer_5 $fwd_primer_mid
    if {$temp_info(overlap_len,$i) >=0} {
      if {$info(gibson_wizard_default_add_linkers)} {
        # calculate the linker oligo
        for {set k 9} {$k < 100 && ([set tmg [Tm [string range $fusion_sequence $fwd_primer_5 [expr {$fwd_primer_5 + $k-1}]] $info(primer_dna) $info(primer_salt)]] eq "<0" || $tmg < $temp_info(gibson_tm,$i)) && [expr {$fwd_primer_5 + $k}] < $fusion_template_length} {incr k} {}
        dict set temp_info(linker_dict,$i) right_overhang_length $k
        dict set temp_info(linker_dict,$i) gibson_tm_actual2 $tmg
        for {set k 9} {$k < 100 && ([set tmg [Tm [string range $fusion_sequence [expr {$rev_primer_5 - $k+1}] $rev_primer_5] $info(primer_dna) $info(primer_salt)]] eq "<0" || $tmg < $temp_info(gibson_tm,$i)) && [expr {$rev_primer_5 - $k}] >= 0} {incr k} {}
        dict set temp_info(linker_dict,$i) left_overhang_length $k
        ## gibson_align_display linker_display  linker_align_display
      } else {
        set tmg 0
      }
    } else {
      set tmg  [Tm [string range $fusion_sequence $fwd_primer_5 $rev_primer_5] $info(primer_dna) $info(primer_salt)]
    }
  }

  set temp_info(rev_3,$i) $rev_primer_3
  set temp_info(rev_mid,$i) $rev_primer_mid
  set temp_info(rev_5,$i) $rev_primer_5
  set temp_info(rev_primer,$i) [revcom [string range $fusion_sequence $rev_primer_3 $rev_primer_5]]
  set temp_info(fwd_3,$next_i) $fwd_primer_3
  set temp_info(fwd_mid,$next_i) $fwd_primer_mid
  set temp_info(fwd_5,$next_i) $fwd_primer_5
  set temp_info(fwd_primer,$next_i) [string range $fusion_sequence $fwd_primer_5 $fwd_primer_3]

  # set display texts
  set tm1 [expr {[string is double $tm1]?$tm1:0}]
  set tm1_long [Tm $temp_info(rev_primer,$i) $info(primer_dna) $info(primer_salt)]
  set tm1_long [expr {[string is double $tm1_long]?$tm1_long:0}]
  set temp_info(template1_tm_actual,$i) "$tm1\u00B0C $tm1_long\u00B0C [expr {$rev_primer_5-$rev_primer_3+1}] bases"
  set tm2 [expr {[string is double $tm2]?$tm2:0}]
  set tm2_long [Tm $temp_info(fwd_primer,$next_i) $info(primer_dna) $info(primer_salt)]
  set tm2_long [expr {[string is double $tm2_long]?$tm2_long:0}]
  set temp_info(template2_tm_actual,$i) "$tm2\u00B0C $tm2_long\u00B0C [expr {$fwd_primer_3-$fwd_primer_5+1}] bases"
  set tmg [expr {[string is double $tmg]?$tmg:0}]
  set temp_info(gibson_tm_actual,$i) $tmg

  set display_left [expr {min($fwd_primer_5, $rev_primer_3, $rev_primer_5-25, ($rev_primer_5 - [dict get $temp_info(linker_dict,$i) left_overhang_length] ))}]
  if { [dict get $temp_info(linker_dict,$i) gibson_tm_actual2] ==0} {
    ## no linker made - just show simple Gibson Tms
    if {$tmg == 0} {
      set temp_info(gibson_tm_label,$i) "** Error: No overlapping bases at this junction"
    } elseif {$tmg < [expr {$info(gibson_wizard_default_g_tm)}]} {
      set temp_info(gibson_tm_label,$i) "$tmg\u00B0C [expr {$rev_primer_5-$fwd_primer_5+1}] bases ** Warning: less than default Tm"
    } else {
      set temp_info(gibson_tm_label,$i) "$tmg\u00B0C [expr {$rev_primer_5-$fwd_primer_5+1}] bases"
    }
    set temp_info(gibson_align_display) "[string repeat { } [expr {$fwd_primer_5 - $display_left}]][string repeat {|} [expr {$rev_primer_5 - $fwd_primer_5 + 1}]]"
  } else {
    ## Linker was made- set linker texts and Gibson Tms
    set tmg2 [dict get $temp_info(linker_dict,$i) gibson_tm_actual2] 
    if {$tmg < [expr {$info(gibson_wizard_default_g_tm)}] || $tmg2< $info(gibson_wizard_default_g_tm) } {
      set temp_info(gibson_tm_label,$i) "$tmg\u00B0C ([dict get $temp_info(linker_dict,$i) left_overhang_length] bases), $tmg2\u00B0C ([dict get $temp_info(linker_dict,$i) right_overhang_length] bases)  ** Warning: less than default Tm"
    } else {
      set temp_info(gibson_tm_label,$i) "$tmg\u00B0C ([dict get $temp_info(linker_dict,$i) left_overhang_length] bases), $tmg2\u00B0C ([dict get $temp_info(linker_dict,$i) right_overhang_length] bases)"
    }
    set temp_info(gibson_align_display) "[string repeat { } [expr {1+$rev_primer_5 - [dict get $temp_info(linker_dict,$i) left_overhang_length] - $display_left}]][string repeat {|} [expr {[dict get $temp_info(linker_dict,$i) left_overhang_length] }]]"
    set temp_info(linker_display) "[string repeat { } [expr {$rev_primer_5 - [dict get $temp_info(linker_dict,$i) left_overhang_length] - $display_left }]]\u25c4[string range $fusion_sequence [expr {$rev_primer_5 +1- [dict get $temp_info(linker_dict,$i) left_overhang_length]}] [expr {$fwd_primer_5 + [dict get $temp_info(linker_dict,$i) right_overhang_length]  -1}]  ]"
    set temp_info(linker_align_display) "[string repeat { } [expr {$fwd_primer_5 - $display_left}]][string repeat {|} [expr {[dict get $temp_info(linker_dict,$i) right_overhang_length] }]]"
    set temp_info(linker_oligo_sequence,$i) [revcom [string range $fusion_sequence [expr {$rev_primer_5 +1- [dict get $temp_info(linker_dict,$i) left_overhang_length]}] [expr {$fwd_primer_5 + [dict get $temp_info(linker_dict,$i) right_overhang_length]  -1}]  ]]
  }

  set temp_info(template1_display) [string range $fusion_sequence $display_left $rev_primer_mid]
  set temp_info(template1_align_display) "[string repeat { } [expr {$rev_primer_3 - $display_left}]]\u25c4[string repeat \u2567 [expr {$rev_primer_mid - $rev_primer_3}]][string repeat \u2500 [expr {$rev_primer_5 - $rev_primer_mid}]]"
  set temp_info(primer1_display) "[string repeat { } [expr {$rev_primer_3 - $display_left}]][string range $fusion_sequence $rev_primer_3 $rev_primer_5]"
  set temp_info(primer2_display) "[string repeat { } [expr {$fwd_primer_5 - $display_left}]][string range $fusion_sequence $fwd_primer_5 $fwd_primer_3]"
  set temp_info(template2_align_display) "[string repeat { } [expr {$fwd_primer_5 - $display_left}]][string repeat \u2500 [expr {$fwd_primer_mid - $fwd_primer_5}]][string repeat \u2564 [expr {$fwd_primer_3 - $fwd_primer_mid}]]\u25ba"
  set temp_info(template2_display) "[string repeat { } [expr {$fwd_primer_mid - $display_left}]][string range $fusion_sequence $fwd_primer_mid [expr {max($fwd_primer_3, $rev_primer_5, $fwd_primer_5+25, ($fwd_primer_5 + [dict get $temp_info(linker_dict,$i) right_overhang_length]))}]]"
  ## set disabled labels etc. for skipping primer
  if {$temp_info(skip_primer,$i)} {
    set temp_info(template1_tm_actual,$i) ""
    set temp_info(template1_align_display) "[string repeat { } [expr {$fwd_primer_5 - $display_left}]][string repeat {|} [expr {$rev_primer_5 - $fwd_primer_5 + 1}]]"
    set temp_info(primer1_display) "[string repeat { } [expr {$fwd_primer_5 - $display_left}]][string repeat {|} [expr {$rev_primer_5 - $fwd_primer_5 + 1}]]"
  } 
  if {$temp_info(skip_primer,$next_i)} {
    set temp_info(template2_tm_actual,$i) ""
    set temp_info(template2_align_display) "[string repeat { } [expr {$fwd_primer_5 - $display_left}]][string repeat {|} [expr {$rev_primer_5 - $fwd_primer_5 + 1}]]"
    set temp_info(primer2_display) "[string repeat { } [expr {$fwd_primer_5 - $display_left}]][string repeat {|} [expr {$rev_primer_5 - $fwd_primer_5 + 1}]]"
  }

}

############
## return the longest overlap between two sequences (as list of: position in first seq, position in second sequence, length of overlap) returns empty list for no overlaps.
#############
proc gibson_wizard_find_overlap {seq1 seq2 {seed_size 12}} {
  set seq1 [string tolower $seq1]
  set seq2 [string tolower $seq2]
  set result [list]
  set res0 [list]
  set i 0
  for {set k 0} {$k<= [expr {[string length $seq1]-$seed_size}]} {incr k} {
    while {[set f [string first [string range $seq1 $k [expr {$k+$seed_size-1}]] $seq2 $i]] > -1} {
      set j $seed_size
      while {$j <= [expr {[string length $seq1]-$k}] && [string first [string range $seq1 $k [expr {$k+$j-1}]] $seq2 $i] >-1} {
        incr j
       }
      lappend res0 [list $k $f [expr {$j-1}]]
      set i [expr {$f+1}]
    }
    set i 0
  }
  set res0 [lsort -decreasing -index 2 -integer $res0]
  foreach m $res0 {
    set found 0
    lassign $m m0 m1 m2
    foreach n $result {
      lassign $n n0 n1 n2
      if {[expr {$n1-$n0}] == [expr {$m1 -$m0}]  && [expr {$m0-$n0}] < $n2} {
        set found 1
        break
      }
    }
    if {!$found} {
      lappend result $m
    }
  }
    
  return $result
}

############
##
#############
proc gibson_wizard_set_defaults {s} {
  global info temp_info


  set next_text [$s.okframe.ok cget -text]
  if {[winfo exists $s.j] && [grid info $s.j] != {}} {
    set back_frame $s.j
  } elseif {[grid info $s.f] != {}} {
    set back_frame $s.f
  } else {
    sputs error
    return
  }

  grid remove $back_frame
  grid remove $s.okframe.ok
  set back_show [expr {[grid info $s.okframe.back] != {}}]
  grid remove $s.okframe.back
  $s.okframe.setdef configure -text [mc "Set"] -command "event generate $s <<SetDefaults>>"


  if {![winfo exists $s.d]} {
    frame $s.d 

    grid [frame $s.d.f1] -row 1 -column 1 -sticky nswe
    grid [label $s.d.f1.l0 -text [mc "Default primer Tm"]] -row 1 -column 1 -sticky w
    #set temp_info(gibson_wizard_default_tm_scaled) [expr {($info(gibson_wizard_default_tm)-50)/22.0}]
    #grid [ttk::scale $s.d.f1.tmsc -orient horizontal -length 200 -command "set info(gibson_wizard_default_tm) \[expr {round(\$temp_info(gibson_wizard_default_tm_scaled)*22.0+50)}\];#"  -variable temp_info(gibson_wizard_default_tm_scaled) -from 0 -to 1] -row 1 -column 2 -sticky ew
    #grid [label $s.d.f1.l1 -textvariable info(gibson_wizard_default_tm)] -row 1 -column 3 -sticky e
    grid [ttk::spinbox $s.d.f1.tmsc -width 3 -from 45 -to 72 -validate key -validatecommand "string_is_in_range %P 45 72" -textvariable info(gibson_wizard_default_tm)] -row 1 -column 2 -sticky ew

    grid [frame $s.d.f2] -row 2 -column 1 -sticky nswe 
    grid [label $s.d.f2.l0 -text [mc "Default overlap Tm"]] -row 1 -column 1 -sticky w
    grid [ttk::spinbox $s.d.f2.gsc -width 3 -from 0 -to 150 -validate key -validatecommand "string_is_in_range %P 0 150" -textvariable info(gibson_wizard_default_g_tm)] -row 1 -column 2 -sticky ew

    grid [frame $s.d.nameframe] -row 3 -column 1 -sticky nswe 
      grid [label $s.d.nameframe.pnamel -text [mc "Next Primer Name:"]] -row 0 -column 1 -sticky e
      tooltip_install $s.d.nameframe.pnamel [mc "Set the name that will be applied to primers using the command in the menu button to the right. Also use the menu button to set variable text in the name."]
      grid [ttk::entry $s.d.nameframe.entry -textvariable info(primer_name_string) -width 15] -row 0 -column 2  -columnspan 1 -sticky w
      tooltip_install $s.d.nameframe.entry [mc "Set the name that will be applied to primers using the command in the menu button to the right. Also use the menu button to set variable text in the name."]
      grid [ttk::menubutton $s.d.nameframe.sub -text [mc "Insert Substitution Codes into Name Field"] -menu $s.d.nameframe.sub.menu ] -row 0 -column 3 -columnspan 1
      tooltip_install $s.d.nameframe.sub [mc "Insert Substitution Codes into Name Field."]
        menu $s.d.nameframe.sub.menu 
        foreach {mlabel subs} [list [mc "Next Number"] %# [mc "Next Number (3 digit)"] %3 [mc "Next Number(4 digit)"] %4 [mc "Next Number(5 digit)"] %5 [mc "Next Number(6 digit)"] %6  [mc "Target Name"] %T  [mc "Template Name"] %t [mc "Direction Fwd/Rev"] %W [mc "Direction fwd/rev"] %w [mc "Direction F/R"] %F [mc "Direction f/r"] %f [mc "5' Location"] %L [mc "Year"] %y [mc "Month"] %m [mc "Day"] %d [mc "Just a %% character"] %% ] {
          $s.d.nameframe.sub.menu  add command -label [mc "$mlabel (%1\$s)" $subs] -command "$s.d.nameframe.entry insert insert \"$subs\""
        }
      grid [label $s.d.nameframe.pnuml -text [mc "Next Primer Number:"]] -row 1 -column 1
      tooltip_install $s.d.nameframe.pnuml [mc "If your primer name contains a %%# substitution variable, this will be the primer number of the next name applied."]
      grid [ttk::spinbox $s.d.nameframe.pnumber -textvariable info(primer_next_number) -from 0 -to 20 -validate all -validatecommand "string_is_in_range %P 0 1000000000" -width 4 -command ""] -row 1 -column 2 -columnspan 1 -sticky w
      tooltip_install $s.d.nameframe.pnumber [mc "If your primer name contains a %%# substitution variable, this will be the primer number of the next name applied."]
      
    
    grid [frame $s.d.f3] -row 4 -column 1 -sticky nswe
    grid [label $s.d.f3.l0 -text [mc "Default Exonuclease direction"]] -row 1 -column 1 -sticky w
    grid [menubutton $s.d.f3.exo_mb -state normal -textvariable temp_info(gibson_wizard_exo_side_display)] -row 1 -column 2 -sticky w
    $s.d.f3.exo_mb configure -menu [menu $s.d.f3.exo_mb.menu]
    $s.d.f3.exo_mb.menu add radiobutton -command "set temp_info(gibson_wizard_exo_side_display) {5' Exo (Gibson)}" -label [mc "5' Exo (Gibson)"] -variable info(gibson_wizard_exo_side) -value 5
    $s.d.f3.exo_mb.menu add radiobutton -command "set temp_info(gibson_wizard_exo_side_display) {3' Exo (InFusion)}" -label [mc "3' Exo (InFusion)"] -variable info(gibson_wizard_exo_side) -value 3
    $s.d.f3.exo_mb.menu add radiobutton -command "set temp_info(gibson_wizard_exo_side_display) {No Exo}" -label [mc "No Exo"] -variable info(gibson_wizard_exo_side) -value 0

    switch $info(gibson_wizard_exo_side) {
      0 {set temp_info(gibson_wizard_exo_side_display) {No Exo}}
      3 {set temp_info(gibson_wizard_exo_side_display) {3' Exo (InFusion)}}
      5 {set temp_info(gibson_wizard_exo_side_display) {5' Exo (Gibson)}}
    }
    grid [frame $s.d.f4] -row 5 -column 1 -sticky nswe
    grid [checkbutton $s.d.f4.c1 -text [mc "Add ssDNA Linkers to Junctions with no Overlap"] -variable info(gibson_wizard_default_add_linkers)] -row 1 -column 1 -sticky w
    grid [frame $s.d.f5] -row 6 -column 1 -sticky nswe
    grid [checkbutton $s.d.f5.c1 -text [mc "Allow Removal of Mismatching Ends with an Internal Overlap (NEBuilder)"] -variable info(gibson_wizard_default_gibson_deletion)] -row 1 -column 1 -sticky w

    grid [frame $s.d.f6] -row 7 -column 1 -sticky nswe
    grid [checkbutton $s.d.f6.c1 -text [mc "Add Amplicon Features to Product"] -variable info(gibson_wizard_add_amplicon_features)] -row 1 -column 1 -sticky w
  }
  grid $s.d -row 1 -column 1 -sticky nswe

  bind $s <<SetDefaults>> "\
    grid remove $s.d;
    $s.okframe.setdef configure -text \[mc \"Set Defaults\"\] -command \"gibson_wizard_set_defaults $s\";\
    if {$back_show} {grid configure $s.okframe.back};\
    grid configure $s.okframe.ok;\
    grid configure $back_frame;\
  "
}

proc string_is_in_range {a from to} {
  return [expr {$a ne "" && [string is integer $a] && $a>=$from && $a <= $to}] 
}

############
##
#############
proc gibson_wizard_generate_product {} {
  global info temp_info

  set dna ""
  set tags [list]
  set fragments $temp_info(fragment_number)
  set min_gibson_tm $temp_info(gibson_tm_actual,0)
  set filecomment ""
  set primer_order [list]


  if {[dict exists $info(feature_default_type_colors) primer_bind]} {
    set revcolors [dict get $info(feature_default_type_colors) primer_bind]
  } else {
    set revcolors [list $info(feature_default_fcolor) $info(feature_default_rcolor)]
  }

  if {[dict exists $info(feature_default_type_gformat) primer_bind]} {
    set gformat [dict get $info(feature_default_type_gformat) primer_bind]
  } else {
    set gformat $info(feature_default_gformat)
  }

  if {[dict exists $info(feature_default_type_colors) misc_feature]} {
    set revcolors_misc [dict get $info(feature_default_type_colors) misc_feature]
  } else {
    set revcolors_misc [list $info(feature_default_fcolor) $info(feature_default_rcolor)]
  }
  if {[dict exists $info(feature_default_type_gformat) misc_feature]} {
    set gformat_misc [dict get $info(feature_default_type_gformat) misc_feature]
  } else {
    set gformat_misc $info(feature_default_gformat)
  }

  set p_count 0
  for {set i 0} {$i < $fragments} {incr i} {
    set next_i [expr {($i + 1) % $fragments}]
    set w1 $temp_info(window,$i)

    set min_gibson_tm [expr {min($min_gibson_tm, $temp_info(gibson_tm_actual,$i))}]

    if {![info exists temp_info(template_seq,$i)] || $temp_info(template_seq,$i)  == ""} {
      set temp_info(template_seq,$i) [gibson_wizard_get_dna $temp_info(window,$i) $temp_info(first,$i) $temp_info(last,$i) $temp_info(rc,$i)]
    }

    set end [string length $dna]

    if {$temp_info(overlap_len,$i) > 0} {
##work here for gibson deletion- use left_end_deletion, right_end_deletion, overlap_len to set the sequence
      append dna [string range $temp_info(template_seq,$i) $temp_info(left_end_deletion,$i) end-$temp_info(right_end_deletion,$i)] $temp_info(overlap_seq,$i)
    } else {
##work here for gibson deletion- use left_end_deletion, right_end_deletion, overlap_len to set the sequence
      append dna [string range $temp_info(template_seq,$i) $temp_info(left_end_deletion,$i) end+[expr {$temp_info(overlap_len,$i)-$temp_info(right_end_deletion,$i)}]]
    }

##work here for gibson deletion- use left_end_deletion, right_end_deletion, overlap_len to set the sequence tag range
    set len [ix2bp $w1.textarea [end_ix $w1.textarea]]

    if {$temp_info(rc,$i)} {
    ## Gibson bug work here- correct without inline $temp_info(last,$i)
      if {$temp_info(last,$i) < 0} {
        set new_tags [get_tags2 $w1.textarea [expr {($temp_info(first,$i)+$temp_info(right_end_deletion,$i)) % $len}] [expr {($temp_info(last,$i)-$temp_info(left_end_deletion,$i)) }] $temp_info(rc,$i) $end]
      } else {
        set new_tags [get_tags2 $w1.textarea [expr {($temp_info(first,$i)+$temp_info(right_end_deletion,$i)) % $len}] [expr {($temp_info(last,$i)-$temp_info(left_end_deletion,$i))  % $len}] $temp_info(rc,$i) $end]
      }
    } else {
      if {$temp_info(last,$i) < 0} {
        set new_tags [get_tags2 $w1.textarea [expr {($temp_info(first,$i)+$temp_info(left_end_deletion,$i)) % $len}] [expr {($temp_info(last,$i)-$temp_info(right_end_deletion,$i)) }] $temp_info(rc,$i) $end]
      } else {
        set new_tags [get_tags2 $w1.textarea [expr {($temp_info(first,$i)+$temp_info(left_end_deletion,$i)) % $len}] [expr {($temp_info(last,$i)-$temp_info(right_end_deletion,$i))  % $len}] $temp_info(rc,$i) $end]
      }

    }


    ###### check for overlaps between wrong ends
    set incorect_overlaps_warning [list]
    for {set j 0} {$j <= $i} {incr j} {
      set overlap_search_range 99
      if {$i == $j} {
        set overlap_search_range [expr {min(99, [string length $temp_info(template_seq,$i)]/2)}]
      }
      if {$j == $next_i} {
        if { [llength [gibson_wizard_find_overlap [string range $temp_info(template_seq,$i) end-$overlap_search_range end] [string range $temp_info(template_seq,$j) 0 $overlap_search_range]]] > 1} {
          lappend incorect_overlaps_warning [mc "First fragment left end has multiple overlaps with last fragment right end."]
        }
      } elseif { [llength [gibson_wizard_find_overlap [string range $temp_info(template_seq,$i) end-$overlap_search_range end] [string range $temp_info(template_seq,$j) 0 $overlap_search_range]]] > 0} {
        lappend incorect_overlaps_warning [mc "Fragment %1\$s left end has an overlap with fragment %2\$s right end." [expr {$j+1}] [expr {$i+1}] ]
      }
      if {$j == [expr {$i -1}]} {
        if { [llength [gibson_wizard_find_overlap [string range $temp_info(template_seq,$j) end-$overlap_search_range end] [string range $temp_info(template_seq,$i) 0 $overlap_search_range]]] > 1} {
          lappend incorect_overlaps_warning [mc "Fragment %1\$s right end has multiple overlaps with fragment %2\$s left end." [expr {$j+1}] [expr {$i+1}] ]
        }
      } elseif {$i !=$j && [llength [gibson_wizard_find_overlap [string range $temp_info(template_seq,$j) end-$overlap_search_range end] [string range $temp_info(template_seq,$i) 0 $overlap_search_range]]] > 0} {
          lappend incorect_overlaps_warning [mc "Fragment %1\$s right end has an overlap with fragment %2\$s left end." [expr {$j+1}] [expr {$i+1}] ]
      }
      if { [llength [gibson_wizard_find_overlap [string range $temp_info(template_seq,$j) 0 $overlap_search_range] [revcom [string range $temp_info(template_seq,$i) 0 $overlap_search_range]]]] > 0} {
          lappend incorect_overlaps_warning [mc "Fragment %1\$s left end has an overlap with fragment %2\$s left end." [expr {$j+1}] [expr {$i+1}] ]
      }
      if { [llength [gibson_wizard_find_overlap [string range $temp_info(template_seq,$j) end-$overlap_search_range end] [revcom [string range $temp_info(template_seq,$i) end-$overlap_search_range end]]]] > 0} {
          lappend incorect_overlaps_warning [mc "Fragment %1\$s right end has an overlap with fragment %2\$s right end." [expr {$j+1}] [expr {$i+1}] ]
      }
    }


    set new_tags_temp [list]
    foreach {at bt} $new_tags {
      if {[regexp {fn?[0-9]+#} $at]} {
        lappend new_tags_temp $at $bt
      }
    }
    set new_tags $new_tags_temp
    unset new_tags_temp

     ## add in the linker oligo sequence here
    if {[info exists temp_info(linker_oligo_sequence,$i)] && $temp_info(linker_oligo_sequence,$i) ne {}} {
        ## rev linker
        ##work here for gibson deletion- use left_end_deletion,$i was not included in the calculation of fwd_5 fwd_3 or rev_5 or rev_3, so subtract  left_end_deletion,$i from those values
      set coords [list [expr {$temp_info(rev_5,$i)-$temp_info(left_end_deletion,$i) + $end +1- [dict get $temp_info(linker_dict,$i) left_overhang_length]}] [expr {$temp_info(rev_5,$i) -$temp_info(left_end_deletion,$i) + $end+1 +$temp_info(overlap_len,$i) + [dict get $temp_info(linker_dict,$i) right_overhang_length]}] ]
      set bg_color [lindex $revcolors 1]
      set metadata [list $temp_info(linker_name,$i) $gformat primer_bind 1 [list note "linker oligo sequence:$temp_info(linker_oligo_sequence,$i)"] [list]]
      lappend_tags new_tags f0# [list $coords [list $bg_color {} {} {}] [list <<Metadata>> <<Revcolors>>] [list $metadata $revcolors]]

      lappend primer_order "$temp_info(linker_name,$i)\t$temp_info(linker_oligo_sequence,$i)" 
      set min_gibson_tm [expr {min($min_gibson_tm,[dict get $temp_info(linker_dict,$i) gibson_tm_actual2])}]
    }
      ### add in the primer_bind features here, need to use $temp_info(skip_primer,$i)
    if {!$temp_info(skip_primer,$next_i)} {
       ## fwd primer
##work here for gibson deletion- use left_end_deletion,$i was not included in the calculation of fwd_5 fwd_3 or rev_5 or rev_3, so subtract  left_end_deletion,$i from those values
      set coords [list [expr {$temp_info(fwd_5,$next_i) + $end -$temp_info(left_end_deletion,$i)}] [expr {$temp_info(fwd_3,$next_i) + $end -$temp_info(left_end_deletion,$i) +1}]]
      set bg_color [lindex $revcolors 0]
      set metadata [list $temp_info(fwd_primer_name,$next_i) $gformat primer_bind 0 [list PCR_conditions "primer sequence:$temp_info(fwd_primer,$next_i)"] [list]]
      lappend_tags new_tags f0# [list $coords [list $bg_color {} {} {}] [list <<Metadata>> <<Revcolors>> ] [list $metadata $revcolors]]
    }

    if {!$temp_info(skip_primer,$i)} {
      incr p_count
        ## rev primer
##work here for gibson deletion- use left_end_deletion,$i was not included in the calculation of fwd_5 fwd_3 or rev_5 or rev_3, so subtract  left_end_deletion,$i from those values
      set coords [list [expr {$temp_info(rev_3,$i) -$temp_info(left_end_deletion,$i) + $end}] [expr {$temp_info(rev_5,$i)-$temp_info(left_end_deletion,$i) + $end+1}]]
      set bg_color [lindex $revcolors 1]
      set metadata [list $temp_info(rev_primer_name,$i) $gformat primer_bind 1 [list PCR_conditions "primer sequence:$temp_info(rev_primer,$i)"] [list]]
      lappend_tags new_tags f0# [list $coords [list $bg_color {} {} {}] [list <<Metadata>> <<Revcolors>>] [list $metadata $revcolors]]




      ## File comment for PCR
      set last_i [expr {($i - 1) % $fragments}]
      set i_tail [expr {$temp_info(fwd_mid,$i) - $temp_info(fwd_5,$i)}]
      set base_len [expr {$temp_info(fwd_3,$i) - $temp_info(fwd_mid,$i)}]
      set fwd_primer_base [string range $temp_info(fwd_primer,$i) end-$base_len end]
      set base_len [expr {$temp_info(rev_mid,$i) - $temp_info(rev_3,$i)}]
      set rev_primer_base [string range $temp_info(rev_primer,$i) end-$base_len end]
      set tm_string1 "[Tm $fwd_primer_base], [Tm $temp_info(fwd_primer,$i)]"
      set tm_string2 "[Tm $rev_primer_base], [Tm $temp_info(rev_primer,$i)]"

      set amplicon_note "PCR:\ntemplate: [file rootname [wm title $w1]]\n$temp_info(fwd_primer_name,$i) $temp_info(fwd_primer,$i) $tm_string1\n$temp_info(rev_primer_name,$i) $temp_info(rev_primer,$i) $tm_string2\nProduct length: [expr {1+$temp_info(rev_5,$i) + $i_tail}]"
      lappend primer_order "$temp_info(fwd_primer_name,$i)\t$temp_info(fwd_primer,$i)" "$temp_info(rev_primer_name,$i)\t$temp_info(rev_primer,$i)"
    } elseif {$temp_info(digest_enz,$i) != {}} {
      ## File comment for Digest
      set amplicon_note "Digest: [file rootname [wm title $w1]] [lindex $temp_info(digest_enz,$i) 4]bp, [lindex $temp_info(digest_enz,$i) 0] - [lindex $temp_info(digest_enz,$i) 2]"
    } else {
      ## File comment for generic DNA
      set amplicon_note "Linear DNA:[wm title $w1]"
    }

##work here for gibson linker- $temp_info(linker_dict,$i) dict: gibson_tm_actual2    left_overhang_length   right_overhang_length  ($temp_info(gibson_tm_actual,$i) is the left Tm)



    append filecomment $amplicon_note \n

    set amplicon_note_list [list]
    foreach line [split $amplicon_note \n] {
      lappend amplicon_note_list "note" $line
    }
    ## add in amplicon misc_feature here
    if {$info(gibson_wizard_add_amplicon_features)} {
##work here for gibson deletion- use left_end_deletion,$i was not included in the calculation of fwd_5 fwd_3 or rev_5 or rev_3, so subtract  left_end_deletion,$i from those values
      set coords [list [expr {$end - ($temp_info(fwd_mid,$i) - $temp_info(fwd_5,$i)) -$temp_info(left_end_deletion,$i)}] [expr {$end + 1+$temp_info(rev_5,$i) -$temp_info(left_end_deletion,$i)}]]

      set bg_color [lindex $revcolors_misc $temp_info(rc,$i)]
      set metadata [list "Gibson_fragment_$i" $gformat_misc misc_feature $temp_info(rc,$i) $amplicon_note_list [list]]
      lappend_tags new_tags f0# [list $coords [list $bg_color {} {} {}] [list <<Metadata>> <<Revcolors>>] [list $metadata $revcolors_misc]]
    }

    if {$next_i ==0} {
      ##move tags past the end of the last fragment to the beginning
      set end [string length $dna]
      set new_tags2 [list]
      foreach {tag data} $new_tags {
        set newcoords [list]  
        foreach {a b} [lindex $data 0] {
          if {$b <= $end} {
            lappend newcoords $a $b
          } elseif {$a >= $end} {
            lappend newcoords [expr {$a-$end}] [expr {$b-$end}]
          } elseif {$b > $end} {
            lappend newcoords $a [expr {$end}]
            lappend newcoords 0 [expr {$b-$end}]
          } 
        }
        if {$newcoords != [list]} {
          lset data 0 $newcoords
          lappend new_tags2 $tag $data
        }
      }
      lappend_tags tags {*}$new_tags2
    } else {
      lappend_tags tags {*}$new_tags
    }
  }
  append filecomment [join $primer_order \n]


  if {$min_gibson_tm <= 0} {
    set filecomment "**Error: at least one fragment has no overlap.\n$filecomment"
  } elseif {$min_gibson_tm < $info(gibson_wizard_default_g_tm)} {
    set filecomment "Gibson reaction:\n**Warning: lowest overhang Tm ($min_gibson_tm \u00B0C) is < $info(gibson_wizard_default_g_tm) \u00B0C.\n$filecomment"
  } else {
    set filecomment "Gibson reaction:\nOverhang Tm: $min_gibson_tm \u00B0C\n$filecomment"
  }

  if {$incorect_overlaps_warning != [list]} {
    set filecomment "**Errors: [join $incorect_overlaps_warning \n]\n$filecomment"
  }

  dialog_cancel .dialog

  if {$incorect_overlaps_warning != [list] && [tk_messageBox -message [mc "%s incorrect overlaps exist.\n [join $incorect_overlaps_warning \n]\n Continue?" [llength $incorect_overlaps_warning]] -type yesno] == "no"} {
    return
  }
  if {$min_gibson_tm <= 0  && [tk_messageBox -message [mc "At least one fragment has no overlap.\nMake a product with blunt ligation?"] -type yesno] == "no"} {
    return
  }
  regsub -all %% $info(primer_name_string) "" sub
  if {[regexp {%[#3-6]} $sub]} {
	incr info(primer_next_number) [expr {2*$p_count}]
  }
  create_window $dna "" $filecomment "circular" 1 0 New_Gibson $tags {} GenBank

}

############
##
#############
proc gibson_wizard_get_dna {w1 dna_first dna_last dir} {
  if {$dna_last > $dna_first} {
    ## fragment not through origin
    set new_dna [textarea_get $w1.textarea [bp2ix $w1.textarea $dna_first] [bp2ix $w1.textarea $dna_last]]
  } else {
    ## fragment  through origin
    set len [ix2bp $w1.textarea end]
    set new_dna [textarea_get $w1.textarea [bp2ix $w1.textarea $dna_first] [bp2ix $w1.textarea [expr {$len}]]]
    append new_dna [textarea_get $w1.textarea [bp2ix $w1.textarea 0] [bp2ix $w1.textarea [expr {$dna_last % $len}]]]
  } 
  if {$dir} {
    ## reverse fragment
    set new_dna [revcom $new_dna]
  } 
  return $new_dna
}


## defaults- Tm, 5' extension, search time
## fragments- PCR, oligos
## frame- fragment Tm, left search, right search
set info(gg_wizard_default_tm) 59
set  info(gibson_wizard_add_amplicon_features) 0
set info(gg_wizard_5_extension_seq) GCGC
set info(gg_wizard_site_linker_seq) GCGC
set info(gg_wizard_default_search_time) 1.0


## unset gg_calc(junction_index) when changing any window, region or revcom, so that recalculation starts from 0
## generate primers and results table in a text box $temp_info(as_oligos,$i)
## generate product $temp_info(as_oligos,$i)

############
##
#############
proc initialize_gg_data_tables {} {
  global gg_calc info
  set gg_calc(data_4) [list]
  set gg_calc(data_3) [list]
  set filename [file join $info(Accdir) "plosone_3base.csv"]
  if {![catch {open $filename r} fileid err]} {
    while {[eof $fileid] != 1} {
      lappend gg_calc(data_3) [split [gets $fileid] \,]
    }
  } else {
    tk_messageBox -message [mc "Error Reading Golden Gate Data:\n%s" $err] -type ok
    return
  }
  close $fileid
  set filename [file join $info(Accdir) "plosone_sum_4base.csv"]
  if {![catch {open $filename r} fileid err]} {
    while {[eof $fileid] != 1} {
      lappend gg_calc(data_4) [split [gets $fileid] \,]
    }
  } else {
    tk_messageBox -message [mc "Error Reading Golden Gate Data:\n%s" $err] -type ok
    return
  }
  close $fileid
  set gg_calc(b2n) [dict create aaaa 0 aaac 1 aaag 2 aaat 3 aaca 4 aacc 5 aacg 6 aact 7 aaga 8 aagc 9 aagg 10 aagt 11 aata 12 aatc 13 aatg 14 aatt 15 acaa 16 acac 17 acag 18 acat 19 acca 20 accc 21 accg 22 acct 23 acga 24 acgc 25 acgg 26 acgt 27 acta 28 actc 29 actg 30 actt 31 agaa 32 agac 33 agag 34 agat 35 agca 36 agcc 37 agcg 38 agct 39 agga 40 aggc 41 aggg 42 aggt 43 agta 44 agtc 45 agtg 46 agtt 47 ataa 48 atac 49 atag 50 atat 51 atca 52 atcc 53 atcg 54 atct 55 atga 56 atgc 57 atgg 58 atgt 59 atta 60 attc 61 attg 62 attt 63 caaa 64 caac 65 caag 66 caat 67 caca 68 cacc 69 cacg 70 cact 71 caga 72 cagc 73 cagg 74 cagt 75 cata 76 catc 77 catg 78 catt 79 ccaa 80 ccac 81 ccag 82 ccat 83 ccca 84 cccc 85 cccg 86 ccct 87 ccga 88 ccgc 89 ccgg 90 ccgt 91 ccta 92 cctc 93 cctg 94 cctt 95 cgaa 96 cgac 97 cgag 98 cgat 99 cgca 100 cgcc 101 cgcg 102 cgct 103 cgga 104 cggc 105 cggg 106 cggt 107 cgta 108 cgtc 109 cgtg 110 cgtt 111 ctaa 112 ctac 113 ctag 114 ctat 115 ctca 116 ctcc 117 ctcg 118 ctct 119 ctga 120 ctgc 121 ctgg 122 ctgt 123 ctta 124 cttc 125 cttg 126 cttt 127 gaaa 128 gaac 129 gaag 130 gaat 131 gaca 132 gacc 133 gacg 134 gact 135 gaga 136 gagc 137 gagg 138 gagt 139 gata 140 gatc 141 gatg 142 gatt 143 gcaa 144 gcac 145 gcag 146 gcat 147 gcca 148 gccc 149 gccg 150 gcct 151 gcga 152 gcgc 153 gcgg 154 gcgt 155 gcta 156 gctc 157 gctg 158 gctt 159 ggaa 160 ggac 161 ggag 162 ggat 163 ggca 164 ggcc 165 ggcg 166 ggct 167 ggga 168 gggc 169 gggg 170 gggt 171 ggta 172 ggtc 173 ggtg 174 ggtt 175 gtaa 176 gtac 177 gtag 178 gtat 179 gtca 180 gtcc 181 gtcg 182 gtct 183 gtga 184 gtgc 185 gtgg 186 gtgt 187 gtta 188 gttc 189 gttg 190 gttt 191 taaa 192 taac 193 taag 194 taat 195 taca 196 tacc 197 tacg 198 tact 199 taga 200 tagc 201 tagg 202 tagt 203 tata 204 tatc 205 tatg 206 tatt 207 tcaa 208 tcac 209 tcag 210 tcat 211 tcca 212 tccc 213 tccg 214 tcct 215 tcga 216 tcgc 217 tcgg 218 tcgt 219 tcta 220 tctc 221 tctg 222 tctt 223 tgaa 224 tgac 225 tgag 226 tgat 227 tgca 228 tgcc 229 tgcg 230 tgct 231 tgga 232 tggc 233 tggg 234 tggt 235 tgta 236 tgtc 237 tgtg 238 tgtt 239 ttaa 240 ttac 241 ttag 242 ttat 243 ttca 244 ttcc 245 ttcg 246 ttct 247 ttga 248 ttgc 249 ttgg 250 ttgt 251 ttta 252 tttc 253 tttg 254 tttt 255 aaa 0 aac 1 aag 2 aat 3 aca 4 acc 5 acg 6 act 7 aga 8 agc 9 agg 10 agt 11 ata 12 atc 13 atg 14 att 15 caa 16 cac 17 cag 18 cat 19 cca 20 ccc 21 ccg 22 cct 23 cga 24 cgc 25 cgg 26 cgt 27 cta 28 ctc 29 ctg 30 ctt 31 gaa 32 gac 33 gag 34 gat 35 gca 36 gcc 37 gcg 38 gct 39 gga 40 ggc 41 ggg 42 ggt 43 gta 44 gtc 45 gtg 46 gtt 47 taa 48 tac 49 tag 50 tat 51 tca 52 tcc 53 tcg 54 tct 55 tga 56 tgc 57 tgg 58 tgt 59 tta 60 ttc 61 ttg 62 ttt 63]
    
    set gg_calc(n2rc_4) [dict create 0 255 1 191 2 127 3 63 4 239 5 175 6 111 7 47 8 223 9 159 10 95 11 31 12 207 13 143 14 79 15 15 16 251 17 187 18 123 19 59 20 235 21 171 22 107 23 43 24 219 25 155 26 91 27 27 28 203 29 139 30 75 31 11 32 247 33 183 34 119 35 55 36 231 37 167 38 103 39 39 40 215 41 151 42 87 43 23 44 199 45 135 46 71 47 7 48 243 49 179 50 115 51 51 52 227 53 163 54 99 55 35 56 211 57 147 58 83 59 19 60 195 61 131 62 67 63 3 64 254 65 190 66 126 67 62 68 238 69 174 70 110 71 46 72 222 73 158 74 94 75 30 76 206 77 142 78 78 79 14 80 250 81 186 82 122 83 58 84 234 85 170 86 106 87 42 88 218 89 154 90 90 91 26 92 202 93 138 94 74 95 10 96 246 97 182 98 118 99 54 100 230 101 166 102 102 103 38 104 214 105 150 106 86 107 22 108 198 109 134 110 70 111 6 112 242 113 178 114 114 115 50 116 226 117 162 118 98 119 34 120 210 121 146 122 82 123 18 124 194 125 130 126 66 127 2 128 253 129 189 130 125 131 61 132 237 133 173 134 109 135 45 136 221 137 157 138 93 139 29 140 205 141 141 142 77 143 13 144 249 145 185 146 121 147 57 148 233 149 169 150 105 151 41 152 217 153 153 154 89 155 25 156 201 157 137 158 73 159 9 160 245 161 181 162 117 163 53 164 229 165 165 166 101 167 37 168 213 169 149 170 85 171 21 172 197 173 133 174 69 175 5 176 241 177 177 178 113 179 49 180 225 181 161 182 97 183 33 184 209 185 145 186 81 187 17 188 193 189 129 190 65 191 1 192 252 193 188 194 124 195 60 196 236 197 172 198 108 199 44 200 220 201 156 202 92 203 28 204 204 205 140 206 76 207 12 208 248 209 184 210 120 211 56 212 232 213 168 214 104 215 40 216 216 217 152 218 88 219 24 220 200 221 136 222 72 223 8 224 244 225 180 226 116 227 52 228 228 229 164 230 100 231 36 232 212 233 148 234 84 235 20 236 196 237 132 238 68 239 4 240 240 241 176 242 112 243 48 244 224 245 160 246 96 247 32 248 208 249 144 250 80 251 16 252 192 253 128 254 64 255 0]
    
    set gg_calc(n2rc_3) [dict create 0 63 1 47 2 31 3 15 4 59 5 43 6 27 7 11 8 55 9 39 10 23 11 7 12 51 13 35 14 19 15 3 16 62 17 46 18 30 19 14 20 58 21 42 22 26 23 10 24 54 25 38 26 22 27 6 28 50 29 34 30 18 31 2 32 61 33 45 34 29 35 13 36 57 37 41 38 25 39 9 40 53 41 37 42 21 43 5 44 49 45 33 46 17 47 1 48 60 49 44 50 28 51 12 52 56 53 40 54 24 55 8 56 52 57 36 58 20 59 4 60 48 61 32 62 16 63 0]

  set data_4_double $gg_calc(data_4);#sputs ok
  for {set i 0} {$i <256} {incr i} {
    for {set j 0} {$j <256} {incr j} {
      set a [lindex $gg_calc(data_4) $i $j]
      set b [lindex $gg_calc(data_4) $i [dict get $gg_calc(n2rc_4) $j]]
      lset data_4_double $i $j [expr {$a + $b}]
    }
  }
  set gg_calc(data_4_double) $data_4_double
    
  set data_3_double $gg_calc(data_3);#sputs ok
  for {set i 0} {$i <64} {incr i} {
    for {set j 0} {$j <64} {incr j} {
      set a [lindex $gg_calc(data_3) $i $j]
      set b [lindex $gg_calc(data_3) $i [dict get $gg_calc(n2rc_3) $j]]
      lset data_3_double $i $j [expr {$a + $b}]
    }
  }
  set gg_calc(data_3_double) $data_3_double
  return ""
}

############
##
#############
proc gg_wizard_dialog {w} {
  global info temp_info modifier dialogblock modstring gg_calc
	
  if {$dialogblock == 1} {return}

  set s [new_dialog $w "Golden Gate Designer" "NEW DNA"]
  wm resizable [winfo toplevel $s] 0 0

  bind $s <<Cancel>> "gg_wizard_dialog_cancel $s"
  bind $s <<OK>> "set ok 1"
  array unset temp_info

  grid rowconfigure $s 1 -weight 1
  if {[gg_wizard_fragments_frame $s] eq "error"} {
    gg_wizard_dialog_cancel $s
  } else {
    raise $s
  }
}

############
##
#############
proc gg_wizard_dialog_cancel {s} {
  global dialogblock temp_info gg_calc

  destroy $s
  catch {array unset  temp_info}
  catch {array unset gg_calc}
  set dialogblock 0
  bind . <<RaiseDialogs>> ""
}

############
##
#############
proc gg_wizard_fragments_frame {s} {
  global info temp_info
  if {![winfo exists $s.f]} {
    grid [frame $s.f] -row 1 -column 1 -sticky nswe
    grid [frame $s.f.enz] -row 0 -column 1 -sticky nswe
    grid [message $s.f.enz.ref1  -text [mc "All data from Pryor JM, et al. https://doi.org/10.1371/journal.pone.0238592"] -aspect 800 ] -row 0 -column 1 -columnspan 2 -sticky nsw
   # grid [label $s.f.enz.ref  -text "" ] -row 1 -column 1 -columnspan 2 -sticky nsw
    bind $s.f.enz.ref1 <Any-Button> " open_url https://doi.org/10.1371/journal.pone.0238592"
    tooltip_install $s.f.enz.ref1 "Click Here to Open Reference"
    grid [menubutton $s.f.enz.menub -menu $s.f.enz.menub.m -textvariable temp_info(gg_enz_text)] -row 2 -column 1 -sticky nsw
    menu $s.f.enz.menub.m
    set temp_info(gg_enz) ""
    set enz_list [golden_gate_enzymes]
    if {[llength $enz_list] == 0} {
      set temp_info(gg_enz_text) [mc "No Suitable Enzymes Available"]
    } elseif {[llength $enz_list] == 1} {
      set temp_info(gg_enz_text) [lindex $enz_list 0]
      set temp_info(gg_enz) [lindex $enz_list 0]
    } else {
      set temp_info(gg_enz_text) [mc "Choose an Enzyme..."]
      foreach enz $enz_list {
	  $s.f.enz.menub.m add radiobutton -label "$enz" -command "set temp_info(gg_enz) $enz; gg_wizard_frame_validate $s.f.frags" -variable temp_info(gg_enz_text) -value $enz
      }
    }
    
    grid [frame $s.f.frags] -row 1 -column 1 -sticky nswe
    
    grid rowconfigure $s.f 4 -weight 1
    grid [frame $s.f.okframe] -row 5 -column 1 -sticky swe
    grid [button $s.f.okframe.setdef -text [mc "Set Defaults"] -command "gg_wizard_set_defaults $s" -state normal] -row 1 -column 2 -sticky n
    grid [button $s.f.okframe.next -text [mc "Next"] -command "gg_wizard_summary_frame $s" -default active -state normal] -row 1 -column 4 -sticky n

    if {[gg_wizard_add_fragment_frame $s.f.frags] eq "error"} {return error}
  } else {
    grid configure $s.f 
    foreach f [list $s.summary $s.p] {
      if {[winfo exists $f]} {
        grid remove $f
      }
    }
  }
}

############
##
#############
proc gg_wizard_add_fragment_frame {s {after_frame {}}} {
  global temp_info

  for {set i 0} {[winfo exists $s.f$i]} {incr i} {}

  if {[winfo exists $after_frame]} {
   set after_i [dict get [grid info $after_frame] -row]
   incr after_i
  } else {
   set after_i 0
  }

  foreach frame [grid slaves $s] {
    if {[set current_row [dict get [grid info $frame] -row]] >= $after_i} {
      grid configure $frame -row [expr {$current_row +1}]
    }
  }

  grid [frame $s.f$i] -row $after_i -column 1 -sticky nswe


  grid [frame $s.f$i.f1] -row 1 -column 1 -sticky nswe

  grid [frame $s.f$i.f1.add_buttons]  -row 1 -column 1 -sticky nsw
  grid [button $s.f$i.f1.add_buttons.add -text "+" -command "gg_wizard_add_fragment_frame $s $s.f$i" -width 1 ]  -row 1 -column 1 -sticky n
  grid [button $s.f$i.f1.add_buttons.remove -text "-"  -width 1  -command "if {\[llength \[grid slaves $s\]\] > 1} {gg_wizard_delete_fragment_frame $s $i}"] -row 1 -column 2 -sticky n

  grid [frame $s.f$i.f1.sels] -row 1 -column 2 -sticky nswe 
  menubutton $s.f$i.f1.sels.win_button
    menu $s.f$i.f1.sels.win_button.menu
    foreach window [dnawindows_list 1] {
      if {[ix2bp $window.textarea end] > 30} {
	$s.f$i.f1.sels.win_button.menu add radiobutton -command "$s.f$i.f1.sels.win_button configure -text \{[wm title $window]\}; set temp_info(frame_window,$i) $window; set temp_info(frame_rc,$i) 0; set temp_info(frame_as_oligos,$i) 0; set temp_info(frame_left_bound,$i) 4; set temp_info(frame_left_tm,$i) \$info(gg_wizard_default_tm); set temp_info(frame_right_bound,$i) -4; set temp_info(frame_right_tm,$i) \$info(gg_wizard_default_tm);set temp_info(frame_sel,$i) {}; gg_wizard_sel_menu $window $s $i; gg_wizard_frame_validate $s" -label [wm title $window] -variable temp_info(frame_window,$i) -value $window
      }
    }


  if {[$s.f$i.f1.sels.win_button.menu index end] eq "none" || [$s.f$i.f1.sels.win_button.menu index end] eq ""} {
    #event generate [winfo toplevel $s] <<Cancel>>
    tk_messageBox -message [mc "No windows available for Golden Gate cloning"] -type ok -icon warning
    return "error"
  }

  $s.f$i.f1.sels.win_button configure -menu $s.f$i.f1.sels.win_button.menu -indicatoron 1 -relief raised 
  grid $s.f$i.f1.sels.win_button -row 1 -column 2 -sticky nswe
    grid [label $s.f$i.f1.sels.error_label -textvariable temp_info(frame_error,$i)] -row 2 -column 2 -sticky n
    grid remove $s.f$i.f1.sels.error_label


  grid [frame $s.f$i.f1.sels.rcframe] -row 4 -column 2 -sticky nswe
  grid [menubutton $s.f$i.f1.sels.rcframe.sel_button] -row 1 -column 0 -sticky nw
  bind $s.f$i.f1.sels.rcframe.sel_button <Button-1> "gg_wizard_sel_menu \$temp_info(frame_window,$i) $s $i 1; break"
  $s.f$i.f1.sels.rcframe.sel_button configure -menu [menu $s.f$i.f1.sels.rcframe.sel_button.menu]
  grid [checkbutton $s.f$i.f1.sels.rcframe.rc -variable temp_info(frame_rc,$i) -text [mc "Rev-Com"] -command "gg_wizard_frame_validate $s" ] -row 1 -column 1 -sticky nw 
  grid [checkbutton $s.f$i.f1.sels.rcframe.as_oligos -variable temp_info(frame_as_oligos,$i) -text [mc "dsOligo"]  ] -row 1 -column 2 -sticky nw 
  #grid [menubutton $s.f$i.f1.sels.rcframe.as_oligos -state normal -textvariable temp_info(frame_as_oligos_display,$i)] -row 1 -column 2 -sticky nwe
  #$s.f$i.f1.sels.rcframe.as_oligos configure -menu [menu $s.f$i.f1.sels.rcframe.as_oligos.menu]
  #$s.f$i.f1.sels.rcframe.as_oligos.menu add radiobutton -command "set temp_info(frame_as_oligos_display,$i) {PCR with tails}" -label [mc "PCR with tails"] -variable temp_info(frame_as_oligos,$i) -value 0
  #$s.f$i.f1.sels.rcframe.as_oligos.menu add radiobutton -command "set temp_info(frame_as_oligos_display,$i) {dsOligo}" -label [mc "dsOligo"] -variable temp_info(frame_as_oligos,$i) -value 1
  
  grid [ttk::separator $s.f$i.separator ] -row 2 -column 1 -sticky nwe
  grid columnconfigure $s.f$i 1 -weight 1
  $s.f$i.f1.sels.win_button.menu invoke 0
}

############
##
#############
proc gg_wizard_delete_fragment_frame {s i} {
  global temp_info

  array unset temp_info "frame*,$i"
  set deleted_row [dict get [grid info $s.f$i] -row]
  destroy $s.f$i
  foreach frame [grid slaves $s] {
    if {[set current_row [dict get [grid info $frame] -row]] > $deleted_row} {
      grid configure $frame -row [expr {$current_row -1}]
    }
  }
    gg_wizard_frame_validate $s
}



############
##
#############
proc gg_wizard_sel_menu {w s i {post 0}} {
  global temp_info info
  if {![winfo exists $s.f$i.f1.sels.rcframe.sel_button.menu]} {
    return
  }



  set t [winfo toplevel $s]
  set menu  $s.f$i.f1.sels.rcframe.sel_button.menu
  $menu delete 0 end
  set seq_length [ix2bp $w.textarea end]

  if {$info($w,circular) eq "circular"} {
    if {[$w.textarea tag ranges sel] != {}} {
      # $s.f$i.f1.sels.rcframe.sel_button.menu delete 0 2
      set sel_first [ix2bp $w.textarea [$w.textarea index sel.first]]
      set sel_last [ix2bp $w.textarea [$w.textarea index sel.last]]
      if {[expr {$sel_last - $sel_first}] > 10} {
	  $menu insert 0 radiobutton -command "$s.f$i.f1.sels.rcframe.sel_button configure -text \"Selected [expr {$sel_first+1}]-[expr {$sel_last}]\"; set temp_info(frame_first,$i) $sel_first; set temp_info(frame_last,$i) $sel_last; set temp_info(frame_enzyme,$i) {}; gg_wizard_frame_validate $s" -label [mc "Selected %s - %s" [expr {$sel_first+1}] [expr {$sel_last}]] -variable temp_info(frame_sel,$i) -value 0
      }
      if {[expr {$seq_length - $sel_last + $sel_first}] > 10} {
        $menu insert 1 radiobutton -command "$s.f$i.f1.sels.rcframe.sel_button configure -text \"All but Selected [expr {(($sel_last+1) % $seq_length)}]-[expr {(($sel_first-1) % $seq_length) +1}]\"; set temp_info(frame_first,$i) [expr {(($sel_last+1) % $seq_length) - 1}]; set temp_info(frame_last,$i) [expr {(($sel_first-1) % $seq_length) +1}]; set temp_info(frame_enzyme,$i) {};  gg_wizard_frame_validate $s" -label [mc "All but Selected %s - %s" [expr {(($sel_last+1) % $seq_length)}] [expr {(($sel_first-1) % $seq_length) +1}]]  -variable temp_info(frame_sel,$i) -value 1
      }
      $menu insert 2 radiobutton -command "$s.f$i.f1.sels.rcframe.sel_button configure -text \"All- Open at Origin\"; set temp_info(frame_first,$i) [ix2bp $w.textarea [$w.textarea index 1.0]]; set temp_info(frame_last,$i) [ix2bp $w.textarea end]; set temp_info(frame_enzyme,$i) {};  gg_wizard_frame_validate $s" -label [mc "All- Open at Origin"]  -variable temp_info(frame_sel,$i) -value 2
    } else {
      # $s.f$i.f1.sels.rcframe.sel_button.menu delete 0 1
      set insert_pos [ix2bp $w.textarea [$w.textarea index insert]]
      $menu insert 0 radiobutton -command "$s.f$i.f1.sels.rcframe.sel_button configure -text \"All- Open at Origin\"; set temp_info(frame_first,$i) [ix2bp $w.textarea [$w.textarea index 1.0]]; set temp_info(frame_last,$i) [ix2bp $w.textarea end]; set temp_info(frame_enzyme,$i) {};  gg_wizard_frame_validate $s" -label [mc "All- Open at Origin"]  -variable temp_info(frame_sel,$i) -value 2
      $menu insert 1 radiobutton -command "$s.f$i.f1.sels.rcframe.sel_button configure -text \"All- Open at Insert [expr {$insert_pos + 1}]\"; set temp_info(frame_first,$i) [expr {(($insert_pos+1) % $seq_length) -1}]; set temp_info(frame_last,$i) [expr {(($insert_pos-1) % $seq_length) +1}]; set temp_info(frame_enzyme,$i) {};  gg_wizard_frame_validate $s" -label [mc "All- Open at Insert %s" [expr {$insert_pos + 1}]]  -variable temp_info(frame_sel,$i) -value 3
    }
  } else {
      # $menu delete 0 2
    if {[$w.textarea tag ranges sel] != {}} {
      set sel_first [ix2bp $w.textarea [$w.textarea index sel.first]]
      set sel_last [ix2bp $w.textarea [$w.textarea index sel.last]]
      if {[expr {$sel_last - $sel_first}] > 20} {
        $menu insert 0 radiobutton -command "$s.f$i.f1.sels.rcframe.sel_button configure -text \"Selected [expr {$sel_first+1}]-[expr {$sel_last}]\"; set temp_info(frame_first,$i) $sel_first; set temp_info(frame_last,$i) $sel_last; set temp_info(frame_enzyme,$i) {};  gg_wizard_frame_validate $s" -label [mc "Selected %s - %s" [expr {$sel_first+1}] [expr {$sel_last}]] -variable temp_info(frame_sel,$i) -value 0
      }
      $menu insert 1 radiobutton -command "$s.f$i.f1.sels.rcframe.sel_button configure -text \"All\"; set temp_info(frame_first,$i) [ix2bp $w.textarea [$w.textarea index 1.0]]; set temp_info(frame_last,$i) [ix2bp $w.textarea end]; set temp_info(frame_enzyme,$i) {};  gg_wizard_frame_validate $s" -label [mc "All"] -variable temp_info(frame_sel,$i) -value 4
      if {[expr {$seq_length - $sel_last + $sel_first}] > 20} {
        $menu insert 2 radiobutton -command "$s.f$i.f1.sels.rcframe.sel_button configure -text \"Circularize - All but Selected [expr {(($sel_last+1) % $seq_length)}]-[expr {(($sel_first-1) % $seq_length) +1}]\"; set temp_info(frame_first,$i) [expr {(($sel_last+1) % $seq_length) - 1}]; set temp_info(frame_last,$i) [expr {(($sel_first-1) % $seq_length) +1}]; set temp_info(frame_enzyme,$i) {};  gg_wizard_frame_validate $s" -label [mc "Circularize - All but Selected %s - %s" [expr {(($sel_last+1) % $seq_length)}] [expr {(($sel_first-1) % $seq_length) +1}]] -variable temp_info(frame_sel,$i) -value 5
      }
    } else {
      # $menu delete 0 1
      set insert_pos [ix2bp $w.textarea [$w.textarea index insert]]
      $menu insert 0 radiobutton -command "$s.f$i.f1.sels.rcframe.sel_button configure -text \"All\"; set temp_info(frame_first,$i) [ix2bp $w.textarea [$w.textarea index 1.0]]; set temp_info(frame_last,$i) [ix2bp $w.textarea end]; set temp_info(frame_enzyme,$i) {};  gg_wizard_frame_validate $s" -label [mc "All"] -variable temp_info(frame_sel,$i) -value 0
      $menu insert 1 radiobutton -command "$s.f$i.f1.sels.rcframe.sel_button configure -text \"Circularize - Open at Insert [expr {$insert_pos + 1}]\"; set temp_info(frame_first,$i) [expr {(($insert_pos+1) % $seq_length) -1}]; set temp_info(frame_last,$i) [expr {(($insert_pos-1) % $seq_length) +1}];  set temp_info(frame_enzyme,$i) {}; gg_wizard_frame_validate $s" -label [mc "Circularize - Open at Insert %s" [expr {$insert_pos + 1}]]   -variable temp_info(frame_sel,$i) -value 6
    }
  }
  ## work here GG fragment input ok
  ## add restriction fragments
  set index 0
  foreach fragment [lsearch -all -inline -index 0 [golden_gate_fragments  $temp_info(gg_enz)] $w] {
     if {[lindex $fragment 1 0 0] eq $temp_info(gg_enz) &&  [lindex $fragment 1 1 0] eq $temp_info(gg_enz)} {
       $menu insert end radiobutton -command "$s.f$i.f1.sels.rcframe.sel_button configure -text \"$temp_info(gg_enz) fragment ([lindex $fragment 1 0 1] -[lindex $fragment 1 1 1])\"; set temp_info(frame_first,$i) [expr {[lindex $fragment 1 0 1]}]; set temp_info(frame_last,$i) [expr {[lindex $fragment 1 1 1]}]; set temp_info(frame_enzyme,$i) $temp_info(gg_enz); gg_wizard_frame_validate $s" -label [mc "%s fragment %s - %s" $temp_info(gg_enz)  ([lindex $fragment 1 0 1] [lindex $fragment 1 1 1])]   -variable temp_info(frame_sel,$i) -value [ expr {7+$index}]
     }
  }

  if {![info exists temp_info(frame_sel,$i)] || $temp_info(frame_sel,$i) =={}} {
    $menu invoke 0
  } 
  if {$post} {
    event generate $s.f$i.f1.sels.rcframe.sel_button <<Invoke>>
  }
}

############
##
#############
proc gg_wizard_frame_validate {s} {
  global temp_info info enzinfo
  set top [winfo toplevel $s]
  $top.f.okframe.next configure -state normal
  #sputs s $s $top.f.okframe.next

  if {$temp_info(gg_enz) == ""} {
      $top.f.okframe.next configure -state disabled
      return
  } else {
      set flatpat [string tolower $enzinfo(flatpat,$temp_info(gg_enz))]
      set pat_len [expr {[string length $flatpat]}]
      set temp_info(oh_len) [expr {[lindex $enzinfo(enz_cut_sites,$temp_info(gg_enz)) 1] -[lindex $enzinfo(enz_cut_sites,$temp_info(gg_enz)) 0]}]
      set regpat "$flatpat|[revcom $flatpat]"
      regsub -all {[^ACGTacgt]} $info(gg_wizard_5_extension_seq) "" info(gg_wizard_5_extension_seq)
      regsub -all {[^ACGTacgt]} $info(gg_wizard_site_linker_seq) "" info(gg_wizard_site_linker_seq)
      if {$info(gg_wizard_site_linker_seq) ==""} {set info(gg_wizard_site_linker_seq) "G"}
      set linker_len [expr {min([lindex $enzinfo(enz_cut_sites,$temp_info(gg_enz)) 1], [lindex $enzinfo(enz_cut_sites,$temp_info(gg_enz)) 0])- [string length $flatpat]}]
      set info(gg_wizard_site_linker_seq) [string repeat $info(gg_wizard_site_linker_seq) $linker_len]
      set info(gg_wizard_site_linker_seq) [string range $info(gg_wizard_site_linker_seq) 0 [expr {$linker_len -1}]]
      set temp_info(enz_extension_seq) "$info(gg_wizard_5_extension_seq)$flatpat$info(gg_wizard_site_linker_seq)"
  }

  set temp_info(fragment_number) [llength [grid slaves $s]]
  set last_index 0
  for {set i 0} {$i < $temp_info(fragment_number)} {incr i} {
    if {![regexp {[0-9]+$} [set index_frame [grid slaves $s -row $i -column 1]] index]} {
      sputs can't get index validate $i $temp_info(fragment_number) [grid slaves $s]
      event generate $top <<Cancel>>
      array unset temp_info
      return
    } else {
      set temp_info(window,$i)  $temp_info(frame_window,$index)
      set temp_info(rc,$i) $temp_info(frame_rc,$index)
      set temp_info(first,$i) $temp_info(frame_first,$index)
      set temp_info(last,$i) $temp_info(frame_last,$index)

      set temp_info(left_bound,$i) $temp_info(frame_left_bound,$index)
      set temp_info(left_tm,$i) $temp_info(frame_left_tm,$index)
      set temp_info(right_bound,$i) $temp_info(frame_right_bound,$index)
      set temp_info(right_tm,$i) $temp_info(frame_right_tm,$index)
      set temp_info(enzyme,$i) $temp_info(frame_enzyme,$index)
      set temp_info(frame_error,$index) ""
      grid remove $s.f$index.f1.sels.error_label
    ## work here GG fragment input ok
    ## GG fragment input- if $temp_info(enzyme,$i) ne {}  adjust first and last to the ends of the cut sites
      if {$temp_info(enzyme,$i) ne {} } { 
        ## fragment is a restriction fragment
        if {$temp_info(enzyme,$i) ne $temp_info(gg_enz) } {
          # if the fragment is set to be a restriction fragment, but doesn't match the currently selected enzyme, reset to the first menu option
          set menu  $s.f$index.f1.sels.rcframe.sel_button.menu
          if {[winfo exists $menu]} {
            after 1 "$menu invoke 0"
            return
          }
        }
        grid remove $s.f$index.f1.sels.rcframe.as_oligos
        set temp_info(first,$i) [expr {$temp_info(first,$i) + [lindex $enzinfo(enz_cut_sites,$temp_info(gg_enz)) 0] -1 }]
        set temp_info(last,$i) [expr {$temp_info(last,$i) + $pat_len - [lindex $enzinfo(enz_cut_sites,$temp_info(gg_enz)) 0] - 1}]
        if {$i >0 && $temp_info(enzyme,[expr {$i-1}])  ne {} } {
           ## check for matching overhangs
           set temp_template [gg_wizard_get_dna $temp_info(window,$i) $temp_info(first,$i) $temp_info(last,$i) $temp_info(rc,$i)]
          if {[string toupper [string range $temp_info(template_seq,[expr {$i-1}]) end-[expr {$temp_info(oh_len)-1}] end]] ne  [string toupper [string range $temp_template 0 [expr {$temp_info(oh_len)-1}] ]] } {
            grid configure $s.f$index.f1.sels.error_label
            set temp_info(frame_error,$index) [mc "The prior restriction fragment has incompatible ends (%1\$s - %2\$s)." [string range $temp_info(template_seq,[expr {$i-1}]) end-[expr {$temp_info(oh_len)-1}] end] [string range $temp_template 0 [expr {$temp_info(oh_len)-1}] ])]
            $top.f.okframe.next configure -state disabled
          } else {
            ## remove RE overhang on the left side of the second fragment for adjacent RE fragments
            if {$temp_info(rc,$i)} {
              set temp_info(last,$i) [expr {$temp_info(last,$i) - $temp_info(oh_len)}]
            } else {
              set temp_info(first,$i) [expr {$temp_info(first,$i) + $temp_info(oh_len)}]
            }
          }
        }
      } else {
        grid configure $s.f$index.f1.sels.rcframe.as_oligos
      }
      set temp_info(template_seq,$i) [gg_wizard_get_dna $temp_info(window,$i) $temp_info(first,$i) $temp_info(last,$i) $temp_info(rc,$i)]
      if {[regexp -nocase $regpat $temp_info(template_seq,$i)]} {
        grid configure $s.f$index.f1.sels.error_label
        set temp_info(frame_error,$index) [mc "Site %s is present in this fragment." $temp_info(gg_enz) ]
        $top.f.okframe.next configure -state disabled
      } elseif {[lindex [regexp -nocase -inline -indices $regpat $temp_info(enz_extension_seq)] 0] < [string length $info(gg_wizard_5_extension_seq)]} {
        grid configure $s.f$index.f1.sels.error_label
        set temp_info(frame_error,$index) [mc "The 5' extension creates a(n) %s site." $temp_info(gg_enz) ]
        $top.f.okframe.next configure -state disabled
      } elseif {$i >0} {
        if { [regexp -nocase $regpat "[string range $temp_info(template_seq,[expr {$i-1}]) end-$pat_len end][string range $temp_info(template_seq,[expr {$i}]) 0 $pat_len]"]} {
	    set temp_info(frame_error,$last_index) [mc "Site %s is present in the junction of this fragment." $temp_info(gg_enz)]
	    grid configure $s.f$last_index.f1.sels.error_label
	    set temp_info(frame_error,$index) [mc "Site %s is present in the junction of this fragment." $temp_info(gg_enz)]
	    grid configure $s.f$index.f1.sels.error_label
          $top.f.okframe.next configure -state disabled
        } elseif { [gg_wizard_seq_to_overhangs "[string range $temp_info(template_seq,[expr {$i-1}]) end+$temp_info(right_bound,[expr {$i-1}]) end+$temp_info(left_bound,$i)][string range $temp_info(template_seq,$i) $temp_info(right_bound,[expr {$i-1}]) $temp_info(left_bound,$i)]" $temp_info(oh_len)] == {}} {
          set temp_info(frame_error,$last_index) [mc "No valid overhangs in the junction of this fragment."]
          set temp_info(frame_error,$index) [mc "No valid overhangs in the junction of this fragment."]
          $top.f.okframe.next configure -state disabled	    
	}
      }
      set last_index $index
      if {$i ==0} {set index_zero $index}
    }
  }
  set res ""

  ## work here GG fragment input ok
  ## check last fragment right end to first fragment left end compatibility
  if { $temp_info(enzyme,[expr {$i-1}])  ne {} && $temp_info(enzyme,0)  ne {}  } {
    set temp_template $temp_info(template_seq,0)
    if {[string toupper [string range $temp_info(template_seq,[expr {$i-1}]) end-[expr {$temp_info(oh_len)-1}] end]] ne  [string toupper [string range $temp_template 0 [expr {$temp_info(oh_len)-1}] ]] } {
      grid configure $s.f$index_zero.f1.sels.error_label
      set temp_info(frame_error,$index_zero) [mc "The firast and last fragments have incompatible ends (%1\$s - %2\$s)." [string range $temp_info(template_seq,[expr {$i-1}]) end-[expr {$temp_info(oh_len)-1}] end] [string range $temp_template 0 [expr {$temp_info(oh_len)-1}] ])]
      $top.f.okframe.next configure -state disabled
    } else {
      ## remove RE overhang on the left side of the first fragment  if first and last fragment are RE
      if {$temp_info(rc,0)} {
        set temp_info(last,0) [expr {$temp_info(last,0) - $temp_info(oh_len)}]
      } else {
        set temp_info(first,0) [expr {$temp_info(first,0) + $temp_info(oh_len)}]
      }
    }
  }
  set temp_info(template_seq,0) [gg_wizard_get_dna $temp_info(window,0) $temp_info(first,0) $temp_info(last,0) $temp_info(rc,0)]
  if {[regexp $regpat "[string range $temp_info(template_seq,[expr {$i-1}]) end-$pat_len end][string range $temp_info(template_seq,[expr {0}]) 0 $pat_len]"]} {
    set temp_info(frame_error,$last_index) [mc "Site %s is present in the junction of this fragment." $temp_info(gg_enz)]
    grid configure $s.f$last_index.f1.sels.error_label
    set temp_info(frame_error,$index_zero) [mc "Site %s is present in the junction of this fragment." $temp_info(gg_enz)]
    grid configure $s.f$index_zero.f1.sels.error_label
    $top.f.okframe.next configure -state disabled
  } elseif { [gg_wizard_seq_to_overhangs "[string range $temp_info(template_seq,[expr {$i-1}]) end+$temp_info(right_bound,[expr {$i-1}]) end+$temp_info(left_bound,0)][string range $temp_info(template_seq,0) $temp_info(right_bound,[expr {$i-1}]) $temp_info(left_bound,0)]" $temp_info(oh_len)] == {}} {
    set temp_info(frame_error,$last_index) [mc "No valid overhangs in the junction of this fragment."]
    grid configure $s.f$last_index.f1.sels.error_label
    set temp_info(frame_error,$index_zero) [mc "No valid overhangs in the junction of this fragment."]
    grid configure $s.f$index_zero.f1.sels.error_label
    $top.f.okframe.next configure -state disabled	    
  }

}

############
##
#############
proc gg_wizard_frame_to_data {s} {
  global temp_info info enzinfo

  set temp_info(fragment_number) [llength [grid slaves $s.f.frags]]
  for {set i 0} {$i < $temp_info(fragment_number)} {incr i} {
    if {![regexp {[0-9]+$} [grid slaves $s.f.frags -row $i -column 1] index]} {
      sputs can't get index to_data  $i $temp_info(fragment_number) [grid slaves $s]
      event generate $s <<Cancel>>
      array unset temp_info
      return
    } else {
      set temp_info(window,$i)  $temp_info(frame_window,$index)
      set temp_info(rc,$i) $temp_info(frame_rc,$index)
      set temp_info(as_oligos,$i) $temp_info(frame_as_oligos,$index)
      set temp_info(first,$i) $temp_info(frame_first,$index)
      set temp_info(last,$i) $temp_info(frame_last,$index)
      set temp_info(left_bound,$i) 4
      set temp_info(left_tm,$i) $info(gg_wizard_default_tm)
      set temp_info(right_bound,$i) -4
      set temp_info(right_tm,$i) $info(gg_wizard_default_tm)
      set temp_info(enzyme,$i) $temp_info(frame_enzyme,$index)
      if {$temp_info(enzyme,$i)  ne {} } { 
        ## work here GG fragment input ok
        ## fragment is a restriction fragment
        set temp_info(as_oligos,$i) 0
        set flatpat [string tolower $enzinfo(flatpat,$temp_info(gg_enz))]
        set pat_len [expr {[string length $flatpat]}]
        set temp_info(first,$i) [expr {$temp_info(first,$i) + [lindex $enzinfo(enz_cut_sites,$temp_info(gg_enz)) 0]}]
        set temp_info(last,$i) [expr {$temp_info(last,$i) + $pat_len - [lindex $enzinfo(enz_cut_sites,$temp_info(gg_enz)) 0] - 1}]
        if {$i >0 && $temp_info(enzyme,[expr {$i-1}])  ne {} } {
          ## remove RE overhang on the left side of the second fragment for adjacent RE fragments
          if {$temp_info(rc,$i)} {
            set temp_info(last,$i) [expr {$temp_info(last,$i) - $temp_info(oh_len)}]
          } else {
            set temp_info(first,$i) [expr {$temp_info(first,$i) + $temp_info(oh_len)}]
          }
        }
      }
    }
  }
  if {$temp_info(enzyme,[expr {$i-1}])  ne {} && $temp_info(enzyme,0)  ne {}} {
      ## remove RE overhang on the left side of the second fragment for adjacent RE fragments
      if {$temp_info(rc,0)} {
        set temp_info(last,0) [expr {$temp_info(last,0) - $temp_info(oh_len)}]
      } else {
        set temp_info(first,0) [expr {$temp_info(first,0) + $temp_info(oh_len)}]
      }
    }
}

############
##
#############
proc gg_wizard_seq_to_overhangs {s size {max 1000}} {
  set len [string length $s]
  set s [string tolower $s]
  set i [expr {($len- $size) /2}]
  set res [list]
  set d [list]
  for {set j $i} {$j >=0} {incr j -1} {
    set a [string range $s $j [expr {$j +$size-1}]]
    if {[revcom $a] ne $a && [lsearch $d $a] == -1 && ![regexp  {[^acgt]} $a]} {
      lappend d $a
      lappend res [list $a $j]
    }
    if {[llength $res] == $max} {break}
    set a [string range $s end-[expr {$j +$size-1}]  end-$j]
    if {[revcom $a] ne $a && [lsearch $d $a] == -1 && ![regexp  {[^acgt]} $a]} {
      lappend d $a
      lappend res [list $a [expr {$len-$j - $size}]]
    }
    if {[llength $res] == $max} {break}
  }
  return $res
}

############
##
#############
proc gg_wizard_s_to_number {s} {
  set r 0
  foreach a [split $s ""] {
    set r [expr {4*$r +[string map {a 0 c 1 g 2 t 3} $a] }]
  }
  return $r
}

############
##  USED ONLY IN TESTING
#############
proc gg_wizard_row_efficiency_calc {a c_list} {
  global gg_calc
  set eff 1
  set sum 0
  foreach b $c_list {
    incr sum [lindex $gg_calc(data) $a $b]
  }
  set eff [expr { $eff * (1.0*  [lindex $gg_calc(data) $a $a] / $sum)}]
  return $eff
}

############
##
#############
proc gg_wizard_summary_frame {s} {
  global info temp_info gg_calc


  if {![winfo exists $s.summary]} {
    grid [frame $s.summary] -row 1 -column 1 -sticky nswe
    grid [frame $s.summary.f1] -row 0 -column 1 -sticky nswe
    grid [frame $s.summary.f1.text_frame] -row 1 -column 1 -sticky nswe
    grid [text $s.summary.f1.text_frame.result_text -font labelfont -wrap none -xscrollcommand "optionscrollbar $s.summary.f1.text_frame.horiz_sc" -yscrollcommand "optionscrollbar $s.summary.f1.text_frame.vert_sc"] -row 1 -column 1 -sticky nswe
    grid [scrollbar $s.summary.f1.text_frame.vert_sc -orient vertical -command "$s.summary.f1.text_frame.result_text yview"] -row 1 -column 2 -sticky nsw
    grid [scrollbar $s.summary.f1.text_frame.horiz_sc -orient horizontal -command "$s.summary.f1.text_frame.result_text xview"] -row 2 -column 1 -sticky nwe
      
    grid rowconfigure $s.summary.f1 4 -weight 1
    grid [frame $s.summary.okframe] -row 5 -column 1 -sticky swe
    grid [button $s.summary.okframe.setdef -text [mc "Set Defaults"] -command "gg_wizard_set_defaults $s" -state normal] -row 1 -column 2 -sticky n
    grid [button $s.summary.okframe.back -text [mc "Back"] -command "gg_wizard_fragments_frame $s"] -row 1 -column 3 -sticky n
    grid [button $s.summary.okframe.calcN -text [mc "Calculate New"] -command "gg_wizard_calculate_init $s; gg_wizard_calculate $s"] -row 1 -column 4 -sticky n
    grid [button $s.summary.okframe.calc -text [mc "Recalculate" ] -state normal -command "gg_wizard_calculate $s"] -row 1 -column 5 -sticky n
   # grid [button $s.summary.okframe.next -text [mc "Next"] -command "gg_wizard_primer_frame $s 0"] -row 1 -column 6 -sticky n
    grid [button $s.summary.okframe.exit -text [mc "Close Dialog"] -command "event generate $s <<Cancel>>"] -row 1 -column 7 -sticky n
    grid [button $s.summary.okframe.finish -text [mc "Generate Product"] -command "gg_wizard_generate_product $s" -default active] -row 1 -column 8 -sticky n

  } else {
    grid configure $s.summary
    foreach f [list $s.f $s.p] {
      if {[winfo exists $f]} {
        grid remove $f
      }
    }
  }
  ## force recalculation whenever re-entering the summary frame- maybe this is how the calculate new should be done
  gg_wizard_frame_to_data $s
  gg_wizard_calculate_init $s
  gg_wizard_calculate $s
}

############
## NOT USED
#############
proc gg_wizard_primer_frame {s i} {
  if {![winfo exists $s.p]} {
    grid [frame $s.p] -row 1 -column 1 -sticky nswe
    grid [frame $s.p.f1] -row 0 -column 1 -sticky nswe

    grid rowconfigure $s.p.f1 0 -weight 1
    grid [frame $s.p.okframe] -row 5 -column 1 -sticky swe
    grid [button $s.p.okframe.setdef -text [mc "Set Defaults"] -command "gg_wizard_set_defaults $s" -state normal] -row 1 -column 2 -sticky n
    grid [button $s.p.okframe.back -text [mc "Back"] -command "gg_wizard_summary_frame $s"] -row 1 -column 3 -sticky n
    grid [button $s.p.okframe.prev -text [mc "<<<"] -command "gg_wizard_primer_frame $s $i"] -row 1 -column 4 -sticky n
    grid [label $s.p.okframe.nofx -text "$i of xxx"] -row 1 -column 5 -sticky n
    grid [button $s.p.okframe.next -text [mc ">>>"] -command "gg_wizard_primer_frame $s $i"] -row 1 -column 6 -sticky n
    grid [button $s.p.okframe.finish -text [mc "Finish"] -command "gg_wizard_generate_product $s" -default active] -row 1 -column 7 -sticky n

  } else {
    grid configure  $s.p
    foreach f [list $s.f $s.summary] {
      if {[winfo exists $f]} {
        grid remove $f
      }
    }
  }
}


############
##
#############
proc gg_wizard_calculate {s} {
  global temp_info info gg_calc enzinfo

  if {![info exists gg_calc(junction_index)]} {
    gg_wizard_calculate_init $s
  }
  set target [expr {[set start_ms [clock milliseconds]] + int(1000*$info(gg_wizard_default_search_time)) }]
  set new_eff 0

  set count 0
  while {[clock milliseconds] < $target && $new_eff< 1.0} {
    set oh_to_change [expr {int(rand() * $temp_info(fragment_number)) }]
    set oh_rc_to_change [expr {$oh_to_change + $temp_info(fragment_number) }]
    set old_index [lindex $gg_calc(junction_index) $oh_to_change]
    set old_oh [lindex $gg_calc(oh_list) $oh_to_change]
    set map_len [llength [set j_map [lindex $gg_calc(junction_map_as_oh) $oh_to_change]]]
    set new_index [expr {(int( rand() * ($map_len - 1)) + 1 + $old_index) % $map_len }]

    set new_oh [lindex $j_map $new_index]
    set new_num_list [list]
    set new_den_list [list]
    set new_oh_list [list] 
    set new_oh_list_half [lreplace $gg_calc(oh_list_half) $oh_to_change $oh_to_change $new_oh]
    set i 0
    set new_eff 1.0
    foreach num $gg_calc(numerators_list) den $gg_calc(denoms_list) a $gg_calc(oh_list) {
      if {$i == $oh_to_change || $i == $oh_rc_to_change } {
        if {$i == $oh_to_change} {
          lappend new_oh_list $new_oh
          set num [lindex $gg_calc(data) $new_oh $new_oh]
          set den 0
          foreach oh $new_oh_list_half {
            incr den [lindex $gg_calc(data_double) $new_oh $oh]
          }
        } else {
          lappend new_oh_list [set b [dict get $gg_calc(n2rc) $new_oh]]
          set num [lindex $gg_calc(data) $b $b]
          set den 0
          foreach oh $new_oh_list_half {
            incr den [lindex $gg_calc(data_double) $b $oh]
          }
        }
        #sputs num $num

        set new_eff [expr {$new_eff * $num / $den}]
        lappend new_num_list $num
        lappend new_den_list $den

      } else {
        set den1 $den
        set den [expr {$den - [lindex $gg_calc(data_double) $a $old_oh] + [lindex $gg_calc(data_double) $a $new_oh]}]
        set new_eff [expr {$new_eff * $num / $den}]
        lappend new_num_list $num
        lappend new_den_list $den
        lappend new_oh_list $a
	if {$num > $den} {sputs err num:$a $old_oh $new_oh $num $den1 $den}
      }
      incr i
    }
    if {$new_eff >= $gg_calc(current_eff)} {
      set gg_calc(current_eff) $new_eff
      lset gg_calc(junction_index) $oh_to_change $new_index
      set gg_calc(oh_list) $new_oh_list
      set gg_calc(oh_list_half) $new_oh_list_half
      set gg_calc(numerators_list) $new_num_list
      set gg_calc(denoms_list) $new_den_list
      #sputs new $new_eff $oh_to_change $new_index $new_oh_list $new_oh_list_half $new_num_list $new_den_list
    }
    incr count
  }
  
  #sputs eff list:$gg_calc(current_eff) $gg_calc(oh_list_half) $count [expr {[clock milliseconds] - $start_ms}]
  ## generate report
  set text $s.summary.f1.text_frame.result_text
  #$text configure -state normal
  $text delete 1.0 end
  $text insert end "Total efficiency: [expr {round($gg_calc(current_eff)*1000)/10.0}]%\n\n"
  set p_count 0
  for {set i 0} {$i < $temp_info(fragment_number)} {incr i} {
	set last_i [expr {($i -1) % $temp_info(fragment_number)}]
	set index_l [lindex $gg_calc(junction_index) $last_i]
	set oh_seq_l [lindex $gg_calc(junction_map) $last_i $index_l 0]
	set rc_oh_seq_l [revcom $oh_seq_l]
	set temp_info(incr_left,$i) [lindex $gg_calc(junction_map) $last_i $index_l 1]
	set num_l [lindex $gg_calc(numerators_list) $last_i]
	set den_l [lindex $gg_calc(denoms_list) $last_i]

	set index_r [lindex $gg_calc(junction_index) $i]
	set oh_seq_r [lindex $gg_calc(junction_map) $i $index_r 0]
	set rc_oh_seq_r [revcom $oh_seq_r]
	set temp_info(incr_right,$i)  [lindex $gg_calc(junction_map) $i $index_r 1]
	set num_r [lindex $gg_calc(numerators_list) [expr {$i+ $temp_info(fragment_number)}]]
	set den_r [lindex $gg_calc(denoms_list) [expr {$i+ $temp_info(fragment_number)}]]

	set next_i [expr {($i +1) % $temp_info(fragment_number)}]
  
	$text insert end "[file rootname [wm title $temp_info(window,$i)]]\n"
	$text insert end "Left overhang: $oh_seq_l, [expr {round(1000.0*$num_l/$den_l)/10.0}]% efficiency.\n"
	#[gg_wizard_row_efficiency_calc [dict get $gg_calc(b2n) $oh_seq_l] $gg_calc(oh_list)]
	#$text insert end "[string range $temp_info(template_seq,$last_i) end+$temp_info(right_bound,$last_i) end] $temp_info(incr_left,$i) [string range $temp_info(template_seq,$i) 0 20]\n"
	$text insert end "Right overhang: $rc_oh_seq_r, [expr {round(1000.0*$num_r/$den_r)/10.0}]% efficiency.\n"
	#[gg_wizard_row_efficiency_calc [dict get $gg_calc(b2n) $rc_oh_seq_r] $gg_calc(oh_list)]
	#$text insert end "[string range $temp_info(template_seq,$i) end+ $temp_info(right_bound,$i) end] $temp_info(incr_right,$i) [string range $temp_info(template_seq,$next_i) 0 20]\n"
  
	if {$temp_info(as_oligos,$i)} {
	   ## work here GG fragment input - bug- RE fragment to oligo off by 1 nt on fwd primer
	  set temp_info(fwd_primer_len,$i) 0
	  set temp_info(fwd_primer_base,$i) ""
	  ## work here GG fragment input bug- fwd_primer seq is off by 1 for GG fragment before the oligo
	  set temp_info(fwd_primer,$i) "[string range $temp_info(template_seq,$last_i) end+[expr {$temp_info(right_bound,$last_i)+$temp_info(incr_left,$i)}] end][string range $temp_info(template_seq,$i) [expr {$temp_info(right_bound,$last_i)+$temp_info(incr_left,$i)-1}] end+[expr {$temp_info(right_bound,$i)+$temp_info(incr_right,$i)-1}]][string range $temp_info(template_seq,$next_i) 0 [expr {$temp_info(right_bound,$i)+$temp_info(incr_right,$i)-2}]]"
  $text insert end "fwd oligo: $temp_info(fwd_primer,$i)\n"
	  set temp_info(rev_primer_len,$i) 0
	  set temp_info(rev_primer_base,$i) ""
	  set temp_info(rev_primer,$i) [revcom "[string range $temp_info(template_seq,$last_i) end+[expr {$temp_info(right_bound,$last_i)+$temp_info(incr_left,$i)+$temp_info(oh_len)}] end][string range $temp_info(template_seq,$i) [expr {$temp_info(right_bound,$last_i)+$temp_info(incr_left,$i)+$temp_info(oh_len)-1}] end+[expr {$temp_info(right_bound,$i)+$temp_info(incr_right,$i)+$temp_info(oh_len)-1}]][string range $temp_info(template_seq,$next_i) 0 [expr {$temp_info(right_bound,$i)+$temp_info(incr_right,$i)+$temp_info(oh_len)-2}]]"]
	  $text insert end "rev oligo: $temp_info(rev_primer,$i)\n\n\n"
	  set temp_info(fwd_primer_name,$i) "Fwd_oligo_[expr {1 + $i}]"
	  set temp_info(rev_primer_name,$i) "Rev_oligo_[expr {1 + $i}]"
	} elseif {$temp_info(enzyme,$i) ne ""} {
	   ## work here GG fragment input ok
	   ## Do the output information
	  $text insert end "Restriction fragment.\n\n"
	} else {
	  set pl [expr {max($temp_info(right_bound,$last_i) +$temp_info(incr_left,$i), 1)}]
	  while {[Tm [string range $temp_info(template_seq,$i) [expr {$temp_info(right_bound,$last_i)+$temp_info(incr_left,$i)-1}] $pl]] < $temp_info(left_tm,$i) && $pl < [string length $temp_info(template_seq,$i)]} {incr pl} 
	  set temp_info(fwd_primer_len,$i) $pl
	  set temp_info(fwd_primer_base,$i) [string range $temp_info(template_seq,$i) [expr {$temp_info(right_bound,$last_i)+$temp_info(incr_left,$i)-1}] $pl]
	  set temp_info(fwd_primer,$i) "$temp_info(enz_extension_seq)[string range $temp_info(template_seq,$last_i) end+[expr {$temp_info(right_bound,$last_i)+$temp_info(incr_left,$i)}] end][string range $temp_info(template_seq,$i) [expr {$temp_info(right_bound,$last_i)+$temp_info(incr_left,$i)-1}] $pl]"
	  # check for a second RE site in the primer (created by the linker sequence)
	  set flatpat [string tolower $enzinfo(flatpat,$temp_info(gg_enz))]
	  set regpat "$flatpat|[revcom $flatpat]"
	  if {[regexp -start [expr { 1 + [string length $info(gg_wizard_5_extension_seq)]} ] $regpat $temp_info(fwd_primer,$i)] } {
		$text insert end "** Warning: The forward primer has multiple Golden Gate restriction sites, generated by the linker sequence.\n"
	  }
	  set left_base_tm [Tm $temp_info(fwd_primer_base,$i)]
	  set left_total_tm [Tm $temp_info(fwd_primer,$i)]
	  $text insert end "fwd primer (Tm1=$left_base_tm\u2103, Tm2= $left_total_tm\u2103): $temp_info(enz_extension_seq)[string range $temp_info(template_seq,$last_i) end+[expr {$temp_info(right_bound,$last_i)+$temp_info(incr_left,$i)}] end] [string range $temp_info(template_seq,$i) [expr {$temp_info(right_bound,$last_i)+$temp_info(incr_left,$i)-1}] $pl]\n"

	  set pr [expr {max($temp_info(right_bound,$i)+$temp_info(incr_right,$i)+$temp_info(oh_len), 1)}]

	  while {[Tm [string range $temp_info(template_seq,$i) end+[expr {-$pr}] end+[expr {$temp_info(right_bound,$i) +$temp_info(incr_right,$i)+$temp_info(oh_len)-1}]]] < $temp_info(right_tm,$i) && $pr < [string length $temp_info(template_seq,$i)]} {incr pr} 
	   #sputs tm [set yy [string range $temp_info(template_seq,$i) end+[expr {-$pr}] end+[expr {$temp_info(right_bound,$i) +$temp_info(incr_right,$i)+$temp_info(oh_len)-1}]]] [Tm $yy]
	  set temp_info(rev_primer_len,$i) $pr
	  set temp_info(rev_primer_base,$i) [revcom [string range $temp_info(template_seq,$i) end+[expr {-$pr}] end+[expr {$temp_info(right_bound,$i)+$temp_info(incr_right,$i)+$temp_info(oh_len)-1}]]]
	  set temp_info(rev_primer,$i) "$temp_info(enz_extension_seq)[revcom "[string range $temp_info(template_seq,$i) end+[expr {-$pr}] end+[expr {$temp_info(right_bound,$i)+$temp_info(incr_right,$i)+$temp_info(oh_len)-1}]][string range $temp_info(template_seq,$next_i) 0 [expr {$temp_info(right_bound,$i)+$temp_info(incr_right,$i)+$temp_info(oh_len)-2}]]"]"
	  if {[regexp -start [expr { 1 + [string length $info(gg_wizard_5_extension_seq)]} ] $regpat $temp_info(rev_primer,$i)] } {
		$text insert end "** Warning: The reverse primer has multiple Golden Gate restriction sites, generated by the linker sequence.\n"
	  }
	  set right_base_tm [Tm $temp_info(rev_primer_base,$i)]
	  set right_total_tm [Tm $temp_info(rev_primer,$i)]
	  $text insert end "rev primer  (Tm1=$right_base_tm\u2103, Tm2= $right_total_tm\u2103: $temp_info(enz_extension_seq)[revcom "[string range $temp_info(template_seq,$i) end+[expr {-$pr}] end+[expr {$temp_info(right_bound,$i)+$temp_info(incr_right,$i)+$temp_info(oh_len)-1}]] [string range $temp_info(template_seq,$next_i) 0 [expr {$temp_info(right_bound,$i)+$temp_info(incr_right,$i)+$temp_info(oh_len)-2}]]"]\n\n\n"
	  #primer_generate_name {w number direction five_prime target}
	  set temp_info(fwd_primer_name,$i) [primer_generate_name $temp_info(window,$i) [expr {$info(primer_next_number) +$p_count*2}] 0  0 [file rootname [wm title $temp_info(window,$i)]]]
	  set temp_info(rev_primer_name,$i) [primer_generate_name $temp_info(window,$i) [expr {$info(primer_next_number) +$p_count*2+1}] 1  0 [file rootname [wm title $temp_info(window,$i)]]]
	  incr p_count
	}
  }
}

############
##
#############
proc gg_wizard_calculate_init {s} {
  global temp_info info gg_calc 

  set max_slide 1
  if {![info exists gg_calc] || [llength $gg_calc(data_4)] == 0} {
    initialize_gg_data_tables
  }
  if {$temp_info(oh_len) == 4} {
    set gg_calc(data) $gg_calc(data_4)
    set gg_calc(data_double) $gg_calc(data_4_double)
    set  gg_calc(n2rc) $gg_calc(n2rc_4) 
  } else {
    set gg_calc(data) $gg_calc(data_3)
    set gg_calc(data_double) $gg_calc(data_3_double)
    set gg_calc(n2rc) $gg_calc(n2rc_3) 
  }
  set gg_calc(junction_map) [list]
  set gg_calc(junction_map_as_oh) [list]
  set gg_calc(junction_index) [list]
  set gg_calc(oh_list) [list]
  set gg_calc(oh_list_half) [list]
  set gg_calc(numerators_list) [list]
  set gg_calc(denoms_list) [list]

  for {set i 0} {$i < $temp_info(fragment_number)} {incr i} {
    set next_i [expr {($i +1) % $temp_info(fragment_number)}]
    if {$temp_info(enzyme,$i) eq {} } {
      if {$temp_info(enzyme,$next_i) eq {} } {
        set new_list [gg_wizard_seq_to_overhangs "[string range $temp_info(template_seq,$i) end+$temp_info(right_bound,$i) end+$temp_info(left_bound,$next_i)][string range $temp_info(template_seq,$next_i) $temp_info(right_bound,$i) $temp_info(left_bound,$next_i)]" $temp_info(oh_len) $max_slide]
      } else {
        set new_list [list [list [string tolower [string range $temp_info(template_seq,$next_i) 0  [expr {$temp_info(oh_len)-1}]]] 5]]
      }
    } else {
## work here GG fragment input ok
      ## GG fragment input- if $temp_info(enzyme,$i) ne {} set new_list to just the single fragment that is index 1 ==expr {4-oh_len} (aka 0 for 4bp oh, 1 for 3 bp oh),  if $temp_info(enzyme,$next_i) ne {} set new_list to just the single fragment that is index 1 ==4, if both are locked, check that the results are the same, then move the right junction oh_len to the right and keep the single element new_list
      set new_list [list [list [string tolower [string range $temp_info(template_seq,$i) end-[expr {$temp_info(oh_len)-1}] end]] [expr {5 - $temp_info(oh_len)}]]]
    }
    lappend gg_calc(junction_map) $new_list
    lappend gg_calc(junction_map_as_oh) [lmap a $new_list {dict get $gg_calc(b2n) [lindex $a 0]}]
    lappend gg_calc(junction_index) 0
    lappend gg_calc(oh_list)  [set a [lindex $gg_calc(junction_map_as_oh) end 0]]
    lappend gg_calc(oh_list_half) $a
    lappend gg_calc(numerators_list) [lindex $gg_calc(data) $a $a]
  }
  foreach oh $gg_calc(oh_list) {
    lappend gg_calc(oh_list) [set a [dict get $gg_calc(n2rc) $oh]]
    lappend gg_calc(numerators_list) [lindex $gg_calc(data) $a $a]
  }
  set gg_calc(current_eff) 1.0
  foreach a $gg_calc(oh_list) num $gg_calc(numerators_list) {
    set den 0
    foreach oh $gg_calc(oh_list_half) {
      incr den [lindex $gg_calc(data_double) $a $oh]
    }
    lappend gg_calc(denoms_list) $den
    set gg_calc(current_eff) [expr {$gg_calc(current_eff)*$num/$den}]
  }
  #sputs map $gg_calc(current_eff) $gg_calc(junction_map) $gg_calc(junction_map_as_oh) $gg_calc(oh_list) $gg_calc(numerators_list) $gg_calc(denoms_list)
}

############
##
#############
proc gg_wizard_set_defaults {s} {
  global info temp_info


  if {![winfo exists $s.d]} {
    frame $s.d
    
    grid [frame $s.d.f1] -row 2 -column 1 -sticky nswe
    grid [label $s.d.f1.l0 -text [mc "Default primer Tm"]] -row 1 -column 1 -sticky w
    set temp_info(gg_wizard_default_tm_scaled) [expr {($info(gg_wizard_default_tm)-50)/22.0}]
    grid [ttk::scale $s.d.f1.tmsc -orient horizontal -length 200 -command "set info(gg_wizard_default_tm) \[expr {round(\$temp_info(gg_wizard_default_tm_scaled)*22.0+50)}\];#"  -variable temp_info(gg_wizard_default_tm_scaled) -from 0 -to 1] -row 1 -column 2 -sticky ew
    grid [label $s.d.f1.l1 -textvariable info(gg_wizard_default_tm)] -row 1 -column 3 -sticky e

    grid [frame $s.d.f2] -row 3 -column 1 -sticky nswe
    grid [label $s.d.f2.l0 -text [mc "Default search time"]] -row 1 -column 1 -sticky w
    grid [ttk::scale $s.d.f2.tmsc -orient horizontal -length 200 -command "set info(gg_wizard_default_search_time) \[expr {round(\$info(gg_wizard_default_search_time)*10)/10.0}\];#"  -variable info(gg_wizard_default_search_time) -from 0.5 -to 10] -row 1 -column 2 -sticky ew
    grid [label $s.d.f2.l2 -textvariable info(gg_wizard_default_search_time)] -row 1 -column 3 -sticky e
    

    grid [frame $s.d.f3] -row 4 -column 1 -sticky nswe
    grid [label $s.d.f3.l0 -text [mc "Default 5' extension"]] -row 1 -column 1 -sticky w
    grid [entry $s.d.f3.ext -state normal -textvariable info(gg_wizard_5_extension_seq) -width 5] -row 1 -column 2 -sticky w

    grid [frame $s.d.f4] -row 5 -column 1 -sticky nswe
    grid [label $s.d.f4.l0 -text [mc "Default site linker sequence"]] -row 1 -column 1 -sticky w
    grid [entry $s.d.f4.ext -state normal -textvariable info(gg_wizard_site_linker_seq) -width 5] -row 1 -column 2 -sticky w

    grid [frame $s.d.nameframe] -row 6 -column 1 -sticky nswe 
      grid [label $s.d.nameframe.pnamel -text [mc "Next Primer Name:"]] -row 0 -column 1 -sticky e
      tooltip_install $s.d.nameframe.pnamel "Set the name that will be applied to primers using the command in the menu button to the right. Also use the menu button to set variable text in the name."
      grid [ttk::entry $s.d.nameframe.entry -textvariable info(primer_name_string) -width 15] -row 0 -column 2  -columnspan 2 -sticky w
      tooltip_install $s.d.nameframe.entry "Set the name that will be applied to primers using the command in the menu button to the right. Also use the menu button to set variable text in the name."
      grid [ttk::menubutton $s.d.nameframe.sub -text [mc "Insert Substitution Codes"] -menu $s.d.nameframe.sub.menu ] -row 0 -column 4 -columnspan 1 -sticky w
      tooltip_install $s.d.nameframe.sub [mc "Insert Substitution Codes into Name Field."]
        menu $s.d.nameframe.sub.menu 
        foreach {mlabel subs} [list [mc "Next Number"] %# [mc "Next Number (3 digit)"] %3 [mc "Next Number(4 digit)"] %4 [mc "Next Number(5 digit)"] %5 [mc "Next Number(6 digit)"] %6  [mc "Target Name"] %T  [mc "Template Name"] %t [mc "Direction Fwd/Rev"] %W [mc "Direction fwd/rev"] %w [mc "Direction F/R"] %F [mc "Direction f/r"] %f [mc "5' Location"] %L [mc "Year"] %y [mc "Month"] %m [mc "Day"] %d [mc "Just a %% character"] %% ] {
          $s.d.nameframe.sub.menu  add command -label [mc "$mlabel (%1\$s)" $subs] -command "$s.d.nameframe.entry insert insert \"$subs\""
        }
      grid [label $s.d.nameframe.pnuml -text [mc "Next Primer Number:"]] -row 1 -column 1 -columnspan 2 -sticky w
      tooltip_install $s.d.nameframe.pnuml [mc "If your primer name contains a %%# substitution variable, this will be the primer number of the next name applied."]
      grid [ttk::spinbox $s.d.nameframe.pnumber -textvariable info(primer_next_number) -from 0 -to 20 -validate all -validatecommand "string_is_in_range %P 0 1000000000" -width 4 -command ""] -row 1 -column 3 -columnspan 1 -sticky w
      tooltip_install $s.d.nameframe.pnumber [mc "If your primer name contains a %%# substitution variable, this will be the primer number of the next name applied."]
     
    grid [frame $s.d.f5] -row 7 -column 1 -sticky nswe
    grid [checkbutton $s.d.f5.c1 -text [mc "Add amplicon features to product"] -variable info(gibson_wizard_add_amplicon_features)] -row 1 -column 1 -sticky w
    
    grid rowconfigure $s.d 7 -weight 1
    grid [frame $s.d.okframe] -row 10 -column 1 -sticky swe
    grid [button $s.d.okframe.ok -text [mc "Set Defaults"] -command "event generate $s <<SetDefaults>>"] -row 1 -column 1 -sticky n
  }
  grid $s.d -row 1 -column 1 -rowspan 2 -sticky nswe

    bind $s <<SetDefaults>> "gg_wizard_frame_validate $s.f.frags; grid remove $s.d"
}

############
##
#############
proc gg_wizard_generate_product {s} {
  global info temp_info

  set dna ""
  set tags [list]
  set fragments $temp_info(fragment_number)
  set filecomment "Golden Gate reaction: $temp_info(gg_enz)\n"
  set primer_order [list]


  if {[dict exists $info(feature_default_type_colors) primer_bind]} {
    set revcolors [dict get $info(feature_default_type_colors) primer_bind]
  } else {
    set revcolors [list $info(feature_default_fcolor) $info(feature_default_rcolor)]
  }

  if {[dict exists $info(feature_default_type_gformat) primer_bind]} {
    set gformat [dict get $info(feature_default_type_gformat) primer_bind]
  } else {
    set gformat $info(feature_default_gformat)
  }

  if {[dict exists $info(feature_default_type_colors) misc_feature]} {
    set revcolors_misc [dict get $info(feature_default_type_colors) misc_feature]
  } else {
    set revcolors_misc [list $info(feature_default_fcolor) $info(feature_default_rcolor)]
  }
  if {[dict exists $info(feature_default_type_gformat) misc_feature]} {
    set gformat_misc [dict get $info(feature_default_type_gformat) misc_feature]
  } else {
    set gformat_misc $info(feature_default_gformat)
  }

  set new_tags [list]
  set p_count 0
  for {set i 0} {$i < $fragments} {incr i} {
    set next_i [expr {($i + 1) % $fragments}]
    set last_i [expr {($i - 1) % $fragments}]
    set w1 $temp_info(window,$i)

    if {![info exists temp_info(template_seq,$i)] || $temp_info(template_seq,$i)  == ""} {
      set temp_info(template_seq,$i) [gg_wizard_get_dna $temp_info(window,$i) $temp_info(first,$i) $temp_info(last,$i) $temp_info(rc,$i)]
    }

    set end [string length $dna]

    append dna $temp_info(template_seq,$i)
    #set new_tags [get_tags2 $w1.textarea $temp_info(first,$i) [expr {$temp_info(last,$i)}] $temp_info(rc,$i) $end]
    lappend_tags new_tags {*}[get_tags2 $w1.textarea $temp_info(first,$i) [expr {$temp_info(last,$i)}] $temp_info(rc,$i) $end]
    #sputs tags $w1.textarea  $temp_info(first,$i) [expr {$temp_info(last,$i)}] [get_tags2 $w1.textarea $temp_info(first,$i) [expr {$temp_info(last,$i)}] $temp_info(rc,$i) $end]
    #sputs \n
    if {!$temp_info(as_oligos,$i) && $temp_info(enzyme,$i) eq {}} {
      incr p_count
      ## fwd primer
      set coords [list [expr {$end  + $temp_info(right_bound,$last_i) + $temp_info(incr_left,$i)-1}] [expr {$end + $temp_info(fwd_primer_len,$i)+1}] ]

      set bg_color [lindex $revcolors 0]
      set metadata [list $temp_info(fwd_primer_name,$i) $gformat primer_bind 0 [list PCR_conditions "primer sequence:$temp_info(fwd_primer,$i)"] [list]]
      lappend_tags new_tags f0# [list $coords [list $bg_color {} {} {}] [list <<Revcolors>> <<Metadata>>] [list $revcolors $metadata]]
      set left_coord [lindex $coords 0]
      
      ## rev primer
      set coords [list [expr {[string length $dna]-$temp_info(rev_primer_len,$i) -1}] [expr {[string length $dna]+$temp_info(right_bound,$i)+$temp_info(incr_right,$i)+$temp_info(oh_len)-1}] ]
      set bg_color [lindex $revcolors 1]
      set metadata [list $temp_info(rev_primer_name,$i) $gformat primer_bind 1 [list PCR_conditions "primer sequence:$temp_info(rev_primer,$i)"] [list]]
      lappend_tags new_tags f0# [list $coords [list $bg_color {} {} {}] [list <<Revcolors>> <<Metadata>>] [list $revcolors $metadata]]
      
      ## File comment for PCR
      set length_string "[expr {[lindex $coords 1]- $left_coord +2 *[string length $temp_info(enz_extension_seq)]}]"
      set tm_string1 "[Tm $temp_info(fwd_primer_base,$i)], [Tm $temp_info(fwd_primer,$i)]"
      set tm_string2 "[Tm $temp_info(rev_primer_base,$i)], [Tm $temp_info(rev_primer,$i)]"

      set amplicon_note "PCR:\nTemplate: [file rootname [wm title $w1]] \n$temp_info(fwd_primer_name,$i) $temp_info(fwd_primer,$i) $tm_string1\n$temp_info(rev_primer_name,$i) $temp_info(rev_primer,$i) $tm_string2\nProduct length: $length_string"

    } elseif {$temp_info(enzyme,$i) eq {}} {
      ## File comment for oligo DNA
      set amplicon_note "dsOligos: [file rootname [wm title $w1]]\n$temp_info(fwd_primer_name,$i) $temp_info(fwd_primer,$i)\n$temp_info(rev_primer_name,$i) $temp_info(rev_primer,$i)"
    } else {
      set amplicon_note "Restriction fragment: [file rootname [wm title $w1]] $temp_info(enzyme,$i) "
    }

    if {$temp_info(enzyme,$i) eq {}} {
      lappend primer_order "$temp_info(fwd_primer_name,$i)\t$temp_info(fwd_primer,$i)" "$temp_info(rev_primer_name,$i)\t$temp_info(rev_primer,$i)"
    }
    append filecomment $amplicon_note \n

    set amplicon_note_list [list]
    foreach line [split $amplicon_note \n] {
      lappend amplicon_note_list "note" $line
    }

    if {$info(gibson_wizard_add_amplicon_features)} {
      ## add in amplicon misc_feature here
      set coords [list [expr {$end +$temp_info(right_bound,$last_i)+$temp_info(incr_left,$i)}] [expr {[string length $dna] + $temp_info(right_bound,$i)+$temp_info(incr_right,$i)+$temp_info(oh_len)-1}]]
      set bg_color [lindex $revcolors_misc $temp_info(rc,$i)]
      set metadata [list "Gg_fragment_$i" $gformat_misc misc_feature $temp_info(rc,$i) $amplicon_note_list [list]]
      lappend_tags new_tags f0# [list $coords [list $bg_color {} {} {}] [list <<Revcolors>> <<Metadata>>] [list $revcolors_misc $metadata]]
    }

    if {$next_i ==0} {
      ##move tags past the end of the last fragment to the beginning
## need to look for features with negative values and move to end
      set end [string length $dna]
      set new_tags2 [list]
      foreach {tag data} $new_tags {
        set newcoords [list]  
	foreach {a b} [lindex $data 0] {
	  if {$a <0} {
            lappend newcoords [expr {$end + $a}] [expr {$end}]
            lappend newcoords 0 [expr {$b}]		
	  } elseif {$b <= $end} {
            lappend newcoords $a $b
          } elseif {$a >= $end} {
            lappend newcoords [expr {$a-$end}] [expr {$b-$end}]
          } elseif {$b > $end} {
            lappend newcoords $a [expr {$end}]
            lappend newcoords 0 [expr {$b-$end}]
          } 
        }
        if {$newcoords != [list]} {
          lset data 0 $newcoords
          lappend new_tags2 $tag $data
        }
      }
      lappend_tags tags {*}$new_tags2
    } else {
      #lappend tags {*}$new_tags
    }
  }
  append filecomment "\n[mc {Primer order:}]\n[join $primer_order \n]"

  incr info(primer_next_number) [expr {$p_count*2}]
  #gg_wizard_dialog_cancel .dialog
  create_window $dna "" $filecomment "circular" 1 0 New_Golden_Gate $tags {} GenBank

}

############
##
#############
proc gg_wizard_get_dna {w1 dna_first dna_last dir} {
  if {$dna_last > $dna_first} {
    ## fragment not through origin
    set new_dna [textarea_get $w1.textarea [bp2ix $w1.textarea $dna_first] [bp2ix $w1.textarea $dna_last]]
  } else {
    ## fragment  through origin
    set len [ix2bp $w1.textarea end]
    set new_dna [textarea_get $w1.textarea [bp2ix $w1.textarea $dna_first] [bp2ix $w1.textarea [expr {$len}]]]
    append new_dna [textarea_get $w1.textarea [bp2ix $w1.textarea 0] [bp2ix $w1.textarea [expr {$dna_last % $len}]]]
  } 
  if {$dir} {
    ## reverse fragment
    set new_dna [revcom $new_dna]
  } 
  return $new_dna
}


############
##
#############
proc pcr_dialog {w} {
  global info temp_info modifier dialogblock modstring


  if {$dialogblock == 1} {return}

  set s [new_dialog $w "PCR..." "PCR"]
  #wm resizable [winfo toplevel $s] 0 0
  wm resizable [winfo toplevel $s] 1 1
  bind $s <<Cancel>> "dialog_cancel $s"
  bind $s <<OK>> "set ok 1"
  array unset temp_info

  grid [frame $s.treeframe] -row 3 -column 1  -sticky nswe
  grid [set tv [ttk::treeview $s.treeframe.tv  -yscrollcommand "optionscrollbar $s.treeframe.sc" -height 10]] -row 1 -column 1 -sticky nswe
  $tv configure -columns {Sequence Direction Location Dist Tm1 Tm2 MM Count Matchlength Note Colors Qualifiers} -displaycolumns {Sequence Direction Dist Location Tm1 Tm2 MM Count}
  $tv heading #0 -text [mc "Name"] -command "treeview_sort $tv {}"
  $tv column #0 -width 50 -minwidth 50 -stretch 1 -anchor e
  $tv heading Sequence -text Sequence
  $tv column Sequence -width 100 -minwidth 50 -stretch 1 -anchor w
  $tv heading Direction -text Direction -command "treeview_sort $tv Direction"
  $tv column Direction -width 60 -minwidth 50 -stretch 1 -anchor c
  $tv heading Dist -text [mc "Dist"]  -command "treeview_sort $tv Dist"
  $tv column Dist -width 60 -minwidth 50 -stretch 1 -anchor e
  $tv heading Location -text [mc "Location  \u2193"]  -command "treeview_sort $tv Location"
  $tv column Location -width 60 -minwidth 50 -stretch 1 -anchor e
  $tv heading Tm1 -text "Tm1"  -command "treeview_sort $tv Tm1"
  $tv column Tm1 -width 60 -minwidth 50 -stretch 1 -anchor e
  $tv heading Tm2 -text "Tm2"  -command "treeview_sort $tv Tm2"
  $tv column Tm2 -width 60 -minwidth 50 -stretch 1 -anchor e
  $tv heading MM -text "MM"  -command "treeview_sort $tv MM"
  $tv column MM -width 60 -minwidth 50 -stretch 1 -anchor e
  $tv heading Count -text [mc "Count"]
  $tv column Count -width 20 -minwidth 20 -stretch 1 -anchor e

  $tv insert {} 0 -id detached
  $tv detach detached


  set temp_info(pcr_key_location_dict) [dict create]
  foreach primer $info(pcr_primer_database) {
    set item [$tv insert {} 0 -text [lindex $primer 0]]
    $tv set $item Sequence [lindex $primer 1] 
    $tv set $item Note [lindex $primer 2]
    $tv set $item Colors [lindex $primer 3]
    $tv set $item Qualifiers [lindex $primer 4] 
    dict set temp_info(pcr_key_location_dict) "[lindex $primer 0]\t[lindex $primer 1]" $item
  }


  $tv tag configure rev_primer -font boldlabelfont
  $tv tag configure fwd_primer -font boldlabelfont
  #bind $tv <<TreeviewSelect>> "##treeview_manageselection $tv; ##edit_box_treeviewselect $w"
  bind $tv <<OldSelection>> {}
  bind $tv <<Sort_column>> Location
  bind $tv <<Sort_direction>> 1
  bind $tv <Double-Button-1> "pcr_dialog_edit_primer $tv %x %y; break"
  bind $tv <Any-Motion> "pcr_dialog_mouseover $tv %x %y"
  bind $tv <Any-Leave> "if {\[winfo exists .w_tooltip\]} {destroy .w_tooltip}; catch {after cancel \$temp_info(pcr_dialog_mouseover_cancel)}"
  bind $tv <FocusOut> "if {\[winfo exists .w_tooltip\]} {destroy .w_tooltip}; catch {after cancel \$temp_info(pcr_dialog_mouseover_cancel)}"
  bind $tv <Unmap> "if {\[winfo exists .w_tooltip\]} {destroy .w_tooltip}; catch {after cancel \$temp_info(pcr_dialog_mouseover_cancel)}"
    
  grid [scrollbar $s.treeframe.sc -orient vertical -command "$s.treeframe.tv yview" -width 15] -row 1 -column 2 -sticky nse 
  grid rowconfigure $s.treeframe 1 -weight 1
  grid columnconfigure $s.treeframe 1 -weight 1


  grid [frame $s.selframe] -row 2 -column 1  -sticky nswe
  #grid [label $s.selframe.l1 -text [mc "Database"]]  -row 1 -column 1  -sticky w
  grid [menubutton $s.selframe.add_primer -text [mc "Primers..."]] -row 1 -column 2  -sticky w
    $s.selframe.add_primer configure -menu [menu $s.selframe.add_primer.menu]
    $s.selframe.add_primer.menu add command -label [mc {Add Primers from Clipboard}] -accelerator "$modstring+V" -command "pcr_dialog_paste_primers $tv \$temp_info(template_window)"
    $s.selframe.add_primer.menu add command -label [mc {Add Primers from File}] -accelerator "$modstring+O" -command  "pcr_dialog_open_primers $tv"
    $s.selframe.add_primer.menu add cascade -label [mc {Add Primers from Sequence}] -menu [menu $s.selframe.add_primer.menu.seqs_menu]
        foreach window [dnawindows_list 1] {
          $s.selframe.add_primer.menu.seqs_menu add command -command "pcr_dialog_add_primers_from_sequence $tv $window" -label [wm title $window]
        }

    $s.selframe.add_primer.menu add separator
    $s.selframe.add_primer.menu add command -label [mc {Add Selected Primers as Features to Template}]  -command  "pcr_dialog_add_primers_to_template $tv \$temp_info(template_window)"
    $s.selframe.add_primer.menu add separator
    $s.selframe.add_primer.menu add command -label [mc {Copy Selected Primers}] -accelerator "$modstring+C" -command  "pcr_dialog_copy_primers $tv"
    $s.selframe.add_primer.menu add command -label [mc {Save Selected Primers}] -accelerator "$modstring+S" -command  "pcr_dialog_save_primers $tv new"
    #$s.selframe.add_primer.menu add command -label [mc {Append Selected Primers to Primer File}] -accelerator "$modstring+Shift+S" -command  "pcr_dialog_save_primers $tv append"

    $s.selframe.add_primer.menu add separator
    $s.selframe.add_primer.menu add command -label [mc {Select All}] -accelerator "$modstring+A" -command "$tv selection add \[$tv children {}\]"
    $s.selframe.add_primer.menu add command -label [mc {Invert Selection}] -accelerator "$modstring+Shift+A" -command "set selstore \[$tv selection\]; $tv selection add \[$tv children {}\]; $tv selection remove \$selstore; unset -nocomplain selstore"
    #$s.selframe.add_primer.menu add command -label [mc {Clear Selection}] -command "$tv selection remove \[$tv children {}\]"

    $s.selframe.add_primer.menu add separator
    $s.selframe.add_primer.menu add command -label [mc {Delete Selected}] -accelerator "$modstring+BackSpace" -command  "pcr_dialog_delete_primers $tv 0"
    $s.selframe.add_primer.menu add command -label [mc {Delete All}] -accelerator "$modstring+Shift-BackSpace" -command  "pcr_dialog_delete_primers $tv 1"

  #grid [ttk::checkbutton $s.selframe.select_pairs -text [mc "Select Primer Pairs"] -variable temp_info(pcr_selectmode) -command "pcr_dialog_set_selectmode $s \$temp_info(pcr_selectmode)" -onvalue "PCR" -offvalue "extended"] -row 1 -column 3  -sticky w

  #grid [menubutton $s.selframe.sel -text [mc "Change Selection..."]] -row 1 -column 4  -sticky w
  #  $s.selframe.sel configure -menu [menu $s.selframe.sel.menu]
  #  $s.selframe.sel.menu add command -label [mc {Select All}] -command "$tv selection add \[$tv children {}\]"
  #  $s.selframe.sel.menu add command -label [mc {Invert Selection}] -command "set selstore \[$tv selection\]; $tv selection add \[$tv children {}\]; $tv selection remove \$selstore; unset -nocomplain selstore"
  #  $s.selframe.sel.menu add command -label [mc {Clear Selection}] -command "$tv selection remove \[$tv children {}\]"

  grid [frame $s.mapframe] -row 4 -column 1 -sticky nswe
  grid [canvas $s.mapframe.c -background $info(graphic_bg_color)] -row 1 -column 1 -sticky nswe
  grid columnconfigure $s.mapframe 1 -weight 1

  grid [frame $s.templframe] -row 5 -column 1 -sticky nswe
  grid [label $s.templframe.templ1 -text [mc "Template"]] -row 1 -column 1 -sticky w
  grid [menubutton $s.templframe.template -textvariable temp_info(pcr_template_display)] -row 1 -column 2  -sticky w
  $s.templframe.template configure -menu [menu $s.templframe.template.menu]
    foreach window [dnawindows_list 1] {
      $s.templframe.template.menu add radiobutton -command "pcr_dialog_change_template_window $tv; set temp_info(pcr_template_display) \[file rootname \[wm title $window\]\]" -variable temp_info(template_window) -value $window -label [file rootname [wm title $window]]
    }
 # grid [button $s.templframe.add_primers -text [mc {Add Selected Primers to Template}] -command "pcr_dialog_add_primers_to_template $tv \$temp_info(template_window)"] -row 1 -column 3 -sticky w
 # grid [ttk::separator $s.templframe.s1] -row 2 -column 1 -columnspan 4 -sticky we
  grid columnconfigure $s.templframe 4 -weight 1

  grid [frame $s.limitframe] -row 6 -column 1 -sticky nswe
  grid [label $s.limitframe.l1 -text [mc "Show Primers"]]  -row 1 -column 1  -sticky w
  grid [menubutton $s.limitframe.sel -textvariable temp_info(pcr_show_display)] -row 1 -column 2 -columnspan 4 -sticky w
    $s.limitframe.sel configure -menu [menu $s.limitframe.sel.menu]
    $s.limitframe.sel.menu add radiobutton -label [mc "Unique in Template"] -command "set temp_info(pcr_show_display) \[mc \"Unique in Template\"\];pcr_dialog_filter $tv $w" -variable temp_info(pcr_show) -value 0
    $s.limitframe.sel.menu add radiobutton -label [mc "Anywhere in Template"] -command "set temp_info(pcr_show_display) \[mc \"Anywhere in Template\"\];pcr_dialog_filter $tv $w" -variable temp_info(pcr_show) -value 1
    #$s.limitframe.sel.menu add radiobutton -label [mc "Unique In Template Selection"] -command "set temp_info(pcr_show_display) \[mc \"Unique In Template Selection\"\];pcr_dialog_filter $tv $w" -variable temp_info(pcr_show) -value 2
    #$s.limitframe.sel.menu add radiobutton -label [mc "Unique Outside Template Selection"] -command "set temp_info(pcr_show_display) \[mc \"Unique Outside Template Selection\"\];pcr_dialog_filter $tv $w" -variable temp_info(pcr_show) -value 3
    $s.limitframe.sel.menu add radiobutton -label [mc "Show All"] -command "set temp_info(pcr_show_display) \[mc \"Show All\"\];pcr_dialog_filter $tv $w" -variable temp_info(pcr_show) -value 4
  grid [label $s.limitframe.l2 -text [mc "Min. Annealing Length"]]  -row 2 -column 2 -sticky e
  grid [label $s.limitframe.l3 -width 3 -textvariable temp_info(pcr_min_match)]  -row 2 -column 3 -sticky w
  #grid [ttk::spinbox $s.limitframe.l3 -width 3 -textvariable temp_info(pcr_min_match) -from 5 -to 30 -validate all -validatecommand "return 1; entry_integer %P %W %V 5 30"]  -row 2 -column 3 -sticky w
  grid [ttk::button $s.limitframe.bmm1  -text "<" -width 1 -command "if {\$temp_info(pcr_min_match) > 5} {incr temp_info(pcr_min_match) -1; pcr_dialog_scan $tv}"]  -row 2 -column 4 -sticky w
  grid [ttk::scale $s.limitframe.3scale -orient horizontal -length 100 -variable temp_info(pcr_min_match) -from 5 -to 30 -command "set temp_info(pcr_min_match) \[expr {int(\$temp_info(pcr_min_match))}\];if {\$temp_info(old_pcr_min_match) != \$temp_info(pcr_min_match)} {pcr_dialog_scan $tv}; set temp_info(old_pcr_min_match) \$temp_info(pcr_min_match);#" ]  -row 2 -column 5 -sticky w
  grid [ttk::button $s.limitframe.bmm2  -text ">" -width 1 -command "if {\$temp_info(pcr_min_match) < 30} {incr temp_info(pcr_min_match); pcr_dialog_scan $tv}"]  -row 2 -column 6 -sticky w
  grid [label $s.limitframe.l4 -text [mc "Max Mismatch"]]  -row 3 -column 2  -sticky e
  grid [label $s.limitframe.l5 -width 3 -textvariable temp_info(pcr_max_mm)]  -row 3 -column 3  -sticky w
  #grid [ttk::spinbox $s.limitframe.l5 -width 3 -textvariable temp_info(pcr_max_mm) -from 0 -to 10 -validate all -validatecommand "return 1; entry_integer %P %W %V 0 10"]  -row 3 -column 3  -sticky w
  grid [ttk::button $s.limitframe.bmm3  -text "<" -width 1 -command "if {\$temp_info(pcr_max_mm) > 0} {incr temp_info(pcr_max_mm) -1; pcr_dialog_scan $tv}"]  -row 3 -column 4 -sticky w
  grid [ttk::scale $s.limitframe.mm_scale -orient horizontal -length 100 -variable temp_info(pcr_max_mm) -from 0 -to 10 -command "set temp_info(pcr_max_mm) \[expr {int(\$temp_info(pcr_max_mm))}\];if {\$temp_info(old_pcr_max_mm) != \$temp_info(pcr_max_mm)} {pcr_dialog_scan $tv};set temp_info(old_pcr_max_mm) \$temp_info(pcr_max_mm);#" ]  -row 3 -column 5 -sticky w
  grid [ttk::button $s.limitframe.bmm4  -text ">" -width 1 -command "if {\$temp_info(pcr_max_mm) < 10} {incr temp_info(pcr_max_mm); pcr_dialog_scan $tv}"]  -row 3 -column 6 -sticky w
  grid [label $s.limitframe.l6 -text [mc "Minimum match at 3' End"]]  -row 4 -column 2  -sticky e
  grid [label $s.limitframe.l7 -width 3 -textvariable temp_info(pcr_min_3_match)]  -row 4 -column 3  -sticky w
  #grid [ttk::spinbox $s.limitframe.l7 -width 3 -textvariable temp_info(pcr_min_3_match) -from 0 -to 4 -validate all -validatecommand "return 1; entry_integer %P %W %V 0 4"]  -row 4 -column 3  -sticky w
  grid [ttk::button $s.limitframe.bmm5  -text "<" -width 1 -command "if {\$temp_info(pcr_min_3_match) > 0} {incr temp_info(pcr_min_3_match) -1; pcr_dialog_scan $tv}"]  -row 4 -column 4 -sticky w
  grid [ttk::scale $s.limitframe.mmatch_scale -orient horizontal -length 100 -variable temp_info(pcr_min_3_match) -from 0 -to 4 -command "set temp_info(pcr_min_3_match) \[expr {int(\$temp_info(pcr_min_3_match))}\];if {\$temp_info(pcr_min_3_match) != \$temp_info(old_pcr_min_3_match)} {pcr_dialog_scan $tv}; set temp_info(old_pcr_min_3_match) \$temp_info(pcr_min_3_match);#" ]  -row 4 -column 5 -sticky w
  grid [ttk::button $s.limitframe.bmm6  -text ">" -width 1 -command "if {\$temp_info(pcr_min_3_match) < 4} {incr temp_info(pcr_min_3_match); pcr_dialog_scan $tv}"]  -row 4 -column 6 -sticky w

  grid [frame $s.infoframe] -row 7 -column 1  -sticky nswe
  grid [text $s.infoframe.text -height 4 -bg [$s cget -bg] -state disabled -font labelfont] -row 1 -column 1 -sticky nswe
  grid columnconfigure $s.infoframe 1 -weight 1

  grid [frame $s.okframe] -row 8 -column 1 -sticky nswe
  grid [button $s.okframe.cancel -text [mc "Close"] -command "event generate $s <<Cancel>>"] -row 1 -column 1 
  grid [ttk::checkbutton $s.okframe.select_pairs -text [mc "Select Primer Pairs"] -variable temp_info(pcr_selectmode) -command "pcr_dialog_set_selectmode $s \$temp_info(pcr_selectmode)" -onvalue "PCR" -offvalue "extended"] -row 1 -column 2  -sticky e
  grid [button $s.okframe.pcr -text [mc "New PCR Product"] -command "pcr_dialog_do_pcr_from_treeview $tv" -default active -state disabled]  -row 1 -column 3 
  grid columnconfigure $s.okframe 2 -weight 1


  #grid [ttk::menubutton $s.okframe.action -textvariable temp_info(pcr_action_display)] -row 1 -column 2
    #$s.okframe.action configure -menu [menu $s.okframe.action.menu]
    #$s.okframe.action.menu add radiobutton -label [mc "New PCR Product"] -command "set temp_info(pcr_action_display) \[mc \"New PCR Product\"\]; pcr_dialog_set_function $s PCR" -variable temp_info(pcr_action) -value 0
    #$s.okframe.action.menu add radiobutton -label [mc "Add Selected Primers to Template"] -command "set temp_info(pcr_action_display) \[mc \"Add Primers to Template\"\]; pcr_dialog_set_function $s add_primers_template" -variable temp_info(pcr_action) -value 1
    #$s.okframe.action.menu add radiobutton -label [mc "Append Selected Primers to Database"] -command "set temp_info(pcr_action_display) \[mc \"Append Primers to Database\"\]; pcr_dialog_set_function $s append_primers_file" -variable temp_info(pcr_action) -value 2
    #$s.okframe.action.menu add radiobutton -label [mc "Save Selected Primers to New Database"] -command "set temp_info(pcr_action_display) \[mc \"Save Primers to New Database\"\]; pcr_dialog_set_function $s save_primers_file" -variable temp_info(pcr_action) -value 3

  #grid [button $s.okframe.ok -text [mc "OK"] -command "event generate $s <<OK>>" -default active -state normal]  -row 1 -column 3  
  grid columnconfigure $s.okframe 2 -weight 1


  grid rowconfigure $s 3 -weight 1
  grid columnconfigure $s 1 -weight 1

  #set temp_info(pcr_action_display) [mc "New PCR Product"]
  #set temp_info(pcr_action) 0
  set temp_info(pcr_selectmode) extended
  set temp_info(template_window) $w
  set temp_info(pcr_template_display) [wm title $w]
  set temp_info(pcr_show_display) [mc "Unique in Template"]
  set temp_info(pcr_show) 0
  set temp_info(pcr_min_match) 17
  set temp_info(old_pcr_min_match) 17
  set temp_info(pcr_max_mm) 0
  set temp_info(old_pcr_max_mm) 0
  set temp_info(pcr_min_3_match) 4
  set temp_info(old_pcr_min_3_match) 4

  bind $tv <$modifier-Key-v> "pcr_dialog_paste_primers $tv \$temp_info(template_window)"
  bind $tv <$modifier-Key-c> "pcr_dialog_copy_primers $tv"
  bind $tv <$modifier-Key-o> "pcr_dialog_open_primers $tv"
  bind $tv <$modifier-Key-s> "pcr_dialog_save_primers $tv new"
  
  bind $tv <$modifier-Key-a> "$tv selection add \[$tv children {}\]"
  bind $tv <$modifier-Shift-Key-A> "set selstore \[$tv selection\]; $tv selection add \[$tv children {}\]; $tv selection remove \$selstore; unset -nocomplain selstore"
  
  #bind $s <$modifier-Shift-Key-s> "pcr_dialog_save_primers $tv append"
  bind $tv <$modifier-Shift-Key-BackSpace> "pcr_dialog_delete_primers $tv 1"
  bind $tv <$modifier-Shift-Key-Delete> "pcr_dialog_delete_primers $tv 1"
  bind $tv <$modifier-Key-BackSpace> "pcr_dialog_delete_primers $tv 0"
  bind $tv <$modifier-Key-Delete> "pcr_dialog_delete_primers $tv 0"
  bind $tv <Configure> "pcr_dialog_scale_map $s.mapframe.c"

  set temp_info(old_template_window) $w
  register_data_receiver $tv <<SelectionChanged>> "pcr_dialog_set_dist $tv"
  bind $tv <Destroy> "dict unset data_transmit(<<SelectionChanged>>) $tv"
  #trace add variable info($w,insert_loc) write "pcr_dialog_set_dist $tv $temp_info(template_window);#"
## fix this
 # bind $s <Destroy> "catch {  trace remove variable info(\$temp_info(template_window),insert_loc) write \"pcr_dialog_set_dist $tv \$temp_info(template_window);#\"}"
  pcr_dialog_scan $tv
  pcr_dialog_set_selectmode $s extended
  after 100 "pcr_dialog_draw_map_features $s.mapframe.c"

  raise $s
}



############
##
#############
proc pcr_dialog_paste_primers {tv w} {
  global temp_info tcl_platform
  if {($tcl_platform(platform) == "unix") && ([tk windowingsystem] != "aqua")} {
    if {[catch {set text [selection get -displayof $w -selection CLIPBOARD]}]} {return}
  } else {
    if {[catch {set text [clipboard get]}]} {return}
  }
  pcr_dialog_load_primers $tv $w $text
}

############
##
#############
proc pcr_dialog_mouseover {tv x y} {
  global temp_info
  set item [$tv identify item $x $y]
  catch "after cancel \$temp_info(pcr_dialog_mouseover_cancel)"
  if {[winfo exists .w_tooltip]} {
    destroy .w_tooltip
  }
  if {$item =={}} {return}
  set temp_info(pcr_dialog_mouseover_cancel) [after 500 "pcr_dialog_tooltip_post $tv $x $y"]
}

############
##
#############
proc pcr_dialog_tooltip_post {tv x y} {
  global temp_info

  set item [$tv identify item $x $y]
  if {$item =={}} {return}
  set note [string range [$tv set $item Note] 0 75]
    if {$note == {}} {return}
  if {[winfo exists .w_tooltip]} {
    destroy .w_tooltip
  }
  if {[catch {toplevel .w_tooltip}]} {
    after 400 "tooltip_post_pcr $tv $x 4y"
    return
  }
  wm overrideredirect .w_tooltip 1;after 4 "catch \{raise .w_tooltip\}"
  wm attributes .w_tooltip -alpha .9
  grid [label .w_tooltip.label1 -text $note -background #7ea2ff -foreground white -border 1 -font labelfont] -row 0 -column 0 -sticky nswe
    wm geometry .w_tooltip "+[expr {[winfo rootx $tv] + $x}]+[expr {[winfo rooty $tv] + $y}]"
}

############
## Needs to edit colors and qualifiers too
#############
proc pcr_dialog_edit_primer {tv x y} {
  global temp_info

  set item [$tv identify item $x $y]
  if {$item =={}} {return}
  set s [winfo toplevel $tv] 

  set temp_info(edit_primer_name) [$tv item $item -text]
  set temp_info(edit_primer_seq) [$tv set $item Sequence]
  set temp_info(edit_primer_note) [$tv set $item Note]
  set temp_info(edit_primer_colors) [$tv set $item Colors]
  set temp_info(edit_primer_qual) [$tv set $item Qualifiers]
  set temp_info(edit_primer_item) $item
  if {![winfo exists $s.editframe]} {
    grid [frame $s.editframe] -row 0 -rowspan 8 -column 1 -sticky nswe
    grid columnconfigure $s.editframe 2  -weight 1
    grid [label $s.editframe.label -text [mc "Edit Primer"]] -row 0 -column 1 -columnspan 2 -sticky w
    grid [label $s.editframe.name_label -text [mc "Name:"]] -row 1 -column 1 -sticky e
    grid [entry $s.editframe.name -state normal -textvariable temp_info(edit_primer_name)] -row 1 -column 2 -sticky ew
    grid [label $s.editframe.seq_label -text [mc "Sequence:"]] -row 2 -column 1 -sticky e
    grid [entry $s.editframe.seq -state normal -textvariable temp_info(edit_primer_seq)] -row 2 -column 2 -sticky ew
    #grid [label $s.editframe.note_label -text [mc "Note:"]] -row 3 -column 1 -sticky e
    #grid [entry $s.editframe.note -state normal -textvariable temp_info(edit_primer_note) -xscrollcommand "optionscrollbar $s.editframe.note_sc"] -row 3 -column 2 -sticky ew
    #grid [scrollbar $s.editframe.note_sc -orient horizontal -command "$s.editframe.note xview"] -row 4 -column 2 -sticky ew
    grid [button $s.editframe.edit_ok -text [mc "OK"] -command "grid remove $s.editframe; grid configure $s.treeframe;pcr_dialog_do_edit_primer $tv"] -row 5 -column 1 -columnspan 2 -sticky n
    grid remove $s.treeframe
  } else {
    grid configure $s.editframe
    grid remove $s.treeframe
  }
}

############
##
#############
proc pcr_dialog_do_edit_primer {tv} {
  global temp_info info

  set item $temp_info(edit_primer_item)
  set old_name [$tv item $item -text]
  set old_seq [$tv set $item Sequence]
  $tv item $item -text $temp_info(edit_primer_name) -tag new_primer]
  $tv set $item Sequence $temp_info(edit_primer_seq)
  #set new_note  [clock format [clock seconds] -format $temp_info(edit_primer_note)]
  #$tv set $item Note $new_note
  set new_qual_list [list]
  foreach {type value} $temp_info(edit_primer_qual) {
    if {$type ne "note"} {
      lappend new_qual_list $type $value
    }
  }
  #foreach n [split $new_note \u00B6] {
  #  lappend new_qual_list note $n
  #}
  $tv set $item Qualifiers $new_qual_list
  set old_key "$old_name)\t$old_seq"
  set temp_info(pcr_key_location_dict) [dict remove  $temp_info(pcr_key_location_dict) $old_key]
  dict set temp_info(pcr_key_location_dict)  "$temp_info(edit_primer_name)\t$temp_info(edit_primer_seq)" $item
  foreach pos [lsearch -nocase -index 1 -all $info(pcr_primer_database) $old_seq] {
    if {[lindex $info(pcr_primer_database) $pos 0] eq $old_name} {
      set info(pcr_primer_database) [lreplace $info(pcr_primer_database) $pos $pos]
    }
  }
  lappend info(pcr_primer_database) [list $temp_info(edit_primer_name) $temp_info(edit_primer_seq) $temp_info(edit_primer_note) $temp_info(edit_primer_colors) $new_qual_list)]
  pcr_dialog_scan $tv
}

############
##
#############
proc pcr_dialog_copy_primers {tv} {
  global temp_info

  set data_dict [dict create]
  foreach item [$tv selection] {
    dict set data_dict "[$tv item $item -text]\t[$tv set $item Sequence]" [$tv set $item Note]
  }
  set data_list [list]
  foreach key [dict keys $data_dict] {
    lappend data_list "$key\t[dict get $data_dict $key]"
  }
  set text [join $data_list \n]
  clipboard clear 
  clipboard_append -displayof [winfo toplevel $tv] $text
  set info(clipboard_text) $text
  set info(clipboard_tags) {}
}

############
##
#############
proc pcr_dialog_open_primers {tv} {
  global temp_info
  set text [list]
  set filename [tk_getOpenFile -title [mc {Open PCR Primers File}] -filetypes {{{Text Files} {.txt}} {{All Files} *}}]
  if {$filename != {}} { 
    if {![catch {open $filename r} fileid err]} {
      while {[eof $fileid] != 1} {
        lappend text [gets $fileid]
      }
    } else {
      catch {close $text_file}
      tk_messageBox -title [mc "Text File not Readable"] -message [mc "The file %s is not readable. It may be locked." $filename] -type ok -icon warning -default ok
      return
    }
    if {[llength $text] > 0} {
      pcr_dialog_load_primers $tv $temp_info(template_window) [join $text \n]
    }
  }
}

############
##
#############
proc pcr_dialog_delete_primers {tv {all 0}} {
  global temp_info info
  if {$all} {
    $tv delete [$tv children {}] 
    $tv delete [$tv children detached] 
    set temp_info(pcr_key_location_dict) [dict create]
    set info(pcr_primer_database) [list]
  } else {
    foreach item [$tv selection] {
      set name [$tv item $item -text]
      set seq [$tv set $item Sequence]
      set temp_info(pcr_key_location_dict) [dict remove  $temp_info(pcr_key_location_dict) "$name\t$seq"]
      foreach pos [lsearch -nocase -index 1 -all $info(pcr_primer_database) $seq] {
        if {[lindex $info(pcr_primer_database) $pos 0] eq $name} {
          set info(pcr_primer_database) [lreplace $info(pcr_primer_database) $pos $pos]
        }
      }
      $tv delete $item
    }
  }
  pcr_dialog_scan $tv
  event generate $tv <<TreeviewSelect>>
}


############
##
#############
proc pcr_dialog_load_primers {tv template text} {
  global temp_info info
  set result [list]
  set log_file_list [list]
  set bad_text {}
  set bad_lines 0

  if {[dict exists $info(feature_default_type_colors) primer_bind]} {
    foreach {default_fwd_color default_rev_color} [dict get $info(feature_default_type_colors) primer_bind] {}
  } else {
    set default_fwd_color $info(feature_default_fcolor)
    set default_rev_color $info(feature_default_rcolor)
  }
  foreach line [split $text \n] {
    if {$line eq {}  || [string index $line 0] eq "#"} {lappend log_file_list $line; continue}
    set seq {}
    set name {New Primer}
    set note {}
    set type "primer_bind"
    set fwd_color $default_fwd_color
    set rev_color $default_rev_color
    set qualifiers {}
    if {[regexp -nocase {^[\s]*((?:(?:/.?/)|(?:\*)|[NBDHVKMRYWSACGT]){5,})[\s]*$} $line - seq]} {
    } elseif {[regexp -nocase {^([^\t,]+)[\t,][\s]*((?:(?:/.?/)|(?:\*)|[NBDHVKMRYWSACGT]){5,})[\s]*$} $line - name seq]} {
    } elseif {[regexp -nocase {^(?:[0-9]+)[\t,][\s]*([^\t,]+)[\t,][\s]*((?:(?:/.?/)|(?:\*)|[NBDHVKMRYWSACGT\s]){5,})[\s]*$} $line - name seq] || [regexp -nocase {^(?:[0-9]+)[\t,][\s]*([^\t]+)[\t\s]+([^\t]{5,})[\s]*$} $line - name seq] || [regexp -nocase {^(?:[0-9]+)[\t,][\s]*([^\t,]+)[\t,][\s]*((?:(?:/.?/)|(?:\*)|[NBDHVKMRYWSACGT\s]){5,})[\s]*[\t,]([^\t]*)$} $line - name seq note] || [regexp -nocase {^(?:[0-9]+)[\t,][\s]*([^\t]+)[\t\s]+([^\t]{5,})[\s]*[\t,]([^\t]*)$} $line - name seq note]} {
    } elseif {[regexp -nocase {^([^\t,]*)[\t,][\s]*((?:(?:/.?/)|(?:\*)|[NBDHVKMRYWSACGT\s]){5,})[\s]*$} $line - name seq] || [regexp -nocase {^([^\t]+)[\t\s]+([^\t]{5,})[\s]*$} $line - name seq] || [regexp -nocase {^([^\t,]+)[\t,][\s]*((?:(?:/.?/)|(?:\*)|[NBDHVKMRYWSACGT\s]){5,})[\s]*[\t,]([^\t]*)$} $line - name seq note] || [regexp -nocase {^([^\t]+)[\t\s]+([^\t]{5,})[\s]*[\t,]([^\t]*)$} $line - name seq note]} {
    } elseif {[regexp -nocase {^([^\t,]*)[\t,][\s]*([^\t,]{5,})*$} $line - name seq]} {
      regsub -all {\s+} $seq "" seq
    } elseif {[regexp -nocase {^([^\t,]*)[\t,][\s]*((?:(?:/.?/)|(?:\*)|[NBDHVKMRYWSACGT]){5,})[\s]*[\t,]([^\t]*)$} $line - name seq note]} {
    } elseif {[regexp -nocase {^([^\t]*)[\t][\s]*((?:(?:/.?/)|(?:\*)|[NBDHVKMRYWSACGT]){5,})[\s]*[\t]([\s]*primer_bind[\s]*)[\t]([^\t]*)[\t]([^\t]*)$} $line - name seq type fwd_color rev_color]} {
    } elseif {[regexp -nocase {^([^\t]*)[\t][\s]*((?:(?:/.?/)|(?:\*)|[NBDHVKMRYWSACGT]){5,})[\s]*[\t]([\s]*primer_bind[\s]*)[\t]([^\t]*)[\t]([^\t]*)[\t]([^\t]*)[\t]([^\t]*)$} $line - name seq type fwd_color rev_color bold ital]} {
    } elseif {[regexp -nocase {^([^\t]*)[\t][\s]*((?:(?:/.?/)|(?:\*)|[NBDHVKMRYWSACGT]){5,})[\s]*[\t]([\s]*primer_bind[\s]*)[\t]([^\t]*)[\t]([^\t]*)[\t]([^\t]*)[\t]([^\t]*)[\t]([^\t]*)(.*)$} $line - name seq type fwd_color rev_color bold ital qualifiers more]} {
      set note_list [list]
      foreach {qtype value} $qualifiers {
        if {$qtype eq "note"} {
          lappend note_list $value
        }
      }
      set note [join $note_list \u00B6]
    } else {
      set bad_text $line
      lappend log_file_list "#$line"
      incr bad_lines
      continue
    }

    regsub -all {\s+} $seq "" seq
    regsub -all {\\[^\\]*\\} $seq "" seq
    regsub -all {/[^/]*/} $seq "" seq
    regsub -all {\*} $seq "" seq
    if {[regexp -nocase {[^NBDHVKMRYWSACGT]} $seq] || [string length $seq] < 5} {
      set bad_text $line
      lappend log_file_list "#$line"
      set seq {}
      incr bad_lines
      continue
    }

    if {$qualifiers eq {} && $note ne {}} {
      foreach n [split $note \u00B6] {
        lappend qualifiers [list note $n]
      }
    }
    if {[catch {[winfo rgb . $fwd_color]}]} {
      set fwd_color $default_fwd_color
    }
    if {[catch {[winfo rgb . $rev_color]}]} {
      set rev_color $default_rev_color
    }
    if {$seq ne {} && $type eq "primer_bind"} {
      set key "$name\t$seq"
      lappend log_file_list $line
      if {[dict exists $temp_info(pcr_key_location_dict) $key]} {
        set new_item [dict get $temp_info(pcr_key_location_dict) $key]
        $tv set $new_item Note $note
        $tv set $new_item Qualifiers $qualifiers
        $tv set $new_item Colors [list $fwd_color $rev_color]
        foreach pos [lsearch -nocase -index 1 -all $info(pcr_primer_database) $seq] {
          if {[lindex $info(pcr_primer_database) $pos 0] eq $name} {
            set info(pcr_primer_database) [lreplace $info(pcr_primer_database) $pos $pos [list $name $seq $note [list $fwd_color $rev_color] $qualifiers]]
          }
        }
      } else {
        set new_item [$tv insert {} end -text $name -tag new_primer]
        $tv set $new_item Sequence $seq
        $tv set $new_item Note $note
        $tv set $new_item Qualifiers $qualifiers
        $tv set $new_item Colors [list $fwd_color $rev_color]
        dict set temp_info(pcr_key_location_dict) $key $new_item
        lappend info(pcr_primer_database) [list $name $seq $note [list $fwd_color $rev_color] $qualifiers]
      }
    }
  }
  pcr_dialog_scan $tv

  if {$bad_text ne {}} {
    if {[string length $bad_text] > 53} {
      set bad_text" [string  range $bad_text 0 24]...[string  range $bad_text end-24 end]"
    }
   if {$bad_lines > 1} {
      set response [tk_messageBox -message [mc "Couldn't parse %1\$s lines.\nLast bad line:\n%2\$s\nDo you want to save a repair file?" $bad_lines $bad_text] -icon warning -type yesno]
    } else {
      set response [tk_messageBox -message [mc "Couldn't parse line:\n%s\nDo you want to save a repair file?" $bad_text] -icon warning -type yesno]
    }
    if {$response eq "yes"} {
       set filename [tk_getSaveFile -title [mc "Save Oligos Repair File"] -defaultextension ".txt"  -filetypes {{"Text File" ".txt"}}]
       while {($filename != "") && ([catch {set save_file [open $filename w]}])} {
         catch {close $save_file}
         tk_messageBox -title [mc "Repair File not Writable"] -message [mc "The file %s is not writable. It may be locked." $filename] -type ok -icon warning -default ok
         set filename [tk_getSaveFile -title [mc "Save Oligos Repair File"] -defaultextension ".txt"  -filetypes {{"Text File" ".txt"}}]
      }

      if {$filename != ""} {
        foreach line $log_file_list {
          puts $save_file $line
        }
        close $save_file
      }
    }
  }
}

############
##
#############
proc pcr_dialog_add_primers_from_sequence {tv w} {
  set result [dict create]
  set text $w.textarea
  foreach ftag [lsearch -inline -all -regexp [$text tag names] {f[0-9]+#}] {
    set note_list [list]
    set sequence {}
    set fwd_color {}
    set rev_color {}
    foreach {name gformat type dir qual_list groups} [$text tag bind $ftag <<Metadata>>] {}
    if {$type ne "primer_bind" && $type ne "primer"} {continue}
    foreach {fwd_color rev_color} [$text tag bind $ftag <<Revcolors>>] {}
    foreach {type value} $qual_list {
      if {$type eq "note"} {
        lappend note_list $value
      }
      if {$type eq "PCR_conditions"} {
        ## todo: need to check for multiple primers if it's a PCR feature?
        regexp -nocase {primer[\s\_]seq(?:uence)\s*[\:\=]\s*([NBDHVKMRYWSACGT]{5,})} $value - sequence
      }
    }
    if {$type eq "primer" && $sequence eq {}} {
      foreach note $note_list {
        if {[regexp -nocase {seq(?:uence)\s*[\:\=]\s*([NBDHVKMRYWSACGT]{5,})} $note - sequence]} {
          break
        }
      }
    }
    set note [join $note_list \u00B6]
    lappend qual_list ApEinfo_graphicformat $gformat
    if {$sequence ne {}} {
      dict set result "$name\t$sequence" [list "primer_bind" $fwd_color $rev_color 0 0 $qual_list]
      continue
    }

    set fntag [regsub f $ftag fn]
    if {[set tag_range [$text tag ranges $fntag]] == {}} {
      set tag_range [$text tag ranges $ftag]
    }

    if {[llength $tag_range] == 4} {
      append sequence [textarea_get $text [lindex $tag_range 2] [lindex $tag_range 3]] [textarea_get $text [lindex $tag_range 0] [lindex $tag_range 1]]
    } elseif {[llength $tag_range] == 2} {
      append sequence [textarea_get $text [lindex $tag_range 0] [lindex $tag_range 1]]
    }
    if {$dir} {
      set sequence [revcom $sequence]
    }
    if {$sequence ne {}} {
      dict set result "$name\t$sequence" [list "primer_bind" $fwd_color $rev_color 0 0 $qual_list]
    }
  }

  set reslist [list] 
  foreach key [dict keys $result] {
    lappend reslist "$key\t[join [dict get $result $key] \t]"
  }
  pcr_dialog_load_primers $tv $w [join $reslist \n]
}

############
##
#############
proc pcr_dialog_add_primers_to_template {tv w} {
  global temp_info fea_info info

  set dna_end [ix2bp $w.textarea end]

  if {[$tv tag has fwd_primer] != {}} {
    set itemlist [concat [$tv tag has fwd_primer] [$tv tag has rev_primer]]
  } else {
    set itemlist [$tv selection]
  }
  foreach item $itemlist {
    if {[$tv set $item Count] < 1} {continue}
    set name [$tv item $item -text]
    set sequence [$tv set $item Sequence]
    set note [$tv set $item Note]
    set location [$tv set $item Location]
    set match_length  [$tv set $item Matchlength]
    set colors_list [$tv set $item Colors]
    if {[llength $colors_list] < 2 || ![catch {winfo rgb . [lindex $colors_list 0]}]} {
      if {[dict exists $info(feature_default_type_colors) primer_bind]} {
        set colors_list [dict get $info(feature_default_type_colors) primer_bind]
      } else {
        set colors_list [list $info(feature_default_fcolor)  $info(feature_default_rcolor)]
      }
    }
    set qualifiers [$tv set $item Qualifiers]
    if {[dict exists $qualifiers ApEinfo_graphicformat]} {
      set gformat [dict get $qualifiers ApEinfo_graphicformat]
      dict unset qualifiers ApEinfo_graphicformat
    } else {
      if {[dict exists $info(feature_default_type_gformat) primer_bind]} {
        set gformat [dict get $info(feature_default_type_gformat) primer_bind]
      } else {
        set gformat $info(feature_default_gformat)
      }
    }
    set dir [expr {[$tv set $item Direction] eq ">>>" ? 0 : 1}]

    ## check for duplicate already in template
    set response {}
    foreach tag [$w.textarea tag names [bp2ix $w.textarea [expr {$dir ? $location : (($location-1)% $dna_end)}]]] {
      set meta [$w.textarea tag bind $tag <<Metadata>>]
      if {[lindex $meta 0] eq $name} {
        set response [tk_messageBox -message [mc "Primer name %s already exists at $location. Add the primer anyway (yes), skip this primer (no), or stop adding primers (cancel)?" $name] -icon warning -type yesnocancel]
        break
      }
    }
    if {$response eq "no"} {continue} elseif {$response eq "cancel"} {break}

    set feature "f$fea_info($w,count)#"
    incr fea_info($w,count)
    textarea_tag_create $w.textarea $feature
    if {$dir} {
      set end [expr {($location + $match_length) % $dna_end}]
      if {$end > $location} {
        textarea_tag_add $w.textarea $feature [bp2ix $w.textarea $location] [bp2ix $w.textarea $end]
      } else {
        textarea_tag_add $w.textarea $feature [bp2ix $w.textarea $location] [$w.textarea index end]
        textarea_tag_add $w.textarea $feature 1.0 [bp2ix $w.textarea $end]
      }
    } else {
      set end [expr {($location - $match_length) % $dna_end}]
      if {$end < $location} {
        textarea_tag_add $w.textarea $feature [bp2ix $w.textarea $end] [bp2ix $w.textarea $location]
      } else {
        textarea_tag_add $w.textarea $feature 1.0 [bp2ix $w.textarea $location]
        textarea_tag_add $w.textarea $feature  [$w.textarea index end] [bp2ix $w.textarea $end]
      }
    }
    if {$qualifiers == {}} {
      foreach n [split $note \u00B6] {
        lappend qualifiers "note" $n
      }
    }
    if {![dict exists $qualifiers PCR_conditions]} {
      lappend qualifiers PCR_conditions "primer sequence:$sequence"
    }
    #sputs item  [list $name $gformat primer_bind $dir $qualifiers {}]
    textarea_tag_bind $w.textarea $feature <<Revcolors>> $colors_list
    textarea_tag_bind $w.textarea $feature <<Metadata>> [list $name $gformat primer_bind $dir $qualifiers {}]
    textarea_tag_configure $w.textarea $feature -background [lindex $colors_list $dir]
    register_undo_separator $w "New Feature"
  }
  features_to_tree_view $w
}

############
## Save primers as feature library formatted file- not doing append at this time
#############
proc pcr_dialog_save_primers {tv mode {filename {}}} {
  global info

  if {[$tv tag has fwd_primer] != {}} {
    set itemlist [concat [$tv tag has fwd_primer] [$tv tag has rev_primer]]
  } else {
    set itemlist [$tv selection]
  }
  if {$itemlist == {}} {
    tk_messageBox -title [mc "No items selected"] -message [mc "No Primers are selected. Noting was written."] -type ok -icon warning -default ok
    return
  }
  
  while { (![file isdirectory $info(default_dnadir)])} {
    set info(default_dnadir) [file dirname $info(default_dnadir)]
  }
  if {[file dirname $info(default_dnadir)] == $info(default_dnadir)} {
    set info(default_dnadir) [valid_default_dir]
  }
  set existing_primers_list [list]
  if {$mode eq "append"} {
    if {$filename == ""} {
      set filename [tk_getSaveFile -title [mc "Save Primers As Tab Delimited Text File"] -initialdir $info(default_dnadir) -defaultextension ".txt" -filetypes {{{Text Files} {.txt}} {{All Files} *}}]
    }

    if {$filename != ""} {
      if {[catch {set text_file [open $filename r]}]} {
        catch {close $text_file}
        tk_messageBox -title [mc "Text File not Readable"] -message [mc "The file %s is not readable. It may be locked." $filename] -type ok -icon warning -default ok
        return
      } else {
        set text [list]
        while {[eof $text_file] != 1} {
          lappend text [gets $text_file]
        }
        close $text_file
      }
      set bad_lines 0
      foreach line $text {
        set seq {}
        if {$line eq {}} {continue}
        if {[regexp -nocase {^[\s]*([NBDHVKMRYWSACGT]{5,})[\s]*$} $line - seq]} {
        } elseif {[regexp -nocase {^([^\t,]+)[\t,][\s]*([NBDHVKMRYWSACGT]{5,})[\s]*$} $line - name seq]} {
        } elseif {[regexp -nocase {^([^\t,]+)[\t,][\s]*([NBDHVKMRYWSACGT]{5,})[\s]*[\t,]([^\t]*)$} $line - name seq note]} {
        } elseif {[regexp -nocase {^([^\t]+)[\t][\s]*([NBDHVKMRYWSACGT]{5,})[\s]*[\t]([\s]*primer_bind[\s]*)[\t]([^\t]*)[\t]([^\t]*)$} $line - name seq type fwd_color rev_color]} {
        } elseif {[regexp -nocase {^([^\t]+)[\t][\s]*([NBDHVKMRYWSACGT]{5,})[\s]*[\t]([\s]*primer_bind[\s]*)[\t]([^\t]*)[\t]([^\t]*)[\t]([^\t]*)[\t]([^\t]*)$} $line - name seq type fwd_color rev_color bold ital]} {
        } elseif {[regexp -nocase {^([^\t]+)[\t][\s]*([NBDHVKMRYWSACGT]{5,})[\s]*[\t]([\s]*primer_bind[\s]*)[\t]([^\t]*)[\t]([^\t]*)[\t]([^\t]*)[\t]([^\t]*)[\t]([^\t]*)(.*)$} $line - name seq type fwd_color rev_color bold ital qualifiers more]} {

        } else {
          set bad_text $line
          incr bad_lines
        }
	lappend existing_primers_list "$name\t$seq"
      }
      if {$bad_lines > 0} {
	tk_messageBox -title [mc "Text File is not a Valid file."] -message [mc "The file %1\$s is not a valid file. %2\$s bad lines found. Can't append." $filename $bad_lines] -type ok -icon warning -default ok
	return
      } else {
        if {[catch {set text_file [open $filename a]}]} {
          catch {close $text_file}
          tk_messageBox -title [mc "Text File not Writable"] -message [mc "The file %s is not writable. It may be locked." $filename] -type ok -icon warning -default ok
        }
      }
    }
  } elseif {$mode eq "new"} {
    if {$filename == ""} {
      set filename [tk_getSaveFile -title [mc "Save Primers As Tab Delimited Text File"] -initialdir $info(default_dnadir) -defaultextension ".txt" -confirmoverwrite 0  -filetypes {{"Text File" ".txt"}}]
    }
    if {[file exists $filename]} {
      if {[tk_messageBox -title [mc "Text File already exists. Do you want to Append?"] -message [mc "The file %s Already exists. Do you want to append?" $filename] -type okcancel -icon warning -default cancel] eq "ok"} {
        pcr_dialog_save_primers $tv append $filename
        return
      } else {
        return
      }
    }
    if {[catch {set text_file [open $filename w]}]} {
      catch {close $text_file}
      tk_messageBox -title [mc "Text File not Writable"] -message [mc "The file %s is not writable. It may be locked." $filename]  -type ok -icon warning -default ok
      return
    }
  } else {sputs bad save mode; return}
  #file is now open and writable- either at the end for append, or beginning for new
  if {$filename != ""} {
    if {[$tv tag has fwd_primer] != {}} {
      set itemlist [concat [$tv tag has fwd_primer] [$tv tag has rev_primer]]
    } else {
      set itemlist [$tv selection]
    }

    set duplicates 0
    foreach item $itemlist {
      set name [$tv item $item -text]
      set sequence [$tv set $item Sequence]
      set primer_colors [$tv set $item Colors]
      foreach {fwd_color rev_color} $primer_colors {}
      set primer_qualifiers [$tv set $item Qualifiers]
      if {[lsearch $existing_primers_list "$name\t$sequence"] == -1} {
        puts $text_file "$name\t$sequence\tprimer_bind\t$fwd_color\t$rev_color\t0\t0\t$primer_qualifiers\t"
	lappend existing_primers_list "$name\t$sequence"
      } else {
        incr duplicates
      }
    }
    close $text_file
    if {$itemlist == {}} {
      tk_messageBox -title [mc "No items selected"] -message [mc "No Primers are selected. Noting was written."] -type ok -icon warning -default ok
    } elseif {$duplicates >0} {
      tk_messageBox -title [mc "Duplicates not written"] -message [mc "%s duplicate primers were found. Duplicates were not written." $duplicates] -type ok -icon warning -default ok
    }
  }
}


############
##***Obsolete
#############
proc pcr_dialog_set_function {s function} {
  global temp_info

  set tv $s.treeframe.tv
  set infotext "$s.infoframe.text"

  switch $function {
    PCR {
      bind $s <<OK>> "pcr_dialog_do_pcr $tv"
      pcr_dialog_set_selectmode $s PCR
    }
    add_primers_template {
      bind $s <<OK>> "pcr_dialog_add_primers_to_template"
      pcr_dialog_set_selectmode $s extended
    }
    append_primers_file {
      bind $s <<OK>> "pcr_dialog_save_primers $tv append"
      pcr_dialog_set_selectmode $s extended
    }
    save_primers_file {
      bind $s <<OK>> "pcr_dialog_save_primers $tv new"
      pcr_dialog_set_selectmode $s extended
    }
  }
}

############
##
#############
proc pcr_dialog_set_selectmode {s mode} {
  set tv $s.treeframe.tv
  set infotext "$s.infoframe.text"
  $infotext configure -state normal
  $infotext delete 1.0 end
  if {$mode eq "PCR"} {
    $tv configure -selectmode browse
    bind $tv <<TreeviewSelect>> ""
    pcr_dialog_tv_select_pairs $tv
    bind $tv <<TreeviewSelect>> "pcr_dialog_tv_select_pairs $tv"
    #grid remove $s.selframe.sel 
  } else {
    bind $tv <<TreeviewSelect>> ""
    $tv selection add [$tv tag has rev_primer]
    $tv selection add [$tv tag has fwd_primer]
    $tv tag remove rev_primer
    $tv tag remove fwd_primer 
    $s.treeframe.tv configure -selectmode extended
    #grid configure $s.selframe.sel 
    $s.okframe.pcr configure -state disabled
    bind $tv <<TreeviewSelect>> "pcr_dialog_tv_select_multiple $tv"
  }
  $infotext configure -state disabled
}
############
##
#############
proc pcr_dialog_tv_select_multiple {tv} {
  pcr_dialog_draw_map_primers $tv [winfo toplevel $tv].mapframe.c
}

############
##
#############
proc pcr_dialog_tv_select_pairs {tv} {
  set s [winfo toplevel $tv]
  set infotext "$s.infoframe.text"
  $infotext configure -state normal
  $infotext delete 1.0 end
  $s.okframe.pcr configure -state disabled
  if {[llength [$tv selection]] > 2} {
    $tv selection remove [$tv children {}]
    $infotext insert end "No forward primer.\nNo reverse primer.\n"
  } else {
    foreach item [$tv selection] {
      set dir [$tv set $item Direction]
      if {$dir eq ">>>"} {
        $tv tag remove fwd_primer
        $tv tag add fwd_primer $item
      } elseif {$dir eq "<<<"} {
        $tv tag remove rev_primer
        $tv tag add rev_primer $item
      }
    }
    if {[llength [$tv selection]] == 2} {
      $tv selection remove [$tv children {}]
    }
    if {[llength [$tv tag has fwd_primer]] == 1} {
      $infotext insert end "Forward primer: [$tv item [$tv tag has fwd_primer] -text]\n"
    } else {
      $tv tag remove fwd_primer
      $infotext insert end "No forward primer.\n"
    }
    if {[llength [$tv tag has rev_primer]] == 1} {
      $infotext insert end "Reverse primer: [$tv item [$tv tag has rev_primer] -text]\n"
      if {[llength [$tv tag has fwd_primer]] == 1} {
        ## Two primers found
        $s.okframe.pcr configure -state normal
        ## Check for linear amplification: either 3' end <10 bp past 5' end of other primer (see _do_pcr below)
        ## primer dimer: either 3' end in front of 5', or >10bp match
        ## hairpin: either primer >10 bp match to itself
      }
    } else {
      $tv tag remove rev_primer
      $infotext insert end "No reverse primer.\n"
    }
  }
  pcr_dialog_draw_map_primers $tv [winfo toplevel $tv].mapframe.c
  $infotext configure -state disabled
}

############
## redaw map when template changes
#############
proc pcr_dialog_draw_map_features {c} {
  global temp_info info

  set w $temp_info(template_window)
  #$c delete all
  canvas_delete_all $c
  set dna_length [ix2bp $w.textarea end]
  set line_width 5
  set c_width [winfo width $c]
  set c_scale [expr {1.0 * ($c_width) /$dna_length}]
  set depthdict [tagdepth_features_window $w.textarea]

  set maxy 0
  $c create rectangle 0 0 [expr {$c_width}] 6 -outline {} -fill {} -tags frame
  foreach tag [$w.textarea tag names] {
    if {![regexp {f[0-9]+#} $tag]} {
      continue
    }
    #regsub "fn" $tag "f" tag
    if {[dict exists $depthdict $tag]} {
      set yplus [dict get $depthdict $tag]
    } else {
      set yplus 0
    }
    set maxy [expr {max($maxy, $yplus)}]
    set fill [lindex [$w.textarea tag bind $tag <<Revcolors>>] [lindex [$w.textarea tag bind $tag <<Metadata>>] 3]]
    if {$fill eq ""} {continue}
    foreach {fstart fend} [$w.textarea tag ranges $tag] {
      $c create line [expr {[ix2bp $w.textarea $fstart] * $c_scale}]  [expr {$line_width/2.0+ $line_width* $yplus}] [expr {[ix2bp $w.textarea $fend] * $c_scale}]  [expr {$line_width/2.0+ $line_width * $yplus}] -tags {scalable feature} -fill $fill -width $line_width
    }
  }
  incr maxy
  $c create text 10 -25 -anchor sw -fill $info(graphic_fg_color) -tags {infobox}
  set bbox [$c bbox all]
  $c configure -scrollregion [list 0 -40 $c_width [expr {5 + $line_width * $maxy}]] -height [expr {5 + $line_width * $maxy +40}]
}
#pcr_dialog_draw_map_features $s.mapframe.c

############
##
#############
# width changes
proc pcr_dialog_scale_map {c} {
  set frame_coord [$c coords frame]
  if {$frame_coord == {}} {return}
  set c_width [winfo width $c]
  $c scale all 0 0 [expr {1.0 * $c_width / [lindex $frame_coord 2]}] 1.0
  lset frame_coord 2 $c_width
  $c coords frame {*}$frame_coord
}

############
##
#############
proc pcr_dialog_draw_map_primers {tv c} {
  global temp_info
  set w $temp_info(template_window)
  $c delete primer
  set c_width [expr {[winfo width $c] -10}]
  set dna_length [ix2bp $w.textarea end]
  set c_scale [expr {1.0 * $c_width /$dna_length}]

  set rev_color #3f3
  set mult_rev_color [gray_color $rev_color]
  set fwd_color #7df
  set mult_fwd_color [gray_color $fwd_color]

  if {[$tv tag has rev_primer] ne {} || [$tv tag has fwd_primer]  ne {}} {
    set item_list [concat [$tv tag has fwd_primer] [$tv tag has rev_primer]]
  } else {
    set item_list [$tv selection]
  }

  foreach item $item_list {
    set count [$tv set $item Count]
    set dir [expr {[$tv set $item Direction] eq ">>>" ? 0 :1}]
    if {$count ==0} {
      continue
    } elseif {$count == 1} {
      set fill [expr {$dir ? $rev_color : $fwd_color}]
    } else {
      set fill [expr {$dir ? $mult_rev_color : $mult_fwd_color}]
    }
    set name [$tv item $item -text]
    set location [$tv set $item Location]
    set match_length  [$tv set $item Matchlength]
    if {$location =={} || $c_scale =={}} {continue}
    set c_loc [expr {$location * $c_scale}]
    if {$dir} {
      set p [$c create polygon [expr {$c_loc +10}] [expr {-15}] [expr {$c_loc+15}] [expr {-25}] [expr {$c_loc+15}] [expr {-5}] -fill $fill  -outline {} -width 5 -activeoutline red -activewidth 1 -tags {scalable primer}]
      set end [expr {($location + $match_length) % $dna_length}]
      if {$end > $location} {
        $c bind $p <Button-1> "select_region $w [bp2ix $w.textarea $location] [bp2ix $w.textarea $end]"
      } else {
        $c bind $p <Button-1> "select_region $w [bp2ix $w.textarea $location] [$w.textarea index end]"
      }
    } else {
      set end [expr {($location - $match_length) % $dna_length}]
      set p [$c create  polygon [expr {$c_loc +10}] [expr {-15}] [expr {$c_loc+5}] [expr {-25}] [expr {$c_loc+5}] [expr {-5}] -fill $fill  -outline {} -width 5 -activeoutline red -activewidth 1 -tags {scalable primer}]
      if {$end < $location} {
        $c bind $p <Button-1> "select_region $w [bp2ix $w.textarea $end] [bp2ix $w.textarea $location]"
      } else {
        $c bind $p <Button-1> "select_region $w 1.0 [bp2ix $w.textarea $location]"
      }
    }
    $c bind $p <Any-Enter> "$c itemconf infobox -text \{$name\}"
    $c bind $p <Any-Leave> "$c itemconf infobox -text {}"
  
  }
}

############
##
#############
proc do_pcr_get_compatible_primers {text tag0 circular} {
  global info
  set fntag [regsub f $tag0 fn]
  if {[set tag_range [$text tag ranges $fntag]] == {}} {
    set tag_range [$text tag ranges $tag0]
  }

  lassign [$text tag bind $tag0 <<Metadata>>] name gformat type dir0 qual_list groups
  set is_circular [expr {$circular eq "circular"}]
  if {!$is_circular && $dir0} {
    if {[llength $tag_range] == 4} {
      set target_3 [ix2bp $text [lindex $tag_range 2]]
    } else {
      set target_3 [ix2bp $text [lindex $tag_range 0]]
    }
  } else {
    set target_3 [ix2bp $text [lindex $tag_range 1]]
  }

  set result [list]
  foreach ftag [lsearch -inline -all -regexp [$text tag names] {f[0-9]+#}] {
    lassign [$text tag bind $ftag <<Metadata>>] name gformat type dir qual_list groups
    if {($type ne "primer_bind" && $type ne "primer") || $dir==$dir0} {continue}
    if {$is_circular} {
      lappend result [list $name $ftag]
    } else {
      set fntag [regsub f $ftag fn]
      if {[set tag_range [$text tag ranges $fntag]] == {}} {
        set tag_range [$text tag ranges $ftag]
      }
      if {$dir} {
        if {[llength $tag_range] == 4} {
          set pair_3 [ix2bp $text [lindex $tag_range 2]]
        } else {
          set pair_3 [ix2bp $text [lindex $tag_range 0]]
        }
        if {$pair_3 > $target_3} {
          lappend result  [list $name $ftag]
        }
      } else {
        set pair_3 [ix2bp $text [lindex $tag_range 1]]
        if {$pair_3 < $target_3} {
          lappend result [list $name $ftag]
        }
      }
    }
  }
  return $result
}

############
##
#############
proc copy_primer_feature_sequence {w tag} {
  set text $w.textarea
  lassign [$text tag bind $tag <<Metadata>>] name gformat type dir qual_list groups
  set sequence ""
  foreach {type value} $qual_list {
    if {$type eq "PCR_conditions" && [regexp -nocase {primer[\s\_]seq(?:uence)\s*[\:\=]\s*([NBDHVKMRYWSACGT]{5,})} $value - sequence]} {
        break
    }
    if {$type eq "note" && [regexp -nocase {seq(?:uence)\s*[\:\=]\s*([NBDHVKMRYWSACGT]{5,})} $value - sequence]} {
        break
    }
  }

  if {$sequence ne {}} {
    clipboard clear;clipboard_append -displayof $w $sequence
  } else {
    set fntag [regsub f $tag fn]
    if {[set tag_range [$text tag ranges $fntag]] == {}} {
      set tag_range [$text tag ranges $tag]
    }
    if {[llength $tag_range] == 4} {
      set dna_sequence "[textarea_get $text [lindex $tag_range 2] [$text index end]][textarea_get $text 1.0 [lindex $tag_range 1]]"
    } else {
      set dna_sequence [textarea_get $text [lindex $tag_range 0] [lindex $tag_range 1]]
    }
    sputs seq 
    if {$dir} {
      clipboard clear;clipboard_append -displayof $w [revcom $dna_sequence]
    } else {
      clipboard clear;clipboard_append -displayof $w $dna_sequence
    }
  }
}

############
##
#############
proc do_pcr_from_tags {w tag0 tag1} {
  set data [list]
  set text $w.textarea
  lassign [$text tag bind $tag0 <<Metadata>>] name0 gformat0 type0 dir0 qual_list0 groups0
  if {$dir0} {
    set fwd_primer_tag $tag1
    set rev_primer_tag $tag0
  } else {
    set fwd_primer_tag $tag0
    set rev_primer_tag $tag1
  }
  lassign [$text tag bind $fwd_primer_tag <<Metadata>>] fwd_name fwd_gformat fwd_type fwd_dir fwd_qual_list fwd_groups
  lassign [$text tag bind $rev_primer_tag <<Metadata>>] rev_name rev_gformat rev_type rev_dir rev_qual_list rev_groups

  lappend data fwd_primer_name $fwd_name
  lappend data fwd_primer_colors [$text tag bind $fwd_primer_tag <<Colors>>]
  lappend data fwd_primer_qualifiers $fwd_qual_list
  set sequence ""
  foreach {type value} $fwd_qual_list {
    if {$type eq "PCR_conditions" && [regexp -nocase {primer[\s\_]seq(?:uence)\s*[\:\=]\s*([NBDHVKMRYWSACGT]{5,})} $value - sequence]} {
        break
    }
    if {$type eq "note" && [regexp -nocase {seq(?:uence)\s*[\:\=]\s*([NBDHVKMRYWSACGT]{5,})} $value - sequence]} {
        break
    }
  }
  set fntag [regsub f $fwd_primer_tag fn]
  if {[set tag_range [$text tag ranges $fntag]] == {}} {
    set tag_range [$text tag ranges $fwd_primer_tag]
  }
  if {[llength $tag_range] == 4} {
    set dna_sequence "[textarea_get $text [lindex $tag_range 2] [$text index end]][textarea_get $text 1.0 [lindex $tag_range 1]]"
  } else {
    set dna_sequence [textarea_get $text [lindex $tag_range 0] [lindex $tag_range 1]]
  }
  lappend data  fwd_primer_i [ix2bp $text [lindex $tag_range 1]]
  if {$sequence ne {}} {
    lappend data  fwd_primer_seq $sequence
    lappend data fwd_primer_j  [string length $sequence]
  } else {
    lappend data  fwd_primer_seq $dna_sequence
    lappend data fwd_primer_j [string length $dna_sequence]
  }

  lappend data rev_primer_name $rev_name
  lappend data rev_primer_colors [$text tag bind $rev_primer_tag <<Colors>>]
  lappend data rev_primer_qualifiers $rev_qual_list
  set sequence ""
  foreach {type value} $rev_qual_list {
    if {$type eq "PCR_conditions" && [regexp -nocase {primer[\s\_]seq(?:uence)\s*[\:\=]\s*([NBDHVKMRYWSACGT]{5,})} $value - sequence]} {
      break
    }
    if {$type eq "note" && [regexp -nocase {seq(?:uence)\s*[\:\=]\s*([NBDHVKMRYWSACGT]{5,})} $value - sequence]} {
      break
    }
  }
  set fntag [regsub f $rev_primer_tag fn]
  if {[set tag_range [$text tag ranges $fntag]] == {}} {
    set tag_range [$text tag ranges $rev_primer_tag]
  }
  if {[llength $tag_range] == 4} {
    set dna_sequence "[textarea_get $text [lindex $tag_range 2] [$text index end]][textarea_get $text 1.0 [lindex $tag_range 1]]"
    lappend data  rev_primer_i [ix2bp $text [lindex $tag_range 2]]
  } else {
    set dna_sequence [textarea_get $text [lindex $tag_range 0] [lindex $tag_range 1]]
    lappend data  rev_primer_i [ix2bp $text [lindex $tag_range 0]]
  }

  if {$sequence ne {}} {
    lappend data  rev_primer_seq $sequence
    lappend data rev_primer_j  [string length $sequence]
  } else {
    lappend data  rev_primer_seq [revcom $dna_sequence]
    lappend data rev_primer_j [string length $dna_sequence]
  }

  pcr_dialog_do_pcr $w $data

}

############
##
#############
proc pcr_dialog_do_pcr_from_treeview {tv} {
  global info temp_info

  set fwd_primer [$tv tag has fwd_primer]
  set rev_primer [$tv tag has rev_primer]

  if {$fwd_primer == {} || $rev_primer =={}} {
    tk_messageBox "No primer pair selected." -type ok
    return
  }

  set data [list]
  lappend data fwd_primer_name [$tv item $fwd_primer -text]
  lappend data fwd_primer_seq [$tv set $fwd_primer Sequence]
  lappend data fwd_primer_colors [$tv set $fwd_primer Colors]
  lappend data fwd_primer_qualifiers [$tv set $fwd_primer Qualifiers]
  #lappend data fwd_primer_mm [$tv set $fwd_primer MM]
  lappend data  fwd_primer_i [$tv set $fwd_primer Location]
  lappend data fwd_primer_j  [$tv set $fwd_primer Matchlength]


  lappend data  rev_primer_name [$tv item $rev_primer -text]
  lappend data  rev_primer_seq [$tv set $rev_primer Sequence]
  lappend data rev_primer_colors [$tv set $rev_primer Colors]
  lappend data  rev_primer_qualifiers [$tv set $rev_primer Qualifiers]
  #lappend data  rev_primer_mm [$tv set $rev_primer MM]
  lappend data rev_primer_i [$tv set $rev_primer Location]
  lappend data  rev_primer_j  [$tv set $rev_primer Matchlength]
  set w $temp_info(template_window)
  pcr_dialog_do_pcr $w $data
}

############
##
#############
proc pcr_dialog_do_pcr {w data} {
  global info temp_info


  ## get primer data:fwd_primer_name   fwd_primer_seq   fwd_primer_colors  fwd_primer_qualifiers  fwd_primer_mm   fwd_primer_i  fwd_primer_j 
    ## rev_primer_name  rev_primer_seq  rev_primer_colors  rev_primer_qualifiers  rev_primer_mm   rev_primer_i   rev_primer_j  

  foreach {var val} $data {
    set $var $val
  }
  set tags [list]

  set len [expr {max (1,[ix2bp $w.textarea end])}]
  set is_circular [expr {$info($w,circular) eq "circular"}]

  ## reset fwd_primer_j and rev_primer_j to the first mismatch between template and primer sequence
  if {$is_circular && [expr {$fwd_primer_i-$fwd_primer_j}] < 0} {
    set fwd_dna_binding [string toupper [textarea_get $w.textarea [bp2ix $w.textarea [expr {($fwd_primer_i-$fwd_primer_j) %$len}]]  end]]
    append fwd_dna_binding [string toupper [textarea_get $w.textarea [bp2ix $w.textarea [expr {$fwd_primer_i-$fwd_primer_j}]] [bp2ix $w.textarea $fwd_primer_i]]]
  } else {
    set fwd_dna_binding [string toupper [textarea_get $w.textarea [bp2ix $w.textarea [expr {$fwd_primer_i-$fwd_primer_j}]] [bp2ix $w.textarea $fwd_primer_i]]]
  }
  set j 0
  while {$j < [string length $fwd_primer_seq] && [string toupper [string index $fwd_primer_seq end-$j]] eq  [string index $fwd_dna_binding end-$j] } {
    incr j
  }
  set fwd_primer_j $j

  if {$is_circular && [expr {$rev_primer_i + $rev_primer_j}] > $len} {
    set rev_dna_binding [textarea_get $w.textarea [bp2ix $w.textarea $rev_primer_i]  end]
    append rev_dna_binding  [textarea_get $w.textarea 1.0 [bp2ix $w.textarea [expr {($rev_primer_i + $rev_primer_j) %$len}]]]
    set rev_dna_binding [string toupper [revcom $rev_dna_binding]]
  } else {
    set rev_dna_binding [string toupper [revcom [textarea_get $w.textarea [bp2ix $w.textarea $rev_primer_i] [bp2ix $w.textarea [expr {$rev_primer_i +$rev_primer_j}]]]]]
  }
  set j 0
  while {$j < [string length $rev_primer_seq] && [string toupper [string index $rev_primer_seq end-$j]] eq  [string index $rev_dna_binding end-$j] } {
    incr j
  }
  set rev_primer_j $j

  set warnings_list [list]
  if {$fwd_primer_j < 15} {
    lappend warnings_list "Warning: First forward primer mismatch $fwd_primer_j bases from 3' end."
  } elseif {$fwd_primer_seq ne {} && [string length $fwd_primer_seq] < [string length fwd_dna_binding]} {
    lappend warnings_list "Warning: Forward primer sequence is shorter than the primer binding feature."
  }
  if {$rev_primer_j < 15} {
    lappend warnings_list "Warning: First reverse primer mismatch $rev_primer_j bases from 3' end."
  } elseif {$rev_primer_seq ne {} && [string length $rev_primer_seq] < [string length rev_dna_binding]} {
    lappend warnings_list "Warning: Reverse primer sequence is shorter than the primer binding feature."
  }

  if {[llength $warnings_list] > 0} {
    if {[ tk_messageBox -message  [join $warnings_list \n] -type okcancel -icon warning] eq "cancel"} {
      return
    }
  }
  if {!$is_circular} {
    if {$fwd_primer_i >= $rev_primer_i} {
      tk_messageBox -message [mc "Primers don't point towards each other."] -type ok
      return
    } 
    #### linear DNA template
    ## if i-j <0 set j to i, so that the tail includes all sequence past the end
    #set fwd_primer_j [expr {min ($fwd_primer_j, $fwd_primer_i)}]
    set dna_first [expr {$fwd_primer_i - $fwd_primer_j}]

    ## if i+j> len set j to len-1,  so that the tail includes all sequence past the end
    #set rev_primer_j [expr {min ($rev_primer_j, $len-$rev_primer_i)}]
    set dna_last [expr {$rev_primer_i + $rev_primer_j}]
  } else {
    ## Circular template, can set ends to go around the origin
    set dna_first [expr {($fwd_primer_i - $fwd_primer_j) % $len}]

    ## calculate dna_last, checking for products that are > $len
    if {$rev_primer_i < $fwd_primer_i} {
      ## for calculating the total length of the product, put the reverse primer to the right of the forward, even past the sequence end. dna_last will use % $len to bring it back in range
      set rev_primer_i [expr {$rev_primer_i + $len}]
    }

    if {($rev_primer_i + $rev_primer_j) - ($fwd_primer_i - $fwd_primer_j) <= $len} {
      set dna_last [expr {($rev_primer_i + $rev_primer_j) % $len}]
    } else {

      ## around the world PCR with primers that overlap- need to duplicate the overlapping sequence and tags (=negative last index)
      ## make the dna_last negative, but recovered by % $len
      set dna_last [expr {(($rev_primer_i + $rev_primer_j) % $len) - $len}]
        #  Overlap warnings    
        #--------->
        #    <----
        #$rev_primer_i -($fwd_primer_i - $fwd_primer_j) > $len
        #
        #| <10 |----->
        #<-------------
        #$rev_primer_i +10 -($fwd_primer_i - $fwd_primer_j)  > $len
     
      if {$rev_primer_i -($fwd_primer_i - $fwd_primer_j) > $len} {
        set warning "Warning: Reverse primer amplifies part of forward primer. Primer dimers are very likely."
        lappend warnings_list $warning
        if {[ tk_messageBox -message  $warning -type okcancel -icon warning] eq "cancel"} {
          return
        }
      } elseif {$rev_primer_i +10 -($fwd_primer_i - $fwd_primer_j)  > $len} {
        set warning "Warning: Reverse primer overlaps forward primer and extends less than 10bp from forward primer. Linear amplification is likely."
        lappend warnings_list $warning
        if {[ tk_messageBox -message  $warning -type okcancel -icon warning] eq "cancel"} {
          return
        }
      }
      if {($rev_primer_i + $rev_primer_j) -($fwd_primer_i) > $len} {
        set warning "Warning: Forwrd primer amplifies part of reverse primer. Primer dimers are very likely."
        lappend warnings_list $warning
        if {[ tk_messageBox -message  $warning -type okcancel -icon warning] eq "cancel"} {
          return
        }
      } elseif {($rev_primer_i + $rev_primer_j) -($fwd_primer_i - 10)  > $len} {
        set warning "Warning: Reverse primer overlaps forward primer and extends less than 10bp from forward primer. Linear amplification is likely."
        lappend warnings_list $warning
        if {[ tk_messageBox -message  $warning -type okcancel -icon warning] eq "cancel"} {
          return
        }
      }
    }
  }

  ## Need to do warning for hairpin and primer pairwise overlap
  set fwd_tail [string range $fwd_primer_seq 0 [expr {[string length $fwd_primer_seq] - $fwd_primer_j -1}]]
  set rev_tail [revcom [string range $rev_primer_seq 0 [expr {[string length $rev_primer_seq] - $rev_primer_j -1}]]]
 
  if {[llength $fwd_primer_colors] < 2 || ![catch {winfo rgb . [lindex $fwd_primer_colors 0]}]} {
    if {[dict exists $info(feature_default_type_colors) primer_bind]} {
      set fwd_primer_colors [dict get $info(feature_default_type_colors) primer_bind]
    } else {
      set fwd_primer_colors [list $info(feature_default_fcolor) $info(feature_default_rcolor)]
    }
  }

  if {[dict exists $fwd_primer_qualifiers ApEinfo_graphicformat]} {
    set fwd_gformat [dict get $fwd_primer_qualifiers ApEinfo_graphicformat]
    dict unset fwd_primer_qualifiers ApEinfo_graphicformat
  } else {
    if {[dict exists $info(feature_default_type_gformat) primer_bind]} {
      set fwd_gformat [dict get $info(feature_default_type_gformat) primer_bind]
    } else {
      set fwd_gformat $info(feature_default_gformat)
    }
  }
  if {[llength $rev_primer_colors] < 2 || ![catch {winfo rgb . [lindex $rev_primer_colors 0]}]} {
    if {[dict exists $info(feature_default_type_colors) primer_bind]} {
      set rev_primer_colors [dict get $info(feature_default_type_colors) primer_bind]
    } else {
      set rev_primer_colors [list $info(feature_default_fcolor) $info(feature_default_rcolor)]
    }
  }
  if {[dict exists $rev_primer_qualifiers ApEinfo_graphicformat]} {
    set rev_gformat [dict get $rev_primer_qualifiers ApEinfo_graphicformat]
    dict unset rev_primer_qualifiers ApEinfo_graphicformat
  } else {
    if {[dict exists $info(feature_default_type_gformat) primer_bind]} {
      set rev_gformat [dict get $info(feature_default_type_gformat) primer_bind]
    } else {
      set rev_gformat $info(feature_default_gformat)
    }
  }

#sputs pcr $dna_first $dna_last  [expr {$dna_last % $len}]

  if {$dna_last > $dna_first} {
    ## fragment not through origin
    set dna [textarea_get $w.textarea [bp2ix $w.textarea $dna_first] [bp2ix $w.textarea $dna_last]]
  } else {
    ## fragment  through origin
    set dna [textarea_get $w.textarea [bp2ix $w.textarea $dna_first] [bp2ix $w.textarea [expr {$len}]]]
    ## $dna_last could be negative, indicating > $len total product. 
    if {$dna_last >= 0} {
      append dna [textarea_get $w.textarea [bp2ix $w.textarea 0] [bp2ix $w.textarea [expr {$dna_last % $len}]]]
    } else {
      if {[expr {$dna_last % $len}] < $dna_first } {
        ## goes through origin twice
        append dna [textarea_get $w.textarea [bp2ix $w.textarea 0] [bp2ix $w.textarea [expr {$len}]]]
      }
      append dna [textarea_get $w.textarea [bp2ix $w.textarea 0] [bp2ix $w.textarea [expr {$dna_last % $len}]]]
    }
  } 
  set end [string length $fwd_tail]


  set new_tags [get_tags2 $w.textarea $dna_first $dna_last 0 $end]
  set dna "$fwd_tail$dna$rev_tail"

   ## fwd primer
   ## Needs work here- needs to take old tag out and add new one in, not skipping and leaving the old one like this
  set found 0
  foreach tag [$w.textarea tag names [bp2ix $w.textarea $dna_first]] {
    set meta [$w.textarea tag bind $tag <<Metadata>>]
    if {[lindex $meta 0] eq $fwd_primer_name} {
      set found 1
      break
    }
  }
  if {!$found} {
    #set coords [list [string length $fwd_tail] [expr {[string length $fwd_primer_seq]}]]
    set coords [list 0 [expr {[string length $fwd_primer_seq]}]]
    set bg_color [lindex $fwd_primer_colors 0]
    if {![dict exists $fwd_primer_qualifiers PCR_conditions]} {
      lappend fwd_primer_qualifiers PCR_conditions "primer sequence:$fwd_primer_seq"
    }
    set metadata [list $fwd_primer_name $fwd_gformat primer_bind 0 $fwd_primer_qualifiers [list]]
    lappend new_tags f0# [list $coords [list $bg_color {} {} {}] [list <<Revcolors>> <<Metadata>>] [list $fwd_primer_colors $metadata]]
  }

  ## rev primer
  set found 0
  foreach tag [$w.textarea tag names [bp2ix $w.textarea [expr {($dna_last -1) % $len}]]] {
    set meta [$w.textarea tag bind $tag <<Metadata>>]
    if {[lindex $meta 0] eq $rev_primer_name} {
      set found 1
      break
    }
  }
  if {!$found} {
    #set coords [list [expr {[string length $dna] - [string length $rev_primer_seq]}] [expr {[string length $dna]-[string length $rev_tail]}]]
    set coords [list [expr {[string length $dna] - [string length $rev_primer_seq]}] [expr {[string length $dna]}]]
    set bg_color [lindex $rev_primer_colors 1]
    lappend rev_primer_qualifiers PCR_conditions "primer sequence:$rev_primer_seq"
    set metadata [list $rev_primer_name $rev_gformat primer_bind 1 $rev_primer_qualifiers [list]]
    lappend new_tags f0# [list $coords [list $bg_color {} {} {}] [list <<Revcolors>> <<Metadata>>] [list $rev_primer_colors $metadata]]
  }

  set filecomment [list]
  lappend filecomment "PCR:"
  lappend filecomment "template: [file rootname [wm title $w]]"
  lappend filecomment {*}$warnings_list
  if {[string length $fwd_primer_seq] != $fwd_primer_j} {
    lappend filecomment "$fwd_primer_name $fwd_primer_seq Tm1: [Tm [string range $fwd_primer_seq end-[expr {$fwd_primer_j-1}] end]]\u00B0C Tm2: [Tm $fwd_primer_seq]\u00B0C."
  } else {
    lappend filecomment "$fwd_primer_name $fwd_primer_seq Tm: [Tm $fwd_primer_seq]\u00B0C."
  }
  if {[string length $rev_primer_seq] != $rev_primer_j} {
    lappend filecomment "$rev_primer_name $rev_primer_seq Tm1: [Tm [string range $rev_primer_seq end-[expr {$rev_primer_j-1}] end]]\u00B0C Tm2: [Tm $rev_primer_seq]\u00B0C."
  } else {
    lappend filecomment "$rev_primer_name $rev_primer_seq Tm: [Tm $rev_primer_seq]\u00B0C."
  }
  lappend filecomment "Product length: [string length $dna]"


  lappend tags {*}$new_tags

  create_window $dna "" [join $filecomment \n] "linear" 1 0 "PCR [string range [file rootname [wm title $w]] 0 15] [string range $fwd_primer_name 0 8] [string range $rev_primer_name 0 8]" $tags {} GenBank {} $info($w,gformat_data)
}

############
##
#############
proc pcr_dialog_scan {tv {d 1}} {
  global temp_info info pcr_break

  if {$d} {after 100 pcr_dialog_scan $tv 0; return}
  set target [expr {[clock milliseconds] + 100}]
  
  set s [winfo toplevel $tv]
  set infotext "$s.infoframe.text"
  $infotext configure -state normal
  #sputs setting break
  if {[info exists pcr_break]} {
    set pcr_break [expr {$pcr_break +1}]
    $infotext delete 1.0 end
    $infotext insert end "Restarting Scan...\n"

  } else {
    set pcr_break 0
    $infotext delete 1.0 end
    $infotext insert end "Starting Scan...\n"
    #sputs doesn't exist
  }
  set old_break $pcr_break
  #sputs starting $old_break
  
  set template $temp_info(template_window)
  set dna [string toupper [textarea_get $template.textarea 1.0 end]]
  set dna_len [string length $dna]
  if {[set is_circular [expr {$info($template,circular) eq "circular"}]]} {
    set dna "$dna$dna"
  }
  set rev_dna [revcom $dna]
  set item_list [$tv tag has new_primer]

  if {$item_list == {}} {
    foreach item [$tv children detached] {
      $tv move $item {} end
    }
    $tv delete [$tv tag has duplicate]
    set item_list [$tv children {}]
  }

  if {![info exists temp_info(precompute_dict_r,$template)]} {
    pcr_dialog_precompute $template $is_circular
  }


  set number 0
  foreach item $item_list {
    if {[clock milliseconds] > $target} {
      #sputs $pcr_break $old_break $i
      #$infotext delete 1.0 end
      $infotext insert end "Scanning primer #$number..."
      $infotext see end
      update
      set target [expr {[clock milliseconds] + 300}]
    }
    if {![info exists pcr_break] || $pcr_break != $old_break} {sputs break $old_break;update;return}

    incr number
    set seq [revcom [string toupper [$tv set $item Sequence]]]
    set count 0
    foreach dir {0 1} {
      foreach found [search_with_mm3 $seq $template $dir $is_circular] {
        foreach {i j mm} $found {}
        if {$count == 0} {
          set new_item $item
        } else {
          set new_item [$tv insert {} end -tags {duplicate new_item} -text [$tv item $item -text]]
          $tv set $new_item Sequence [$tv set $item Sequence]
          $tv set $new_item Colors [$tv set $item Colors]
          $tv set $new_item Qualifiers [$tv set $item Qualifiers]
          $tv set $new_item Note [$tv set $item Note]
        }
        if {$dir} {
          $tv set $new_item Direction >>>
          $tv set $new_item Location [expr {$dna_len - $i}]
        } else {
          $tv set $new_item Direction <<<
          $tv set $new_item Location $i
        }
        set tm [Tm [string range $seq 0 $j]]
        if {![string is double $tm]} {set tm 0}
        $tv set $new_item Tm1 $tm
        set tm [Tm $seq]
        if {![string is double $tm]} {set tm 0}
        $tv set $new_item Tm2 $tm
        $tv set $new_item MM $mm
        $tv set $new_item Matchlength $j

        incr count
      }
    }


    $tv set $item Count $count
    foreach new_item [$tv tag has new_item] {
      $tv set $new_item Count $count
      $tv tag remove new_item $new_item
    }
    if {$count == 0} {
      $tv set $item Direction {}
      $tv set $item Location {}
      $tv set $item Tm1 {}
      $tv set $item Tm2 {}
      $tv set $item MM {}
    }
    $tv tag remove new_primer $item
  }

  $infotext delete 1.0 end
  $infotext insert end [mc "Searched %s primers."  $number ]
  $infotext configure -state disabled

  pcr_dialog_set_dist $tv $temp_info(template_window)
  pcr_dialog_filter $tv $template
  #sputs finished $old_break
  unset pcr_break
}

############
##
#############
proc pcr_dialog_scan_test {tv {d 1}} {
  global pcr_break
  if {$d} {after 100 pcr_dialog_scan_test $tv 0; sputs returning; return}
  set target [expr {[clock milliseconds] + 100}]
  sputs setting break
  if {[info exists pcr_break]} {
    set pcr_break [expr {$pcr_break +1}]
    sputs exists
  } else {
    set pcr_break 0
    sputs doesn't exist
  }
  set old_break $pcr_break
  sputs starting $old_break
  for {set i 0} {$i < 1000000} {incr i} {
    if {[clock milliseconds] > $target} {
      #sputs $pcr_break $old_break $i
      update
      set target [expr {[clock milliseconds] + 100}]
    }
    if {![info exists pcr_break] || $pcr_break != $old_break} {sputs break $old_break;update;return}
    font metrics dnafont
  }
  sputs finished $old_break
  unset pcr_break
}
############
##
#############
proc pcr_dialog_precompute {w circular} {
  global temp_info


  set dna_list [split [set dna [string toupper [textarea_get $w.textarea 1.0 end]]] {}]
  foreach dir {0 1} {

    set dict_1 [dict create]
    set dict_2 [dict create]
    set dict_3 [dict create]
    set dict_4 [dict create]
    foreach a {A C G T} {
      dict set dict_1 $a {}
      foreach b {A C G T} {  
        dict set dict_2 "$a$b" {}
        foreach c {A C G T} {
          dict set dict_3 "$a$b$c" {}
          foreach d {A C G T} {  
            dict set dict_4 "$a$b$c$d" {}
          }
        }
      }
    }
    set two "00"
    set three "000"
    set four "0000"

    if {$dir} {
      set dna_list [split [revcom $dna] {}]
    }
    set i 0
    foreach char $dna_list {
      dict lappend dict_1 $char $i
      append four $char
      set four [string range $four 1 end]

      dict lappend dict_4 $four [expr {$i -3}]
      dict lappend dict_3 [string range $four 1 end] [expr {$i -2}]
      dict lappend dict_2 [string range $four 2 end] [expr {$i -1}]
      incr i
    }
    if {$circular} {
      append four [lindex $dna_list 0]
      set four [string range $four 1 end]
      dict lappend dict_4 $four [expr {$i -3}]
      dict lappend dict_3 [string range $four 1 end] [expr {$i -2}]
      dict lappend dict_2 [string range $four 2 end] [expr {$i -1}]
      incr i
      append four [lindex $dna_list 1]
      set four [string range $four 1 end]
      dict lappend dict_4 $four [expr {$i -3}]
      dict lappend dict_3 [string range $four 1 end] [expr {$i -2}]
      incr i
      append four [lindex $dna_list 2]
      set four [string range $four 1 end]
      dict lappend dict_4 $four [expr {$i -3}]
      lappend dna_list {*}[lrange $dna_list 0 199]
    }

    if {$dir} {
      set temp_info(precompute_dict_r,$w) [list $dict_1 $dict_2 $dict_3 $dict_4]
      set temp_info(precompute_dna_r,$w) $dna_list
    } else {
      set temp_info(precompute_dict_f,$w) [list $dict_1 $dict_2 $dict_3 $dict_4]
      set temp_info(precompute_dna_f,$w) $dna_list
    }
  }
}

############
##
#############
proc pcr_dialog_filter {tv template} {
  global temp_info
  foreach item [$tv children detached] {
    $tv move $item {} end
  }
  foreach item [$tv children {}] {
    switch $temp_info(pcr_show) {
      0 {
        ## unique in template
        if {[$tv set $item Count] != 1} {
          $tv move $item detached end
        }
      }
      1 {
       ## Anywhere in Template
        if {[$tv set $item Count] == 0} {
          $tv move $item detached end
        }
      }
      2 {
       ## Unique in Template Selection
        if {[$tv set $item Count] != 1} {
          $tv move $item detached end
        }
      }
      3 {
       ## Unique outside Template Selection
        if {[$tv set $item Count] != 1} {
          $tv move $item detached end
        }
      }
      4 {
       ## Show all
      }
    }
  }
  $tv selection remove [$tv children detached]
  treeview_sort $tv [bind $tv <<Sort_column>>] 1

}

############
##
#############
proc pcr_dialog_set_dist {tv w} {
  global info temp_info
  
  set template $temp_info(template_window)
  if {$w ne $template} {return}
  set length [ix2bp $template.textarea end]
  set is_circular [expr {$info($template,circular) eq "circular"}]
  foreach item [concat [$tv children {}] [$tv children detached]] {
    if {[$tv set $item Location] == {}} {
      $tv set $item Dist {}
      continue
    }
    if {[$tv set $item Direction] eq "<<<"} {
      if {[$template.textarea tag ranges sel] !={}} {
        set dist [expr {[$tv set $item Location] - [ix2bp $template.textarea sel.last]}]
      } else {
        set dist [expr {[$tv set $item Location] - [ix2bp $template.textarea insert]}]
      }
    } else {
      if {[$template.textarea tag ranges sel] !={}} {
        set dist [expr {[ix2bp $template.textarea sel.first] - [$tv set $item Location]}]
      } else {
        set dist [expr {[ix2bp $template.textarea insert] - [$tv set $item Location]}]
      }
    }
    if {$is_circular} {
      set dist [expr {$dist % $length}]
    }
    $tv set $item Dist $dist
  }
  treeview_sort $tv [bind $tv <<Sort_column>>] 1
}

############
##
#############
proc pcr_dialog_change_template_window {tv} {
  global temp_info info

  $tv tag remove rev_primer
  $tv tag remove fwd_primer 
  #$tv selection remove [$tv children {}]
  set infotext "[winfo toplevel $tv].infoframe.text"; $infotext configure -state normal; $infotext delete 1.0 end; ; $infotext configure -state disabled

  #trace remove variable info($temp_info(old_template_window),insert_loc) write "pcr_dialog_set_dist $tv $temp_info(old_template_window);#"
  #trace add variable info($temp_info(template_window),insert_loc) write "pcr_dialog_set_dist $tv $temp_info(template_window);#"

  set temp_info(old_template_window) $temp_info(template_window)
  pcr_dialog_scan $tv
  pcr_dialog_draw_map_features "[winfo toplevel $tv].mapframe.c"
}


############
## Restriction- Ligation Wizard dialog
#############
proc re_cloning_wizard_dialog {w} {
  global temp_info dialogblock info

  if {$dialogblock == 1} {return}
  set s [new_dialog $w "Restriction-Ligation Assembler..." "NEW DNA"]
  bind $s <<Cancel>> "dialog_cancel $s"
  bind $s <<OK>> "re_cloning_wizard_generate_product; if {!\$info(ligation_wizard_keep_open)} {event generate $s <<Cancel>>} "
  wm resizable $s 0 0

  grid columnconfigure $s 1 -weight 1

  grid [frame $s.win_frame0] -row 1 -column 1 -sticky nswe

  grid [frame $s.win_frame0.left -relief ridge -bd 3] -row 1 -column 1 -sticky nswe
  grid [label $s.win_frame0.left.m_l -textvariable temp_info(left_enz_text,0)] -row 1 -column 1 -sticky w
  grid [menubutton $s.win_frame0.left.m_lp -textvariable temp_info(left_process_text,0) -menu $s.win_frame0.left.m_lp.menu] -row 1 -column 2 -sticky w
  menu $s.win_frame0.left.m_lp.menu -postcommand "re_cloning_wizard_fill_process_menu $s 0 0 $s.win_frame0.left.m_lp.menu"
    
  grid [frame $s.win_frame0.seq -relief ridge -bd 3] -row 1 -column 2 -sticky nswe
  grid [menubutton $s.win_frame0.seq.w -textvariable temp_info(window_text,0) -menu $s.win_frame0.seq.w.menu] -row 1 -column 1 -sticky we
  menu $s.win_frame0.seq.w.menu -postcommand "re_cloning_wizard_fill_window_menu $s 0 $s.win_frame0.seq.w.menu"
  grid [checkbutton $s.win_frame0.seq.rev_com -text [mc "Rev-Com"] -variable temp_info(revcom,0) -command "re_cloning_wizard_update $s" ] -row 1 -column 2 -sticky w
  #grid [button $s.win_frame0.seq.opposite -text "^v"] -row 1 -column 3 -sticky w

  grid [frame $s.win_frame0.right -relief ridge -bd 3] -row 1 -column 3 -sticky nswe
  grid [label $s.win_frame0.right.m_r -textvariable temp_info(right_enz_text,0)] -row 1 -column 1 -sticky w
  grid [menubutton $s.win_frame0.right.m_rp -textvariable temp_info(right_process_text,0) -menu $s.win_frame0.right.m_rp.menu] -row 1 -column 2 -sticky w
  menu $s.win_frame0.right.m_rp.menu -postcommand "re_cloning_wizard_fill_process_menu $s 0 1 $s.win_frame0.right.m_rp.menu"
    
  grid [canvas $s.win_frame0.canvas0 -highlightthickness 0  -bg $info(text_bg_color) -height 60] -row 2 -column 0 -columnspan 4 -sticky new
  $s.win_frame0.canvas0 create text 0 0 -text "" -anchor w -font dnafont -fill $info(graphic_fg_color) -tags [list sequence_right]
  $s.win_frame0.canvas0 create text 0 0 -text ""  -anchor w -font dnafont -fill $info(graphic_fg_color) -tags [list sequence_left]
  $s.win_frame0.canvas0 create line 0 0 0 0 -width 4 -smooth raw -splinesteps 20 -tags [list line_left]
  $s.win_frame0.canvas0 create line 0 0 0 0 -width 4 -smooth raw -splinesteps 20 -tags [list line_right]
  grid columnconfigure  $s.win_frame0 2 -weight 1
  grid columnconfigure  $s.win_frame0.seq 1 -weight 1
  register_data_receiver $s.win_frame0 <<GelLaneClick>> "re_cloning_wizard_gel_lane_click $s"
  bind $s.win_frame0 <<GelLaneDrop>> "sputs drop %d; re_cloning_wizard_gel_lane_drop %d $s 0 "
  bind $s.win_frame0.seq.w <<GelLaneDrop>> "sputs drop %d; re_cloning_wizard_gel_lane_drop %d $s 0 "
  bind $s.win_frame0.canvas0 <<GelLaneDrop>> "sputs drop %d; re_cloning_wizard_gel_lane_drop %d $s 0"
  ####
  grid [frame $s.win_frame1] -row 2 -column 1 -sticky nswe

  grid [canvas $s.win_frame1.canvasleft -highlightthickness 0 -bg $info(text_bg_color) -height 0 -width 30] -row 1  -rowspan 2 -column 0 -sticky nsw
  $s.win_frame1.canvasleft create line 0 0 0 0 -width 4 -tags [list line_left]
  $s.win_frame1.canvasleft create line 0 0 0 0 -width 4 -tags [list line_right]

  grid [canvas $s.win_frame1.sep -highlightthickness 0 -bg $info(text_bg_color) -height 5] -row 1 -column 1 -columnspan 3  -sticky nwe

  grid [frame $s.win_frame1.left -relief ridge -bd 3] -row 2 -column 1 -sticky nswe
  grid [label $s.win_frame1.left.m_l -textvariable temp_info(left_enz_text,1)] -row 1 -column 1 -sticky w
  grid [menubutton $s.win_frame1.left.m_lp -textvariable temp_info(left_process_text,1) -menu $s.win_frame1.left.m_lp.menu] -row 1 -column 2 -sticky w
  menu $s.win_frame1.left.m_lp.menu -postcommand "re_cloning_wizard_fill_process_menu $s 1 0 $s.win_frame1.left.m_lp.menu"

  grid [frame $s.win_frame1.seq -relief ridge -bd 3] -row 2 -column 2 -sticky nswe
  grid [menubutton $s.win_frame1.seq.w -textvariable temp_info(window_text,1)  -menu $s.win_frame1.seq.w.menu] -row 1 -column 1 -sticky we
  menu $s.win_frame1.seq.w.menu -postcommand "re_cloning_wizard_fill_window_menu $s 1 $s.win_frame1.seq.w.menu"
  grid [checkbutton $s.win_frame1.seq.rev_com -text [mc "Rev-Com"] -variable temp_info(revcom,1) -command "re_cloning_wizard_update $s" ] -row 1 -column 2 -sticky w
  #grid [button $s.win_frame1.seq.opposite -text "^v"] -row 1 -column 3 -sticky w

  grid [frame $s.win_frame1.right -relief ridge -bd 3] -row 2 -column 3 -sticky nswe
  grid [label $s.win_frame1.right.m_r -textvariable temp_info(right_enz_text,1)] -row 1 -column 1 -sticky w
  grid [menubutton $s.win_frame1.right.m_rp -textvariable temp_info(right_process_text,1) -menu $s.win_frame1.right.m_rp.menu] -row 1 -column 2 -sticky w
  menu $s.win_frame1.right.m_rp.menu -postcommand "re_cloning_wizard_fill_process_menu $s 1 1 $s.win_frame1.right.m_rp.menu"

  grid [canvas $s.win_frame1.canvas0 -highlightthickness 0 -bg $info(text_bg_color) -height 60] -row 3 -column 0 -columnspan 4 -sticky new
  $s.win_frame1.canvas0 create text 30 30 -text "" -anchor w -font dnafont -fill $info(graphic_fg_color) -tags [list sequence_right]
  $s.win_frame1.canvas0 create text 70 30 -text ""  -anchor w -font dnafont -fill $info(graphic_fg_color) -tags [list sequence_left]
  $s.win_frame1.canvas0 create line 0 0 0 0 -width 4 -smooth raw -splinesteps 20 -tags [list line_left]
  $s.win_frame1.canvas0 create line 0 0 0 0 -width 4 -smooth raw -splinesteps 20 -tags [list line_right]
  $s.win_frame1.canvas0 create line 0 0 0 0 -width 4 -tags [list line_vert]
  grid columnconfigure  $s.win_frame1 2 -weight 1
  grid columnconfigure  $s.win_frame1.seq 1 -weight 1
  bind $s.win_frame1 <<GelLaneDrop>> "re_cloning_wizard_gel_lane_drop %d $s 1 "
  bind $s.win_frame1.seq.w <<GelLaneDrop>> "re_cloning_wizard_gel_lane_drop %d $s 1 "
  bind $s.win_frame1.canvas0 <<GelLaneDrop>> "re_cloning_wizard_gel_lane_drop %d $s 1"
  
  ####
  grid [frame $s.win_frame2] -row 3 -column 1 -sticky nswe

  grid [canvas $s.win_frame2.canvasleft -highlightthickness 0 -bg $info(text_bg_color) -height 0 -width 30] -row 1 -rowspan 2 -column 0 -sticky nsw
  $s.win_frame2.canvasleft create line 0 0 0 0 -width 4 -tags [list line_left]
  $s.win_frame2.canvasleft create line 0 0 0 0 -width 4 -tags [list line_right]

  grid [canvas $s.win_frame2.sep -highlightthickness 0 -bg $info(text_bg_color) -height 5  ] -row 1 -column 1 -columnspan 3 -sticky nwe

  grid [frame $s.win_frame2.left -relief ridge -bd 3] -row 2 -column 1 -sticky nswe
  grid [label $s.win_frame2.left.m_l -textvariable temp_info(left_enz_text,2)] -row 1 -column 1 -sticky w
  grid [menubutton $s.win_frame2.left.m_lp -textvariable temp_info(left_process_text,2) -menu $s.win_frame2.left.m_lp.menu] -row 1 -column 2 -sticky w
  menu $s.win_frame2.left.m_lp.menu -postcommand "re_cloning_wizard_fill_process_menu $s 2 0 $s.win_frame2.left.m_lp.menu"


  grid [frame $s.win_frame2.seq -relief ridge -bd 3] -row 2 -column 2 -sticky nswe
  grid [menubutton $s.win_frame2.seq.w -textvariable temp_info(window_text,2) -menu $s.win_frame2.seq.w.menu] -row 1 -column 1 -sticky we
  menu $s.win_frame2.seq.w.menu -postcommand "re_cloning_wizard_fill_window_menu $s 2 $s.win_frame2.seq.w.menu"
  grid [checkbutton $s.win_frame2.seq.rev_com -text [mc "Rev-Com"] -variable temp_info(revcom,2) -command "re_cloning_wizard_update $s" ] -row 1 -column 2 -sticky w
  #grid [button $s.win_frame2.seq.opposite -text "^v"] -row 1 -column 3 -sticky w

  grid [frame $s.win_frame2.right -relief ridge -bd 3] -row 2 -column 3 -sticky nswe
  grid [label $s.win_frame2.right.m_r -textvariable temp_info(right_enz_text,2)] -row 1 -column 1 -sticky w
  grid [menubutton $s.win_frame2.right.m_rp -textvariable temp_info(right_process_text,2) -menu $s.win_frame2.right.m_rp.menu] -row 1 -column 2 -sticky w
  menu $s.win_frame2.right.m_rp.menu -postcommand "re_cloning_wizard_fill_process_menu $s 2 1 $s.win_frame2.right.m_rp.menu"

  grid [canvas $s.win_frame2.canvas0 -highlightthickness 0 -bg $info(text_bg_color) -height 60] -row 3 -column 0 -columnspan 4 -sticky new
  $s.win_frame2.canvas0 create text 0 0 -text "" -anchor w -font dnafont -fill $info(graphic_fg_color) -tags [list sequence_right]
  $s.win_frame2.canvas0 create text 0 0 -text ""  -anchor w -font dnafont -fill $info(graphic_fg_color) -tags [list sequence_left]
  $s.win_frame2.canvas0 create line 0 0 0 0 -width 4 -smooth raw -splinesteps 20 -tags [list line_left]
  $s.win_frame2.canvas0 create line 0 0 0 0 -width 4 -smooth raw -splinesteps 20 -tags [list line_right]
  $s.win_frame2.canvas0 create line 0 0 0 0 -width 4 -tags [list line_vert]
  grid columnconfigure  $s.win_frame2 2 -weight 1
  grid columnconfigure  $s.win_frame2.seq 1 -weight 1
  bind $s.win_frame2 <<GelLaneDrop>> "re_cloning_wizard_gel_lane_drop %d $s 2 "
  bind $s.win_frame2.seq.w <<GelLaneDrop>> "re_cloning_wizard_gel_lane_drop %d $s 2 "
  bind $s.win_frame2.canvas0 <<GelLaneDrop>> "re_cloning_wizard_gel_lane_drop %d $s 2"

  grid [frame $s.okframe] -row 4 -column 1 -sticky nswe
  grid [button $s.okframe.cancel -text [mc "Cancel"] -command "event generate $s <<Cancel>>"] -row 1 -column 0 -sticky nw -padx 10 -pady 3
  grid [button $s.okframe.ok -text [mc "OK"] -command "event generate $s <<OK>>" -default active] -row 1 -column 1 -sticky nw -padx 10 -pady 3
  grid [checkbutton $s.okframe.keep_open -text [mc "Keep Ligation Dialog Open"] -variable info(ligation_wizard_keep_open)] -row 2 -column 0 -columnspan 2 -sticky w

    
  set temp_info(color_list) [list red blue violet]

  re_cloning_wizard_intitialize $s 0 ""
  re_cloning_wizard_intitialize $s 1 ""
  re_cloning_wizard_intitialize $s 2 ""
  re_cloning_wizard_update $s
}

############
## Draw round rectangles
#############
proc round_rect {x1 y1 x2 y2 r} {
  #$canvas create polygon {*}[round_rect 100 50 200 100 20] -smooth raw -splinesteps 20 -fill {} -outline black
  set k [expr {$r*4.0/3*(sqrt(2)-1)}]
  set res [list [expr {$x1+$r}] $y1 ]
  lappend res [expr {$x2-$r}] $y1 [expr {$x1+$r}] $y1 [expr {$x2-$r}] $y1
  lappend res [expr {$x2-$r+$k}] $y1 $x2 [expr {$y1+$r-$k}] $x2 [expr {$y1+$r}]
  lappend res $x2 [expr {$y2-$r}] $x2 [expr {$y1+$r}] $x2 [expr {$y2-$r}] 
  lappend res $x2 [expr {$y2-$r+$k}] [expr {$x2-$r+$k}] $y2 [expr {$x2-$r}] $y2 
  lappend res [expr {$x1+$r}] $y2 [expr {$x2-$r}] $y2 [expr {$x1+$r}] $y2 
  lappend res [expr {$x1+$r-$k}] $y2 $x1 [expr {$y2-$r+$k}] $x1 [expr {$y2-$r}]
  lappend res  $x1 [expr {$y1+$r}] $x1 [expr {$y2-$r}] $x1 [expr {$y1+$r}] 
  lappend res $x1 [expr {$y1+$r-$k}] [expr {$x1+$r-$k}] $y1 [expr {$x1+$r}] $y1 
  lappend res [expr {$x1+$r}] $y1 

  return $res
}


############
## Restriction- Ligation Wizard darw rounded curves in the ligation canvas
#############
proc round_curve {type x1 x2 x3 x4 x5 y1 y2 y3 r} {
  set k [expr {$r*4.0/3*(sqrt(2)-1)}]
  switch $type {
    0 {
    ## right side, single fragment
      set res [list [expr {$x4+$r}] $y1 [expr {$x5-$r}] $y1 [expr {$x4+$r}] $y1 [expr {$x5-$r}] $y1 [expr {$x5-$r+$k}] $y1]
      lappend res $x5 [expr {$y1+$r-$k}] $x5 [expr {$y1+$r}] $x5 [expr {$y2-$r}] $x5 [expr {$y1+$r}] $x5 [expr {$y2-$r}] $x5 [expr {$y2-$r+$k}]
      lappend res [expr {$x5-$r+$k}] $y2 [expr {$x5-$r}] $y2 [expr {$x1+$r}] $y2 [expr {$x5-$r}] $y2 [expr {$x1+$r}] $y2 [expr {$x1+$r-$k}] $y2
      lappend res $x1 [expr {$y2-$r+$k}] $x1 [expr {$y2-$r}] $x1 [expr {$y1+$r}] $x1 [expr {$y2-$r}] $x1 [expr {$y1+$r}] $x1 [expr {$y1+$r-$k}] [expr {$x1+$r-$k}] $y1
      lappend res [expr {$x1+$r}] $y1 [expr {$x3}] $y1 [expr {$x1+$r}] $y1 [expr {$x3}] $y1
    }
    1 {
    ## right side, non-last of more than one fragment
      set res [list [expr {$x4+$r}] $y1 [expr {$x5-$r}] $y1 [expr {$x4+$r}] $y1 [expr {$x5-$r}] $y1 [expr {$x5-$r+$k}] $y1]
      lappend res $x5 [expr {$y1+$r-$k}] $x5 [expr {$y1+$r}] $x5 [expr {$y2-$r}] $x5 [expr {$y1+$r}] $x5 [expr {$y2-$r}] $x5 [expr {$y2-$r+$k}]
      lappend res [expr {$x5-$r+$k}] $y2 [expr {$x5-$r}] $y2 [expr {$x2+$r}] $y2 [expr {$x2-$r}] $y2 [expr {$x2+$r}] $y2 [expr {$x2+$r-$k}] $y2
      lappend res $x2 [expr {$y2+$r-$k}] $x2 [expr {$y2+$r}] $x2 $y3 $x2 [expr {$y2+$r}] $x2 $y3
    }
    2 {
    ## right side, last of more than one
      set res [list [expr {$x4+$r}] $y1 [expr {$x5-$r}] $y1 [expr {$x4+$r}] $y1 [expr {$x5-$r}] $y1 [expr {$x5-$r+$k}] $y1]
      lappend res $x5 [expr {$y1+$r-$k}] $x5 [expr {$y1+$r}] $x5 [expr {$y2-$r}] $x5 [expr {$y1+$r}] $x5 [expr {$y2-$r}] $x5 [expr {$y2-$r+$k}]
      lappend res [expr {$x5-$r+$k}] $y2 [expr {$x5-$r}] $y2 [expr {$x1+$r}] $y2 [expr {$x5-$r}] $y2 [expr {$x1+$r}] $y2 [expr {$x1+$r-$k}] $y2
      lappend res $x1 [expr {$y2-$r+$k}] $x1 [expr {$y2-$r}] $x1 0 $x1 [expr {$y2-$r}] $x1 0

    }
    3 {
    ## left side, first of more than one
      set res [list $x1 [expr {$y3}] $x1 [expr {$y1+$r}] $x1 [expr {$y3}] $x1 [expr {$y1+$r}] $x1 [expr {$y1+$r-$k}] [expr {$x1+$r-$k}] $y1]
      lappend res [expr {$x1+$r}] $y1 [expr {$x3}] $y1 [expr {$x1+$r}] $y1 [expr {$x3}] $y1
    }
    4 {
    ## left side, non-first of more than one
      set res [list $x2 [expr {0}] $x2 [expr {$y1-$r}] $x2 [expr {0}] $x2 [expr {$y1-$r}] $x2 [expr {$y1-$r+$k}] [expr {$x2+$r-$k}] $y1]
      lappend res [expr {$x2+$r}] $y1 [expr {$x3}] $y1 [expr {$x2+$r}] $y1 [expr {$x3}] $y1
    }
    5 {
    ## continuity, non-first non-last of more than one
      set res [list $x1 [expr {0}] $x1 [expr {$y3}] $x1 [expr {0}] $x1 [expr {$y3}]]
    }
  }
  return $res
}

############
## Restriction- Ligation Wizard update the interface when anything is changed
#############
proc re_cloning_wizard_update {s} {
  global temp_info update_block
  foreach {color0 color1 color2} $temp_info(color_list) {}
 
  if {$temp_info(window,0) == {}} {
    grid remove $s.win_frame1
    grid remove $s.win_frame2
    grid remove $s.win_frame0.canvas0
  } else {
    grid configure $s.win_frame0.canvas0
    if {$temp_info(window,1) == {}} {
      ## one fragment ligation
      grid remove $s.win_frame1.canvas0
      grid configure $s.win_frame1
      grid remove $s.win_frame2
    } else {
      grid configure $s.win_frame1
      grid configure $s.win_frame1.canvas0
      if {$temp_info(window,2) == {}} {
        ## two fragment ligation
        grid remove $s.win_frame2.canvas0
	grid configure $s.win_frame2
      } else {
        ## three fragment ligation
	grid configure $s.win_frame2
	grid configure $s.win_frame2.canvas0
      }
    }
  }

  for {set i 0} {$i < 3} {incr i} {
      if {$temp_info(left_process_text,$i) == {}} {
      $s.win_frame$i.left.m_lp configure -state disabled
      $s.win_frame$i.right.m_rp configure -state disabled
    } else {
      $s.win_frame$i.left.m_lp configure -state -normal
      $s.win_frame$i.right.m_rp configure -state normal
    }
  }
  update idletasks
  

  if {$temp_info(window,0) == {}} {
  } else {
    foreach {x1 x2 x3} {10 20 30} {}
    set x4 [expr {[winfo width $s.win_frame0.canvas0] -20}]
    set x5 [expr {$x4 +10}]
    set y1 [expr {int([font metrics dnafont -linespace] * 1.5)  + 15}]
    set y3 [expr {$y1 *2}]
    $s.win_frame0.canvas0 configure -height $y3
    $s.win_frame1.canvas0 configure -height $y3
    $s.win_frame2.canvas0 configure -height $y3
    set y2 [expr {$y3 - 7}]
    if {$temp_info(window,1) == {}} {
      ## one fragment ligation
      if {!$temp_info(revcom,0)} {
        set right_text [re_cloning_wizard_site_text 0 1 0]
        set left_text [re_cloning_wizard_site_text 0 0 0]
      } else {
        set right_text [re_cloning_wizard_site_text 0 0 1]
        set left_text [re_cloning_wizard_site_text 0 1 1]
      }
      $s.win_frame0.canvas0 itemconfigure sequence_right -fill $color0 -text $right_text
      $s.win_frame0.canvas0 coords sequence_right $x3 $y1
      foreach {xr1 yr1 xr2 yr2} [$s.win_frame0.canvas0 bbox sequence_right] {}
      $s.win_frame0.canvas0 itemconfigure sequence_left -fill $color0 -text $left_text
      $s.win_frame0.canvas0 coords sequence_left [expr {4 + $xr2}] $y1   
      foreach {xl1 yl1 xl2 yl2} [$s.win_frame0.canvas0 bbox sequence_left] {}
      $s.win_frame0.canvas0 coords line_right {*}[round_curve 0 $x1 $x2 $x3 $x4 $x5 $y1 $y2 $y3 5]
      $s.win_frame0.canvas0 itemconfigure line_right -fill $color0
      $s.win_frame0.canvas0 itemconfigure line_left -state hidden
      re_cloning_wizard_draw_map_features $s.win_frame0.canvas0 0 [expr {8 + $xl2}] $x4 $y1
      
      $s.win_frame1.canvasleft itemconfigure line_left -state hidden
      $s.win_frame1.canvasleft itemconfigure line_right -state hidden
    } else {
      if {$temp_info(window,2) == {}} {
        ## two fragment ligation
	if {!$temp_info(revcom,1)} {
          set right_text [re_cloning_wizard_site_text 1 1 0]
        } else {
          set right_text [re_cloning_wizard_site_text 1 0 1]
        }
        $s.win_frame0.canvas0 itemconfigure sequence_right -fill $color1 -text $right_text
        $s.win_frame0.canvas0 coords sequence_right $x3 $y1
        foreach {xr1 yr1 xr2 yr2} [$s.win_frame0.canvas0 bbox sequence_right] {}
        if {!$temp_info(revcom,0)} {
          set left_text [re_cloning_wizard_site_text 0 0 0]
        } else {
          set left_text [re_cloning_wizard_site_text 0 1 1]
        }
        $s.win_frame0.canvas0 itemconfigure sequence_left -fill $color0 -text $left_text
        $s.win_frame0.canvas0 coords sequence_left [expr {4 + $xr2}] $y1   
        foreach {xl1 yl1 xl2 yl2} [$s.win_frame0.canvas0 bbox sequence_left] {}
        $s.win_frame0.canvas0 coords line_right {*}[round_curve 1 $x1 $x2 $x3 $x4 $x5 $y1 $y2 $y3 5]
        $s.win_frame0.canvas0 itemconfigure line_right -fill $color0
        $s.win_frame0.canvas0 coords line_left {*}[round_curve 3 $x1 $x2 $x3 $x4 $x5 $y1 $y2 $y3 5]
        $s.win_frame0.canvas0 itemconfigure line_left -state normal -fill $color1
        if {!$temp_info(revcom,0)} {
          set right_text [re_cloning_wizard_site_text 0 1 0]
        } else {
          set right_text [re_cloning_wizard_site_text 0 0 1]
        }
        re_cloning_wizard_draw_map_features $s.win_frame0.canvas0 0 [expr {8 + $xl2}] $x4 $y1
        $s.win_frame1.canvas0 itemconfigure sequence_right -fill $color0 -text $right_text
        $s.win_frame1.canvas0 coords sequence_right $x3 $y1
        foreach {xr1 yr1 xr2 yr2} [$s.win_frame1.canvas0 bbox sequence_right] {}
	if {!$temp_info(revcom,1)} {
          set left_text [re_cloning_wizard_site_text 1 0 0]
        } else {
          set left_text [re_cloning_wizard_site_text 1 1 1]
        }
        $s.win_frame1.canvas0 itemconfigure sequence_left -fill $color1 -text $left_text
        $s.win_frame1.canvas0 coords sequence_left [expr {4 + $xr2}] $y1   
        foreach {xl1 yl1 xl2 yl2} [$s.win_frame0.canvas0 bbox sequence_left] {}
        $s.win_frame1.canvas0 coords line_right {*}[round_curve 2 $x1 $x2 $x3 $x4 $x5 $y1 $y2 $y3 5]
        $s.win_frame1.canvas0 itemconfigure line_right -fill $color1
        $s.win_frame1.canvas0 coords line_left {*}[round_curve 4 $x1 $x2 $x3 $x4 $x5 $y1 $y2 $y3 5]
        $s.win_frame1.canvas0 itemconfigure line_left -state normal -fill $color0
        $s.win_frame1.canvas0 itemconfigure line_vert -state hidden
        re_cloning_wizard_draw_map_features $s.win_frame1.canvas0 1 [expr {8 + $xl2}] $x4 $y1
	set h [winfo height $s.win_frame1.canvasleft]
	$s.win_frame1.canvasleft coords line_left $x1 0 $x1 $h
	$s.win_frame1.canvasleft itemconfigure line_left -fill $color1 -state normal
	$s.win_frame1.canvasleft coords line_right $x2 0 $x2 $h
	$s.win_frame1.canvasleft itemconfigure line_right -fill $color0 -state normal
	
	$s.win_frame2.canvasleft itemconfigure line_left -state hidden
	$s.win_frame2.canvasleft itemconfigure line_right -state hidden
      } else {
	  ## three fragment ligation
        if {!$temp_info(revcom,2)} {
          set right_text [re_cloning_wizard_site_text 2 1 0]
        } else {
          set right_text [re_cloning_wizard_site_text 2 0 1]
        }
        $s.win_frame0.canvas0 itemconfigure sequence_right -fill $color2 -text $right_text
        $s.win_frame0.canvas0 coords sequence_right $x3 $y1
        foreach {xr1 yr1 xr2 yr2} [$s.win_frame0.canvas0 bbox sequence_right] {}
	if {!$temp_info(revcom,0)} {
          set left_text [re_cloning_wizard_site_text 0 0 0]
        } else {
          set left_text [re_cloning_wizard_site_text 0 1 1]
        }
        $s.win_frame0.canvas0 itemconfigure sequence_left -fill $color0 -text $left_text
        $s.win_frame0.canvas0 coords sequence_left [expr {4 + $xr2}] $y1   
        foreach {xl1 yl1 xl2 yl2} [$s.win_frame0.canvas0 bbox sequence_left] {}
        $s.win_frame0.canvas0 coords line_right {*}[round_curve 1 $x1 $x2 $x3 $x4 $x5 $y1 $y2 $y3 5]
        $s.win_frame0.canvas0 itemconfigure line_right -fill $color0
        $s.win_frame0.canvas0 coords line_left {*}[round_curve 3 $x1 $x2 $x3 $x4 $x5 $y1 $y2 $y3 5]
        $s.win_frame0.canvas0 itemconfigure line_left -state normal -fill $color2

        if {!$temp_info(revcom,0)} {
          set right_text [re_cloning_wizard_site_text 0 1 0]
        } else {
          set right_text [re_cloning_wizard_site_text 0 0 1]
        }
        re_cloning_wizard_draw_map_features $s.win_frame0.canvas0 0 [expr {8 + $xl2}] $x4 $y1
        $s.win_frame1.canvas0 itemconfigure sequence_right -fill $color0 -text $right_text
        $s.win_frame1.canvas0 coords sequence_right $x3 $y1
        foreach {xr1 yr1 xr2 yr2} [$s.win_frame1.canvas0 bbox sequence_right] {}
	if {!$temp_info(revcom,1)} {
          set left_text [re_cloning_wizard_site_text 1 0 0]
        } else {
          set left_text [re_cloning_wizard_site_text 1 1 1]
        }
        $s.win_frame1.canvas0 itemconfigure sequence_left -fill $color1 -text $left_text
        $s.win_frame1.canvas0 coords sequence_left [expr {4 + $xr2}] $y1   
        foreach {xl1 yl1 xl2 yl2} [$s.win_frame1.canvas0 bbox sequence_left] {}
        $s.win_frame1.canvas0 coords line_right {*}[round_curve 1 $x1 $x2 $x3 $x4 $x5 $y1 $y2 $y3 5]
        $s.win_frame1.canvas0 itemconfigure line_right -fill $color1
        $s.win_frame1.canvas0 coords line_left {*}[round_curve 4 $x1 $x2 $x3 $x4 $x5 $y1 $y2 $y3 5]
        $s.win_frame1.canvas0 itemconfigure line_left -state normal -fill $color0
	$s.win_frame1.canvas0 coords line_vert $x1 0 $x1 $y3
        $s.win_frame1.canvas0 itemconfigure line_vert -state normal -fill $color2
        re_cloning_wizard_draw_map_features $s.win_frame1.canvas0 1 [expr {8 + $xl2}] $x4 $y1
	set h [winfo height $s.win_frame1.canvasleft]
	$s.win_frame1.canvasleft coords line_left $x1 0 $x1 $h
	$s.win_frame1.canvasleft itemconfigure line_left -fill $color2 -state normal
	$s.win_frame1.canvasleft coords line_right $x2 0 $x2 $h
	$s.win_frame1.canvasleft itemconfigure line_right -fill $color0  -state normal
        if {!$temp_info(revcom,1)} {
          set right_text [re_cloning_wizard_site_text 1 1 0]
        } else {
          set right_text [re_cloning_wizard_site_text 1 0 1]
        }
        $s.win_frame2.canvas0 itemconfigure sequence_right -fill $color1 -text $right_text
        $s.win_frame2.canvas0 coords sequence_right $x3 $y1
        foreach {xr1 yr1 xr2 yr2} [$s.win_frame2.canvas0 bbox sequence_right] {}
	if {!$temp_info(revcom,2)} {
          set left_text [re_cloning_wizard_site_text 2 0 0]
        } else {
          set left_text [re_cloning_wizard_site_text 2 1 1]
        }
        $s.win_frame2.canvas0 itemconfigure sequence_left -fill $color2 -text $left_text
        $s.win_frame2.canvas0 coords sequence_left [expr {4 + $xl2}] $y1   
        foreach {xl1 yl1 xl2 yl2} [$s.win_frame2.canvas0 bbox sequence_left] {}
        $s.win_frame2.canvas0 coords line_right {*}[round_curve 2 $x1 $x2 $x3 $x4 $x5 $y1 $y2 $y3 5]
        $s.win_frame2.canvas0 itemconfigure line_right -fill $color2
        $s.win_frame2.canvas0 coords line_left {*}[round_curve 4 $x1 $x2 $x3 $x4 $x5 $y1 $y2 $y3 5]
        $s.win_frame2.canvas0 itemconfigure line_left -state normal -fill $color1
        re_cloning_wizard_draw_map_features $s.win_frame2.canvas0 2 [expr {8 + $xl2}] $x4 $y1
        set h [winfo height $s.win_frame2.canvasleft]
	$s.win_frame2.canvasleft coords line_left $x1 0 $x1 $h
	$s.win_frame2.canvasleft itemconfigure line_left -fill $color2 -state normal
	$s.win_frame2.canvasleft coords line_right $x2 0 $x2 $h
	$s.win_frame2.canvasleft itemconfigure line_right -fill $color1 -state normal
      }
    }
    
  }
  # validate
  if {$temp_info(window,0) != {}} {
    set valid 1
      foreach i [list 0 1 2] {
      if {$temp_info(window,$i) != {}} {
	  set j [expr {($i+1) % 3}]
	  if {$temp_info(window,$j) == {}} {
	      set j 0
	  }
        if {$temp_info(revcom,$i)} {
          if {$temp_info(revcom,$j)} {
	      if {$temp_info(left_overhang_seq,$i) ne $temp_info(right_overhang_seq,$j) || $temp_info(left_overhang_dir,$i) != $temp_info(right_overhang_dir,$j) } {
              set valid 0
	      break
	    }
          } elseif {[revcom $temp_info(left_overhang_seq,$i)] ne $temp_info(left_overhang_seq,$j) || $temp_info(left_overhang_dir,$i) != $temp_info(left_overhang_dir,$j)} {
            set valid 0
            break
          }
        } elseif {$temp_info(revcom,$j)} {
	    if {$temp_info(right_overhang_seq,$i) ne [revcom $temp_info(right_overhang_seq,$j)] || $temp_info(right_overhang_dir,$i) != $temp_info(right_overhang_dir,$j) } {
            set valid 0
            break
          }
        } elseif {$temp_info(right_overhang_seq,$i) ne  $temp_info(left_overhang_seq,$j) || $temp_info(right_overhang_dir,$i) != $temp_info(left_overhang_dir,$j)} {
          set valid 0
          break
        }
      }
    }
  } else {
    set valid 0
  }
  if {$valid} {
    $s.okframe.ok configure -state normal -text [mc "OK"]
  } else {
    $s.okframe.ok configure -state disabled -text [mc "Can't Ligate"]
  }
}

############
## Restriction- Ligation Wizard draw map features in each canvas
#############
proc re_cloning_wizard_draw_map_features {c i x1 x2 y} {
  global temp_info info

  set w $temp_info(window,$i)
  $c delete map
  $c delete infobox
  set len [ix2bp $w.textarea end]
  if {$len ==0} {return}
  set dir $temp_info(revcom,$i)
  set first  $temp_info(left_process_top,$i)
  set last [expr {$temp_info(right_process_top,$i) % ($len+1)}]
  set line_width 5
  set c_width [expr {$x2 - $x1}]
  set c_scale [expr {1.0 * ($c_width) /(($last-$first-1) % ($len) +1)}]
  set maxy 0
  #$c create rectangle $x1 $y $x2 [expr {$y +6}] -outline black -fill {} -tags [list map frame]
  foreach {tag data} [get_tags2 $w.textarea $first $last $dir] {
    if {![regexp {f[0-9]+#} $tag]} {
      continue
    }
    set fill [lindex $data 1 0]
    if {$fill eq ""} {continue}
      foreach {fstart fend} [lindex $data 0] {
        set line [$c create line [expr {$x1 +  $fstart * $c_scale}]  $y [expr {$x1 + $fend * $c_scale}] $y -tags {map feature} -fill $fill -width $line_width]
	  $c bind $line <Any-Enter> "$c itemconf infobox -text \{[lindex $data 3 0 0]\}"
	$c bind $line  <Any-Leave> "$c itemconf infobox -text {}"
      set k 0
      while {[llength [$c find overlapping {*}[$c coords $line]]] > 1 && $k<6} {
        $c move $line 0 $line_width
        incr k
      }
    }
  }
  $c create text $x1 [expr {$y-5}] -anchor sw  -fill $info(graphic_fg_color) -tags {infobox map}
}

############
## Restriction- Ligation Wizard make the canvas text for each restriction site overhang, calculates the sequence start and end points and overhangs
#############
proc re_cloning_wizard_site_text {i right_side revcom} {
  global enzinfo temp_info
  #toplevel .t
    #bind .t <<GelLaneDrop>> "sputs \[dict get %d canvas\] \[dict get %d band\] \[\[dict get %d canvas\] bind \[dict get %d band\] <<Link>>\] "
  if {$right_side} {
    set w $temp_info(window,$i) 
    set top $temp_info(right_enz_top,$i)
    set bottom $temp_info(right_enz_bottom,$i)
    set enz $temp_info(right_enz_text,$i)
    if {$temp_info(right_process_text,$i) eq "Same"} {
      if {[regexp {[ACGT] Overhang} $temp_info(left_process_text,$i)] && $temp_info(right_enz_top,$i) != $temp_info(right_enz_bottom,$i)} {
        set process_text "None"
      } else {
        set process_text $temp_info(left_process_text,$i)
      }
    } else {
      set process_text $temp_info(right_process_text,$i)
    }
    set process_top $top
    set process_bottom $bottom
    set process_ext ""
      switch $process_text {
      "None" {}
      "T4/ Klenow Fill+Exo" {
        set process_top $bottom
      }
      "Mung Bean Exo" {
        set process_top [expr {min($bottom, $top)}]
        set process_bottom $process_top
      }
      "A Overhang" {
        set process_ext "A"
      }
      "T Overhang" {
        set process_ext "T"
      }
      "C Overhang" {
        set process_ext "C"
      }
      "G Overhang" {
        set process_ext "G"
      }
      default {sputs "untrapped process:$process_text"}
    }
    set temp_info(right_process_top,$i) $process_top
    set temp_info(right_process_bottom,$i) $process_bottom
    set temp_info(right_process_ext,$i) $process_ext
  } else {
    set w $temp_info(window,$i) 
    set top $temp_info(left_enz_top,$i)
    set bottom $temp_info(left_enz_bottom,$i)
    set enz $temp_info(left_enz_text,$i)
    set process_top $top
    set process_bottom $bottom
    set process_ext ""
    switch $temp_info(left_process_text,$i) {
      "None" {}
      "T4/ Klenow Fill+Exo" {
        set process_bottom $top
      }
      "Mung Bean Exo" {
        set process_top [expr {max($bottom, $top)}]
        set process_bottom $process_top
      }
      "A Overhang" {
        set process_ext "A"
      }
      "T Overhang" {
        set process_ext "T"
      }
      "C Overhang" {
        set process_ext "C"
      }
      "G Overhang" {
        set process_ext "G"
      }
      default {sputs "untrapped process:$temp_info(left_process_text,$i)"}
    }
    set temp_info(left_process_top,$i) $process_top
    set temp_info(left_process_bottom,$i) $process_bottom
    set temp_info(left_process_ext,$i) $process_ext
  }
  set text [textarea_get $w.textarea 1.0 end]
  append text [string range $text 0 100]
    
  if {$right_side} {
    ## right side site
    set left [expr {min($top-3,$bottom-3)}]
    if {$process_top > $process_bottom} {
      set temp_info(right_overhang_seq,$i) [string range $text $process_bottom $process_top-1]
      set temp_info(right_overhang_dir,$i) 3
    } elseif {$process_top == $process_bottom} {
      set temp_info(right_overhang_seq,$i) $process_ext
	set temp_info(right_overhang_dir,$i) [expr {$process_ext =={} ? 0: 3}]
    } else {
      set temp_info(right_overhang_seq,$i) [string range $text $process_top $process_bottom-1]
      set temp_info(right_overhang_dir,$i) 5
    }
    set temp_info(right_overhang_seq,$i) [string toupper $temp_info(right_overhang_seq,$i)]
    set top_line [string range $text $left $process_top-1]
    set top_line "$top_line$process_ext[string repeat " " [expr {$process_bottom-$process_top}]]"
    set bottom_line [string range $text $left $process_bottom-1]
    set bottom_line "$bottom_line[string repeat " " [expr {$process_top-$process_bottom+[string length $process_ext]}]]"
    set bottom_line [com $bottom_line]
    if {!$revcom} {
      return "$enz\n$top_line\n$bottom_line"
    } else {
      return "$enz\n[rev $bottom_line]\n[rev $top_line]"
    }
  } else {
    set right [expr {max($top+2,$bottom+2)}]
    if {$process_top > $process_bottom} {
      set temp_info(left_overhang_seq,$i) [string range $text $process_bottom $process_top-1]
      set temp_info(left_overhang_dir,$i) 3
    } elseif {$process_top == $process_bottom} {
      set temp_info(left_overhang_seq,$i) [com $process_ext]
      set temp_info(left_overhang_dir,$i) [expr {$process_ext =={} ? 0: 3}]
    } else {
      set temp_info(left_overhang_seq,$i) [string range $text $process_top $process_bottom-1]
      set temp_info(left_overhang_dir,$i) 5
    }
    set temp_info(left_overhang_seq,$i) [string toupper $temp_info(left_overhang_seq,$i)] 
    
    set top_line [string range $text $process_top $right]
    set top_line "[string repeat " " [expr {$process_top-$process_bottom+[string length $process_ext]}]]$top_line"
    set bottom_line [string range $text $process_bottom $right]
    set bottom_line [com $bottom_line]
    set bottom_line "[string repeat " " [expr {$process_bottom-$process_top}]]$process_ext$bottom_line"
    if {!$revcom} {
      return "$enz\n$top_line\n$bottom_line"
     } else {
      return "$enz\n[rev $bottom_line]\n[rev $top_line]"
    }
  }
}

############
## Restriction- Ligation Wizard process gel lane drops into the menubutton
#############
proc re_cloning_wizard_gel_lane_drop {data s i} {
  global temp_info info

  if {![winfo exists $s]} {
    return
  }

  set canvas [dict get $data canvas]
  set band [dict get $data band]
  set link_data [$canvas bind $band <<Link>>]
  if {$link_data == {}} {return}
  foreach {window from_top to_top from_bottom to_bottom enz1 e1d enz2 e2d} $link_data {}
    if {$from_top == -1 && $enz1 eq "uncut"} {tk_messageBox -message [mc "Uncut plasmid can't be used in a cloning reaction."] -type ok;return}
  set temp_info(left_enz_text,$i) $enz1
  set temp_info(left_process_text,$i) "None"
  set temp_info(right_enz_text,$i) $enz2
  set temp_info(right_process_text,$i) "Same"
  set temp_info(window,$i) $window
  set temp_info(left_enz_top,$i) $from_top
  set temp_info(left_enz_bottom,$i) $from_bottom
  set temp_info(right_enz_top,$i) $to_top
  set temp_info(right_enz_bottom,$i) $to_bottom
  set temp_info(revcom,$i) 0
  set temp_info(window_text,$i) [wm title $window]
  re_cloning_wizard_update $s
}

############
## Restriction- Ligation Wizard process gel lane clicks- assign band data to the next emty window
#############
proc re_cloning_wizard_gel_lane_click {s args} {
  global temp_info info

  if {![winfo exists $s]} {
    return
  }
  for {set i 0} {$i <2 && $temp_info(window,$i) !={}} {incr i} {}
  set link_data $args
  if {$link_data == {}} {return}
  foreach {window from_top to_top from_bottom to_bottom enz1 e1d enz2 e2d} $link_data {}
    if {$from_top == -1 && $enz1 eq "uncut"} {tk_messageBox -message [mc "Uncut plasmid can't be used in a cloning reaction."] -type ok;return}
  set temp_info(left_enz_text,$i) $enz1
  set temp_info(left_process_text,$i) "None"
  set temp_info(right_enz_text,$i) $enz2
  set temp_info(right_process_text,$i) "Same"
  set temp_info(window,$i) $window
  set temp_info(left_enz_top,$i) $from_top
  set temp_info(left_enz_bottom,$i) $from_bottom
  set temp_info(right_enz_top,$i) $to_top
  set temp_info(right_enz_bottom,$i) $to_bottom
  set temp_info(revcom,$i) 0
  set temp_info(window_text,$i) [wm title $window]
  re_cloning_wizard_update $s
}


############
## Restriction- Ligation Wizard fill menubutton menu to show currently available linear sequences
#############
proc re_cloning_wizard_fill_window_menu {s i m} {
    global info temp_info
    $m delete 0 end

  foreach window [dnawindows_list] {
    if {$info($window,circular) eq "linear"} {
      $m add radiobutton -label [wm title $window] -variable temp_info(window,$i) -value $window -command "re_cloning_wizard_intitialize $s $i $window; re_cloning_wizard_update $s"
    }
  }
  if {[$m index end] == "" || [$m index end] == "none"} {
      $m add command -label [mc "No Linear Windows Found."] -state disabled
  }
  if {[info exists temp_info(window,$i)] && $temp_info(window,$i) ne {}} {
    $m add command -label [mc "Delete this fragment"] -command "re_cloning_wizard_delete $s $i"
  }
}

############
## Restriction- Ligation Wizard fill process menubutton depending on if the end is blunt
#############
proc re_cloning_wizard_fill_process_menu {s i right m} {
  global info temp_info
    
  $m delete 0 end
  set side left
  if {$right} {
    $m add radiobutton -label [mc "Same"] -variable temp_info(right_process_text,$i) -value "Same" -command "re_cloning_wizard_update $s"
    set side right
  }
    
  if {$temp_info($side\_enz_top,$i) == $temp_info($side\_enz_bottom,$i)} {
    $m add radiobutton -label [mc "None"] -variable temp_info($side\_process_text,$i) -value "None" -command "re_cloning_wizard_update $s"
    $m add radiobutton -label [mc "A Overhang"] -variable temp_info($side\_process_text,$i) -value "A Overhang" -command "re_cloning_wizard_update $s"
    $m add radiobutton -label [mc "T Overhang"] -variable temp_info($side\_process_text,$i) -value "T Overhang" -command "re_cloning_wizard_update $s"
    $m add radiobutton -label [mc "C Overhang"] -variable temp_info($side\_process_text,$i) -value "C Overhang" -command "re_cloning_wizard_update $s"
    $m add radiobutton -label [mc "G Overhang"] -variable temp_info($side\_process_text,$i) -value "G Overhang" -command "re_cloning_wizard_update $s"
  } else {
    $m add radiobutton -label [mc "None"] -variable temp_info($side\_process_text,$i) -value "None" -command "re_cloning_wizard_update $s"
    $m add radiobutton -label [mc "T4/ Klenow Fill+Exo"] -variable temp_info($side\_process_text,$i) -value "T4/ Klenow Fill+Exo" -command "re_cloning_wizard_update $s"
    $m add radiobutton -label [mc "Mung Bean Exo"] -variable temp_info($side\_process_text,$i) -value "Mung Bean Exo" -command "re_cloning_wizard_update $s"
  }
}

############
## Restriction- Ligation Wizard initialize all variables for a fragment
#############
proc re_cloning_wizard_intitialize {s i w} {
  global temp_info

  set temp_info(window,$i) $w
  set temp_info(left_enz_top,$i) 0
  set temp_info(left_enz_bottom,$i) 0
  set temp_info(revcom,$i) 0
  if {[winfo exists $w]} {
    set temp_info(left_enz_text,$i) "end"
    set temp_info(left_process_text,$i) "None"
    set temp_info(right_enz_text,$i) "end"
    set temp_info(right_process_text,$i) "Same"
    set temp_info(right_enz_top,$i) [ix2bp $w.textarea end]
    set temp_info(right_enz_bottom,$i) $temp_info(right_enz_top,$i)
    set temp_info(window_text,$i) [wm title $w]
  } else {
    set temp_info(left_enz_text,$i) ""
    set temp_info(left_process_text,$i) ""
    set temp_info(right_enz_text,$i) ""
    set temp_info(right_process_text,$i) ""
    set temp_info(right_enz_top,$i) 0
    set temp_info(right_enz_bottom,$i) 0
    set temp_info(window_text,$i) "Click a Gel Band, or Select a Window...."
  }
}

############
## Restriction- Ligation Wizard delete a fragment
#############
proc re_cloning_wizard_delete {s i} {
  global temp_info
  for {set j $i} {$j < 2} {incr j} {
    set k [expr {$j+1}]
    set temp_info(left_enz_text,$j) $temp_info(left_enz_text,$k)
    set temp_info(left_process_text,$j) $temp_info(left_process_text,$k)
    set temp_info(right_enz_text,$j) $temp_info(right_enz_text,$k)
    set temp_info(right_process_text,$j) $temp_info(right_process_text,$k)
    set temp_info(window,$j) $temp_info(window,$k)
    set temp_info(left_enz_top,$j) $temp_info(left_enz_top,$k)
    set temp_info(left_enz_bottom,$j) $temp_info(left_enz_bottom,$k)
    set temp_info(revcom,$j) $temp_info(revcom,$k)
    set temp_info(right_enz_top,$j) $temp_info(right_enz_top,$k)
    set temp_info(right_enz_bottom,$j) $temp_info(right_enz_bottom,$k)
    set temp_info(window_text,$j) $temp_info(window_text,$k)
  }
  re_cloning_wizard_intitialize $s 2 ""
  re_cloning_wizard_update $s
}

############
## Restriction- Ligation Wizard generate final product
#############
proc re_cloning_wizard_generate_product {} {
  global enzinfo  temp_info

  set dna ""
  set tags [list]
  set filecomment "Ligation reaction:\n"

  set text_0 ""
  for {set i 0} {[info exists temp_info(window,$i)] && ($temp_info(window,$i) ne "") && ($i < 20)} {incr i} {
    set w $temp_info(window,$i)
    set text [textarea_get $w.textarea 1.0 end]
    set len [string length $text]
    set dir $temp_info(revcom,$i)
    set first_enz $temp_info(left_enz_text,$i)
    if {$dir} {
      set first $temp_info(left_process_bottom,$i)
    } else {
      set first $temp_info(left_process_top,$i)
    }
    if {$temp_info(left_process_text,$i) ne "None"} {
      set first_enz "$first_enz,$temp_info(left_process_text,$i)"
    }
    set first_ext $temp_info(left_process_ext,$i)
    set last_enz $temp_info(right_enz_text,$i)
    if {$temp_info(right_process_text,$i) ne "None"} {
      if {$temp_info(right_process_text,$i) ne "Same"} {
	set last_enz "$last_enz,$temp_info(right_process_text,$i)"
      } elseif {$temp_info(left_process_text,$i) ne "None"} {
        set first_enz "$first_enz,$temp_info(left_process_text,$i)"
      }
    }
    if {$dir} {
      set last [expr {$temp_info(right_process_bottom,$i) % ($len)}]
    } else {
      set last [expr {$temp_info(right_process_top,$i) % ($len)}]
    }
    incr last -1
    set last_ext $temp_info(right_process_ext,$i)

    if {$dir} {
      append filecomment "[file rootname [wm title $w]] from $last ($last_enz) to $first ($first_enz)\n"
    } else {
      append filecomment "[file rootname [wm title $w]] from $first ($first_enz) to $last ($last_enz)\n"
    }
    set end [string length $dna]

    if {$first < $last} {
      if {$dir} {
	append dna [revcom [string range $text $first $last]] $first_ext
      } else {
	  append dna [string range $text $first $last] $last_ext
      }
    } elseif {$i > 0} {
      if {$dir} {
	append dna  [revcom [string range $text 0 $last]] [revcom [string range $text $first end]]  $first_ext
      } else {
	append dna [string range $text $first end]  [string range $text 0 $last] $last_ext
      }
    } else {
      if {$dir} {
        append dna  [revcom [string range $text $first end]]  $first_ext
        set new_tags [get_tags2 $w.textarea $first [string length $text] $dir $end]
        set text_0 [revcom [string range $text 0 $last]]
        set tags_0 [get_tags2 $w.textarea 0 [expr {$last +1}] $dir 0]
      } else {
	append dna  [string range $text 0 $last] $last_ext
	set new_tags [get_tags2 $w.textarea 0 [expr {$last+1}] $dir $end]
        set text_0 [string range $text $first end]
	set tags_0 [get_tags2 $w.textarea $first [string length $text] $dir 0]
      }
    }

	
    if {$i > 0 || $text_0 ==""} {
      set new_tags [get_tags2 $w.textarea $first [expr {$last+1}] $dir $end]
    }
		
    lappend_tags tags {*}$new_tags
  }

  if {$text_0 ne ""} {
    set end_0 [string length $dna]
    append dna $text_0
    set end [string length $dna]
    set new_tags2 [list]
    foreach {tag data} $tags_0 {
      set newcoords [list]  
      foreach {a b} [lindex $data 0] {
	set a [expr {$a +$end_0}]
        set b [expr {$b +$end_0}]
        if {$b <= $end} {
          lappend newcoords $a $b
        } elseif {$a >= $end} {
          lappend newcoords [expr {$a-$end}] [expr {$b-$end}]
        } elseif {$b > $end} {
          lappend newcoords $a [expr {$end}]
          lappend newcoords 0 [expr {$b-$end}]
        } 
      }
      if {$newcoords != [list]} {
        lset data 0 $newcoords
        lappend new_tags2 $tag $data
      }
    }
    lappend_tags tags {*}$new_tags2
  }

  create_window $dna "" $filecomment "circular" 1 0 New_Ligation $tags {} GenBank
}





############
##  Use precompute to speed up
#############
proc search_with_mm3 {s w dir circular} {
  global temp_info

  set minimum_match $temp_info(pcr_min_match)
  if {[string length $s] < $minimum_match} {return [list]}

  set degenerate_primer [regexp {[^ACGT]} $s]

  set mm_allowed $temp_info(pcr_max_mm)

  if {$mm_allowed > 0} {
    set minimum_match_3 $temp_info(pcr_min_3_match)
  } else {
    set minimum_match_3 4
  }

  set s_list [split $s {}]

  set result [list]
  incr minimum_match -1

  if {$degenerate_primer} {
    set s_list [string map {B BYSKCGT D DRWKAGT H HMWYACT K KGT M MAC N NBDHVKMRYWSACGT R RAG S SGC V VMSRACG W WAT Y YCT} $s_list]
  }

  if {$minimum_match_3 == 0 || $degenerate_primer} {
   ## linear search required for 3' mm possible
    if {$dir} {
      set dna_list $temp_info(precompute_dna_r,$w)
    } else {
      set dna_list $temp_info(precompute_dna_f,$w)
    }
    for {set i 0} {$i <= [expr {$circular ? [llength $dna_list] - 200 : [llength $dna_list] - [llength $s_list]}] } {incr i} {
      set mm 0
      set j 0
      if {$degenerate_primer} {
        foreach c_primer $s_list c_template [lrange $dna_list $i [expr {$i+ [llength $s_list] -1}]] {
          if {[string first $c_template $c_primer] == -1} {
            incr mm
          }
          if {$mm > $mm_allowed} {incr mm -1; break}
          incr j
        }
      } else {
        foreach c_primer $s_list  c_template [lrange $dna_list $i [expr {$i+ [llength $s_list] -1}]] {
          if {$c_primer ne $c_template} {incr mm}
          if {$mm > $mm_allowed} {incr mm -1; break}
          incr j
        }
      }
      if {$j >= $minimum_match} {
        while {[lindex $s_list $j] ne [lindex $dna_list [expr {$i +$j}]]} {
          incr j -1
        }
        lappend result [list $i $j $mm]
      }
    }
  } else {
    ## Can use precomputed sites if 3' end has to match at least 1 base
    if {$dir} {
      set precompute_list [lindex $temp_info(precompute_dict_r,$w) [expr {$minimum_match_3 -1}]]
      set dna_list $temp_info(precompute_dna_r,$w)
    } else {
      set precompute_list [lindex $temp_info(precompute_dict_f,$w) [expr {$minimum_match_3 -1}]]
      set dna_list $temp_info(precompute_dna_f,$w)
    }

    foreach i [dict get $precompute_list [string range $s 0 [expr {$minimum_match_3 -1}]]] {
      set mm 0
      set j [expr {$minimum_match_3 - 1}]
      foreach c_primer [lrange $s_list $minimum_match_3 end]  c_template [lrange $dna_list [expr {$i + $minimum_match_3}] [expr {$i+ [llength $s_list] -1}]] {
        if {$c_primer ne $c_template} {incr mm}
        if {$mm > $mm_allowed} {incr mm -1; break}
        incr j
      }
      if {$j >= $minimum_match} {
        while {[lindex $s_list $j] ne [lindex $dna_list [expr {$i +$j}]]} {
          incr j -1
        }
        incr j
        lappend result [list $i $j $mm]
      }
    }
  }

  return $result
}


################
## Create features from FASTA sequences
################
proc multi_search_dialog {w} { 
  global ok info dialogblock ms_select_window allow_mm_number reverse_color forward_color feature_type genbank_divided_typelist

  if {$dialogblock == 1 || [file_lock_check $w 0]} {return}

  set s [new_dialog $w "FASTA Multi-Search..."]
  bind $s <<Cancel>> "set ok -1"
  bind $s  <<OK>> "set ok 1"
  set ok 0

  grid [frame $s.winframe] -row 0 -column 0 -sticky nswe
  grid [label $s.winframe.label -text [mc "Search Sequence:"]] -row 0 -column 0 -sticky wns
  grid [menubutton $s.winframe.win_button -text [wm title $w]] -row 0 -column 1 -sticky wns
  menu $s.winframe.win_button.menu 
  foreach window [dnawindows_list 1] {
    $s.winframe.win_button.menu add radiobutton -command "$s.winframe.win_button configure -text [wm title $window]" -label [wm title $window] -variable ms_select_window -value $window 
  }
  set ms_select_window $w
  $s.winframe.win_button configure -menu $s.winframe.win_button.menu 

  grid [frame $s.seqframe] -row 1 -column 0 -sticky nswe
  grid [button $s.seqframe.file_button -text [mc "Load FASTA File"] -command "multi_search_dialog_load_fasta $s.seqframe.filename $s.okframe.ok"] -row 0 -column 0 -sticky nsew
  grid [label $s.seqframe.filename] -row 0 -column 1 -sticky nsew
  if {[file exists $info(fasta_search_file)]} {
    $s.seqframe.filename configure -text $info(fasta_search_file)
  }

  grid [frame $s.featureframe] -row 2 -column 0 -sticky nswe
  grid [label $s.featureframe.mm_label -text [mc "Allow mismatches:"]] -row 0 -column 0 -sticky ne
  grid [menubutton $s.featureframe.mm_button -menu $s.featureframe.mm_button.menu -textvariable allow_mm_number] -row 0 -column 1 -sticky ne
  menu $s.featureframe.mm_button.menu
  for {set mma 0} {$mma <26} {incr mma} {
    $s.featureframe.mm_button.menu add radiobutton -label $mma -variable allow_mm_number -value $mma
  }
  set allow_mm_number 0

  grid [frame $s.colorframe] -row 3 -column 0 -sticky nswe
  set forward_color pink
  set reverse_color pink
  set feature_type misc_feature
  grid [label $s.colorframe.colorf_label -text [mc "Forward Color:"]] -row 1 -column 0 -sticky ne
  grid [color_button $s.colorframe.colorf forward_color ] -row 1 -column 1 -sticky nw
  grid [label $s.colorframe.colorr_label -text [mc "Reverse Color:"]] -row 2 -column 0 -sticky ne
  grid [color_button $s.colorframe.colorr reverse_color ] -row 2 -column 1 -sticky nw
  grid [ttk::menubutton $s.colorframe.type -menu $s.colorframe.type.menu -textvariable feature_type  -width 15] -row 3 -column 0 -columnspan 2 -sticky nw

  menu $s.colorframe.type.menu
  foreach {header types} $genbank_divided_typelist {
    $s.colorframe.type.menu add cascade -label $header -menu [menu $s.colorframe.type.menu.[string tolower $header]]
    foreach type $types {
      if {[string index $type 0] eq "-"} {set typelabel " $type"} else {set typelabel $type}
      $s.colorframe.type.menu.[string tolower $header] add radiobutton -label $typelabel -variable feature_type -value $type
    }
  }

  grid [frame $s.okframe] -row 4 -column 0 -sticky nswe
  grid [button $s.okframe.cancel -text [mc "Cancel"] -command "set ok -1"] -row 1 -column 0 -sticky nw -padx 10 -pady 3
  grid [button $s.okframe.ok -text [mc "OK"] -command "set ok 1" -default active -state disabled] -row 1 -column 1 -sticky nw -padx 10 -pady 3

  vwait ok



  if {$ok == 1} {
    set filename [$s.seqframe.filename cget -text]
    multi_search $ms_select_window $filename $allow_mm_number [list $forward_color $reverse_color]  $feature_type $s
      destroy .dialog
  } else {
      destroy .dialog
  }
  set dialogblock 0
  bind . <<RaiseDialogs>> ""
  unset -nocomplain ok allow_mm_number ms_select_window  reverse_color forward_color feature_type
}

################
## Check multi-search FASTA file for validity
################
proc multi_search_dialog_load_fasta {filename_label ok_button} {

  set f [tk_getOpenFile -title [mc "open FASTA Search File"] -filetypes {{{FASTA Files} {.fa .fasta}} {{Text Files} {.txt}} {{All Files} *}}]
  if {$f =={} || [catch {open $f r} fileid] || [catch {read $fileid} fastatext]} {
    $filename_label configure -text ""
    $ok_button configure -state disabled
    return
  }

  if {[set count [regexp -all {>([^\n]+)\n([abcdghkmnrstvwyABCDGHKMNRSTVWY]+)\n+} $fastatext]] < 0} {
    tk_messageBox -message [mc "This is not a FASTA formatted file"] -type ok
    $filename_label configure -text ""
    $ok_button configure -state disabled
    return
  } else {
    tk_messageBox -message [mc "Read %s search patterns from the file." $count] -type ok
    $filename_label configure -text $f
    $ok_button configure -state active
  }
}



################
## Execute multi-search
################
proc multi_search {w {f ""} {mm_allowed 3} {color_list {pink pink}} {feature_type misc_feature} {s {}}} {
  global info fea_info ok text

  if {$f == {}} {
    set f [tk_getOpenFile -title [mc "open FASTA Search File"] -filetypes {{{FASTA Files} {.fa .fasta}} {{Text Files} {.txt}} {{All Files} *}}]
  }
  if {![catch {open $f r} fileid]} {
    catch {read $fileid} fastatext
    catch {close $fileid}
  }
  set info(fasta_search_file) $f
  set fastatext "$fastatext\n"
  set fasta_list [regexp -all -inline {>([^\n]+)\n([abcdghkmnrstvwyABCDGHKMNRSTVWY]+)\n+}  $fastatext]
  if {[llength $fasta_list] > 0} {
    if {$s =={}} {
      set a [toplevel .multi_search]
      grid [ttk::progressbar $a.prog -orient horizontal -mode determinate -maximum [expr {[llength $fasta_list]/3}] -value 1] -row 1 -column 1 -sticky nwe
      grid columnconfigure $a 1 -weight 1
    } else {
      set a $s
      foreach child [winfo children $s] {
        if {$child != "$s.okframe"} {destroy $child}
      }
      $s.okframe.ok configure -state disabled
      grid [ttk::progressbar $s.prog -orient horizontal -mode determinate -maximum [expr {[llength $fasta_list]/3}] -value 1] -row 1 -column 0 -sticky nwe
    }
    update idletasks
    set text [textarea_get $w.textarea 1.0 [end_ix $w.textarea]]
    set text_length [string length $text]
    set text [string toupper $text]
    set text_list [split $text ""]
    set found 0
    set rec 1
    set update_rate 1
    set time1 [clock milliseconds]
    foreach {ignore title seq} $fasta_list {
      if {[expr {$rec% $update_rate}] == 0} {
        if {$ok == -1 || ![winfo exists $a.prog]} {break} 
        $a.prog configure -value $rec
        if {$found} {features_to_tree_view $w; set found 0}
        update idletasks
        set time2 [clock milliseconds]
        if {$time2 > $time1} {
          set update_rate [expr {min (300, max(1, int($update_rate*500/($time2-$time1))))}]
        } else {
          set update_rate 1
       } 
        set time1 $time2
      }
      incr rec
      set seq [string toupper $seq]
      regsub -all U $seq T seq
      regsub -all {[^ACGTBDHKMNRSVWY]} $seq "" seq
      if {[regexp {[BDHKMNRSVWY]} $seq]} {
        set degen 1
      } else {
        set degen 0
      }
      for {set direction 0} {$direction < 2} {incr direction} {
        if {$direction} {
          set seq [revcom $seq]
        }
        if {$degen} {
          set s_list [split $seq ""]
          set seq_list [string map {B BYSKCGT D DRWKAGT H HMWYACT K KGT M MAC N NBDHVKMRYWSACGT R RAG S SGC V VMSRACG W WAT Y YCT b byskcgt d drwkagt h hmwyact k kgt m mac n nbdhvkmrywsacgt r rag s sgc v vmsracg w wat y yct} $s_list]
        }
        for {set i 0} {$i <= [expr {[string length $text] - [string length $seq]}]} {incr i} {
          set mm 0
          set mm_list [list]
          for {set j 0} {$j < [string length $seq]} {incr j} {
            if {$degen} {
              if {[string first [lindex $text_list [expr {$i+$j}]] [lindex $seq_list $j]] ==-1} {
                incr mm
                lappend mm_list $j
                if {$mm > $mm_allowed} break
              }
            } else {
              if {[string index $text [expr {$i+$j}]] ne [string index $seq $j]} {
                incr mm
                lappend mm_list $j
                if {$mm > $mm_allowed} break
              }
            }
          }
          if {$mm <= $mm_allowed} {
            set found 1
            set tagname "f$fea_info($w,count)#"
            textarea_tag_create $w.textarea $tagname
            set region [list $i [expr {$i+[string length $seq]}]]
            if {[lindex $region 1] <= $text_length} {
              textarea_tag_add $w.textarea $tagname [bp2ix $w.textarea [lindex $region 0]] [bp2ix $w.textarea [expr {[lindex $region 1]}]]
            } else {
              if {[lindex $region 0] <= $text_length} {
                textarea_tag_add $w.textarea $tagname [bp2ix $w.textarea [lindex $region 0]] [end_ix $w.textarea]
                textarea_tag_add $w.textarea $tagname 1.0 [bp2ix $w.textarea [expr {[lindex $region 1]-$text_length}]]
              } else {
                textarea_tag_add $w.textarea $tagname [bp2ix $w.textarea [expr {[lindex $region 0]-$text_length-1}]] [bp2ix $w.textarea [expr {[lindex $region 1]-$text_length}]]
              }
            }
            textarea_tag_bind $w.textarea  $tagname <<Revcolors>> $color_list
            #<<Metadata>>:(0)name, (1)format_info, (2)type, (3)fwd/rev, (4)annotations_string (qualifiers data)
            if {[catch {set gformatlist [dict get $info(feature_default_type_gformat) $feature_type]}]} {
              set gformatlist $info(feature_default_gformat)
            }
            set metadata [list $title $gformatlist $feature_type [expr {$direction}] {}]
            textarea_tag_bind $w.textarea  $tagname <<Metadata>> $metadata
            textarea_tag_configure $w.textarea  $tagname -background [lindex $color_list $direction]
            if {$mm > 0} {
              textarea_tag_create $w.textarea "fn$fea_info($w,count)#"
              textarea_tag_add $w.textarea  "fn$fea_info($w,count)#" [bp2ix $w.textarea [lindex $region 0]] [bp2ix $w.textarea [expr {[lindex $region 1]}]]
              foreach j $mm_list {
                textarea_tag_remove $w.textarea   $tagname [bp2ix $w.textarea [expr {$i+$j}]] [bp2ix $w.textarea [expr {1+$i+$j}]]
              }
            }
            incr fea_info($w,count)
          }
        }
      }
    }
    if {[winfo exists .multi_search]} {destroy .multi_search}
    features_to_tree_view $w
  }
}



################
## dCAPS dialog
################
  ## todo: ask for Tm of primer and trim suggested primer to that.
  # ask to scan only selected enzyms
  # ask to scan for only forward/rev or only wt/mut
  # sort based on 3' most mismatch, regardless of number of mismatches?
  # get pre and post texts when circular
proc dcaps_dialog {w} {
  global info modifier dialogblock 
  global ok mut2_text max_mm

  if {$dialogblock == 1} {return}

 
  if {[$w.textarea tag ranges sel] != {}} {
    if {[llength [$w.textarea tag ranges sel]] > 2 || [string length [set mut_text [textarea_get $w.textarea sel.first sel.last]]] > 1} {
#selection used here - ok
      tk_messageBox -message [mc "dCAPS tool requires a single character selected."] -type ok
      return
    } else {
      set mut_index [$w.textarea index sel.first]
#selection used here - ok
    }
  } else {
    set mut_index [$w.textarea index insert]
    set mut_text [textarea_get $w.textarea $mut_index $mut_index+1char]
  }
  if {$mut_text ni [list A C G T a c g t]} {
    tk_messageBox -message [mc "dCAPS tool requires the selected character be A, C, G or T."] -type ok
    return
  }

  set a [new_dialog $w "dCAPS Calculator..." "ANALYZE"]
  bind $a <<Cancel>> "set ok -1"
  bind $a <<OK>> "set ok 1"
  set ok 0


  set pre_text [textarea_get $w.textarea $mut_index-27char $mut_index]
  set pre_text [string range $pre_text end-24 end]
  set post_text [textarea_get $w.textarea $mut_index+1char $mut_index+28char]
  set post_text [string range $post_text 0 24]
  grid [frame $a.typeframe -relief ridge -borderwidth 2] -row 1 -column 1 -sticky nswe
  grid [label $a.typeframe.prelabel -text $pre_text] -row 1 -column 1 -sticky ne
  grid [label $a.typeframe.mutlabel -text $mut_text] -row 1 -column 2 -sticky n
  grid [label $a.typeframe.postlabel -text $post_text] -row 1 -column 3 -sticky nw
  grid [label $a.typeframe.mut2label -text [mc "Alternate allele:"]] -row 2 -column 1 -sticky ne
  grid [menubutton $a.typeframe.menubutton -textvariable mut2_text -menu $a.typeframe.menubutton.menu -indicator on -relief raised] -row 2 -column 2 -sticky n
  menu $a.typeframe.menubutton.menu
  foreach nt [list A C G T] {
    if {[string toupper $mut_text] ne $nt} {
      $a.typeframe.menubutton.menu add radiobutton -label $nt -variable mut2_text -value $nt
    }
  }
  if {[string toupper $mut_text] == "A"} {set mut2_text "C"} else {set mut2_text "A"}

  grid [label $a.typeframe.mmlabel -text [mc "Maximum mismatch:"]] -row 3 -column 1 -sticky ne
  grid [menubutton $a.typeframe.menubutton2 -textvariable max_mm -menu $a.typeframe.menubutton2.menu -indicator on -relief raised] -row 3 -column 2 -sticky nw
  menu $a.typeframe.menubutton2.menu
  foreach nt [list 0 1 2 3 4 5] {
    $a.typeframe.menubutton2.menu add radiobutton -label $nt -variable max_mm -value $nt
  }
  set max_mm 0


  grid [frame $a.okframe] -row 3 -column 1 -sticky nswe
  grid [button $a.okframe.cancel -text [mc "Cancel"] -command "set ok -1"] -row 1 -column 0 -sticky nw -padx 10 -pady 3
  grid [button $a.okframe.ok -text [mc "OK"] -command "set ok 1" -default active] -row 1 -column 1 -sticky nw -padx 10 -pady 3

  vwait ok
  set dialogblock 0
  destroy $a
  bind . <<RaiseDialogs>> ""

  if {$ok == -1} {unset mut2_text max_mm; return}
  set title [mc "dCAPS"]
  set a [new_analysis_window $w $title list_enzymes]
  create_textframe $a 120
    
  catch {$a.textframe.text insert end "[clock format [clock seconds] -format $info(clock_format)]\n"}
  $a.textframe.text insert end "[wm title $w] \n"
  $a.textframe.text insert end "$pre_text\("
  $a.textframe.text insert end "$mut_text\/$mut2_text" red
  $a.textframe.text tag configure red -foreground red -font bolddnafont
  $a.textframe.text tag configure mismatch -foreground green -font dnafont
  $a.textframe.text insert end ")$post_text\n\n"

  set separator 0
#fwd, wt cut
  set reslist [lsort -command dcaps_sort [dcaps $pre_text $mut_text $mut2_text $post_text $max_mm]]
  $a.textframe.text insert end "Forward primer, wild-type cut\n"
  foreach r $reslist {
    foreach {enz offset mmlist flatpat} $r {}
    $a.textframe.text insert end "[string repeat { } 15]$pre_text" [list] $mut_text red 
    foreach mm $mmlist {
      $a.textframe.text tag add mismatch end-[expr {$mm+3}]\char end-[expr {$mm+2}]char
    }
    $a.textframe.text insert end "[string range $post_text 0 [expr {[string length $flatpat]-$offset-2}]]\n" [list]
    $a.textframe.text insert end [string range "$enz[string repeat " " 15]" 0 14] [list] [string repeat " " [expr {25-$offset}]]$flatpat\n [list]
    set temp $pre_text
    foreach mm $mmlist {
      set temp [string replace $temp end-$mm end-$mm [string index $flatpat [expr {$offset-$mm-1}]]]
    }
    $a.textframe.text insert end "[string repeat { } 15]$temp\n\n\n" [list]
  }
  if {$reslist == [list]} {
    $a.textframe.text insert end "[mc "**None**"]\n\n\n" [list]
   }
   set separator 1
#rev, wt cut
  if {$separator} {$a.textframe.text insert end [string repeat \u2500 20]\n}
  set reslist [lsort -command dcaps_sort [dcaps [revcom $post_text] [revcom $mut_text] [revcom $mut2_text] [revcom $pre_text] $max_mm]]
  $a.textframe.text insert end "Reverse primer, wild-type cut\n"
  foreach r $reslist {
    foreach {enz offset mmlist flatpat} $r {}
    $a.textframe.text insert end "[string repeat { } 15][revcom $post_text]" [list] [revcom $mut_text] red 
    foreach mm $mmlist {
      $a.textframe.text tag add mismatch end-[expr {$mm+3}]\char end-[expr {$mm+2}]char
    }
    $a.textframe.text insert end "[string range [revcom $pre_text] 0 [expr {[string length $flatpat]-$offset-2}]]\n" [list]
    $a.textframe.text insert end [string range "$enz[string repeat " " 15]" 0 14] [list] [string repeat " " [expr {25-$offset}]]$flatpat\n [list]
    set temp [revcom $post_text]
    foreach mm $mmlist {
      set temp [string replace $temp end-$mm end-$mm [string index $flatpat [expr {$offset-$mm-1}]]]
    }
    $a.textframe.text insert end "[string repeat { } 15]$temp\n\n\n" [list]
  }
  if {$reslist == [list]} {
    $a.textframe.text insert end "[mc "**None**"]\n\n\n" [list]
   }
   set separator 1
#fwd, mut cut
  if {$separator} {$a.textframe.text insert end [string repeat \u2500 20]\n}
  set reslist [lsort -command dcaps_sort [dcaps $pre_text $mut2_text $mut_text $post_text $max_mm]]
  $a.textframe.text insert end "Forward primer, alternate allele cut\n"
  foreach r $reslist {
    foreach {enz offset mmlist flatpat} $r {}
    $a.textframe.text insert end "[string repeat { } 15]$pre_text" [list] $mut2_text red 
    foreach mm $mmlist {
      $a.textframe.text tag add mismatch end-[expr {$mm+3}]\char end-[expr {$mm+2}]char
    }
    $a.textframe.text insert end "[string range $post_text 0 [expr {[string length $flatpat]-$offset-2}]]\n" [list]
    $a.textframe.text insert end [string range "$enz[string repeat " " 15]" 0 14] [list] [string repeat " " [expr {25-$offset}]]$flatpat\n [list]
    set temp $pre_text
    foreach mm $mmlist {
      set temp [string replace $temp end-$mm end-$mm [string index $flatpat [expr {$offset-$mm-1}]]]
    }
    $a.textframe.text insert end "[string repeat { } 15]$temp\n\n\n" [list]
  }
  if {$reslist == [list]} {
    $a.textframe.text insert end "[mc "**None**"]\n\n\n" [list]
   }
   set separator 1
#rev, mut cut
  if {$separator} {$a.textframe.text insert end [string repeat \u2500 20]\n}
  set reslist [lsort -command dcaps_sort [dcaps [revcom $post_text] [revcom $mut2_text] [revcom $mut_text] [revcom $pre_text] $max_mm]]
  $a.textframe.text insert end "Reverse primer, alternate allele cut\n"
  foreach r $reslist {
    foreach {enz offset mmlist flatpat} $r {}
    $a.textframe.text insert end "[string repeat { } 15][revcom $post_text]" [list] [revcom $mut2_text] red 
    foreach mm $mmlist {
      $a.textframe.text tag add mismatch end-[expr {$mm+3}]\char end-[expr {$mm+2}]char
    }
    $a.textframe.text insert end "[string range [revcom $pre_text] 0 [expr {[string length $flatpat]-$offset-2}]]\n" [list]
    $a.textframe.text insert end [string range "$enz[string repeat " " 15]" 0 14] [list] [string repeat " " [expr {25-$offset}]]$flatpat\n [list]
    set temp [revcom $post_text]
    foreach mm $mmlist {
      set temp [string replace $temp end-$mm end-$mm [string index $flatpat [expr {$offset-$mm-1}]]]
    }
    $a.textframe.text insert end "[string repeat { } 15]$temp\n\n\n" [list]
  }
  if {$reslist == [list]} {
    $a.textframe.text insert end "[mc "**None**"]\n\n\n" [list]
   }
  $a.textframe.text configure -state disabled
  focus $a.textframe.text 
  unset mut2_text max_mm
}

################
## calculate dCAPS mutations
################
proc dcaps {pre mut1 mut2 post min} {
global enzymes enzinfo
  set result [list]
  set mut1 [string toupper $mut1]
  set mut2 [string toupper $mut2]
  set pre [string toupper $pre]
  set post [string toupper $post]
  foreach enz $enzymes {
    # skip metylation requiring enzymes
    if {$enz in [list AbaSI AoxI BisI BlsI DpnI FspEI GlaI GluI KroI LpnPI MalI MspJI MteI PcsI PkrI SgeI]} {continue}
    set flatpat $enzinfo(flatpat,$enz)
    foreach pat [expr {$flatpat eq [revcom $flatpat]?[list $flatpat]:[list $flatpat [revcom $flatpat]]}] {
      for {set i 0} {$i < [set patlen [string length $pat]]} {incr i} {
        if {[set y [string index $pat $i]] ne "N" && nt_match($mut1,$y) && !nt_match($mut2,$y)} {
#[expr {nt_match($mut1,$y)^nt_match($mut2,$y)}]
          set match 1
          for {set j [expr {$i+1}]} {$j < $patlen} {incr j} {
            if {![expr {nt_match([string index $post [expr {$j-$i-1}]], [string index $pat $j])}]} {
              set match 0
              break
            }
          }
          if {!$match} {continue}
          set mm 0
          set mmlist [list]
          for {set j 0} {$j < $i} {incr j} {
            set c [expr {($i-$j-1)}]
            if {[expr {!nt_match([string index $pre end-$c], [string index $pat $j])}]} {
              incr mm
              lappend mmlist $c
            }
          }
          if {$mm <= $min} {
            lappend result [list $enz $i [lreverse $mmlist] $pat]
          }
        }
      }
    }
  }
  return $result
}

################
## sort dCAPS result list
################
proc dcaps_sort {a b} {
  set a [lindex $a 2]
  set b [lindex $b 2]
  if {[llength $a] != [llength $b]} {
    return [expr {[llength $a] < [llength $b]?-1:1}]
  } else {
    foreach a1 $a b1 $b {
      if {$a1 != $b1} {return [expr {$a1>$b1?-1:1}]}
    }
  }
  return 0
}

################
## nt match function
################
proc tcl::mathfunc::nt_match {a b} {
  return [expr {[string first $a [string map {B BYSKCGT D DRWKAGT H HMWYACT K KGT M MAC N NBDHVKMRYWSACGT R RAG S SGC V VMSRACG W WAT Y YCT} $b]]> -1}]
}

################
## return a sequence length (1 based) function
################
proc ::tcl::mathfunc::seq_len_mod {x len} {
  if {$x % $len== 0} {
    return $len
   } else {
     return [expr {$x % $len}]
  }
}

############
##
###########
proc sg_score {t} {
  return [sg_score_doench $t]
}

############
##
###########
proc sg_score_doench {t} {
  set intercept 0.597636154
  set gc_low -0.202625894
  set gc_high -0.166587752
  set single_base_features [list G 2 -0.275377128 A 3 -0.323887456 C 3 0.172128871 C 4 -0.100666209 C 5 -0.20180294 G 5 0.245956633 A 6 0.036440041 C 6 0.098376835 C 7 -0.741181291 G 7 -0.393264397 A 12 -0.466099015 A 15 0.085376945 C 15 -0.013813972 A 16 0.272620512 C 16 -0.119022648 T 16 -0.285944222 A 17 0.097454592 G 17 -0.17554617 C 18 -0.345795451 G 18 -0.678096426 A 19 0.22508903 C 19 -0.507794051 G 20 -0.417373597 T 20 -0.054306959 G 21 0.379899366 T 21 -0.090712644 C 22 0.057823319 T 22 -0.530567296 T 23 -0.877007428 C 24 -0.876235846 G 24 0.278916259 T 24 -0.403102218 A 25 -0.077300704 C 25 0.287935617 T 25 -0.221637217 G 28 -0.689016682 T 28 0.117877577 C 29 -0.160445304 G 30 0.386342585]

  set double_base_features [list GT 2 -0.625778696 GC 5 0.300043317 AA 6 -0.834836245 TA 6 0.760627772 GG 7 -0.490816749 GG 12 -1.516907439 TA 12 0.7092612 TC 12 0.496298609 TT 12 -0.586873894 GG 13 -0.334563735 GA 14 0.76384993 GC 14 -0.53702517 TG 17 -0.798146133 GG 19 -0.66680873 TC 19 0.353183252 CC 20 0.748072092 TG 20 -0.367266772 AC 21 0.568209132 CG 21 0.329072074 GA 21 -0.836456755 GG 21 -0.782207584 TC 22 -1.029692957 CG 23 0.856197823 CT 23 -0.463207679 AA 24 -0.579492389 AG 24 0.649075537 AG 25 -0.077300704 CG 25 0.287935617 TG 25 -0.221637217 GT 27 0.117877577 GG 29 -0.697740024]

  set t [string range [string toupper $t] 0 29]
  set g_s $intercept

  foreach {base pos score} $single_base_features {
    if {[string index $t $pos-1] eq $base} {
      set g_s [expr {$g_s+($score)}]
    }
  }
  foreach {base pos score} $double_base_features {
    if {[string range $t $pos-1 $pos] eq $base} {
      set g_s [expr {$g_s+($score)}]
    }
  }

  set gc [string length [string map -nocase {a "" t "" n "" b "" d "" h "" k "" m "" r "" v "" w "" y "" * ""} [string range $t 4 23]]]
  if {$gc < 10} {
    set g_s [expr {$g_s+(10-$gc)*$gc_low}]
  } elseif {$gc > 10} {
    set g_s [expr {$g_s+($gc-10)*$gc_high}]
  }
  set f_s [expr {1.0/(1+exp(-$g_s))}]
  return [expr {round($f_s * 1e6)/1e6}]
}

############
##
###########
proc sg_score_moreno_mateos {t} {
#set h_list AA19 -0.097377097 TT18 -0.094424075 TT13 -0.08618771 CT26 -0.084264893 GC25 -0.073453609 T21 -0.068730497 TG23 -0.066388075 AG23 -0.054338456 G30 -0.046315914 A04 -0.042153521 AG34 -0.041935908 GA34 -0.037797707 A18 -0.033820432 C25 -0.031648353 C31 -0.030715556 G01 -0.029693709 C16 -0.021638609 A14 -0.018487229 A11 -0.018287292 T34 -0.017647692 AA10 -0.016905415 A19 -0.015576499 G34 -0.014167123 C30 -0.013182733 GA31 -0.01227989 T24 -0.011996172 A15 -0.010595296 G04 -0.005448869 GG09 -0.00157799 T23 -0.001422243 C15 -0.000477727 C26 -0.000368973 T27 -0.000280845 A31 0.00158975 GT18 0.002391744 C09 0.002449224 GA20 0.009740799 A25 0.010506405 A12 0.011633235 A32 0.012435231 T22 0.013224035 C20 0.015089514 G17 0.01549378 G18 0.016457816 T30 0.017263162 A13 0.017628924 G19 0.017916844 A27 0.019126815 G11 0.020929039 TG03 0.022949996 GC03 0.024681785 G14 0.025116714 GG10 0.026802158 G12 0.027591138 G32 0.03071249 A22 0.031930909 G20 0.033957008 C21 0.034262921 TT17 0.03492881 T13 0.035445171 G26 0.036146649 A24 0.037466478 C22 0.03763162 G16 0.037970942 GG12 0.041883009 TG18 0.045908991 TG31 0.048136812 A35 0.048596259 G15 0.051129717 C24 0.052972314 TG15 0.053372822 GT11 0.053678436 GC09 0.054171402 CA30 0.057759851 GT24 0.060952114 G13 0.061360905 CA24 0.06221937 AG10 0.063717093 G10 0.067739182 C13 0.069495944 GT31 0.07342535 GG13 0.074355848 C27 0.079933922 G27 0.085151052 CC21 0.088919601 CC23 0.095072286 G22 0.10114438 G24 0.105488325 GT23 0.106718563 GG25 0.111559441 G09 0.114600681

  set intercept 0.183930944
  set single_base_features [list T 21 -0.068730497 G 30 -0.046315914 A 4 -0.042153521 A 18 -0.033820432 C 25 -0.031648353 C 31 -0.030715556 G 1 -0.029693709 C 16 -0.021638609 A 14 -0.018487229 A 11 -0.018287292 T 34 -0.017647692 A 19 -0.015576499 G 34 -0.014167123 C 30 -0.013182733 T 24 -0.011996172 A 15 -0.010595296 G 4 -0.005448869 T 23 -0.001422243 C 15 -0.000477727 C 26 -0.000368973 T 27 -0.000280845 A 31 0.00158975 C 9 0.002449224 A 25 0.010506405 A 12 0.011633235 A 32 0.012435231 T 22 0.013224035 C 20 0.015089514 G 17 0.01549378 G 18 0.016457816 T 30 0.017263162 A 13 0.017628924 G 19 0.017916844 A 27 0.019126815 G 11 0.020929039 G 14 0.025116714 G 12 0.027591138 G 32 0.03071249 A 22 0.031930909 G 20 0.033957008 C 21 0.034262921 T 13 0.035445171 G 26 0.036146649 A 24 0.037466478 C 22 0.03763162 G 16 0.037970942 A 35 0.048596259 G 15 0.051129717 C 24 0.052972314 G 13 0.061360905 G 10 0.067739182 C 13 0.069495944 C 27 0.079933922 G 27 0.085151052 G 22 0.10114438 G 24 0.105488325 G 9 0.114600681]

  set double_base_features [list AA 19 -0.097377097 TT 18 -0.094424075 TT 13 -0.08618771 CT 26 -0.084264893 GC 25 -0.073453609 TG 23 -0.066388075 AG 23 -0.054338456 AG 34 -0.041935908 GA 34 -0.037797707 AA 10 -0.016905415 GA 31 -0.01227989 GG 9 -0.00157799 GT 18 0.002391744 GA 20 0.009740799 TG 3 0.022949996 GC 3 0.024681785 GG 10 0.026802158 TT 17 0.03492881 GG 12 0.041883009 TG 18 0.045908991 TG 31 0.048136812 TG 15 0.053372822 GT 11 0.053678436 GC 9 0.054171402 CA 30 0.057759851 GT 24 0.060952114 CA 24 0.06221937 AG 10 0.063717093 GT 31 0.07342535 GG 13 0.074355848 CC 21 0.088919601 CC 23 0.095072286 GT 23 0.106718563 GG 25 0.111559441]

  set t [string range [string toupper $t] 0 29]
  set g_s $intercept

  foreach {base pos score} $single_base_features {
    if {[string index $t $pos+2] eq $base} {
      set g_s [expr {$g_s+($score)}]
sputs [string index $t $pos+2] $pos $score $g_s
    }
  }
  foreach {base pos score} $double_base_features {
    if {[string range $t $pos+2 $pos+3] eq $base} {
      set g_s [expr {$g_s+($score)}]
    }
  }
  set f_s [expr {1.0/(1+exp(-$g_s))}]
return $f_s
  return [expr {round($f_s * 1e6)/1e6}]
}



############
##
###########
proc sg_RNA_find_sgRNA {text start_ix} {
  set t [string toupper $text]
  set start 0
  set result [list]
  while {[set ix [regexp -inline -indices -start $start {.{25}GG.{3}} $t]] != {}} {
    lappend result [list [string range $text [lindex $ix 0 0] [lindex $ix 0 0]+29] [expr {$start_ix+[lindex $ix 0 0]+19}] >>> [sg_score [string range $t [lindex $ix 0 0] [lindex $ix 0 0]+29]] [expr {[string toupper [string index $text [lindex $ix 0 0]+4]] eq "G"}] [expr {[string toupper [string range $text [lindex $ix 0 0]+22 [lindex $ix 0 0]+23]] eq "GG"}]]
    set start [expr {[lindex $ix 0 0] + 1}]
  }
  set start 0
  while {[set ix [regexp -inline -indices -start $start {.{3}CC.{25}} $t]] != {}} {
    lappend result [list [revcom [string range $text [lindex $ix 0 0] [lindex $ix 0 0]+29]] [expr {$start_ix+[lindex $ix 0 0]+9}] <<< [sg_score [revcom [string range $t [lindex $ix 0 0] [lindex $ix 0 0]+29]]] [expr {[string toupper [string index $text [lindex $ix 0 0]+25]] eq "C"}] [expr {[string toupper [string range $text [lindex $ix 0 0]+6 [lindex $ix 0 0]+7]] eq "CC"}]]
    set start [expr {[lindex $ix 0 0] + 1}]
  }

  return $result
}

############
##
###########
proc sg_RNA_analysis {w} {
  ## need to make a new add_output_menu window type- list
  ## add $w info to top, add ref info to bottom of window.
  global info

  set top [new_analysis_window $w "sgRNA Analysis" sgRNA_analysis]
  set f [frame $top.tvframe -height 2000]
  set t $f.tv
  set sc $f.sc
  ttk::treeview $t -yscrollcommand "optionscrollbar $sc" -height 20
  scrollbar $sc -orient vertical -command "$t yview" -width 15
  grid $f -row 3 -column 0 -sticky nsew  -padx {5 0}
  grid $f.tv -row 0 -column 0  -sticky nsew
  grid $f.sc -row 0 -column 1 -sticky nsw
  grid columnconfigure $f 0 -weight 1
  grid rowconfigure $f 0 -weight 1
  grid columnconfigure $f 1 -minsize 1
  grid columnconfigure $top 0 -weight 1
  grid rowconfigure $top 3 -weight 1

  set f2 [frame $top.scaleframe]
  grid $f2 -row 4 -column 0 -sticky nsew
  grid [label $f2.scalelabel -text [mc "Minimum Score:"]] -row 0 -column 1 -sticky NW
  set info(sgRNA_cuttoff,$top) 0
  grid [label $f2.scalelabel2 -textvariable info(sgRNA_cuttoff,$top)] -row 0 -column 2 -sticky NW
  if {$info(use_tile)} {
    grid [ttk::scale $top.scaleframe.scale -from 0 -to 1 -command "sg_RNA_manage_slider $top;#" -orient horizontal -variable info(sgRNA_cuttoff,$top)] -row 0 -column 3 -sticky nwe
  } else {
    grid [scale $top.scaleframe.scale -from 0 -to 1 -sliderrelief raised -showvalue 0 -resolution 0.1 -troughcolor white -background $info(bg_color) -width 10  -command ";#" -orient horizontal -variable info(sgRNA_cuttoff,$top)] -row 0 -column 3 -sticky nswe 
  }
  grid columnconfigure $f2 3 -minsize 175
  grid columnconfigure $f2 3 -weight 1

  set f3 [frame $top.refframe]
  grid $f3 -row 5 -column 0 -sticky nsew
  grid [label $top.refframe.reflabel -text [mc "Scores from: Doench et al. Nature Biotechnology (2014) doi:10.1038/nbt.3026"]] -row 1 -column 1 -sticky nw






  wm protocol $top WM_DELETE_WINDOW "closewindow $top; unset info(sgRNA_cuttoff,$top)"
  add_output_menu $t "List" list $w

  $t configure -columns {Location Direction Score 5'G 3'GG}
  $t heading #0 -text [mc "sgRNA"] ;#-command "treeview_sort $t {}"
  $t column #0 -width 300 -minwidth 50 -stretch 1 -anchor e
  $t heading Location -text [mc "Location \u2193"] -command "treeview_sort $t Location"
  $t column Location -width 60 -minwidth 50 -stretch 1 -anchor c
  $t heading Direction -text Direction  -command "treeview_sort $t Direction"
  $t column Direction -width 60 -minwidth 20 -stretch 1 -anchor c
  $t heading Score -text [mc "Score"]  -command "treeview_sort $t Score 0 -real"
  $t column Score -width 90 -minwidth 60 -stretch 1 -anchor c
  $t heading 5'G -text [mc "5'G"]  -command "treeview_sort $t 5'G"
  $t column 5'G -width 20 -minwidth 20 -stretch 1 -anchor c
  $t heading 3'GG -text [mc "3'GG"]  -command "treeview_sort $t 3'GG"
  $t column 3'GG -width 30 -minwidth 20 -stretch 1 -anchor c

  bind $t <<TreeviewSelect>> "treeview_manageselection $t"
  bind $t <<OldSelection>> {}
  $t tag configure sel -background $info(text_select_bg_color)
  bind $t <<Sort_column>> Location
  bind $t <<Sort_direction>> 1
  bind $t <Motion> "treeview_highlight_under_mouse $t %x %y"
  bind $t <Activate> "treeview_highlight_under_mouse $t \[expr {\[winfo pointerx $t\]-\[winfo rootx $t\]}\] \[expr {\[winfo pointery $t\]-\[winfo rooty $t\]}\]"
  bind $t <Enter> "treeview_highlight_under_mouse $t \[expr {\[winfo pointerx $t\]-\[winfo rootx $t\]}\] \[expr {\[winfo pointery $t\]-\[winfo rooty $t\]}\]"
  bind $t <Leave> "$t tag remove highlight"
  bind $t <MouseWheel> "[bind Treeview <MouseWheel>]; treeview_highlight_under_mouse $t %x %y; break"
  bind $t <Double-Button-1> "sg_RNA_double_button $w $t %x %y"
  $t tag configure highlight -foreground red


  ####get text and start_x from $w selection
  if {[$w.textarea tag ranges sel] == ""} {
    set start 0
    set end [ix2bp $w.textarea end]
  } else {
    set  start [ix2bp $w.textarea [$w.textarea index sel.first]]
    set end [ix2bp $w.textarea [$w.textarea index sel.last]]
# selection used here
  }
  set text [textarea_get $w.textarea [bp2ix $w.textarea $start] [bp2ix $w.textarea $end]]
  incr start
  set data [sg_RNA_find_sgRNA $text $start]
  set data [lsort -index 1 -dictionary $data]
  set linkbase_dict [list]
  foreach d $data {
    set new_item [$f.tv insert {} end -values [lrange $d 1 end] -text [string range [lindex $d 0] 4 23]]
    if {[lindex $d 2] eq ">>>"} {
      dict set linkbase_dict $new_item [list [expr {[lindex $d 1]-16}] [expr {[lindex $d 1]+4}]]
    } else {
       dict set linkbase_dict $new_item [list [expr {[lindex $d 1]-4}] [expr {[lindex $d 1]+16}]]
    }
  }
  bind $t <<LinkDict>> $linkbase_dict
}




############
##
###########
proc sg_RNA_double_button {w t x y} {
  if {[set item [$t identify row $x $y]] != {}} {
# && ([$t identify region $x $y] eq "cell" || [$t identify region $x $y] eq "tree" ) ;# can use identify region when 8.6 is available"
sputs [$t identify row $x $y]  [$t identify region $x $y]
    if {[bind $t <<LinkDict>>] != {} && [set link_base [dict get [bind $t <<LinkDict>>] $item]] != {}} {
      select_region $w [bp2ix $w.textarea [lindex $link_base 0]] [bp2ix $w.textarea [lindex $link_base 1]]
    }
    wm deiconify $w
    raise $w
  }
}

############
##
###########
proc sg_RNA_manage_slider {a} {
  global info
  set info(sgRNA_cuttoff,$a) [expr {round($info(sgRNA_cuttoff,$a) * 1e4) / 1e4}]
  set update 0
  foreach c [$a.tvframe.tv children {}] {
    if {[$a.tvframe.tv set $c Score] < $info(sgRNA_cuttoff,$a)} {
      $a.tvframe.tv detach $c
      set new_detached [bind $a.tvframe.tv <<Detached>>]
      lappend new_detached $c
      bind $a.tvframe.tv <<Detached>> $new_detached
      set update 1
    }
  }
  set new_detached [list]
  foreach c [bind $a.tvframe.tv <<Detached>>] {
    if {[$a.tvframe.tv set $c Score] >= $info(sgRNA_cuttoff,$a)} {
      $a.tvframe.tv move $c {} end
      set update 1
    } else {
      lappend new_detached $c
    }
    bind $a.tvframe.tv <<Detached>> $new_detached
  }
  ### resort columns
  if {$update} {
    set column [bind $a.tvframe.tv <<Sort_column>>]
    set direction [bind $a.tvframe.tv <<Sort_direction>>]
    set l [list]
    foreach item [$a.tvframe.tv children {}] {
      if {$column != {}} {
        lappend l [list $item [$a.tvframe.tv set $item $column]]
      } else {
        lappend l [list $item [$a.tvframe.tv item $item -text]]
      }
    }
    set o [list]
    foreach pair [lsort -dictionary -index 1 {*}-[expr {$direction?"increasing":"decreasing"}] $l] {
        lappend o [lindex $pair 0]
    }
    $a.tvframe.tv children {} $o 
  }

}

############
##
###########
proc treeview_highlight_under_mouse {t x y} {
  treeview_tag_remove $t highlight 
  if {[set item [$t identify row $x $y]] != {} && $item ne "heading"} {
    $t item $item -tags [list {*}[$t item $item -tags] highlight]
    #$t tag add highlight $item;# can use this when 8.6 is available
  }
  event generate $t <FocusOut>
}

################
## remove a tag from a treeview- fixes bug in old 8.5 treeview code
################
proc treeview_tag_remove {t tag {parent {}}} {
  #### can use pathname tag remove when 8.6 is available
  foreach item [$t children $parent] {
    if {[$t exists $item]} {
      if {([set i [lsearch [$t item $item -tags] $tag]] > -1)} {
        $t item $item -tags [lreplace [$t item $item -tags] $i $i]  
      }
      treeview_tag_remove $t $tag $item
    }
  }
}

################
## multi-fragment loxP
################
proc lox_recombination_window {window} {
  global info modifier dialogblock 
  global ok loxP_acceptor  loxP_acceptor_win loxP_donor


  if {$dialogblock == 1} {return}

  set a [new_dialog $window "Mutifragment Cre Reaction..." "NEW DNA"]
  bind $a <<Cancel>> "set ok -1"
  bind $a <<OK>> "set ok 1"
  set ok 0

  set loxP_acceptor ""
  grid [frame $a.acceptorframe -relief ridge -borderwidth 2] -row 1 -column 1 -sticky nswe
  grid [menubutton $a.acceptorframe.menubutton -textvariable loxP_acceptor_win -menu $a.acceptorframe.menubutton.menu -indicator on -relief raised] -row 1 -column 1
  set loxP_acceptor_win [mc "Choose an Acceptor Vector"]
  menu $a.acceptorframe.menubutton.menu
  set maxwidth 25
  set loxP_acceptor ""
  foreach {win} [dnawindows_list 1] {
    set text [textarea_get $window.textarea 1.0 [end_ix $window.textarea]]
    set len [string length $text]
    if {$info($window,circular) == "circular"} {
      append text [string range $text 0 33]
    }
    set loxP_list  [dict get $info(recomb,sites) loxP]
    set loxP_site [regsubpattern "[lindex $loxP_list 0][lindex $loxP_list 1][lindex $loxP_list 2]"]
    set index_list1 [regexp -all -indices -nocase -inline $loxP_site $text]
    if {[llength $index_list1] > 1 && [lindex $index_list1 1 0] >= $len} {
      set index_list1 [lrange  $index_list1 0 0]
    }
    set loxP_site [revcom_regexp $loxP_site]
    set index_list2 [regexp -all -indices -nocase -inline $loxP_site $text]
    if {[llength $index_list2] > 1 && [lindex $index_list2 1 1] >= $len} {
      set index_list2 [lrange  $index_list2 0 0]
    }
    if {[llength $index_list1] == 1 && [llength $index_list2] == 0} {
      $a.acceptorframe.menubutton.menu add radiobutton -label [wm title $window] -variable loxP_acceptor -value "$window,$index_list1,0" -command "fill_loxP_frame; set loxP_acceptor_win \"[wm title $window]\""
      if {[string length [wm title $window]] > $maxwidth} {set maxwidth [string length [wm title $window]]}   
    } elseif {[llength $index_list1] == 0 && [llength $index_list2] == 1} {
      $a.acceptorframe.menubutton.menu add radiobutton -label [wm title $window] -variable loxP_acceptor -value "$window,$index_list2,1" -command "fill_loxP_frame; set loxP_acceptor_win \"[wm title $window]\""
      if {[string length [wm title $window]] > $maxwidth} {set maxwidth [string length [wm title $window]]}   
    }
  }
  set loxP_acceptor ""
  incr maxwidth 3
  if {$maxwidth > 200} {set maxwidth 200}
  $a.acceptorframe.menubutton configure -width $maxwidth
  grid [labelframe $a.donorframe -relief ridge -borderwidth 2 -text [mc "Donor Vectors"]] -row 2 -column 1 -sticky nswe
  grid [frame $a.okframe] -row 3 -column 1 -sticky nswe
  grid [button $a.okframe.cancel -text [mc "Cancel"] -command "set ok -1"] -row 1 -column 0 -sticky nw -padx 10 -pady 3
  grid [button $a.okframe.ok -text [mc "OK"] -command "set ok 1" -default active] -row 1 -column 1 -sticky nw -padx 10 -pady 3


  vwait ok

  destroy $a
  set dialogblock 0
  bind . <<RaiseDialogs>> ""
  if {$ok == 1 && ([regexp {(.+),(.+),([0-1])} $loxP_acceptor blank loxP_acceptor_win loxP_acceptor_ix loxP_acceptor_dir])} {
    set w $loxP_acceptor_win
    set acceptor_title [file rootname [wm title $w]]
    if {$loxP_acceptor_dir} {
      set loxP_acceptor_ix [expr {[lindex $loxP_acceptor_ix 0 1]+2}]
      set first_dna [revcom [textarea_get $w.textarea [bp2ix $w.textarea [expr $loxP_acceptor_ix]] end]]
      set first_tags [get_tags $w.textarea [list [bp2ix $w.textarea [expr $loxP_acceptor_ix]] end] "reverse"]
      set last_dna [revcom [textarea_get $w.textarea [bp2ix $w.textarea 0] [bp2ix $w.textarea [expr $loxP_acceptor_ix]]]]
      set last_tags [get_tags $w.textarea [list 1.0 [bp2ix $w.textarea [expr $loxP_acceptor_ix]]] "reverse"]
    } else {
      set loxP_acceptor_ix [lindex $loxP_acceptor_ix 0 0]
      set first_dna  [textarea_get $w.textarea [bp2ix $w.textarea 0] [bp2ix $w.textarea $loxP_acceptor_ix]]
      set first_tags [get_tags $w.textarea [list [bp2ix $w.textarea 0] [bp2ix $w.textarea $loxP_acceptor_ix]] "forward"]
      set last_dna  [textarea_get $w.textarea [bp2ix $w.textarea $loxP_acceptor_ix] end]
      set last_tags [get_tags $w.textarea [list [bp2ix $w.textarea $loxP_acceptor_ix] end] "forward"]
    }
    set loxplist [list]
    foreach p [array names loxP_donor] {
      if {$loxP_donor($p) ne 0} {
         lappend loxplist $loxP_donor($p)
       }
    }
    set new_win_list [list]
    foreach loxplist2 [combinations $loxplist] {
      set dna $first_dna
      set tags $first_tags
      set new_title $acceptor_title 
      foreach loxp_donor $loxplist2 {
        if {![regexp {(.+),(.+),([0-1])} $loxp_donor blank loxp_donor_win loxp_donor_ix loxp_donor_dir]} {
          continue
        }
        set end [string length $dna]
        set w $loxp_donor_win
        if {$loxp_donor_dir} {
          set loxp_donor_ix [expr {[lindex $loxp_donor_ix 0 1]+2}]
          set d1_dna [revcom [textarea_get $w.textarea [bp2ix $w.textarea [expr $loxp_donor_ix]] end]]
          set d1_tags [get_tags $w.textarea [list [bp2ix $w.textarea [expr $loxp_donor_ix]] end] "reverse"]
          set d2_dna [revcom [textarea_get $w.textarea [bp2ix $w.textarea 0] [bp2ix $w.textarea [expr $loxp_donor_ix]]]]
          set d2_tags [get_tags $w.textarea [list 1.0 [bp2ix $w.textarea [expr $loxp_donor_ix]]] "reverse"]
        } else {
          set loxp_donor_ix [lindex $loxp_donor_ix 0 0]
          set d1_dna  [textarea_get $w.textarea [bp2ix $w.textarea 0] [bp2ix $w.textarea $loxp_donor_ix]]
          set d1_tags [get_tags $w.textarea [list [bp2ix $w.textarea 0] [bp2ix $w.textarea $loxp_donor_ix]] "forward"]
          set d2_dna  [textarea_get $w.textarea [bp2ix $w.textarea $loxp_donor_ix] end]
          set d2_tags [get_tags $w.textarea [list [bp2ix $w.textarea $loxp_donor_ix] end] "forward"]
        }
        append dna $d2_dna
        foreach {tag data} $d2_tags {
          lset data 0 [list [expr {$end + [lindex $data 0 0]}] [expr {$end + [lindex $data 0 1]}]]
          lappend_tags tags $tag $data
        }
        set end [string length $dna]
        append dna $d1_dna
        foreach {tag data} $d1_tags {
          set newcoords [list]
          foreach coords [lindex $data 0] {
            lappend newcoords [expr {$end + $coords}]
          }
          lset data 0 $newcoords
          lappend_tags tags $tag $data
        }
        append new_title _ [file rootname [wm title $w]]
      }
      set end [string length $dna]
      append dna $last_dna
      foreach {tag data} $last_tags {
        set newcoords [list]
        foreach coords [lindex $data 0] {
          lappend newcoords [expr {$end + $coords}]
        }
        lset data 0 $newcoords
        lappend_tags tags $tag $data
      }
      lappend new_win_list [create_window $dna "" "" "circular" 1 0 $new_title $tags {} GenBank]
    }
    set savedir [tk_chooseDirectory]
    if {$savedir ne ""} {
      foreach w $new_win_list {
        save_file $w Save GenBank [file join $savedir [wm title $w]]
      }
    }
  }
 
  unset -nocomplain ok loxP_acceptor loxP_acceptor_win loxP_donor
}

################
## 
################
proc combinations {l} {
  if {[llength $l] == 1} {
    return [list $l]
  } else {
    set reslist [list]
    for {set i 0} {$i < [llength $l]} {incr i} {
      foreach l2 [combinations [lreplace $l $i $i]] {
        lappend reslist [concat [list [lindex $l $i]] $l2]
      }
    }
    return $reslist
  }
}

################
## 
################
proc fill_loxP_frame {} {
  global loxP_acceptor loxP_donor info
  set a .dialog
  set i 0
  foreach window [dnawindows_list 1] {
    if {[regexp "$window," $loxP_acceptor]} continue
    set text [textarea_get $window.textarea 1.0 [end_ix $window.textarea]]
    set len [string length $text]
    if {$info($window,circular) == "circular"} {
      append text [string range $text 0 33]
    }
    set loxP_list  [dict get $info(recomb,sites) loxP]
    set loxP_site [regsubpattern "[lindex $loxP_list 0][lindex $loxP_list 1][lindex $loxP_list 2]"]
    set index_list1 [regexp -all -indices -nocase -inline $loxP_site $text]
    if {[llength $index_list1] > 1 && [lindex $index_list1 1 0] >= $len} {
      set index_list1  [lrange $index_list1 0 0]
    }
    set loxP_site [revcom_regexp $loxP_site]
    set index_list2 [regexp -all -indices -nocase -inline $loxP_site $text]
    if {[llength $index_list2] > 1 && [lindex $index_list2 1 0] >= $len} {
      set index_list2  [lrange $index_list2 0 0]
    }
    if {[llength $index_list1] == 1 && [llength $index_list2] == 0} {
      catch {destroy $a.donorframe.c$i}
      grid [checkbutton $a.donorframe.c$i -text [wm title $window] -variable loxP_donor($i) -onvalue "$window,$index_list1,0" -selectcolor white] -row $i -column 0 -sticky w
      set loxP_donor($i) 0
      incr i
    } elseif {[llength $index_list1] == 0 && [llength $index_list2] == 1} {
      catch {destroy $a.donorframe.c$i}
      grid [checkbutton $a.donorframe.c$i -text [wm title $window] -variable loxP_donor($i) -onvalue "$window,$index_list2,1" -selectcolor white] -row $i -column 0 -sticky w
      set loxP_donor($i) 0
      incr i
    }
  }
  while {[winfo exists $a.donorframe.c$i]} {
    catch {destroy $a.donorframe.c$i}
    array unset loxP_donor $i
    incr i
  }
}

################
## 
################
proc digest_open_windows {} {
  global info
  set dnawinlist [dnawindows_list 1]
  set a [new_analysis_window $dnawinlist "Multi-digest $info(enz_currently_selected)" multi_digest]
  create_textframe $a 100
  set outputmenu [add_output_menu $a.textframe.text "Text" text .]
  $a.textframe.text insert end "Digest: [join $info(enz_currently_selected) ,]\n"
  foreach window $dnawinlist {
    set w $window
    findenzymes $w
    set start 1
    set total_length [ix2bp $w.textarea end]
    if {$total_length < 1} continue
    set end $total_length
    set templist [list]
    foreach enzyme $info(enz_currently_selected) {
      if {($info($w,circular) != "circular")} {
        ##on linear fragments reject sites that CUT outside the range
        foreach site $info($w,$enzyme) dir $info($w,enzdir,$enzyme) {
          if {$site >= $end} {break}
          if {$site >= $start} {
            set cutsitelist [enz_cut_offset $enzyme $site $dir]
            if {([lindex $cutsitelist 0] >= $start) && ([lindex $cutsitelist 1] >= $start) && ([lindex $cutsitelist 0] <= $end) && ([lindex $cutsitelist 1] <= $end)} {
              lappend templist [list $site $enzyme $dir]
            }
          }
        }
      } else {
        foreach site $info($w,$enzyme) dir $info($w,enzdir,$enzyme) {
          if {$site >= $end} {break}
          if {$site >= $start} {lappend templist [list $site $enzyme $dir]}
        }
      }
    }
    if {($info($w,circular) != "circular")} {
      lappend templist [list $start "Start" 0]
      lappend templist [list $end "End" 0]
    }
    set templist [lsort -integer -index 0 $templist]
    set fraglist [list]
    set i 0
    set lastsite [lindex [lindex $templist 0] 0]
    set lastenz [lindex [lindex $templist 0] 1]
    set lastsitedir [lindex [lindex $templist 0] 2]
    foreach pair [lrange $templist 1 end] {
      if {[expr {[lindex $pair 0]- $lastsite}] > 0} {
        lappend fraglist [list [expr {[lindex $pair 0]- $lastsite}] $lastenz $lastsite [lindex $pair 1] [lindex $pair 0] $i [expr {round(100.0*([lindex $pair 0]- $lastsite)/$total_length)}] $lastsitedir [lindex $pair 2]]
        set lastsite [lindex $pair 0]
        set lastenz [lindex $pair 1]
        set lastsitedir [lindex $pair 2]
        incr i
      }
    }
    if {($info($w,circular) == "circular")} {
      if {$templist != [list]} {
        lappend fraglist [list [expr {[lindex [lindex $templist 0] 0]+ $total_length - $lastsite}] $lastenz $lastsite [lindex [lindex $templist 0] 1] [lindex [lindex $templist 0] 0] $i [expr {round(100.0*([lindex [lindex $templist 0] 0]+ $total_length - $lastsite)/$total_length)}] $lastsitedir [lindex [lindex $templist 0] 2]]
      } else {    
        lappend fraglist [list  $total_length uncut 0 "" 0 0 100 0 0]
      }
    }
    set fraglist [lsort -integer -index 0 -decreasing $fraglist]
    set fragout [list]
    foreach frag $fraglist {
      if {[lindex $frag 1] ne "uncut"} {
        lappend fragout [lindex $frag 0]
      } else {
        lappend fragout "[lindex $frag 0] (uncut)"
      }
    }
    $a.textframe.text insert end "[wm title $w]: [join $fragout ,]\n"
  }
  $a.textframe.text configure -state disabled
  if {[info exists info(last_analysis_xy)]} {
    wm geometry [winfo toplevel $a] [textbox_geometry $a.textframe.text {*}$info(last_analysis_xy)]
  } else {
    scan [wm geometry [winfo toplevel $a]] "%dx%d+%d+%d" w h x y
    wm geometry [winfo toplevel $a] [textbox_geometry $a.textframe.text $x $y]
  }
}


## tkpath can't delete all, so when tk_path is in operation, make a new version of this proc
proc canvas_delete_all {c} {
  $c delete all
}

################
## initialize some info for MS Windows
################
proc initialize_win32 {} {
  package require registry
  global info possible_extensions tcl_platform env

  #if {[catch {package require tls}]} {
  #  if {[file exists [file join $info(Accdir) "lib" "tls1.6.7.1" "tls1671.dll"]]} {
   #   source [file join $info(Accdir) "lib" "tls1.6.7.1"  tls.tcl]
  #    tls::initlib [file join $info(Accdir) "lib" "tls1.6.7.1"]  tls1671.dll
  #  }
  #} 
  if {[catch {exec curl --version}]} {
    ## try loading the tls package if curl isn't available
    if {![catch {package require tls}]} {
      ::tls::init  -ssl3 false -ssl2 false -tls1 false -tls1.2 true -tls1.1 false
      ::http::register https 443 ::tls::socket
      set info(tls) "tls" 
    }
  } else {
    set info(tls) "curl"
  }

  package require pdf4tcl
  package require qrcode


  ## read dark mode setting
  set info(dark_mode) 0
  if {$info(user_set_dark_mode) == -1} {
    if {![catch {set is_light [registry get {HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Themes\Personalize} "AppsUseLightTheme"]}]} {
      set info(dark_mode) [expr {!$is_light}]
      sputs darkmode was set from registry : $info(dark_mode)
    }
  } else {
    set info(dark_mode) $info(user_set_dark_mode)
    sputs darkmode was set from settings : $info(dark_mode)
  }


  ##set browser info
 ## don't use this- just use the system default with open
  if {0} {
  set root HKEY_CLASSES_ROOT
  if {![catch {set appKey [registry get $root\\.html ""]} err1]} {
    if {(![catch {registry get $root\\$appKey\\shell\\open\\command ""} err1 ]) && (![catch {set appCmd [registry get $root\\$appKey\\shell\\open\\command ""]} err1])} {
      regsub -all {\\} $appCmd  {\\\\} info(appCmd)
      if {[string match -nocase *iexplore.exe* $info(appCmd)]} {
        set info(browser) iexplore
      } elseif {[string match -nocase *netscape.exe* $info(appCmd)]} {
        set info(browser) NETSCAPE
      } elseif {[string match -nocase *mozilla.exe* $info(appCmd)]} {
        set info(browser) Mozilla
      } elseif {[string match -nocase *opera.exe* $info(appCmd)]} {
        set info(browser) Opera
      } elseif {[string match -nocase *firefox.exe* $info(appCmd)]} {
        set info(browser) Firefox
      } elseif {[string match -nocase *chrome.exe* $info(appCmd)]} {
        set info(browser) Chrome
      } else {
        sputs "Sorry, I don't recognize the browser: [file tail $info(appCmd)]"
        set info(browser) ""
      } 
    } else {
      sputs "Sorry, no shell command registered for .html files" $appKey $err1
      set info(browser) ""
    }
  } else {
      sputs "Sorry, no application registered for .html files" $err1
      set info(browser) ""
  }
  }
  ##set system colors info
  set info(tk_ps_fonts) [list helvetica Helvetica arial Helvetica times TimesNewRomanPSMT {news gothic mt} TimesNewRomanPSMT {times new roman} TimesNewRomanPSMT courier Courier {courier new} Courier]

  ##set window icon
  if {[file exists [file join $info(Accdir) "Icons and images" "APE_icon.ico"]]} {
    set window_icon [file join $info(Accdir) "Icons and images" "APE_icon.ico"]
    catch {wm iconbitmap . -default $window_icon}
  }
  
  ##load the wmf, gdi, hdc and printer dlls
  catch {package require hdc}
  catch {package require printer}
  catch {package require gdi}
  catch {package require wmf}


  catch {package require twapi}
  if {[lsearch -glob [info loaded] "*twapi*"] == -1} {
    if {[catch {package require twapi_base}]} {
      sputs loading twapi from lib directory
      if {$tcl_platform(pointerSize) == 8} {
        if {[file exists [file join $info(Accdir) "lib" "twapi_base64.dll"]]} {
          if {[catch {load [file join $info(Accdir) "lib" "twapi_base64.dll"]} err]} {
            spus error in twapi_base: $err
          } else {
           # ::twapi::import_commands
          }
        }
      } else {
        if {[file exists [file join $info(Accdir) "lib" "twapi_base.dll"]]} {
          if {[catch {load [file join $info(Accdir) "lib" "twapi_base.dll"]} err]} {
            spus error in twapi_base: $err
          } else {
           # ::twapi::import_commands
          }
        }
      }
    } else {
      ## twapi should be included in the wishkit
     # package require twapi_shell
     # package require twapi_process
     # ::twapi::import_commands
    }
  } else {
    package require twapi
   # ::twapi::import_commands
  }

  #twapi tls doesn't support post?
  #::http::register https 443 ::twapi::tls_socket


  #if {[file exists [file join $info(Accdir) "lib" "tkpng.dll"]]} {
   # if {[catch {load [file join $info(Accdir) "lib" "tkpng.dll"]} err]} {
   #   spus error in tkpng: $err
   # }
  #}

  if {[file exists [file join $info(Accdir) "lib" "libsnack.dll"]]} {
    if {[catch {load [file join $info(Accdir) "lib" "libsnack.dll"]} err]} {
      spus error in libsnack: $err
    } else {
      load_snack_sounds
    }
  }

  ##load the drag and drop dll
  
   ###[file exists [file join $info(Accdir) "lib" "libtkdnd.dll"]]
   #    load [file join $info(Accdir) "lib" "libtkdnd.dll"]
  if { ![catch {package require tkdnd}]} {
    proc HandleFileDrop {data type} {
      #sputs "data:$data type:$type"
      if {$type eq "Files" || $type eq "CF_HDROP" || $type eq "DND_Files"} {
        foreach filename $data {
          if {[file extension $filename] == ".lnk"} {
            if {[file exists [set filename [find_link_target $filename]]]} {
              catch {open_file $filename}
            }
          } else {
            catch {open_file $filename}
          }
        }
      }
    }

    if {[info procs ::twapi::read_shortcut] == {}} {
    ### hand-rolled shortcut resolver
    proc find_link_target {filename} {
      set fileid [open $filename r]
 
      if {[read $fileid 1] != "L"} {close $fileid; return ""}
      #read flags
      seek $fileid 0x14
      binary scan [read $fileid 4] b7 flags
      set has_id_list [string index $flags 0]
      set is_file [string index $flags 1]
      set has_desc [string index $flags 2]
      set has_rel_path [string index $flags 3]
      set has_working_dir [string index $flags 4]
      set has_command_line [string index $flags 5]
      set has_custom_icon [string index $flags 6]


      if {!$is_file} {close $fileid; return ""}

      #if item id list, skip it
      if {$has_id_list} {
        #read the item ID list size
        seek $fileid 0x4C
        binary scan [read $fileid 2] s id_size
        set file_loc_off [expr (0x4E+$id_size)]
      } else {
        set file_loc_off 0x4E
      }

      #read the location info_header
      seek $fileid $file_loc_off
      set x [read $fileid 28]
      binary scan $x iiiiiii structure_len offset_last_item location_flags local_v_off   local_path_off net_v_off final_path_off
      set has_local [expr {$location_flags % 2}]
      set has_net [expr {$location_flags >> 1}]


      if {$has_local} {
        #read local_volume_table_header
        seek $fileid [expr {$file_loc_off+$local_v_off}]
        binary scan [read $fileid 16] iiii len_loc_v_table fixed_disk vol_ser vol_label_off
        set vol_label ""
        while {(![string equal [set c [read $fileid 1]] \0]) && (![eof $fileid])} {
          set vol_label "$vol_label$c"
        }

        seek $fileid [expr {$file_loc_off+$local_path_off}]
        set local_path ""
        while {(![string equal [set c [read $fileid 1]] \0]) && (![eof $fileid])} {
          set local_path "$local_path$c"
        }
      }
 
      if {$has_net} {
        #read net_volume_table_header
        seek $fileid [expr {$file_loc_off+$net_v_off}]
        binary scan [read $fileid 20] iiiii len_net_v_table x share_name_off x x

        set share_name ""
        while {(![string equal [set c [read $fileid 1]] \0]) && (![eof $fileid])} {
          set share_name "$share_name$c"
        }
      }

      seek $fileid [expr {$file_loc_off+$final_path_off}]
      set final_path ""
      while {(![string equal [set c [read $fileid 1]] \0]) && (![eof $fileid])} {
        set final_path "$final_path$c"
      }

      close $fileid
      if {$has_local} {
        set leader $local_path
      } elseif {$has_net} {
        set leader $share_name
      }

      if {$final_path != ""} {
        return "$leader[file separator]$final_path"
      } else {
        return $leader
      }
    }
    ### end: hand-rolled shortcut resolver
    } else {
      proc find_link_target {filename} {
        reurn [::twapi::read_shortcut $filename -path]
      }
    }
  
  }


  if {![catch {package require tkpath}]} {
    #rename canvas tk_canvas
    #proc canvas {args} {
    #  return [tkp::canvas {*}$args] 
    #}
    #proc canvas_delete_all {c} {
    #  $c delete [$c children 0]
   # }
    #proc canvas_text_itemconfigure_angle {c tag_or_id angle} {
    # 
   # }
    #proc canvas_text__itemcget_angle {c tag_or_id} {
    # 
   # }
  }
}

################
## try to set up the users default directory on a windows system- return 1 if successful, 0 if not, and report the error to the user
################
proc initilize_windows_user_defauts {dir {msg ""}} {
  global info

  if {![file isdirectory $dir]} {
    if {[catch {file mkdir $dir} err]} {
     sputs "Can't create users directory $dir, $err. $msg" -type ok -icon info
     return 0
    }
  }
  if {![file writable $dir]} {
    sputs "Can't write to users directory $dir. $msg" -type ok -icon info
    return 0
  }

  set info(user_defaults_dir) [file join $dir Ape]
  #tk_messageBox -message [mc "Users directory\n%s" $dir] -type ok -icon info
  if {![file isdirectory $info(user_defaults_dir)]} {
    if {[catch {file mkdir $info(user_defaults_dir)} err]} {
     sputs "Can't create ApE directory in $dir, $err. $msg" -type ok -icon info
     return 0
    }
  }
  return 1
}


################
## initialize some info for Aqua (OS X)
################
proc initialize_aqua {} {
  global info tk_patchLevel

  if {![catch {package require tls}]} {
    ::tls::init  -tls1 0 -tls1.1 0 -tls1.2 1 -ssl2 0 -ssl3 0
    ##::http::register https 443 ::tls::socket
    ::http::register https 443 [list ::tls::socket -autoservername true]
    set info(tls) "tls" 
  } else {
    set info(tls) "curl" 
  }

  package require pdf4tcl
  package require qrcode

  set info(dark_mode) 0
  if {$info(user_set_dark_mode) == -1} {
    catch {set info(dark_mode) [tk::unsupported::MacWindowStyle isdark .]}
  } else {
    set info(dark_mode) $info(user_set_dark_mode)
  }


  bind . <<DarkAqua>>  "darkmode_set -1; sputs aqua dark event"
  bind . <<LightAqua>>  "darkmode_set -1; sputs aqua light event"

  set modstring "Cmd"

  proc ::tk::mac::Quit {} {
    ## need to do this after, so the option_q global can be set
    after 10 exit_with_checks
  }

  if {!$info(use_cocoa)} {
   proc ::tk::mac::ShowPreferences {} {configure_preferences}  
  } else {
    proc tkAboutDialog {} {after 200 about_dialog .}
    proc ::tk::mac::ShowPreferences {} {after 200 configure_preferences}
    proc ::tk::mac::ShowHelp {} {open_url https://www.youtube.com/playlist?list=PLXd4WouGm92muGl4mJx5EvUFVSWZKdyuA}
  }

  if {[catch {load [file join $info(Accdir) lib MacCarbonPrint.dylib]} errmsg]} {
    if {[catch {load [file join $info(Accdir) lib libcocoaprint.dylib]} errmsg]} {
      #sputs $errmsg
    }
  }
#for doing hide shortcut- bug in intel macs
  #if {[catch {load [file join $info(Accdir) lib tclCarbonHICommand.dylib]} errmsg]} {
  #  sputs $errmsg
  #}
## switch this to the system command line: exec say 
#  if {[catch {load [file join $info(Accdir) lib TclSpeech2.0.dylib]} errmsg]} {
 #   sputs $errmsg
 # }

  if {0} {
   ## Don't need image-png after Tk 8.6
    if {[catch {load [file join $info(Accdir) lib Img1.4 libzlibtcl1.2.11.dylib]} errmsg]} {
      sputs $errmsg
    } else {
      if {[catch {load [file join $info(Accdir) lib Img1.4 libtkimg1.4.7.dylib]} errmsg]} {
        sputs $errmsg
      }
      if {[catch {load [file join $info(Accdir) lib Img1.4 libpngtcl1.6.28.dylib]} errmsg]} {
        sputs $errmsg
      }
      if {[catch {load [file join $info(Accdir) lib Img1.4 libtkimgpng1.4.7.dylib]} errmsg]} {
        sputs $errmsg
      }
    }
  }

  if {0} {
#loads Img png support for loading png files- with windows version, can load png files for toolbars
    if {[catch {load [file join $info(Accdir) lib Img1.3 libzlibtcl1.2.3.dylib]} errmsg]} {
      sputs $errmsg
    }
    if {[catch {load [file join $info(Accdir) lib Img1.3 libtkimg1.3.dylib]} errmsg]} {
      sputs $errmsg
    }
    if {[catch {load [file join $info(Accdir) lib Img1.3 libpngtcl1.2.6.dylib]} errmsg]} {
      sputs $errmsg
    }
    if {[catch {load [file join $info(Accdir) lib Img1.3 libtkimgpng1.3.dylib]} errmsg]} {
      sputs $errmsg
    }
  }


if {1} {
  #add menubar to the window
  set bugdelay 10
  set w ""
  . configure -menu [menu .menubar]
menu  .menubar.filemenu 
.menubar add cascade -menu .menubar.filemenu -label [mc "File"]
.menubar.filemenu add command -label [mc "New"] -accelerator "$modstring+N" -command  "create_window" 
.menubar.filemenu add command  -label [mc "Open..."] -accelerator "$modstring+O"  -command  "open_file_dialog"
menu .menubar.filemenu.open_previous
.menubar.filemenu add cascade -label [mc "Open Recent Files"] -menu .menubar.filemenu.open_previous
.menubar.filemenu add command -state disabled -label [mc "Duplicate Selection"]  -accelerator "$modstring+D"  -command  "duplicate_window $w selection"
.menubar.filemenu add command -state disabled -label [mc "Duplicate Full Sequence"]  -accelerator "$modstring+Shift+D"  -command  "duplicate_window $w all"
.menubar.filemenu add command -state disabled -label [mc "Close"] -accelerator "$modstring+W" -command  "closewindow $w"
.menubar.filemenu add separator
.menubar.filemenu add command -state disabled -label [mc "Save"]  -accelerator "$modstring+S" -command  "save_file $w Save"
.menubar.filemenu add command -state disabled -label [mc "Save As..."]  -accelerator "$modstring+Shift+S" -command  "save_file $w Save_as"
.menubar.filemenu add separator
.menubar.filemenu add command -state disabled -label [mc "Print..."] -accelerator "$modstring+P" -command  "after $bugdelay enz_text_map $w -1"
.menubar.filemenu add separator
menu .menubar.filemenu.cloud_access
.menubar.filemenu add cascade -label [mc "Access Cloud Services"] -menu .menubar.filemenu.cloud_access
  menu .menubar.filemenu.cloud_access.labarchives
  .menubar.filemenu.cloud_access add cascade -label [mc "LabArchives"] -menu .menubar.filemenu.cloud_access.labarchives
  .menubar.filemenu.cloud_access.labarchives add command -state disabled -label [mc "Upload Open Files To LabArchives"] -command  "labarchive_upload_dialog $w"
  .menubar.filemenu.cloud_access.labarchives add command -state disabled -label [mc "Download Files From LabArchives"] -command  "labarchive_download_dialog $w"


#exit is added below in the platform specific code

#define edit menu
menu  .menubar.edit  
.menubar add cascade -menu .menubar.edit  -label [mc "Edit "]
.menubar.edit  add command -state disabled -label [mc "Undo"] -accelerator "$modstring+Z" -command  "undo $w"
bind .menubar.edit <<undostate>> disabled
bind .menubar.edit <<undolabel>> [mc "Undo"]
.menubar.edit  add command -state disabled -label [mc "Redo"] -accelerator "$modstring+Shift+Z" -command  "undo $w 0"
bind .menubar.edit <<redostate>> disabled
bind .menubar.edit <<redolabel>> [mc "Redo"]
.menubar.edit  add command -state disabled -label [mc "Cut"]  -accelerator "$modstring+X" -command  "clip_cut_copy $w cut"
.menubar.edit  add command -state disabled -label [mc "Copy"]  -accelerator "$modstring+C" -command  "clip_cut_copy $w copy"
.menubar.edit  add command -state disabled -label [mc "Paste"]  -accelerator "$modstring+V" -command  "clip_paste $w"
.menubar.edit  add separator
.menubar.edit  add command -state disabled -label [mc "Cut Rev-Com"]  -accelerator "$modstring+Shift+X" -command  "clip_cut_copy $w cut rev-com"
.menubar.edit  add command -state disabled -label [mc "Copy Rev-Com"]  -accelerator "$modstring+Shift+C" -command  "clip_cut_copy $w copy rev-com"
.menubar.edit  add command -state disabled -label [mc "Paste Rev-Com"]  -accelerator "$modstring+Shift+V" -command  "clip_paste $w rev-com"
.menubar.edit  add separator
  menu .menubar.edit.copy_special 
  .menubar.edit  add cascade -menu .menubar.edit.copy_special -label [mc "Copy Special"]
  .menubar.edit.copy_special add command -state disabled -label [mc "Copy All as GenBank"] -accelerator "$modstring+B" -command  "clipboard clear;clipboard_append -displayof $w \[genbank_text $w\]"
  #.menubar.edit.copy_special add separator
  #.menubar.edit.copy_special add command -state disabled -label [mc "Copy All But Selected"] -command  "clip_copy_special $w all_but_selected"
  #.menubar.edit.copy_special add command -state disabled -label [mc "Copy All But Selected Rev-Com"] -command  "clip_copy_special $w all_but_selected"
  .menubar.edit.copy_special add separator
  .menubar.edit.copy_special add command -state disabled -label [mc "Copy Uppercase"] -command  "clip_copy_special $w upper"
  .menubar.edit.copy_special add command -state disabled -label [mc "Copy Uppercase Rev-Com"] -command  "clip_copy_special $w upper rev_com"
  .menubar.edit.copy_special add separator
  .menubar.edit.copy_special add command -state disabled -label [mc "Copy Translated"] -command  "clip_copy_special $w translated"
  .menubar.edit.copy_special add command -state disabled -label [mc "Copy Uppercase Translated"] -command  "clip_copy_special $w translated_uc"
  .menubar.edit.copy_special add command -state disabled -label [mc "Copy Translated Rev-Com"] -command  "clip_copy_special $w translated rev_com"
  .menubar.edit.copy_special add command -state disabled -label [mc "Copy Uppercase Translated Rev-Com"] -command  "clip_copy_special $w translated_uc rev_com"
  .menubar.edit.copy_special add separator
  .menubar.edit.copy_special add command -state disabled -label [mc "Copy as FASTA"] -command  "clip_copy_special $w fasta"
  .menubar.edit.copy_special add separator
  .menubar.edit.copy_special add command -state disabled -label [mc "Copy Reverse (NOT A GOOD IDEA)"] -command  "clip_copy_special $w reverse"
  .menubar.edit.copy_special add command -state disabled -label [mc "Copy Complement (NOT A GOOD IDEA)"] -command  "clip_copy_special $w complement"
  .menubar.edit.copy_special add separator
  .menubar.edit.copy_special add command -state disabled -label [mc "Copy Features as NCBI Bankit table"] -command  "clipboard clear;clipboard_append -displayof $w \[bankit_text $w\]"
.menubar.edit  add separator
if {[tk windowingsystem] != "aqua"} {
  .menubar.edit  add command -state disabled -label [mc "Preferences..."]  -command  "configure_preferences $w"  -accelerator "$modstring+,"
  .menubar.edit  add separator
}

.menubar.edit  add command -state disabled -label [mc "Select All"]  -accelerator "$modstring+A" -command  "select_all $w"
.menubar.edit  add command -state disabled -label [mc "Select From-To..."]  -accelerator "$modstring+Shift+A" -command  "after $bugdelay select_from_to $w"
.menubar.edit  add command -state disabled -label [mc "Jump To..."]  -accelerator "$modstring+J" -command  "after $bugdelay jump_to $w"
.menubar.edit  add separator
.menubar.edit  add command -state disabled -label [mc "Find..."]  -accelerator "$modstring+F" -command  "after $bugdelay find_dialog $w"
.menubar.edit  add command -state disabled -label [mc "Find Again"]  -accelerator "$modstring+G" -command  "do_find $w again"
.menubar.edit  add command -state disabled -label [mc "Clear Find Highlighting"] -accelerator "$modstring+Shift+F" -command  "clear_find_highlight $w"
.menubar.edit  add separator
.menubar.edit  add command -state disabled -label [mc "Convert to UPPERCASE"]  -accelerator "$modstring++" -command  "change_case $w upper"
.menubar.edit  add command -state disabled -label [mc "Convert to lowercase"]  -accelerator "$modstring+-" -command  "change_case $w lower"
.menubar.edit  add command -state disabled -label [mc "UPPER<->lower"] -accelerator "$modstring+=" -command  "change_case $w exchange"
.menubar.edit  add separator
.menubar.edit  add command -state disabled -label [mc "Reverse-Complement"]  -accelerator "$modstring+/" -command  "rev_com_window $w"
.menubar.edit  add separator
.menubar.edit  add command -state disabled -label [mc "Circular<->Linear"] -command  "toggle_circ $w"
.menubar.edit  add command -state disabled -label [mc "Set Origin"]  -accelerator "$modstring+I" -command  "set_origin $w"
.menubar.edit  add command -state disabled -label [mc "Linearize @ insert site"] -command  "linearize $w"


#add enzymes menu
menu  .menubar.enzymes
.menubar add cascade -menu .menubar.enzymes -label [mc "Enzymes"]
.menubar.enzymes add command -state disabled -label [mc "Enzyme Selector..."] -accelerator "$modstring+E" -command  "after $bugdelay enzyme_selection_dialog $w"
.menubar.enzymes add separator
.menubar.enzymes add checkbutton -state disabled -label [mc "Selection Only"] -accelerator "$modstring+Shift-E" -onvalue "selection" -offvalue "all" -variable info(analyze_selection)

.menubar.enzymes add separator
.menubar.enzymes add command -state disabled -label [mc "Graphic Map"] -accelerator "$modstring+Y" -command  "after $bugdelay enz_graphic_map $w"
.menubar.enzymes add command -state disabled -label [mc "Graphic Map +U"] -accelerator "$modstring+Shift+Y" -command  "after $bugdelay enz_graphic_map $w {==1}"
.menubar.enzymes add separator
.menubar.enzymes add command -state disabled -label [mc "Highlight"] -command  "highlight_enzymes $w \$info(enz_currently_selected)";#uses selected
.menubar.enzymes add command -state disabled -label [mc "Clear Highlighting"] -command  "highlight_enzymes_clear $w"
.menubar.enzymes add separator
.menubar.enzymes add command -state disabled -label [mc "Digestion"] -accelerator "$modstring+R" -command  "after $bugdelay {enz_digest $w \$info(enz_currently_selected) \$info(analyze_selection)}"
#.menubar.enzymes add command -state disabled -label [mc "Partial Digestion..."] -accelerator "$modstring+Shift+R" -command  "after $bugdelay enz_digest_partial_dialog $w"
.menubar.enzymes add command -state disabled -label [mc "Digestion Dialog..."] -accelerator "$modstring+Shift+R" -command  "after $bugdelay enz_digest_dialog2 $w"
.menubar.enzymes add cascade -label [mc "Ladder"] -menu [menu .menubar.enzymes.ladders]
.menubar.enzymes add separator
.menubar.enzymes add command -state disabled -label [mc "List Enzymes..."] -command  "after $bugdelay list_enzymes_dialog $w"
menu .menubar.enzymes.lists
  .menubar.enzymes.lists add command -state disabled -label [mc "Site Usage"] -command  "after $bugdelay findenzymes $w; list_enzymes_window $w 1 all"
  .menubar.enzymes.lists add command -state disabled -label [mc "Unique Sites"] -command  "after $bugdelay findenzymes $w; list_enzymes_window $w 0 unique"
  .menubar.enzymes.lists add command -state disabled -label [mc "Absent Sites"] -command  "after $bugdelay findenzymes $w; list_enzymes_window $w 0 absent"
.menubar.enzymes add cascade -label [mc "Quick Lists"] -menu .menubar.enzymes.lists
.menubar.enzymes add separator
.menubar.enzymes add command -state disabled -label [mc "Silent Sites"]  -command  "after $bugdelay {silent_sites $w \$info(enz_currently_selected)}"
  .menubar.enzymes add command -state disabled -label [mc "Find Diagnostic Site"]  -command  "after $bugdelay {add_daignostic_site_dialog $w}"
.menubar.enzymes add separator
.menubar.enzymes add command -state disabled -label [mc "Text Map..."] -accelerator "$modstring+Shift+T" -command  "after $bugdelay enz_text_map $w"

#add ORFs menu
menu  .menubar.orf
.menubar add cascade -menu .menubar.orf -label [mc "ORFs"]
  .menubar.orf add command -state disabled -label [mc "Find Next"] -accelerator "$modstring+>" -command  "next_ORF $w forward"
  .menubar.orf add command -state disabled -label [mc "Find Previous"] -accelerator "$modstring+<" -command  "next_ORF $w reverse"
  #.menubar.orf add command -state disabled  -label [mc "Highlight all"] -command  "next_ORF $w all"
  menu .menubar.orf.start
  .menubar.orf add cascade -menu .menubar.orf.start -label [mc "ORF Starts With"]
    .menubar.orf.start add radiobutton -label [mc "Met"] -variable info(find_orf_starts) -value "Met"
    .menubar.orf.start add radiobutton -label [mc "Stop+1"] -variable info(find_orf_starts) -value "Stop+1"
  menu .menubar.orf.search_strand
  .menubar.orf add cascade -menu .menubar.orf.search_strand -label [mc "Search Strand"]
    .menubar.orf.search_strand add radiobutton -label [mc "Top"] -variable info(find_orf_strand) -value 1  -command  "set info(find_orf_strand_text) [mc Top]"
    .menubar.orf.search_strand add radiobutton -label [mc "Bottom"] -variable info(find_orf_strand) -value -1  -command  "set info(find_orf_strand_text) [mc Bottom]"
    .menubar.orf.search_strand add radiobutton -label [mc "Both"] -variable info(find_orf_strand) -value 0  -command  "set info(find_orf_strand_text) [mc Both]"
  menu .menubar.orf.min_orf
    foreach min [list 3 30 60 90 180 300 600 900 1200 1500] {
      .menubar.orf.min_orf add radiobutton -label $min -variable info(find_orf_min) -value $min
    }
  .menubar.orf add cascade -menu .menubar.orf.min_orf -label [mc "Minimum bp"]
  .menubar.orf add separator
  .menubar.orf add command -state disabled -label [mc "Translate..."] -accelerator "$modstring+T" -command  "after $bugdelay translation_window $w"
  .menubar.orf add separator
  .menubar.orf add command -state disabled -label [mc "ORF map"] -command  "after $bugdelay orf_map $w \$info(analyze_selection)"
  .menubar.orf add separator
    menu .menubar.orf.selection_translate_dir
      .menubar.orf.selection_translate_dir add radiobutton -label [mc "Forward"] -variable info($w,selection_shows_Trans_dir) -value 0 -command  "selection_manager $w"
      .menubar.orf.selection_translate_dir add radiobutton -label [mc "Reverse"] -variable info($w,selection_shows_Trans_dir) -value 1 -command  "selection_manager $w"
      set info($w,selection_shows_Trans_dir) 0
      set info($w,selection_shows_Trans_upper) 0
      set info($w,selection_Trans_rev) ""
      set info($w,selection_Trans) ""
  #.menubar.orf add checkbutton -label [mc "Selection Translate"] -variable info(selection_shows_Trans) -onvalue 1 -offvalue 0 -command  "selection_manager $w"
  .menubar.orf add checkbutton -state disabled -label [mc "Selection Translate"] -variable info($w,selection_shows_Trans) -onvalue 1 -offvalue 0 -command  "if {\$info($w,selection_shows_Trans)} {grid propagate $w.infoframe 1; grid configure $w.infoframe.trans;update idletasks; grid propagate $w.infoframe 0; selection_manager $w} else {grid propagate $w.infoframe 1; grid remove $w.infoframe.trans;update idletasks; grid propagate $w.infoframe 0}"
  .menubar.orf add cascade -label [mc "Selection Translate Direction"]  -menu .menubar.orf.selection_translate_dir
  .menubar.orf add checkbutton -state disabled -label [mc "Selection Translate Uppercase ONLY"] -variable info($w,selection_shows_Trans_upper) -onvalue 1 -offvalue 0

  set info($w,selection_shows_Trans) $info(selection_shows_Trans)
  #.menubar.orf add command -state disabled -label [mc "Codon Usage"]
  #.menubar.orf add command -state disabled -label [mc "Compare Codon Bias" ]
  #.menubar.orf add command -state disabled -label [mc "Open Codon Bias Table"]
  #.menubar.orf add separator

#add features menu
menu  .menubar.features
.menubar add cascade -menu .menubar.features -label [mc "Features"]
  .menubar.features add command -state disabled -label [mc "New Feature..."] -accelerator "$modstring+." -command  "add_sel_feature_file_dialog $w"
  .menubar.features add command -state disabled -label [mc "List Features"] -command  "after $bugdelay list_features $w"
  #.menubar.features add command -state disabled -label [mc "Edit Features..."] -command  "after $bugdelay configure_features $w"
  .menubar.features add command -state disabled -label [mc "Edit Features..."] -command "after $bugdelay  \{grid configure $w.tvframe; grid configure $w.tvframe.buttons\}"
  .menubar.features add command -state disabled -label [mc "Clear Features"] -accelerator "$modstring+Shift+K" -command  "feature_clear $w"
  #.menubar.features add command -state disabled -label [mc "Edit Feature Color Favorites"] -command  "edit_color_favorites $w"
  .menubar.features add command -state disabled -label [mc "Restack Features by Length"] -command  "restack_features $w"
  .menubar.features add command -state disabled -label [mc "Adjust Feature Colors for Readability"] -command  "features_adjust_color_dialog $w"
  .menubar.features add separator
  .menubar.features add command -state disabled -label [mc "Open Feature Library and Annotate"] -command  ""
  .menubar.features add command -state disabled -label [mc "Edit Feature Library..."] -command  "after $bugdelay edit_feature_library $w"
  .menubar.features add command -state disabled -label [mc "New Feature in Library..."] -command  "after $bugdelay add_sel_feature_library $w"
  .menubar.features add command -state disabled -label [mc "Open Feature Library..."] -command  "after $bugdelay {open_feature_library \{\} new 1}"
  .menubar.features add command -state disabled -label [mc "Annotate Features Using Current Library"] -accelerator "$modstring+K" -command  "feature_scan $w"
  .menubar.features add separator
  .menubar.features add checkbutton -state disabled -label [mc "Show X-Ray Window"] -variable info($w,seq_tooltip) -onvalue 1 -offvalue 0 -accelerator "Space"
  .menubar.features add separator
  .menubar.features add command -state disabled -label [mc "Annotate Features Using FASTA Search File..."] -command "multi_search_dialog $w"
  .menubar.features add separator
  .menubar.features add command -state disabled -label [mc "New Features From Found Highlighting"] -accelerator "$modstring+Shift+G" -command  "feature_from_found $w"
  .menubar.features add separator
  .menubar.features add command -state disabled -label [mc "Add Features from GFF3 file..."] -command  "add_gff_annotations $w"


#add Tools menu
menu  .menubar.tools
.menubar add cascade -menu .menubar.tools -label [mc "Tools"]
  .menubar.tools add command -state disabled -label [mc "Align Sequences..."] -accelerator "$modstring+L" -command  "after $bugdelay align_dialog2 $w"
  #.menubar.tools add command -state disabled -label [mc "Align Two Sequences..."] -accelerator "$modstring+Shift+L" -command  "after $bugdelay align_dialog $w"
  .menubar.tools add separator
  .menubar.tools add command -state disabled -label [mc "Restriction-Ligation Assembler..."] -accelerator "" -command  "after $bugdelay re_cloning_wizard_dialog $w"
  .menubar.tools add separator
  .menubar.tools add command -state disabled -label [mc "Recombination Assembler..."] -accelerator "" -command  "after $bugdelay recombination_window $w"
  .menubar.tools add command -state disabled -label [mc "Recombination Reaction Editor..."] -accelerator "" -command  "after $bugdelay recomb_dialog $w"
  .menubar.tools add separator
  #.menubar.tools add command -state disabled -label [mc "Gibson Reaction"] -command  "after $bugdelay gibson_dialog $w"
  .menubar.tools add command -state disabled -label [mc "Gibson Designer..."] -command  "after $bugdelay gibson_wizard_dialog $w"
  .menubar.tools add separator
.menubar.tools add command -state disabled -label [mc "PCR"] -command  "after $bugdelay pcr_dialog $w"
  .menubar.tools add command -state disabled -label [mc "Find PCR Primers..."] -command  "after $bugdelay primer_window $w"
  .menubar.tools add separator
  .menubar.tools add command -state disabled -label [mc "Golden Gate Designer..."] -command  "after $bugdelay gg_wizard_dialog $w"
  .menubar.tools add command -state disabled -label [mc "Golden Gate Assembler..."] -command  "after $bugdelay golden_gate_dialog $w"
  .menubar.tools add separator
  .menubar.tools add command -state disabled -label [mc "dCAPS Calculator..."] -command  "after $bugdelay dcaps_dialog $w"
  .menubar.tools add separator
  .menubar.tools add command -state disabled -label [mc "Calculator..."] -accelerator "$modstring+1" -command  "calc" 
  .menubar.tools add command -state disabled -label [mc "Molecular Reaction Calculator..."] -accelerator "$modstring+2" -command  "mol_calc" 
  .menubar.tools add separator
  .menubar.tools add command -state disabled -label [mc "BLAST Sequences At NCBI..."] -accelerator "$modstring+Shift+B" -command  "after $bugdelay NCBI_Blast $w"
 # .menubar.tools add command -state disabled -label [mc "BLAST Sequences At Wormbase..."] -command  "Wormbase_Blast $w"
  .menubar.tools add command -state disabled -label [mc "Download Sequences From NCBI..."] -command  "after $bugdelay entrez_dialog $w"
  .menubar.tools add separator
  .menubar.tools add command -state disabled -label [mc "Random Palette Generator"] -command  "after $bugdelay palette_test $w"
  .menubar.tools add separator
  .menubar.tools add command -state disabled -label [mc "sgRNA Analysis"] -command  "after $bugdelay sg_RNA_analysis $w" 
  .menubar.tools add separator
  .menubar.tools add command -state disabled -label [mc "Insert Repeat Sequence..."] -command  "after $bugdelay insert_repeat $w"
  .menubar.tools add command -state disabled -label [mc "Insert Restriction Enzyme Recognition Sequence..."] 
  .menubar.tools add separator
  .menubar.tools add command -state disabled -label [mc "Multi-Cre Recombination..."] -command  "after $bugdelay lox_recombination_window $w" 
  .menubar.tools add separator
  .menubar.tools add command -state disabled -label [mc "Digest All Open Windows"] -command  "after $bugdelay digest_open_windows"
  if  {[tk windowingsystem] == "aqua" || ([info commands snack::sound] != {})} {
    .menubar.tools add separator
    .menubar.tools add command -state disabled -label [mc "Start/Stop Speak Text..."] -accelerator "" -command  "after $bugdelay speak_dialog $w"
  }

  if {$info(use_aqua_system_windows_menu) && [tk windowingsystem] == "aqua"} {
    ## aqua system windows menu
    .menubar add cascade -menu [menu .menubar.view] -label [mc "View"]
      menu  .menubar.view.darkmodemenu
      .menubar.view.darkmodemenu add radiobutton -label [mc "Dark Mode"] -variable info(user_set_dark_mode) -value 1 -command "darkmode_set -1"
      .menubar.view.darkmodemenu add radiobutton -label [mc "Light Mode"] -variable info(user_set_dark_mode) -value 0 -command "darkmode_set -1"
      if { [bind . <<DarkAqua>> ] ne {} } {
         .menubar.view.darkmodemenu add radiobutton -label [mc "Match System Mode"] -variable info(user_set_dark_mode) -value -1 -command "darkmode_set -1"
      }
      .menubar.view add cascade -label [mc "Dark Mode"] -menu  .menubar.view.darkmodemenu
      .menubar.view add separator
    .menubar add cascade -menu [menu .menubar.window] -label [mc "Window"]
  } else {
    ## Standard ApE windows menu
    .menubar add cascade -menu [menu .menubar.windows] -label [mc "Window"]
  }


  menu  .menubar.help 
  .menubar add cascade -menu .menubar.help -label [mc "Help"]
  .menubar.help add command -state disabled -label [mc "Standard Genetic Code"] -command  "genetic_code_dialog $w"
  .menubar.help add command -state disabled -label [mc "Amino Acid Info"] -command  "aa_info_dialog $w"

    set iconlist [list .menubar.filemenu [mc New] new .menubar.filemenu [mc Open...] open .menubar.filemenu [mc Save] save .menubar.edit  [mc "Cut"] cut .menubar.edit  [mc "Copy"] copy .menubar.edit  [mc "Paste"] paste .menubar.edit  [mc "Cut Rev-Com"] cut .menubar.edit  [mc "Copy Rev-Com"] copy .menubar.edit  [mc "Paste Rev-Com"] paste .menubar.edit  [mc "Select From-To..."] select .menubar.edit  [mc "Jump To..."] jump .menubar.edit  [mc "Find..."] find .menubar.edit  [mc "Convert to UPPERCASE"] uppercase .menubar.edit  [mc "Convert to lowercase"] lowercase .menubar.edit  [mc "Reverse-Complement"] reverse_com .menubar.enzymes [mc "Enzyme Selector..."] enzymes .menubar.enzymes [mc "Graphic Map"] graphic_map .menubar.enzymes [mc "Graphic Map +U"] graphic_map .menubar.enzymes [mc "Highlight"] highlight_enzymes .menubar.enzymes [mc "Clear Highlighting"] highlight_enzymes .menubar.enzymes [mc "Digestion"] digest .menubar.enzymes [mc "Digestion Dialog..."] digest .menubar.enzymes [mc "Text Map..."] text_map .menubar.tools [mc "Find PCR Primers..."] find_primers .menubar.tools [mc "Align Sequences..."] align  .menubar.tools [mc "PCR"] pcr .menubar.tools [mc "Recombination Assembler..."] gibson .menubar.tools [mc "Gibson Designer..."] gibson .menubar.tools [mc "Golden Gate Assembler..."] golden_gate .menubar.tools [mc "Golden Gate Designer..."] golden_gate]


   #define the apple menu
    #menu .menubar.apple
    #  .menubar add cascade -menu .menubar.apple
    #  .menubar.apple add command -label [mc "About ApE"] -command "about_dialog ." 
    #  .menubar.apple add separator
      #.menubar.apple add command -label [mc "Preferences..."]  -command "configure_preferences ." -accelerator "$modstring+,"
}
  set info(newaquax) 20
  set info(newaquay) 20
  set info(aqua_page_setup) {}
  #set ::tk::mac::CGAntialiasLimit $info(mac_antialias_limit)


  proc aqua_minimize {w} {
	wm iconify $w
    }

  ###
  ## bug in Aqua that doesn't fire B1-Leave events
  ##
  bind Text  <B1-Leave> ""
   proc tk::TextSelectTo {w x y} {
    variable ::tk::Priv

    if {![winfo exists $w]} {
	return
    }
    if {[info exists Priv(y)]} {
      if {$Priv(y) >= [winfo height $w]} {
  	$w yview scroll [expr {1 + $Priv(y) - [winfo height $w]}] pixels
      } elseif {$Priv(y) < 0} {
  	$w yview scroll [expr {-1 + $Priv(y)}] pixels
      } elseif {$Priv(x) >= [winfo width $w]} {
  	$w xview scroll 2 units
      } elseif {$Priv(x) < 0} {
  	$w xview scroll -2 units
      } else {
        tk::CancelRepeat
      }
    }


    set anchorname [tk::TextAnchor $w]
    set cur [TextClosestGap $w $x $y]
    if {[catch {$w index $anchorname}]} {
	$w mark set $anchorname $cur
    }
    set anchor [$w index $anchorname]
    if {[$w compare $cur != $anchor] || (abs($Priv(pressX) - $x) >= 3)} {
	set Priv(mouseMoved) 1
    }
    switch -- $Priv(selectMode) {
	char {
	    if {[$w compare $cur < $anchorname]} {
		set first $cur
		set last $anchorname
	    } else {
		set first $anchorname
		set last $cur
	    }
	}
	word {
	    # Set initial range based only on the anchor (1 char min width)
	    if {[$w mark gravity $anchorname] eq "right"} {
		set first $anchorname
		set last "$anchorname + 1c"
	    } else {
		set first "$anchorname - 1c"
		set last $anchorname
	    }
	    # Extend range (if necessary) based on the current point
	    if {[$w compare $cur < $first]} {
		set first $cur
	    } elseif {[$w compare $cur > $last]} {
		set last $cur
	    }

	    # Now find word boundaries
	    set first [TextPrevPos $w "$first + 1c" tcl_wordBreakBefore]
	    set last [TextNextPos $w "$last - 1c" tcl_wordBreakAfter]
	}
	line {
	    # Set initial range based only on the anchor
	    set first "$anchorname linestart"
	    set last "$anchorname lineend"

	    # Extend range (if necessary) based on the current point
	    if {[$w compare $cur < $first]} {
		set first "$cur linestart"
	    } elseif {[$w compare $cur > $last]} {
		set last "$cur lineend"
	    }
	    set first [$w index $first]
	    set last [$w index "$last + 1c"]
	}
    }
    if {$Priv(mouseMoved) || ($Priv(selectMode) ne "char")} {
	$w tag remove sel 0.0 end
	$w mark set insert $cur
	$w tag add sel $first $last
	$w tag remove sel $last end
	update idletasks
    }
   }

    proc tk::EntryMouseSelect {w x} {

      variable ::tk::Priv

      if {[info exists Priv(x)]} {
        set x $Priv(x)
      } else {
        set x 0
      }
      if {![winfo exists $w]} {
	  return
      }
      if {$x >= [winfo width $w]} {
	  $w xview scroll 2 units
      } elseif {$x < 0} {
	  $w xview scroll -2 units
      }
      set cur [EntryClosestGap $w $x]
      set anchor [$w index anchor]
      if {($cur != $anchor) || (abs($Priv(pressX) - $x) >= 3)} {
  	set Priv(mouseMoved) 1
      }
      switch $Priv(selectMode) {
	  char {
	      if {$Priv(mouseMoved)} {
	  	if {$cur < $anchor} {
		      $w selection range $cur $anchor
	  	} elseif {$cur > $anchor} {
		      $w selection range $anchor $cur
	  	} else {
		      $w selection clear
	  	}
	      }
	  }
	  word {
	    if {$cur < $anchor} {
	  	  set before [tcl_wordBreakBefore [$w get] $cur]
		  set after [tcl_wordBreakAfter [$w get] $anchor-1]
	      } elseif {$cur > $anchor} {
		  set before [tcl_wordBreakBefore [$w get] $anchor]
		  set after [tcl_wordBreakAfter [$w get] $cur-1]
	      } else {
		  if {[$w index @$Priv(pressX)] < $anchor} {
		      incr anchor -1
		  }  
		  set before [tcl_wordBreakBefore [$w get] $anchor]
		  set after [tcl_wordBreakAfter [$w get] $anchor]
	      }
	      if {$before < 0} {
	  	set before 0
	      }
	      if {$after < 0} {
		  set after end
	      }
	      $w selection range $before $after
	  }
	  line {
	      $w selection range 0 end
	  } 
      }
      if {$Priv(mouseMoved)} {
          $w icursor $cur
      }
      update idletasks
    }
   ###### end B1-Leave bug fix




   ## bug in Aqua that crashes when making a  toplevel when a  toolbar-type window exists
  ## fixed now
if {0} {
  rename toplevel real_toplevel
  proc toplevel {args} {
     global info
    foreach w [winfo children .] {
      if {[winfo class $w] ne "Toplevel"} {continue}
      if {[catch {set style [lindex [tk::unsupported::MacWindowStyle style $w] 0]}]} {sputs err $w;continue}
      if {$style eq "help" || $style eq "simple"} {
	#sputs w $w $style
	destroy $w
      }
    }

    real_toplevel {*}$args
    if {$info(dark_mode)} {
	set win [lindex $args 0]
	after 1 "if {\[winfo exists $win\]} {catch {tk::unsupported::MacWindowStyle appearance $win darkaqua}}"
    }
    return [lindex $args 0]
  }
}

   ## bug in Aqua that crashes when destroying a  toplevel when a  menu window is posted
  rename destroy real_destroy
  proc destroy {args} {
    variable ::tk::Priv
    if {[winfo exists [lindex $args 0]]  && [winfo class [lindex $args 0]] eq "Toplevel" && [info exists Priv(popupmenu_posted)] && $Priv(popupmenu_posted)} {
      after 1000 "destroy {*}$args"
    } else {
      real_destroy {*}$args
    }
  }

  ## this is the same as the usual system proc, but sets Priv(popupmenu_posted) for the destroy proc above
  proc tk_popup {menu x y {entry {}}} {
    variable ::tk::Priv
    if {$Priv(popup) ne "" || $Priv(postedMb) ne ""} {
	tk::MenuUnpost {}
    }
    set Priv(popupmenu_posted) 1
    tk::PostOverPoint $menu $x $y $entry
    set Priv(popupmenu_posted) 0
  }
}

################
## initialize some Linux packages
################
proc initialize_linux {} {
  global info tk_patchLevel

  if {![catch {package require tls}]} {
    ::tls::init  -tls1 0 -tls1.1 0 -tls1.2 1 -ssl2 0 -ssl3 0
    ##::http::register https 443 ::tls::socket
    ::http::register https 443 [list ::tls::socket -autoservername true]
    set info(tls) "tls" 
  } else {
    set info(tls) "curl" 
  }

  package require pdf4tcl
  package require qrcode
  set filename [file join $info(Accdir) "Icons and images" "ApE_icon.png"]
  if {[file exists $filename]} {
    set icon_photo [image create photo  -file $filename]
    wm iconphoto .  -default $icon_photo
  } 

}

################
## initialize some info for Android
################
proc initialize_android {} {
  global info
  package require tls
  #::tls::init  -tls1 1 -tls1.2 0 -tls1.1 0 -ssl3 0 -ssl2 0
  #::http::register https 443 ::tls::socket

  ::tls::init  -tls1 0 -tls1.1 0 -tls1.2 1 -ssl2 0 -ssl3 0
  ##::http::register https 443 ::tls::socket
  ::http::register https 443 [list ::tls::socket -autoservername true]
  set info(tls) "tls" 

  package require pdf4tcl
  package require qrcode

  #package require Img
  #set info(display_metrics) [borg displaymetrics]
  # create file treeview style: no indicator, 60px image padding

########## 
proc ::tk::NumberEntryButton1 {w x} {
    variable ::tk::Priv

    set Priv(selectMode) char
    set Priv(mouseMoved) 0
    set Priv(pressX) $x
    $w icursor [EntryClosestGap $w $x]
    $w selection from insert
    if {"disabled" ne [$w cget -state]} {
	focus $w
	if {"readonly" ne [$w cget -state]} {
	    if {$::tk::sdltk} {
		if {"SdlTkNoTextInput" in [bindtags $w]} {
		    return
		}
                set hint 0
		if {"SdlTkNumberTextInput" in [bindtags $w]} {
                  set hint 2
		} elseif {"SdlTkPhoneTextInput" in [bindtags $w]} {
                  set hint 3
		} elseif {"SdlTkDateTextInput" in [bindtags $w]} {
                  set hint 4
		}

sputs bindtags $w [bindtags $w] $hint
		if {[catch {
		    lassign [$w bbox insert] x y
		    incr x [winfo rootx $w]
		    incr y [winfo rooty $w]
		}]} {
		    lassign [winfo pointerxy $w] x y
		}
		sdltk textinput 1 $x $y $hint
	    }
	}
    }
}



#############
proc ::tk::TextSetInput {w} {
    if {[focus] ne $w} {
	return
    }
    if {$::tk::sdltk} {
	if {"SdlTkNoTextInput" in [bindtags $w]} {
	    return
	}
        set hint 0
	if {"SdlTkNumberTextInput" in [bindtags $w]} {
          set hint 2
	} elseif {"SdlTkPhoneTextInput" in [bindtags $w]} {
          set hint 3
	} elseif {"SdlTkDateTextInput" in [bindtags $w]} {
          set hint 4
	}
	if {[catch {
	    lassign [$w bbox insert] x y
	    incr x [winfo rootx $w]
	    incr y [winfo rooty $w]
	}]} {
	    lassign [winfo pointerxy $w] x y
	}
	sdltk textinput 1 $x $y $hint
    }
}

#########
proc ::tk::spinbox::ButtonDown {w x y} {
    variable ::tk::Priv

    # Get the element that was clicked in.  If we are not directly over
    # the spinbox, default to entry.  This is necessary for spinbox grabs.
    #
    set Priv(element) [$w identify $x $y]
    if {$Priv(element) eq ""} {
	set Priv(element) "entry"
    }

    switch -exact $Priv(element) {
	"buttonup" - "buttondown" {
	    ::tk::spinbox::ArrowPress $w $x $y
	}
	"entry" {
	    set Priv(selectMode) char
	    set Priv(mouseMoved) 0
	    set Priv(pressX) $x
	    $w icursor [::tk::spinbox::ClosestGap $w $x]
	    $w selection from insert
	    if {"disabled" ne [$w cget -state]} {
		focus $w
		if {"readonly" ne [$w cget -state]} {
		    if {$::tk::sdltk} {
			if {"SdlTkNoTextInput" ni [bindtags $w]} {
                          set hint 0
	                  if {"SdlTkNumberTextInput" in [bindtags $w]} {
                            set hint 2
                  	} elseif {"SdlTkPhoneTextInput" in [bindtags $w]} {
                            set hint 3
	                  } elseif {"SdlTkDateTextInput" in [bindtags $w]} {
                            set hint 4
                  	}
			    if {[catch {
				lassign [$w bbox insert] x y
				incr x [winfo rootx $w]
				incr y [winfo rooty $w]
			    }]} {
				lassign [winfo pointerxy $w] x y
			    }
			    sdltk textinput 1 $x $y
			}
		    }
		}
	    }
	    $w selection clear
	}
	default {
	    return -code error -errorcode {TK SPINBOX UNKNOWN_ELEMENT} \
		"unknown spinbox element \"$Priv(element)\""
	}
    }
}


###### colorpicker dialog remake
namespace eval ::tk {}
namespace eval ::tk::dialog {}
namespace eval ::tk::dialog::color {
    namespace import ::tk::msgcat::*
}

proc ::tk::dialog::color:: {args} {
    variable ::tk::Priv
    set dataName __tk__color
    upvar ::tk::dialog::color::$dataName data
    set w .$dataName
    # The lines variables track the start and end indices of the line
    # elements in the colorbar canvases.
    set data(lines,red,start)   0
    set data(lines,red,last)   -1
    set data(lines,green,start) 0
    set data(lines,green,last) -1
    set data(lines,blue,start)  0
    set data(lines,blue,last)  -1

    # This is the actual number of lines that are drawn in each color strip.
    # Note that the bars may be of any width.
    # However, NUM_COLORBARS must be a number that evenly divides 256.
    # Such as 256, 128, 64, etc.
    set data(NUM_COLORBARS) 64

    # BARS_WIDTH is the number of pixels wide the color bar portion of the
    # canvas is. This number must be a multiple of NUM_COLORBARS
    set data(BARS_WIDTH) 192

    # PLGN_WIDTH is the number of pixels wide of the triangular selection
    # polygon. This also results in the definition of the padding on the
    # left and right sides which is half of PLGN_WIDTH. Make this number even.
    set data(PLGN_HEIGHT) 10

    # PLGN_HEIGHT is the height of the selection polygon and the height of the
    # selection rectangle at the bottom of the color bar. No restrictions.
    set data(PLGN_WIDTH) 10

    Config $dataName $args
    InitValues $dataName

    set sc [winfo screen $data(-parent)]
    set winExists [winfo exists $w]
    if {!$winExists || $sc ne [winfo screen $w]} {
	if {$winExists} {
	    destroy $w
	}
	toplevel $w -class TkColorDialog -screen $sc -bg white
        if {([tk windowingsystem] == "aqua")} {
          tk::unsupported::MacWindowStyle style $w help {}
        } else { 
          wm overrideredirect $w 1
        }
	if {[tk windowingsystem] eq "x11"} {wm attributes $w -type dialog}
	BuildDialog2 $w
    }

    # Dialog boxes should be transient with respect to their parent,
    # so that they will always stay on top of their parent window.  However,
    # some window managers will create the window as withdrawn if the parent
    # window is withdrawn or iconified.  Combined with the grab we put on the
    # window, this can hang the entire application.  Therefore we only make
    # the dialog transient if the parent is viewable.

    if {[winfo viewable [winfo toplevel $data(-parent)]] } {
	wm transient $w $data(-parent)
    }

    # 5. Withdraw the window, then update all the geometry information
    # so we know how big it wants to be, then center the window in the
    # display (Motif style) and de-iconify it.

    ::tk::PlaceWindow $w widget $data(-parent)
    wm title $w $data(-title)

    # 6. Set a grab and claim the focus too.

    ::tk::SetFocusGrab $w $data(okBtn)

    # 7. Wait for the user to respond, then restore the focus and
    # return the index of the selected button.  Restore the focus
    # before deleting the window, since otherwise the window manager
    # may take the focus away so we can't redirect it.  Finally,
    # restore any grab that was in effect.

    vwait ::tk::Priv(selectColor)
    set result $Priv(selectColor)
    ::tk::RestoreFocusGrab $w $data(okBtn)
    unset data

    return $result
}



proc ::tk::dialog::color::BuildDialog2 {w} {
    upvar ::tk::dialog::color::[winfo name $w] data
    # TopFrame contains the color strips and the color selection
    #
    set topFrame [frame $w.top -relief flat -bd 1 -bg white]

    # StripsFrame contains the colorstrips and the individual RGB entries
    set stripsFrame [frame $topFrame.colorStrip -bg white]

    set maxWidth [::tk::mcmaxamp Red Green Blue]
    set maxWidth [expr {$maxWidth<6 ? 6 : $maxWidth}]
    set colorList {
	red   "Red"
	green "Green"
	blue  "Blue"
    }
    foreach {color l} $colorList {
	# each f frame contains an [R|G|B] entry and the equiv. color strip.
	set f [frame $stripsFrame.$color -bg white]

	# The box frame contains the label and entry widget for an [R|G|B]
	set box [frame $f.box -bg white]

	label $box.label -text "[mc $l]:" \
		-width $maxWidth -anchor ne -bg white
	bind $box.label <<AltUnderlined>> [list focus $box.entry]

	entry $box.entry -textvariable \
		::tk::dialog::color::[winfo name $w]($color,intensity) \
		-width 4 -bg white  -highlightthickness 0 -relief flat
	pack $box.label -side left -fill y -padx 2 -pady 3 
	pack $box.entry -side left -anchor n -pady 0 
	pack $box -side left -fill both

	set height [expr {
	    [winfo reqheight $box.entry] -
	    2*([$box.entry cget -highlightthickness] + [$box.entry cget -bd])
	}]

	canvas $f.color -height $height \
		-width $data(BARS_WIDTH) -relief flat -bd 2 -bg white  -highlightthickness 0
	canvas $f.sel -height $data(PLGN_HEIGHT) \
		-width $data(canvasWidth) -highlightthickness 0 -bg white
	pack $f.color -expand yes -fill both
	pack $f.sel -expand yes -fill both

	pack $f -side top -fill x -padx 0 -pady 2

	set data($color,entry) $box.entry
	set data($color,col) $f.color
	set data($color,sel) $f.sel

	bind $data($color,col) <Configure> \
		[list tk::dialog::color::DrawColorScale $w $color 1]
	bind $data($color,col) <Enter> \
		[list tk::dialog::color::EnterColorBar $w $color]
	bind $data($color,col) <Leave> \
		[list tk::dialog::color::LeaveColorBar $w $color]

	bind $data($color,sel) <Enter> \
		[list tk::dialog::color::EnterColorBar $w $color]
	bind $data($color,sel) <Leave> \
		[list tk::dialog::color::LeaveColorBar $w $color]

	bind $box.entry <Return> [list tk::dialog::color::HandleRGBEntry $w]
    }

    pack $stripsFrame -side left -fill both -padx 4 -pady 10

    # The selFrame contains a frame that demonstrates the currently
    # selected color
    #
    set selFrame [frame $topFrame.sel -bg white]
    set lab [::ttk::label $selFrame.lab \
	    -text [mc "Selection:"] -anchor sw]
    set ent [entry $selFrame.ent \
	    -textvariable ::tk::dialog::color::[winfo name $w](selection) \
	    -width 16]
    set f1  [frame $selFrame.f1 -relief flat -bd 2 -bg white]
    set data(finalCanvas) [frame $f1.demo -bd 0 -width 100 -height 70]

    #pack $lab $ent -side top -fill x -padx 4 -pady 2
    pack $f1 -expand yes -anchor nw -fill both -padx 6 -pady 10
    pack $data(finalCanvas) -expand yes -fill both

    bind $ent <Return> [list tk::dialog::color::HandleSelEntry $w]

    pack $selFrame -side left -fill none -anchor nw
    pack $topFrame -side top -expand yes -fill both -anchor nw

    # the botFrame frame contains the buttons
    #
    set botFrame [frame $w.bot -relief flat -bd 1 -bg white]

    ::ttk::button $botFrame.ok -text [mc "OK"]		\
	    -command [list tk::dialog::color::OkCmd $w]
    ::ttk::button $botFrame.cancel -text [mc "CANCEL"]	\
	    -command [list tk::dialog::color::CancelCmd $w]

    set data(okBtn)      $botFrame.ok
    set data(cancelBtn)  $botFrame.cancel

    grid x $botFrame.ok x $botFrame.cancel x -sticky ew
    grid configure $botFrame.ok $botFrame.cancel -padx 10 -pady 10
    grid columnconfigure $botFrame {0 4} -weight 1 -uniform space
    grid columnconfigure $botFrame {1 3} -weight 1 -uniform button
    grid columnconfigure $botFrame 2 -weight 2 -uniform space
    pack $botFrame -side bottom -fill x

    # Accelerator bindings
    bind $lab <<AltUnderlined>> [list focus $ent]
    bind $w <KeyPress-Escape> [list tk::ButtonInvoke $data(cancelBtn)]
    bind $w <Alt-Key> [list tk::AltKeyInDialog $w %A]

    wm protocol $w WM_DELETE_WINDOW [list tk::dialog::color::CancelCmd $w]
    bind $lab <Destroy> [list tk::dialog::color::CancelCmd $w]
}


## end of initialize_android
}

######
## Menu Hamburger
######
proc post_menu_hamburger {w} {
  global info
  #catch {destroy .bg}
  #toplevel .bg -background black
  #wm attributes .bg -fullscreen 0 -alpha .85



  if {![winfo exists $w.menutree]} {
    toplevel $w.menutree -bg white
    wm overrideredirect $w.menutree 1

   # right side indicator, no image padding (so the separator runs the full width, use leading spaces to add justification
    ttk::style layout Menu.Treeview.Item {Treeitem.padding -sticky nswe  -children {Treeitem.impadding -sticky nswe -children {Treeitem.image -side left -sticky {}} Treeitem.text -side left -sticky e Menu.Treeitem.indicator -side right -sticky {} }}

    ttk::style configure Menu.Treeview -rowheight [expr {int(48 * $info(pixels_per_dp))}] -indent 0 -font {Roboto 10 bold}  -borderwidth 0
    ttk::treeview $w.menutree.t -show tree -selectmode none -columns {type var value} -displaycolumns {}  -style Menu.Treeview

    $w.menutree.t tag configure sel -background gray80
    bindtags $w.menutree.t [list $w.menutree.t]
    bind $w.menutree.t <<RadioDict>> [dict create]
    menu_to_treeview $w.menubar $w.menutree.t
    # mouse up-down scroll, left-right swipe
    if {[tk windowingsystem] == "aqua"} {
       bind $w.menutree.t <Button-1> "if {\[info exists info(button_cancel)\]} {after cancel \$info(button_cancel); unset -nocomplain  info(button_cancel)} else {hamburger_treeview_button_down $w.menutree %X %Y}; unset -nocomplain  info(button_cancel)"
       bind $w.menutree.t <Button-3> " if {\[info exists info(button_cancel)\]} {after cancel \$info(button_cancel); unset -nocomplain  info(button_cancel)}"
       bind $w.menutree.t <Motion> "hamburger_treeview_button_motion $w.menutree %X %Y"
       bind $w.menutree.t <ButtonRelease-1> "set info(button_cancel) \[after 50 {menu_treeview_invoke $w.menutree \[hamburger_treeview_button_release $w.menutree %X %Y\]; unset -nocomplain  info(button_cancel)}\]"
       bind $w.menutree.t <ButtonRelease-3> "set info(button_cancel) \[after 50 {menu_treeview_invoke $w.menutree \[hamburger_treeview_button_release $w.menutree %X %Y\]; unset -nocomplain  info(button_cancel)}\]"
       bind $w.menutree.t <Button-2> "hamburger_treeview_button_down $w.menutree %X %Y"
       bind $w.menutree.t <ButtonRelease-2> "menu_treeview_invoke $w.menutree \[hamburger_treeview_button_release $w.menutree %X %Y\]"
    } else {
       bind $w.menutree.t <<FingerDown>> "hamburger_treeview_button_down $w.menutree \[expr {%x * \[winfo screenwidth .\]/10000}\]  \[expr {%y* \[winfo screenheight .\]/10000}\]"
       bind $w.menutree.t <<FingerMotion>> "hamburger_treeview_button_motion $w.menutree \[expr {%x * \[winfo screenwidth .\]/10000}\]  \[expr {%y * \[winfo screenheight .\]/10000}\]"
       bind $w.menutree.t <<FingerUp>> "menu_treeview_invoke $w.menutree \[hamburger_treeview_button_release $w.menutree \[expr {%x * \[winfo screenwidth .\]/10000}\]  \[expr {%y * \[winfo screenheight .\]/10000}\]\];"
    }
  } elseif {[lindex [wm stackorder $w] end] == "$w.menutree"} {
    return
  } else {
    raise $w.menutree
  }
 
  set menuwidth [expr {int(280 * $info(pixels_per_dp))}]
  set screenheight [winfo screenheight .]
  wm geometry $w.menutree [list $menuwidth\x$screenheight+[expr {int(5 - $menuwidth)}]+0]
  place  $w.menutree.t  -x 0 -y 0 -height $screenheight -width $menuwidth
   update idletasks
  $w.menutree.t column #0 -width [expr {[winfo width $w.menutree]-20}]
  menu_on_screen $w.menutree
  bind . <Configure> "wm geometry $w.menutree \[list \[expr {int(280 * $info(pixels_per_dp))}\]\x\[winfo screenheight .\]+0+0]"
}

######
##
######
proc hamburger_treeview_button_down {w x y} {
  global tvx tvy tv_i tvnet tvmode tvxg tvyg
  set tvx $x
  set tvy $y
  set tv_i [lindex [$w.t yview] 0]
  set tvnet 0 
  set tvmode 0 
  set tvxg [winfo x $w]
  set tvyg [winfo y $w]
  set wx [expr {$x - [winfo rootx $w.t]}]
  set wy [expr {$y - [winfo rooty $w.t]}]
  set item [$w.t identify row $wx $wy]
  if {![catch {lindex [$w.t item $item -values] 0}  val]} {
    if {$val != "separator"} {
      $w.t tag add sel $item
    }
  }
}

######
##
######
proc hamburger_treeview_button_motion {w x y} {
  global tvx tvy tv_i tvnet tvmode tvxg tvyg
  if {![info exists tvmode]} {return}
  if {$tvmode ==0} {
    if {[expr {$tvx - $x}] > 40} {
      set tvmode 1
      $w.t tag  remove sel [$w.t tag has sel]
    } elseif {[expr {abs($tvy - $y)}] > 30} {
      set tvmode -1
      $w.t tag  remove sel [$w.t tag has sel]
    }
  } elseif {$tvmode ==1} {
    wm geometry $w "+[expr {$tvxg+min($x -$tvx,0)}]+$tvyg"
    menu_set_bg_alpha $w
  } else {
    set delta [expr {$tv_i + [android_treeview_touch_delta $w.t [expr {-$y + $tvy}]]}]
    #set style [$w.t cget -style]
    if {$delta < 0 && [lindex [$w.t yview] 0] == 0} {
      set val [expr {max(0,min(90, -int($delta*1500)))}]
      place $w.t -y [expr {$val}]
      bind $w.t <<Y_offset>> [expr {-$val}]
      $w configure -background "gray[expr {99-$val}]"
      #ttk::style configure $style -foreground "gray$val"
      #sputs off top  $w.t  [$w.t yview] $delta $val
    } elseif {$delta > [lindex [$w.t yview] 0] && [lindex [$w.t yview] 1] == 1} {
      set val [expr {max(0,min(90, int(($delta - [lindex [$w.t yview] 0])*1500)))}]
      place $w.t -y [expr {-$val}]
      bind $w.t <<Y_offset>> [expr {-$val}]
      $w configure -background "gray[expr {99-$val}]"
      #ttk::style configure $style -foreground "gray$val"
      #sputs off bottom  $w.t  [$w.t yview] $delta [expr {-$y + $tvy}] $val
    } else {
      bind $w.t <<Y_offset>> ""
      $w configure -background white
      #ttk::style configure $style -foreground black
      $w.t yview moveto $delta
    }
  }
}

######
##
######
proc android_treeview_touch_delta {t pixels} {
  set height_in_pixels [winfo height $t]
  foreach {y1 y2} [$t yview] {}
  set scrollable_percent [expr {1- ($y2 - $y1)}]
  set pixels_per_percent [expr {$height_in_pixels / ($y2 - $y1)}]
  set move_percent [expr {($pixels / $pixels_per_percent)}]
  return $move_percent
}

######
##
######
proc hamburger_treeview_button_release {w x y} {
  global tvx tvy tvnet tvmode tvxg tvyg

  if {![info exists tvmode]} {return}
  set return 0
  if {$tvmode == 0} {
    set wx [expr {$x - [winfo rootx $w.t]}]
    set wy [expr {$y - [winfo rooty $w.t]}]
    set return  [$w.t identify row $wx $wy]
  } elseif {$tvmode == 1} {
    if  {[expr {$tvx - $x}] > [expr {[winfo width $w] / 2}]} {
      menu_off_screen $w 
      set return -1
    } else {
      menu_on_screen $w
    }
  } else {
    if { [set offset [bind $w.t <<Y_offset>>]] != ""} {
      menu_on_screen_y $w.t $offset
    }
  }
  $w.t tag  remove sel [$w.t tag has sel]
  unset -nocomplain tvx tvy tvnet tvmode tvxg tvyg
  return $return
}

######
##
######
proc menu_treeview_invoke {w item} {
  if {$item == 0 || $item == -1 || [catch {$w.t item $item -values} values]} {
    return
  }
    switch [$w.t set $item type] {
      cascade {
        $w.t item $item -open [expr {![$w.t item $item -open]}]
     
      }
      separator {

      }
      command {
        menu_off_screen $w
        uplevel #0 [$w.t set $item value]
      }
      default {
        #sputs invoke menu default type [$w.t set $item type] 
      }
    }
}

######
## move tree back onto screen
######
proc menu_on_screen {m} {
  raise $m
  for {set menux [winfo x $m]} {$menux <= 0} {set menux [expr {$menux < 0?min(0,$menux +95):10}]} {
    wm geometry $m [list +$menux+0]
    #update
    #menu_set_bg_alpha $m
  }
}

######
## move tree back onto screen
######
proc menu_on_screen_y {m offset} {
    #set style [$m cget -style]
    set w [winfo toplevel $m]
    set sign [expr {sign([dict get [place info $m] -y])}]
  for {set menuy [expr {abs($offset)}]} {$menuy > 0} {set menuy [expr {max(0, $menuy-25)}]} {
       $w configure -background  "gray[expr {99-$menuy}]"
      place $m -y [expr {$sign * $menuy}]
      #update
  }
   $w configure -background white
   #ttk::style configure $style -foreground black
     place $m -y 0
}

######
##
######
proc menu_off_screen {m} {
  set screenwidth 250
  set destx [expr {int(5 + -.95 * $screenwidth)}] 
  for {set menux [winfo x $m]} {$menux > $destx} {set menux [expr {max($destx,$menux -10)}]} {
    after 5
    update idletasks
    wm geometry $m [list +$menux+0]
    menu_set_bg_alpha $m
  }
  #wm withdraw $m
  lower $m
  bind . <Configure> ""
  #destroy .bg
}

######
##
######
proc menu_set_bg_alpha {m} {
  #set screenwidth 250
  #set destx [expr {int(5 + .95 * $screenwidth)}] 
  #wm attributes .bg -alpha [expr {1.0 *($destx + [winfo x $m])/ $destx * .95}]
}


######
##
######
proc menu_to_treeview {m t {item {}} {depth 0}} {
  $t delete [$t children $item]
  set radiodict [bind $t <<RadioDict>>]
  for {set i 0} {$i <= [$m index end]} {incr i} {
    switch [$m type $i] {
      cascade {
        set new_item [$t insert $item end -text "[string repeat { } [expr {7 + 3* $depth}]][$m entrycget $i -label]"]
        menu_to_treeview [$m entrycget $i -menu] $t $new_item [expr {$depth + 1}]
        $t set $new_item type cascade
      }
      separator {
        set new_item [$t insert $item end -text [string repeat \u2500 20]]
        $t set $new_item type separator
      }
      checkbutton {
        set new_item [$t insert $item end -text "[string repeat { } [expr {7 + 3* $depth}]][$m entrycget $i -label]"]
        $t set $new_item type checkbutton
        $t set $new_item var  [$m entrycget $i -variable]
        $t set $new_item value  [list [$m entrycget $i -offvalue] [$m entrycget $i -onvalue]]
      }
      radiobutton {
        set new_item [$t insert $item end -text "[string repeat { } [expr {7 + 3* $depth}]][$m entrycget $i -label]"]
        $t set $new_item type radiobutton
        $t set $new_item var  [$m entrycget $i -variable]
        dict lappend radiodict [$m entrycget $i -variable] $new_item
      }
      command {
        set new_item [$t insert $item end -text "[string repeat { } [expr {7 + 3* $depth}]][$m entrycget $i -label]"]
        $t set $new_item type command
        $t set $new_item value [$m entrycget $i -command]
      }
      default {
        set new_item [$t insert $item end -text "[string repeat { } [expr {7 + 3* $depth}]][$m entrycget $i -label]"]
      }
    }
  }
  bind $t <<RadioDict>> $radiodict
}

############################
######
## File Browser Hamburger
######
## needs to add a three dot menu for sorting by mod date, create date, size, name
## add external and internal root, or just external root, possibly just external downloads and external docs root. Internal is maintained by savig the current workspace.;

### Save file options
## 1. Save file dialog- needs a filename entry on bottom or in next dialog, 
## 2. Export file dialog: let user rename in the top window (option of copy or rename). Choose directory using this window, but without files shown, and with a "select this directory" button at the bottom or top. No new directory option.
## 3. Save copy as- just save the file with the current name, or option to save a copy with a new name in the current directory

proc post_file_hamburger {dir} {
  global toolbar_images  info file_return
  if {![file isdirectory $dir]} {
    return
  }
  #catch {destroy .bg}
  #toplevel .bg -background black
  #wm attributes .bg -fullscreen 0 -alpha .85

  if {![winfo exists .filetree]} {
    toplevel .filetree -bg white
    wm overrideredirect .filetree 1

    ttk::style configure FileBrowser.Treeview -rowheight [expr {int(48 * $info(pixels_per_dp))}] -font {Roboto 10 bold}  -borderwidth 0
    ttk::treeview .filetree.t -show tree -selectmode none -columns  {type Dir Size Date} -displaycolumns {}  -style FileBrowser.Treeview

    .filetree.t tag configure sel -background gray80
    .filetree.t tag configure dir -image $toolbar_images(folder_open_icon_48)
    bindtags .filetree.t [list .filetree.t]

    directory_to_treeview $dir .filetree.t

    if {[tk windowingsystem] == "aqua"} {
    # mouse up-down scroll, left-right swipe
     bind .filetree.t <Button-1> "if {\[info exists info(button_cancel)\]} {after cancel \$info(button_cancel); unset -nocomplain  info(button_cancel)} else {hamburger_treeview_button_down .filetree %X %Y}; unset -nocomplain  info(button_cancel)"
     bind .filetree.t <Button-3> " if {\[info exists info(button_cancel)\]} {after cancel \$info(button_cancel); unset -nocomplain  info(button_cancel)}"
     bind .filetree.t <Motion> "hamburger_treeview_button_motion .filetree %X %Y"
     bind .filetree.t <ButtonRelease-1> "set info(button_cancel) \[after 50 {file_treeview_invoke .filetree \[hamburger_treeview_button_release .filetree %X %Y\]; unset -nocomplain  info(button_cancel)}\]"
     bind .filetree.t <ButtonRelease-3> "set info(button_cancel) \[after 50 {file_treeview_invoke .filetree \[hamburger_treeview_button_release .filetree %X %Y\]; unset -nocomplain  info(button_cancel)}\]"
     bind .filetree.t <Button-2> "hamburger_treeview_button_down .filetree %X %Y"
     bind .filetree.t <ButtonRelease-2> "file_treeview_invoke .filetree \[hamburger_treeview_button_release .filetree %X %Y\]"
    } else {
       bind .filetree.t  <<FingerDown>> "hamburger_treeview_button_down .filetree \[expr {%x * \[winfo screenwidth .\]/10000}\]  \[expr {%y* \[winfo screenheight .\]/10000}\]"
       bind .filetree.t  <<FingerMotion>> "hamburger_treeview_button_motion .filetree \[expr {%x * \[winfo screenwidth .\]/10000}\]  \[expr {%y * \[winfo screenheight .\]/10000}\]"
       bind .filetree.t  <<FingerUp>> "file_treeview_invoke .filetree \[hamburger_treeview_button_release .filetree  \[expr {%x * \[winfo screenwidth .\]/10000}\]  \[expr {%y * \[winfo screenheight .\]/10000}\]\];"
    }
  } else {
    wm deiconify .filetree
    raise .filetree
    directory_to_treeview $dir .filetree.t
  }

  set screenheight [winfo screenheight .]
  set menuwidth [expr {int(280 * $info(pixels_per_dp))}]

  wm geometry .filetree [list $menuwidth\x$screenheight+[expr {int(5 - $menuwidth)}]+0]
  place .filetree.t -x 0 -y 0 -height $screenheight -width $menuwidth
   update idletasks
  .filetree.t column #0 -width [expr {[winfo width .filetree]-20}]
  menu_on_screen .filetree
  bind . <Configure> "sputs rotate; wm geometry .filetree \[list \[expr {int(280 * $info(pixels_per_dp))}\]\x\[winfo screenheight .\]+0+0]"
  set file_return 0
  vwait file_return
  set return $file_return
  unset file_return
  return $return
}


######
##
######
proc directory_to_treeview {dir tv {depth 0}} {
  global toolbar_images env
  $tv delete [$tv children {}]
  if {$depth > 0} {
    set i [$tv insert {} end -text "  [file tail [file dir $dir]]" -tag root]
    $tv set $i type root
    if {[info exists env(EXTERNAL_STORAGE)] && $dir != $env(EXTERNAL_STORAGE)} {
      $tv set $i Dir [file dir $dir]
    } else {
      $tv set $i Dir "External Storage"
    }
  }
  bind $tv <<Depth>> $depth
  foreach item [lsort -dictionary [glob -directory $dir -nocomplain -types {d} -- *]] {
    set i [$tv insert {} end -text "  [file tail $item]" -tag dir]
    $tv set $i type directory
    $tv set $i Dir $item
  }
  foreach item [lsort -dictionary [glob -directory $dir -nocomplain -types {f} -- *]] {
    set i [$tv insert {} end -text "    [file tail $item]" -image $toolbar_images(document_icon_48) -tag file]
    $tv set $i type file
    $tv set $i Dir $item
  }
}

######
##
######
proc file_treeview_invoke {w item} {
  global file_return
  if {$item == -1} {
    set file_return ""
    return
  }
  if {$item == 0 || [catch {$w.t set $item Dir} dir]} {return}
  if {[file isdir $dir]} {
    set depth [bind $w.t <<Depth>>]
    if {[lsearch [$w.t tag has root] $item] > -1} {
      incr depth -1
    } else {
      incr depth
    }
    directory_to_treeview $dir $w.t $depth
  } else {
    menu_off_screen $w
    sputs open $dir
    set file_return $dir
  }
}




################
## get text from a text window, remove line breaks
################
proc textarea_get {text index1 index2} {
  if {[winfo exists $text]} {
    return [regsub -all \n [$text get $index1 $index2] ""]
  } else {
    return {}
  }
}

################
## insert text into a text window
################
#needs to check tags and break them, register the info into the undo queue, then call a do_text_insert proc that does the insertion
######### do we put file_lock_check, modified, saved, scanned (not needed for change case), unlink_analysis into the textarea functions?
proc textarea_insert {text index seq {preclear_lock_check 1}} {
  global info undo
  if {![winfo exists $text] || [file_lock_check [set w [winfo toplevel $text]] $preclear_lock_check]} {return}
  regsub -all {\n} $seq "" subtext
  if {[string length $subtext] == 0} {return}
  lappend undo(undo,$w) [list textarea_insert [ix2bp $text $index] [string length $subtext]]
  $text insert $index $seq {}
  if {([info exists info($w,textwidth)]) && ($info($w,textwidth) > 1)} {
    reline $text [expr {$info($w,textwidth)}]
  }
  set info($w,scanned) 0
}

#################
## figure out the f and fn tags that are on the two bases flanking the insertion site
################
proc split_tags_after_insertion {w start_index end_index} {
  global info
  set len [expr {max (1,[ix2bp $w.textarea  end])}]
  set first_index [bp2ix $w.textarea [expr { ([ix2bp $w.textarea  $start_index] - 1) %$len}]]
  set last_index [bp2ix $w.textarea [expr {([ix2bp $w.textarea  $end_index] %$len)}]]
  if {$info($w,circular) != "circular" && [$w.textarea compare $first_index > $last_index] } {
    return
  }

  set tags_to_add [list]
  set new_fn_tags [list]
  set tag_l [$w.textarea tag names $last_index]
  foreach tag_f [$w.textarea tag names $first_index] {
    if {$tag_f in $tag_l && [regexp {fn?([0-9]+)#} $tag_f -- f_tag_number]} {
      lappend tags_to_add fn$f_tag_number#
      if {[$w.textarea tag ranges  fn$f_tag_number#] == {}} {
        lappend new_fn_tags $f_tag_number
      }
    }
  }
  set tags_to_add [lsort -unique $tags_to_add]
  foreach fn_tag $tags_to_add {
    textarea_tag_add $w.textarea $fn_tag $start_index $end_index
  }
  foreach f_tag_number $new_fn_tags {
    foreach {i1 i2} [$w.textarea tag ranges f$f_tag_number#] {
      textarea_tag_add $w.textarea fn$f_tag_number# $i1 $i2
    }
  }
}

################
## delete text from a text window, reline
################
proc textarea_delete {text index1 {index2 ""} {preclear_lock_check 1}} {
  global info undo
  if {![winfo exists $text] || [file_lock_check [set w [winfo toplevel $text]] $preclear_lock_check]} {return}
  if {[$text get $index1] == "\n"} {set index1 [$text index $index1-1c]}
  if {$index2 == ""} {set index2 [$text index $index1+1c]}
  foreach {tag data} [get_tags_exact $text [list $index1 $index2]] {
    textarea_tag_remove $text $tag $index1 $index2
    if {[$text tag ranges $tag] == {} && ![regexp {foundf|foundr} $tag]} {
      textarea_tag_delete $text $tag
    }
  }

  ## it's possible to delete all the introns from a feature this way- take out fn tags if there is an fn tag that matches its f tag
  foreach tag_f [$text tag names] {
    if {[regexp {f([0-9]+)#} $tag_f -- tag_num] && [$text tag ranges $tag_f] == [$text tag ranges fn$tag_num#] } {
      textarea_tag_delete $text fn$tag_num#
    }
  }

  lappend undo(undo,$w) [list textarea_delete [regsub -all \n [$text get $index1 $index2] ""] [ix2bp $text $index1]]
  $text delete $index1 $index2

  if {[tk windowingsystem] == "aqua"} {
    set width [expr {int(([winfo width $w.textarea]-4)/[lindex [wm grid $w] 2])}]
    #set width [expr {int([winfo width $w.textarea]*100.0/[font measure dnafont [string repeat 0 100]])}]
  } else {
    set width [expr {int(([winfo width $w.textarea]-2.0*[$w.textarea cget -borderwidth])/[lindex [wm grid $w] 2])}]
    #set width [expr {int(([winfo width $w.textarea]-2.0*[$w.textarea cget -borderwidth])*100.0/[font measure dnafont [string repeat 0 100]])}]
  }
  reline $text [expr {$info($w,textwidth)}]
  set info($w,scanned) 0
}

################
## create feature tags in a text window
################
proc textarea_tag_create {text tag {lockcheck 1}} {
  global info undo
  if {![winfo exists $text]} {return ""}
  set w [winfo toplevel $text]
  if {$lockcheck && [file_lock_check $w]} {return}
  lappend undo(undo,$w) [list textarea_tag_create $tag]
}

################
## add feature tags to a text window
################
proc textarea_tag_add {text tag index1 index2 {lockcheck 1}} {
  global info undo
  if {![winfo exists $text]} {return ""}
  set w [winfo toplevel $text]
  if {$lockcheck && [file_lock_check $w]} {return}
  lappend undo(undo,$w) [list textarea_tag_add $tag  [ix2bp $text $index1] [ix2bp $text $index2]]
  $text tag add $tag $index1 $index2

}

################
## add feature tags to a text window
################
proc textarea_tag_remove {text tag index1 index2 {lockcheck 1}} {
  global info undo
  if {![winfo exists $text]} {return ""}
  set w [winfo toplevel $text]
  if {$lockcheck && [file_lock_check $w]} {return}

  set result [list]
  if {[lsearch -exact [$text tag names $index1] $tag] > -1} {
   lappend result $index1
  }

  foreach {action tagname index} [$text dump -tag $index1+1char $index2+1chars] {
    if {$tagname eq $tag} {
     lappend result $index
    }
  }

  if {[lsearch -exact [$text tag names $index2] $tag] > -1 || ([$text compare $index2 == "end"] && [lsearch -exact [$text tag names "end-1char"] $tag] > -1)} {
    if {[lindex $result 0] != $index2} {
      lappend result $index2
    } else {
      set result [list]
    }
  }

  foreach {first last} $result { 
    lappend undo(undo,$w) [list textarea_tag_remove $tag [ix2bp $text $first] [ix2bp $text $last]]
    $text tag remove $tag $first $last
  }

}

################
## configure feature tags in a text window
################
proc textarea_tag_configure {text tag args} {
  global info undo

  if {![winfo exists $text] ||[file_lock_check [set w [winfo toplevel $text]]]} {return ""}
  set previous_valued 0
  set edit 0
  set editlist [list]
  set new_config [list]
  foreach {option new_value} $args {
    if {[catch {set old_value [$text tag cget $tag $option]}]} {
      return
    } else {
      if {$old_value != "" && ($old_value != $new_value)} {
        lappend editlist $option $old_value
      }
    }
    if {[regexp {f[0-9]+#} $tag] && ($option eq "-background" || $option eq "-bg") && ($new_value ne {})} {
      lappend new_config $option [mix_color $info(text_bg_color) $new_value $info(feature_transparency)]
    } else {
      lappend new_config $option $new_value
    }
  }

  if {$editlist != [list]} {
    lappend undo(undo,$w) [list textarea_tag_configure $tag $editlist]
  }
  $text tag configure $tag {*}$new_config

}

################
## bind feature tags in a text window
################
proc textarea_tag_bind {text tag action actionlist} {
  global info undo

  if {![winfo exists $text] || [file_lock_check [set w [winfo toplevel $text]]]} {return ""}
  if {[set oldlist [$text tag bind $tag $action]] == $actionlist} {return}
  if {[$text tag bind $tag $action] != ""} {
    lappend undo(undo,[winfo toplevel $text]) [list textarea_tag_bind $tag $action $oldlist]
  }
  $text tag bind $tag $action $actionlist

}

##############
## Delete tag from a sequence
##############
proc textarea_tag_delete {text tag {lockcheck 1}} {
  global info undo
  if {![winfo exists $text]} {return}
  set w [winfo toplevel $text]
  if {$lockcheck && [file_lock_check $w]} {return}
  if {[catch {$text tag cget $tag -background}]} {return}

  while {[$text tag nextrange $tag 1.0 end] != {}} {
    textarea_tag_remove $text $tag {*}[$text tag nextrange $tag 1.0 end] $lockcheck
  }

  set actionlist []
  foreach binding [$text tag bind $tag] {
    lappend actionlist [list $binding [$text tag bind $tag $binding]]
  }
  set clist [list]
  foreach config [list -foreground -background -underline -font] {
    if {[$text tag cget $tag $config] != {}} {lappend clist [list $config [$text tag cget $tag $config]]}
  }
  $text tag delete $tag
  lappend undo(undo,$w) [list textarea_tag_delete $tag $actionlist $clist]
  if {[regexp {f[0-9]+#} $tag]} {
    set fntag [regsub "f" $tag "fn"]
    while {[$text tag nextrange $fntag 1.0 end] != {}} {
      textarea_tag_remove $text $fntag {*}[$text tag nextrange $fntag 1.0 end] $lockcheck
    }
    if {[$text tag ranges $fntag] == ""} {
      lappend undo(undo,$w) [list textarea_tag_delete $fntag]
      $text tag delete $fntag
    }
  }


}

##############
## Hide tag from a sequence
##############
proc textarea_tag_hide {text tag {lockcheck 1}} {
  global info undo
  if {![winfo exists $text]} {return}
  set w [winfo toplevel $text]
  if {$lockcheck && [file_lock_check $w]} {return}
  if {[catch {$text tag cget $tag -background}]} {return}

  $text tag configure $tag -background ""
  lappend undo(undo,$w) [list textarea_tag_hide $tag]
}

##############
## Show hidden tag from a sequence
##############
proc textarea_tag_show {text tag {lockcheck 1}} {
  global info undo
  if {![winfo exists $text]} {return}
  set w [winfo toplevel $text]
  if {$lockcheck && [file_lock_check $w]} {return}
  if {[catch {$text tag cget $tag -background}]} {return}

  $text tag configure $tag -background [lindex [$text tag bind $tag <<Revcolors>>] [lindex [$text tag bind $tag <<Metadata>>] 3]]
  lappend undo(undo,$w) [list textarea_tag_show $tag]
}

##############
## Raise tag
##############
proc textarea_tag_raise {text tag {abovethis {}}} {
  global info undo
  if {![winfo exists $text]} {return}
  set w [winfo toplevel $text]
  if {[set pos [lsearch -exact [$text tag names] $tag]] == -1} {return}
  set next_up [lsearch -regexp -inline -start [expr {$pos+1}] [$text tag names] {f[0-9]+}]
  $text tag raise $tag {*}$abovethis
  lappend undo(undo,$w) [list textarea_tag_arrange $tag $next_up]
}

##############
## Raise tag
##############
proc textarea_tag_lower {text tag {belowthis {}}} {
  global info undo
  if {![winfo exists $text]} {return}
  set w [winfo toplevel $text]
  if {[set pos [lsearch -exact [$text tag names] $tag]] == -1} {return}
  set next_up [lsearch -regexp -inline -start [expr {$pos+1}] [$text tag names] {f[0-9]+}]
  $text tag lower $tag {*}$belowthis
  lappend undo(undo,$w) [list textarea_tag_arrange $tag $next_up]
}

##############
## Show hidden tag from a sequence
##############
proc textarea_tag_change_group {text tag add_groups grouplist {lockcheck 1}} {
  global info undo
  set w [winfo toplevel $text]
  if {$lockcheck && [file_lock_check $w]} {return}

  set actual_grouplist [list]
  set metadata [$text tag bind $tag <<Metadata>>]
  set groups [lindex $metadata 5]
  if {$add_groups} {
    ## add groups
    foreach group $grouplist {
      if {[set index [lsearch -exact $groups $group]] == -1} {
        set groups [concat $groups $group] 
        lappend actual_grouplist $group
      }
    }
  } else {
    ## remove groups
    foreach group $grouplist {
      if {[set index [lsearch -exact $groups $group]] > -1} {
        set groups [lreplace $groups $index $index] 
        lappend actual_grouplist $group
      }
    }
  }
  set metadata [lreplace $metadata 5 5 $groups]
  $text tag bind $tag <<Metadata>> $metadata
  lappend undo(undo,$w) [list textarea_tag_change_group $tag $add_groups $actual_grouplist]
}


############
## add undo separator to the undo queue
############
proc register_undo_separator {w type {update_saved_flag 1}} {
global undo info
# process the edit menu undo
#reset the redo queue
  lappend undo(undo,$w) [list undo_separator $type $update_saved_flag]

  if {$info($w,saved) && $update_saved_flag} {
    set info($w,saved) 0
    if {[tk windowingsystem] == "aqua"} {wm attributes $w -modified 1}
  }

  if {[info exists undo(saved_pointer,$w)] && $update_saved_flag} {
    if {$undo(saved_pointer,$w) > -1} {
      incr undo(saved_pointer,$w)
    } else {
      unset -nocomplain undo(saved_pointer,$w)
    }
  }
  set undo(redo,$w) [list]
  if {!$info(android)} {
    $w.menubar.edit entryconfigure 0 -state normal -label [mc "Undo %s" $type]
    bind $w.menubar.edit <<undolabel>> "Undo $type"
    bind $w.menubar.edit <<undostate>> normal
    $w.menubar.edit entryconfigure 1 -label [mc "Redo"] -state disabled
    bind $w.menubar.edit <<redolabel>> "Redo"
    bind $w.menubar.edit <<redostate>> disabled
  }
}

############
## initialize undo and redo queues
############
proc initialize_undo {w} {
global undo info
set undo(undo,$w) [list]
set undo(redo,$w) [list]
  if {$info($w,saved)} {
    set undo(saved_pointer,$w) 0
  } else {
    unset -nocomplain undo(saved_pointer,$w)
  }
  $w.menubar.edit entryconfigure 0 -state disabled
  $w.menubar.edit entryconfigure 1 -state disabled
}

############
## Execute undo queue
############
proc undo {w {direction 1}} {
global undo redo info toolbar_images
# process info($w,undo_que/redo_que) to the next separator (skip separators while separator is "typing"). Put inserted/deleted text and tags onto the undo/redo que.
# move selection to the new text if text is added during the undo/redo
# Process the edit menu of $w- and redo menu if redo que is not empty

# lappend undo(undo,$w) [list change_topology $info($w,circular)]
# lappend undo(undo,$w) [list textarea_insert [ix2bp $text $index] [string length $subtext]]
# lappend undo(undo,$w) [list textarea_delete [regsub -all \n [$text get $index1 $index2] ""] [ix2bp $text $index1]]
# lappend undo(undo,$w) [list textarea_tag_add $tag  [ix2bp $text $index1] [ix2bp $text $index2]]
# lappend undo(undo,$w) [list textarea_tag_create $tag 
# lappend undo(undo,$w) [list textarea_tag_remove $tag [ix2bp $text $index1] [ix2bp $text $index2]]
# lappend undo(undo,$w) [list textarea_tag_configure $tag $args]
# lappend undo(undo,$w) [list textarea_tag_bind $tag $action $actionlist]
# lappend undo(undo,$w) [list textarea_tag_delete $tag $actionlist $clist]
# lappend undo(undo,$w) [list textarea_tag_delete $fntag]
# lappend undo(undo,$w) [list undo_separator $type]
# lappend undo(undo,$w) [list textarea_tag_show $tag]
# lappend undo(undo,$w) [list textarea_tag_hide $tag]
# lappend undo(undo,$w) [list set $variable $value]
# lappend undo(undo,$w) [list unlink_analysis_window $w [unlink_analysis_window $w]]
  
# shift undo actions to the redo list.
  if {$direction} {
    set stack1 undo
    set stack2 redo
  } else {
    set stack2 undo
    set stack1 redo
  }


  if {[llength $undo($stack1,$w)] == 0} {
    return
  }
  if {[lindex $undo($stack1,$w) end 0] ne "undo_separator"} {
    sputs undo error [lindex $undo($stack1,$w) end]
    return
  }
  set undo_type [lindex $undo($stack1,$w) end 1]
  set undo_saved_flag [lindex $undo($stack1,$w) end 2]
  for {set i 1} {($i<[llength $undo($stack1,$w)]) && ([set action [lindex [set element [lindex $undo($stack1,$w) end-$i]] 0]] ne "undo_separator") } {incr i} {
    switch $action {
      change_topology {
        if {([lindex $element 1] == "circular") } {
          set info($w,circular) circular
          $w.menubar.edit entryconfigure [mc "Set Origin"] -state normal
          $w.menubar.edit entryconfigure [mc "Linearize @ insert site"] -state normal
          #$w.infoframe.circular configure -image $toolbar_images(circular)
          lappend undo($stack2,$w) [list change_topology linear]
        } else {
          set info($w,circular) linear
          $w.menubar.edit entryconfigure [mc "Set Origin"] -state disabled
          $w.menubar.edit entryconfigure [mc "Linearize @ insert site"] -state disabled
          #$w.infoframe.circular configure -image ""
          lappend undo($stack2,$w) [list change_topology circular]
        }
        set info($w,circular_text) [mc $info($w,circular)]
      }
      textarea_insert {
        $w.textarea tag remove sel 1.0 end
        $w.textarea tag remove tempsel 1.0 end
        lappend undo($stack2,$w) [list textarea_delete [regsub -all \n [$w.textarea  get [bp2ix $w.textarea [lindex $element 1]] [bp2ix $w.textarea [expr {[lindex $element 1] + [lindex $element 2]}]]
] ""] [lindex $element 1]]
        $w.textarea delete [bp2ix $w.textarea [lindex $element 1]] [bp2ix $w.textarea [expr {[lindex $element 1] + [lindex $element 2]}]]
        reline $w.textarea [expr {$info($w,textwidth)}]
        vertindexbalancer $w
        selection_manager $w
        $w.textarea mark set insert [bp2ix $w.textarea [lindex $element 1]]
        $w.textarea mark set anchor  [bp2ix $w.textarea [lindex $element 1]]
        $w.textarea mark set tk::anchor$w.textarea [bp2ix $w.textarea [lindex $element 1]]

      }
      textarea_delete {
        $w.textarea tag remove sel 1.0 end
        $w.textarea tag remove tempsel 1.0 end
        lappend undo($stack2,$w) [list textarea_insert [lindex $element 2] [string length [lindex $element 1]]]
        $w.textarea insert [bp2ix $w.textarea [lindex $element 2]] [lindex $element 1] {}
        reline $w.textarea [expr {$info($w,textwidth)}]
        vertindexbalancer $w
        selection_manager $w
        $w.textarea tag add sel [bp2ix $w.textarea [lindex $element 2]] [bp2ix $w.textarea [expr {[lindex $element 2]+[string length [lindex $element 1]]}]]
        $w.textarea tag remove tempsel [bp2ix $w.textarea [lindex $element 2]] [bp2ix $w.textarea [expr {[lindex $element 2]+[string length [lindex $element 1]]}]]
        $w.textarea mark set insert [bp2ix $w.textarea [expr {[lindex $element 2]+[string length [lindex $element 1]]}]]
        $w.textarea mark set anchor  [bp2ix $w.textarea [expr {[lindex $element 2]+[string length [lindex $element 1]]}]]
        $w.textarea mark set tk::anchor$w.textarea  [bp2ix $w.textarea [expr {[lindex $element 2]+[string length [lindex $element 1]]}]]
      }
      textarea_tag_add {
        lappend undo($stack2,$w) [list textarea_tag_remove [lindex $element 1] [lindex $element 2] [lindex $element 3]]
        $w.textarea tag remove [lindex $element 1] [bp2ix $w.textarea [lindex $element 2]] [bp2ix $w.textarea [lindex $element 3]]
        if {[$w.textarea tag ranges [lindex $element 1]] == {}} {
        }
      }

      textarea_tag_create {
        set actionlist []
        set tag [lindex $element 1]
        foreach binding [$w.textarea tag bind $tag] {
          lappend actionlist [list $binding [$w.textarea tag bind $tag $binding]]
        }
        set clist [list]
        foreach config [list -foreground -background -underline -font] {
          if {[$w.textarea tag cget $tag $config] != {}} {
            lappend clist [list $config [$w.textarea tag cget $tag $config]]
          }
        }
        $w.textarea tag delete $tag
        lappend undo($stack2,$w) [list textarea_tag_delete $tag $actionlist $clist]
      }

      textarea_tag_remove {
        lappend undo($stack2,$w) [list textarea_tag_add [lindex $element 1] [lindex $element 2] [lindex $element 3]]
        $w.textarea tag add [lindex $element 1] [bp2ix $w.textarea [lindex $element 2]] [bp2ix $w.textarea [lindex $element 3]]
      }

      textarea_tag_delete {
        lappend undo($stack2,$w) [list textarea_tag_create [lindex $element 1]]
        set tag [lindex $element 1]
        set actionlist [lindex $element 2]
        foreach action $actionlist {
          $w.textarea tag bind $tag {*}$action
        }
        set clist [lindex $element 3]
        foreach config $clist {
          $w.textarea tag configure $tag {*}$config
        }
      }
      textarea_tag_configure {
        set tag [lindex $element 1]
        set editlist [list]
        foreach {option new_value} [lindex $element 2] {
          if {[set old_value [$w.textarea tag cget $tag $option]] != "" && ($old_value != $new_value)} {
            lappend editlist $option $old_value
          }
        }

        if {$editlist != [list]} {
          lappend undo($stack2,$w) [list textarea_tag_configure $tag $editlist]
        }
        $w.textarea tag configure [lindex $element 1] {*}[lindex $element 2]
      }
      textarea_tag_bind {
        set oldlist [$w.textarea tag bind [lindex $element 1] [lindex $element 2]]
        lappend undo($stack2,$w) [list textarea_tag_bind [lindex $element 1] [lindex $element 2] $oldlist]
        $w.textarea tag bind [lindex $element 1] [lindex $element 2] [lindex $element 3]
      }
      textarea_tag_hide {
        set tag [lindex $element 1]
        lappend undo($stack2,$w) [list textarea_tag_show $tag]
        $w.textarea tag configure $tag -background [lindex [$w.textarea tag bind $tag <<Revcolors>>] [lindex [$w.textarea tag bind $tag <<Metadata>>] 3]]
      }
      textarea_tag_show {
        set tag [lindex $element 1]
        lappend undo($stack2,$w) [list textarea_tag_hide $tag]
        $w.textarea tag configure $tag -background ""
      }
      textarea_tag_arrange {
        set tag [lindex $element 1]
	if {[set pos [lsearch -exact [$w.textarea tag names] $tag]] > -1} {
          set next_up [lsearch -regexp -inline -start [expr {$pos+1}] [$w.textarea tag names] {f[0-9]+}]
	  lappend undo($stack2,$w) [list textarea_tag_arrange $tag $next_up]
          set prev_up [lindex $element 2]
	  if {$prev_up == {}} {
            $w.textarea tag raise $tag
	  } else {
            $w.textarea tag lower $tag $prev_up
	  }
	}
      }
      set {
	set old_value  [set [lindex $element 1]]
	set [lindex $element 1]  [lindex $element 2]
	lappend undo($stack2,$w) [list set [lindex $element 1] $old_value]
      }
      default {
	sputs "untrapped undo event:[lindex $element 0]"
      }
    }
  }

  features_to_tree_view $w
  set info($w,scanned) 0
### need to set up a system to track where in the udo queue the saved version of the file matches, then reset the saved flag if you get to that position in the queue
  if {$undo_saved_flag} {
    if {[info exists undo(saved_pointer,$w)]} {
      if {$direction} {
        incr undo(saved_pointer,$w) -1
      } else {
         incr undo(saved_pointer,$w) 1
      }
      if {!$undo(saved_pointer,$w)} {
        set info($w,saved) 1
        if {[tk windowingsystem] == "aqua"} {wm attributes $w -modified 0}
      } else {
        set info($w,saved) 0
        if {[tk windowingsystem] == "aqua"} {wm attributes $w -modified 1}
      }
    } else {
      set info($w,saved) 0
      if {[tk windowingsystem] == "aqua"} {wm attributes $w -modified 1}
    }
  }


  set undo($stack1,$w) [lrange $undo($stack1,$w) 0 end-$i]
  lappend undo($stack2,$w) [list undo_separator $undo_type $undo_saved_flag]

  if {[llength $undo(undo,$w)] > 0} {
    set type [lindex $undo(undo,$w) end 1]
    $w.menubar.edit entryconfigure 0 -state normal -label [mc "Undo %s" $type]
    bind $w.menubar.edit <<undolabel>> "Undo $type"
    bind $w.menubar.edit <<undostate>> normal
  } else {
    $w.menubar.edit entryconfigure 0 -state disabled -label [mc "Undo"]
    bind $w.menubar.edit <<undolabel>> "Undo"
    bind $w.menubar.edit <<undostate>> disabled
  }
  if {[llength $undo(redo,$w)] > 0} {
    set type [lindex $undo(redo,$w) end 1]
    $w.menubar.edit entryconfigure 1 -state normal -label [mc "Redo %s" $type]
    bind $w.menubar.edit <<redolabel>> "Redo $type"
    bind $w.menubar.edit <<redostate>> normal
  } else {
    $w.menubar.edit entryconfigure 1 -state disabled -label [mc "Redo"]
    bind $w.menubar.edit <<redolabel>> "Redo"
    bind $w.menubar.edit <<redostate>> disabled
  }

}


############
## register a window to be a data receiver- unhoused virtual events
############
proc register_data_receiver {window type command} {
  global data_transmit
  dict set data_transmit($type) $window $command
}


############
## generate an unhoused virtual event
############
proc send_data {type data} {
  global data_transmit
  if {![info exists data_transmit($type)]} {return}
  foreach {window command} $data_transmit($type) {
    if {[winfo exists $window]} {
      eval $command $data
    } else {
      dict unset data_transmit($type) $window
      if {$data_transmit($type) == {}} {
        array unset data_transmit $type
      }
    }
  }
}

##############
## Update inline mode features to match inline_mode and update all sequence windows
##############
proc change_inline_mode {} {
  global info
  set_inline_features
  foreach w [dnawindows_list] {
    set width [expr {int(([winfo width $w.textarea]-4)/[lindex [wm grid $w] 2])}]
    #set width [expr {int([winfo width $w.textarea]*100.0/[font measure dnafont [string repeat 0 100]])}]
    set info($w,textwidth) $width
    while {[set j [lindex [$w.textarea dump -window 1.0 end] 2]] ne {}} {
     $w.textarea delete $j $j+1c 
    } 
    #take out all \n characters
    while {[$w.textarea index end] > 2} {$w.textarea delete 1.end}
    reline $w.textarea [expr {$width}]
    $w.vertindex delete 1.0 end 
    vertindexbalancer $w
    $w.vertscroll set {*}[$w.textarea yview]
    if {!$info(inline_mode)} {
      $w.map_zoom configure -width 10
      textarea_fill_map $w
      set dna_length [ix2bp $w.textarea end]
       if {$dna_length > 0 && [$w.map_zoom coord frame] != {}} {
         set c_zoom_scale [expr {1.0 * [lindex [wm grid $w] 3]/$width}]
         $w.map_zoom scale all 0 0 1.0 [expr {$c_zoom_scale * $dna_length / [lindex [$w.map_zoom coord frame] 3]}]
         $w.map_zoom configure -scrollregion [$w.map_zoom coords frame] -yscrollincrement [lindex [wm grid $w] 3]
      }
    } else {
      $w.vertindex configure -width 0
      $w.map_zoom configure -width 0
      $w.map_zoom delete all
    }
  }
}

###############
##############
## SET INLINE MODE PROCEDURES
##############
###############
proc set_inline_features {} {
global info

  if {$info(inline_mode)} {
 #########
## INLINE MODE HERE
#########
############
## quick cr inserter for a text window
############
proc reline {t newwidth} {
  global info
  set i 1
  set c 0
  set w  [winfo toplevel $t] 
  set first_char [$t index @0,5]
  set width [winfo width $t]
  if {$width != $info($w,textwidth)} {
    # delete all window elements
    while {[set j [lindex [$t dump -window 1.0 end] 2]] ne {}} {
     $t delete $j $j+1c 
    } 
    #take out all \n characters
    while {[$t index end] > 2} {$t delete 1.end}

    # add \n every width characters
    # then add a canvas
    while {[expr {[lindex [split [$t index $i.end] .] 1]}] > 0} {
      $t insert $i.$newwidth \n
      incr i
      while {[winfo exists $t.c$c]} {incr c}
      $t window create $i.0 -window [canvas $t.c$c -width [expr {40+$width}] -bg $info(text_bg_color) -height 10 -highlightthickness 0 -cursor arrow]
      bindtags $t.c$c [list $t.c$c all]
      bind $t.c$c <MouseWheel> "event generate $t <MouseWheel> -delta  %D"
      bind $t.c$c <B1-Motion> "text_select_xy $w %x \[expr {%Y-\[winfo rooty $t\]}\]"
      bind $t.c$c <Shift-Button-1> " text_reset_anchor $t @%x,\[expr {%Y-\[winfo rooty $t\]}\]; text_select_xy $w %x \[expr {%Y-\[winfo rooty $t\]}\]"
      bind $t.c$c <<Button-1>> " if {(\[focus\] != \"$w.textarea\") && (\$dialogblock == 0)} {focus $w.textarea; textsetcursor $w \[text_closest_gap $w.textarea %x \[expr {%Y-\[winfo rooty $t\]}\]\]} else {textsetcursor $w \[text_closest_gap $w.textarea %x \[expr {%Y-\[winfo rooty $t\]}\]\]}"
      $t insert $i.1 \n
      incr i
    }
    $t delete end-1c end
  }

  foreach {-- mk ix} [$w.textarea dump -mark 1.0 end] {
    if {[expr {int($ix) % 2}] == 0} {
      $w.textarea mark set $mk [$w.textarea index "$ix-1line lineend"]
    }
  }

  if {$info(inline_canvas_fixed_height)} {
    set height_max 0
    foreach {-- c ix} [$t dump -window 1.0 end] {
      lassign [seq_inline_canvas $w [$t index $ix-1l] [$t index $ix-1c] $c] c_height c_width
      set height_max [expr {max($height_max, $c_height)}]
    }
      set info($w,inline_height) $height_max
    foreach {-- c ix} [$t dump -window 1.0 end] {
        $c configure -height [expr {$height_max+10}]
    }
  } else {
   foreach {-- c ix} [$t dump -window 1.0 end] {
      lassign [seq_inline_canvas $w [$t index $ix-1l] [$t index $ix-1c] $c] c_height c_width
      $c configure -height $c_height
    }
  }

  $t yview $first_char

}

##########
## scale the map if height changes
##########
proc textarea_set_map_selection {w} {
  set selecton_gap 5
  set dna_length [ix2bp $w.textarea end]
  if {[$w.map coords frame] == {}} {
    textarea_fill_map $w
  }
  if {[$w.map coords frame] == {}} {
  sputs no map frame $w
    return
  }
  if {$dna_length > 0} {
    set c_scale [expr {[lindex [$w.map coords frame] 3]/ $dna_length}]
  } else {
    set c_scale 0
  }
  set sel_coords [$w.map coords selection]
  if {$sel_coords == {} } {return}
  if {[$w.textarea tag ranges sel] != ""} {
    set first [ix2bp $w.textarea [$w.textarea index sel.first]]
    set last [ix2bp $w.textarea [$w.textarea index sel.last]]
  } else {
    set first [ix2bp $w.textarea [$w.textarea index insert]]
    set last [ix2bp $w.textarea [$w.textarea index insert]]
  }
  lset sel_coords 1 [expr {$first * $c_scale}]
  lset sel_coords 3 [expr {$last * $c_scale}]
  $w.map coords selection {*}$sel_coords
  set sel_color [$w.textarea tag cget sel -background]
  if {[$w.textarea tag ranges sel] ne {} && [expr {[lindex [split [$w.textarea index sel.first] "."] 0] %2}] == 0} {
    $w.textarea tag remove sel [$w.textarea index sel.first]
  }
  foreach {-- c ix} [$w.textarea dump -window 1.0 end] {
    if {[$c find withtag selection] eq {}} {
      $c create rectangle 0 0 0 0 -fill $sel_color -tags selection
      $c lower selection
    } else {
      $c itemconfigure selection -fill $sel_color
    }
    if {[$w.textarea tag ranges sel] eq {} || [$w.textarea compare $ix < sel.first] || [$w.textarea compare "$ix-1line" > sel.last]} {
      $c itemconfigure selection -state hidden
    } elseif {[$w.textarea compare "$ix-1line" < sel.first]} {
      set start_char [lindex [split [$w.textarea index sel.first] "."] 1]
      set s_ix [font measure dnafont [string repeat "A" $start_char]]
      lassign [$c bbox all] sc_x0 sc_y0 sc_x1 sc_y1
      set sc_y1 [expr {$sc_y1 - $selecton_gap}]
      if {[$w.textarea compare $ix > sel.last]} {
        set start_char [lindex [split [$w.textarea index sel.last] "."] 1]
        set e_ix [font measure dnafont [string repeat "A" $start_char]]
        $c itemconfigure selection -state normal
        $c coords selection $s_ix $sc_y0 $e_ix $sc_y1
      } else {
        $c itemconfigure selection -state normal
        $c coords selection $s_ix $sc_y0 $sc_x1 $sc_y1
      }
    } elseif {[$w.textarea compare $ix > sel.last]} {
      lassign [$c bbox all] sc_x0 sc_y0 sc_x1 sc_y1
      set sc_y1 [expr {$sc_y1 - $selecton_gap}]
      set start_char [lindex [split [$w.textarea index sel.last] "."] 1]
      set e_ix [font measure dnafont [string repeat "A" $start_char]]
      $c itemconfigure selection -state normal
      $c coords selection $sc_x0 $sc_y0 $e_ix $sc_y1
    } else {
      $c itemconfigure selection -state normal
      lassign [$c cget -scrollregion] sc_x0 sc_y0 sc_x1 sc_y1
      set sc_y0 [expr {$sc_y0 - 2}]
      set sc_y1 [expr {$sc_y1 - $selecton_gap}]
      $c coords selection $sc_x0 $sc_y0 $sc_x1 $sc_y1
    }
  }
}


############
## convert a textarea index to a bp integer
############
proc ix2bp {t index} {
    set width [lindex [split [$t index 1.end] .] 1]
    set index [$t index $index]
    if {[$t compare $index > end-3c]} {set index [$t index end-3c]}
    lassign [split $index .] line char
    if {!($line%2)} {set char 0}
    return [expr {$width*($line/2)+$char}]
}

############
## convert a bp integer to a textarea index
############
proc bp2ix {t base_position} {
    if {$base_position <= 0 || ![winfo exists $t]} {
      return 1.0
    }
    set width [lindex [split [$t index 1.end] .] 1]
    if {$width == 0} {
      for {set i 2.0} {($width ==0) && [$t compare $i < end]} {set i [$t index $i+2lines]} {
        set width [lindex [split [$t index "$i lineend"] .] 1]
      }
      if {$width == 0} {
        return 1.0
      }
    }
    return [expr {($base_position)/($width)*2+1}].[expr {(($base_position) % ($width)) }]
}

############
## return the index of the last bp
############
proc end_ix {t} {
  return [$t index end-3c]
}

#######
##  makes the index numbers along the left edge and scrollbar match the text box
#######
proc vertindexbalancer {w} {
  global info
  if {![winfo exists $w]} {return}
  set t $w.textarea

  set textend [lindex [split [end_ix $w.textarea] .] 0]
  set vertend [lindex [split [$w.vertindex index end-1chars] .] 0]



  if {0} {
  if {[set c [lindex [$t dump -window 1.0 end] 1]] ne {}} {
    set c_height [expr {$info($w,inline_height) +2}]
  } else {
    set c_height 0
  }
  ## take out vertindex updates
  if {$vertend != $textend} { 
    $w.vertindex delete 1.0 end

    set j 1
    for {set i 0} {$i < $textend} {incr i 2} {
      $w.vertindex insert end $j\n allvertindex
      incr j $info($w,textwidth)
      if {$c_height > 0} {
        $w.vertindex insert end " \n" c_height_tag
      }
    }
    $w.vertindex delete end-1c end
    $w.vertindex tag configure allvertindex -justify right


    set textlen [ix2bp $w.textarea end]
    $w.vertindex configure -width [expr {$textlen < 10 ? 2 : int(.0000000001+log($textlen)/log(10))+1}] 
  }

  if {[$w.vertindex tag ranges c_height_tag] != {} && $c_height != [$w.vertindex tag cget c_height_tag -spacing3]} {
    $w.vertindex tag configure c_height_tag -spacing3 $c_height
  }

  $w.vertindex yview [$t index @0,5]
  ## take out vertindex updates
  }

  $w.vertscroll set {*}[$w.textarea yview]

  if {[$t compare end < 3.0]} {
    if {[grid info $w.vertscroll] != {}} {
      grid remove $w.vertscroll
    }
  } else {
    if {[grid info $w.vertscroll] == "" && !$info(hide_scrollbar)} {
      grid configure $w.vertscroll
    } 
    #$w.vertscroll set {*}[$t yview ]

  }

  if {[$t compare end > 1.0]} {
    ######*$w.map_zoom yview moveto [lindex [$w.textarea yview] 0]
  }
}



#######
## sends the scrollbar commands to both the index box and the text box
#######
proc vertscrollmanager {w args} {
  global info

  if {![winfo exists $w.textarea]} return
  if {[$w.textarea compare insert == end]} {
    $w.textarea mark set insert end-1c
  }
  $w.textarea yview {*}$args
  #$w.vertindex yview {*}$args
  #$w.map_zoom yview {*}$args
  ######*$w.map_zoom yview moveto [lindex [$w.textarea yview] 0]
  $w.vertscroll set {*}[$w.textarea yview]
  if {$info(hide_scrollbar)} {
    grid configure $w.vertscroll
    after cancel "grid remove $w.vertscroll"
    after 750 "grid remove $w.vertscroll"
  }
  ######*vertindexbalancer $w
}

##########
## scale the map if height changes
##########
proc textarea_height_changed {w} {
  global info
  if {![winfo exists $w.map] || [winfo height $w.map] <= 1 || [$w.map bbox all] == ""} {
    return
  }

  if {![info exists info($w,textheight)] || [winfo height $w.map] != $info($w,textheight)} {
    set c_height [winfo height $w.map]
    set c_width [winfo width $w.map]
    $w.map scale all 0 0 1.0 [expr {1.0 * $c_height / ([lindex [$w.map coords frame] 3])}]
    $w.map coords frame 0 0 $c_width $c_height
    $w.map configure -scrollregion [list 0 0 $c_width $c_height]
    set info($w,textheight) $c_height
  }
}

##########
## change the vertical balance if width changes
##########
proc textarea_width_changed {w} {
  global info

  if {![winfo exists $w]} {return}
  if {[winfo width $w.textarea] <= 1} {
    set width $info(default_textarea_width)
  } else {  
    set width [expr {int(([winfo width $w.textarea]-4)/[lindex [wm grid $w] 2])}]
    #set width [expr {int([winfo width $w.textarea]*100.0/[font measure dnafont [string repeat 0 100]])}]
  }
  if {$width != $info($w,textwidth)} {
    set info($w,textwidth) $width
    #$w.textarea mark set templinestart [$w.textarea index @0,0]
    lassign [$w.textarea yview] yv0 yv1
    reline $w.textarea [expr {$width}]

    ####redo the top and bottom numbers
    set iline ""
    set count 10
    while {[string length $iline] < $width} {
      set iline "$iline    *[string repeat " " [expr {5-[string length $count]}]]$count"
      incr count 10
    }


    $w.horzindex delete 1.0 end
    $w.horzindex insert 1.0 $iline
    $w.horzindex2 delete 1.0 end
    $w.horzindex2 insert 1.0 $iline

    #resize_infoframe_fonts $w

    ## adjust the map_zoom pixels per line
######* take out the map_zoom when inline
    if {0} {
    set dna_length [ix2bp $w.textarea end]
    if {$dna_length > 0 && [$w.map_zoom coord frame] != {}} {
      set c_zoom_scale [expr {1.0 * ($info($w,inline_height) - 4 +[lindex [wm grid $w] 3])/$width}]
      $w.map_zoom scale all 0 0 1.0 [expr {$c_zoom_scale * $dna_length / [lindex [$w.map_zoom coord frame] 3]}]
      $w.map_zoom configure -scrollregion [$w.map_zoom coords frame] -yscrollincrement [lindex [wm grid $w] 3]
    }
    } else {
      $w.map_zoom delete all
    }
  }
    textarea_set_map_selection $w
    ####redo the left side numbers
   $w.vertindex delete 1.0 end 
   vertindexbalancer $w

}

#######
## link to translation clicks in canvases
#######
proc inline_canvas_bottom_link {w mode start char_width  x} {
  set char [expr {int($start + $x/$char_width)}]
  if {$mode eq "button"} {
    select_region $w [bp2ix $w.textarea $char] [bp2ix $w.textarea [expr {1+$char}]]
  } elseif {$mode eq "shift"} {
    set char_ix [bp2ix $w.textarea $char]
    if {[$w.textarea tag ranges sel] eq {}} {
      select_region $w $char_ix [bp2ix $w.textarea [expr {1+$char}]]
    } elseif {[$w.textarea compare $char_ix < sel.first]} {
      select_region $w $char_ix [$w.textarea index sel.last]
    } elseif {[$w.textarea compare $char_ix > sel.last]} {
      select_region $w [$w.textarea index sel.first] [bp2ix $w.textarea [expr {1+$char}]]
    } elseif {[$w.textarea count -chars sel.first $char_ix] < [$w.textarea count -chars $char_ix sel.last]} {
      select_region $w $char_ix [$w.textarea index sel.last]
    } else {
      select_region $w [$w.textarea index sel.first]  [bp2ix $w.textarea [expr {1+$char}]]
    } 
  }
}

#######
## link to translation clicks in canvases
#######
proc inline_canvas_trans_link {w start char_width tag x} {
  global info
  set char [expr {int($start + $x/$char_width)}]
  if {[string index [dict get $info($w,trans_dict) $tag] $char] eq " "} {return}
  set pre_char [expr {$char-1}]
  set post_char [expr {$char+1}]
  if { [string index [dict get $info($w,cds_dict) $tag] $pre_char] eq " "} {
    incr pre_char 1
  }
  if { [string index [dict get $info($w,cds_dict) $tag] $post_char] eq " "} {
    incr post_char -1
  }
  select_region $w [bp2ix $w.textarea $pre_char] [bp2ix $w.textarea [expr {1+$post_char}]]
}


#######
## fill info in sequence inline canvas window (called by seq_tooltip_post)
#######
proc seq_inline_canvas {w start_index end_index to_canvas {font dnafont}} {
  global info enzinfo enzymes 
  #set to_canvas $w.seqtooltip.c
  #set start_index [$w.textarea index "$index linestart"]
  #set end_index [$w.textarea index "$index lineend"]
  set start [ix2bp $w.textarea $start_index]
  set end [ix2bp $w.textarea $end_index]

  if {$start >= $end} {return [list 0 0]}
  #set line_width [lindex [$w.textarea dlineinfo $index] 2]
  set line_width [font measure $font [string repeat "A" [expr {$end-$start}]]]
  #set seq_width [expr {[winfo width $w.textarea]-9}]
  set seq_width [expr {$line_width}]



##draw inline canvas here
  #$to_canvas delete all
  canvas_delete_all $to_canvas

  set total_length [expr {$end-$start}]
  set templist [feature_find $w $start $end]


  ## draw index line at -10
  set char_width [expr {1.0*$line_width/($end-$start)}]
  set number_spacing [font measure $font [string repeat "A" 10]]
  set next_number_x 0
  for {set ix [expr {10-($start+1)%10}]} {$ix <= [expr {$end-$start}]}  {incr ix 10} {
    set char_x [expr {($ix+0.5)*$char_width}]
    $to_canvas create line $char_x 0 $char_x -4 -fill $info(text_fg_color)
    if {$char_x > $next_number_x} {
      $to_canvas create text $char_x 0 -text [expr {$ix+($start+1)}] -anchor n -fill $info(text_fg_color)
      set next_number_x [expr {$next_number_x + $number_spacing}]
    }
  }
  #$to_canvas create text [expr {0}] [expr {-3}] -anchor sw -text "Index Line: $start" -font dnafont -fill $info(text_fg_color) -tags bottom_strand

  #draw bottom strand above index
  if {$info(inline_show_second_strand)} {
	set enzy [lindex [$to_canvas bbox all] 1]
	if {$enzy eq {}} {set enzy 0}
	set bottom_strand [$to_canvas create text [expr {0}] [expr {$enzy-1}] -anchor sw -text [com [$w.textarea get $start_index $end_index]] -font dnafont -fill $info(text_fg_color) -tags bottom_strand]
	$to_canvas bind $bottom_strand <Button-1> "inline_canvas_bottom_link $w button $start $char_width %x" 
	$to_canvas bind $bottom_strand <Shift-Button-1> "inline_canvas_bottom_link $w shift $start $char_width %x" 
  }

  #draw enzymes above bottom strand
  if {[lindex [$to_canvas bbox all] 1] eq {}} {
    set enz_bottom 0
  } else {
    set enz_bottom [expr {[lindex [$to_canvas bbox all] 1]+3}]
  }
  set drawn_ranges [list]
  findenzymes $w
  foreach enzyme  [lsearch -inline -regexp -all -not [$w.textarea tag names] {trans[0-9]+#|f[0-9]+#|fn[0-9]+#|tempsel|sel|foundf|foundr}] {
    if {[$w.textarea tag ranges $enzyme] == {}} {continue}
    if {![info exists info($w,$enzyme)] } {
      continue
    }
    if {1} {
      set sitecount 0
      foreach site $info($w,$enzyme) {
        if {[expr {$site-$start+30}] > 0} {

          set seqstart [expr {1.0*($site-$start-1)*$char_width}]
          set seqend [expr {1.0*($site-1-$start+[string length $enzinfo(flatpat,$enzyme)])*$char_width}]
          if {[lindex $info($w,enzdir,$enzyme) $sitecount]} {
            set cut5 [expr {1.0*($site-1-$start+[string length $enzinfo(flatpat,$enzyme)]-[lindex $enzinfo(enz_cut_sites,$enzyme) 1])*$char_width}]
            set cut3 [expr {1.0*($site-1-$start+[string length $enzinfo(flatpat,$enzyme)]-[lindex $enzinfo(enz_cut_sites,$enzyme) 0])*$char_width}]
          } else {
            set cut5 [expr {1.0*($site-1-$start+[lindex $enzinfo(enz_cut_sites,$enzyme) 0])*$char_width}]
            set cut3 [expr {1.0*($site-1-$start+[lindex $enzinfo(enz_cut_sites,$enzyme) 1])*$char_width}]
          }

          if {[expr {1.0*max($seqend, $cut5, $cut3)}] <= 0} {
            incr sitecount
            continue
          }
          if {[expr {1.0*min($seqstart, $cut5, $cut3)/$line_width}] >= 1} break



          set enzy 0
          set left_edge [expr {min($cut5, $cut3, $seqstart)}] 
          set right_edge [expr {max($cut5, $cut3, $seqend)}]
          foreach {s e} $drawn_ranges {
            if {$left_edge > $e || $right_edge < $s} {continue}
            incr enzy [expr {7+[font metrics graphicfont -linespace]}]
          }
          $to_canvas create line $seqstart [expr {$enz_bottom-5-$enzy}] $seqend [expr {$enz_bottom-5-$enzy}] -width 2
          $to_canvas create line $cut5 [expr {$enz_bottom-5-$enzy}] $cut5 [expr {$enz_bottom-9-$enzy}] -width 2
          $to_canvas create line $cut3 [expr {$enz_bottom-5-$enzy}] $cut3 [expr {$enz_bottom-1-$enzy}] -width 2
          if {[expr {min($cut5,$cut3)}] < $seqstart} {
            $to_canvas create line $seqstart [expr {$enz_bottom-5-$enzy}] [expr {min($cut5,$cut3)}] [expr {$enz_bottom-5-$enzy}] -width 1 -dash {3 3}
          }
          if {[expr {max($cut5,$cut3)}] > $seqend} {
            $to_canvas create line $seqend [expr {$enz_bottom-5-$enzy}] [expr {max($cut5,$cut3)}] [expr {$enz_bottom-5-$enzy}] -width 1 -dash {3 3}
          }
          lappend drawn_ranges $left_edge $right_edge
          $to_canvas create text [expr {max(0,1.0*($site-$start-1)/$total_length*$line_width)}] [expr {$enz_bottom-7-$enzy}] -anchor sw -text "$enzyme" -font graphicfont -fill $info(text_fg_color)
        }
        incr sitecount
      }
    }
  }

  ## draw find ranges below index
  if {[lindex [$to_canvas bbox all] 3] eq {}} {
    set find_top 0
  } else {
    set find_top [expr {[lindex [$to_canvas bbox all] 3]+3}]
  }
  set char_height [font metrics Arial -linespace]
  foreach {fs fe} [$w.textarea tag ranges foundf] {
    if {[$w.textarea compare $start_index <= $fe] && [$w.textarea compare $end_index >= $fs]} {
      if {[$w.textarea compare $start_index > $fs]} {
        set fs $start_index
      }
      set fs [expr {[ix2bp $w.textarea $fs] - $start}]
      if {[$w.textarea compare $end_index < $fe]} {
        set fe $end_index
      }
      set fe [expr {[ix2bp $w.textarea $fe] - $start}]
      $to_canvas create polygon [expr {$fs*$char_width}] $find_top [expr {($fe-1)*$char_width}] $find_top [expr {($fe)*$char_width}] [expr {$find_top+$char_height/2}] [expr {($fe-1)*$char_width}] [expr {$find_top+$char_height}] [expr {($fs)*$char_width}] [expr {$find_top+$char_height}] -fill $info(find_forward_highlight)  -outline black
    }
  }
  
  foreach {fs fe} [$w.textarea tag ranges foundr] {
    if {[$w.textarea compare $start_index <= $fe] && [$w.textarea compare $end_index >= $fs]} {
      if {[$w.textarea compare $start_index > $fs]} {
        set fs $start_index
      }
      set fs [expr {[ix2bp $w.textarea $fs] - $start}]
      if {[$w.textarea compare $end_index < $fe]} {
        set fe $end_index
      }
      set fe [expr {[ix2bp $w.textarea $fe] - $start}]
      $to_canvas create polygon [expr {($fs+1)*$char_width}] [expr {$find_top+$char_height*3/2}] [expr {($fe)*$char_width}] [expr {$find_top+$char_height*3/2}] [expr {($fe)*$char_width}] [expr {$find_top+$char_height*5/2}] [expr {($fs+1)*$char_width}] [expr {$find_top+$char_height*5/2}] [expr {($fs)*$char_width}] [expr {$find_top+$char_height*4/2}] -fill $info(find_reverse_highlight) -outline black
    }
  }
  
  if {![info exists info($w,trans_dict)]} {
    set info($w,trans_dict) {}
  }

  ### draw features
  set drawn_ranges [list]
  set feature_top [lindex [$to_canvas bbox all] 3]
  if {$feature_top eq {}} {
    set feature_top 0
  }

  foreach {name tag} $templist {
    regsub "fn" $tag "f" tag


    #need to copy this feature and take out all feature links
    seq_tooltip_linear_feature_draw $to_canvas 0 $w $start $end $total_length $tag $line_width

    $to_canvas bind $tag&&exon <Button-1> "$w.tvframe.tv selection set $tag; $w.tvframe.tv see $tag; set start_end_ix \[feature_tag_start_end_ix $w $tag\]; select_region $w \[bp2ix $w.textarea \[ix2bp $w.textarea \[lindex \$start_end_ix 1\]\]\] \[bp2ix $w.textarea \[ix2bp $w.textarea \[lindex \$start_end_ix 0\]\]\] ; focus .; focus $w.textarea; unset -nocomplain start_end_ix"
    $to_canvas bind $tag&&fwd_arrow <Button-1> "$w.tvframe.tv selection set $tag; $w.tvframe.tv see $tag; set start_end_ix \[feature_tag_start_end_ix $w $tag\]; select_region $w \[bp2ix $w.textarea \[ix2bp $w.textarea \[lindex \$start_end_ix 1\]\]\] \[bp2ix $w.textarea \[ix2bp $w.textarea \[lindex \$start_end_ix 0\]\]\] ; focus .; focus $w.textarea; unset -nocomplain start_end_ix"
    $to_canvas bind $tag&&rev_arrow <Button-1> "$w.tvframe.tv selection set $tag; $w.tvframe.tv see $tag; set start_end_ix \[feature_tag_start_end_ix $w $tag\]; select_region $w \[bp2ix $w.textarea \[ix2bp $w.textarea \[lindex \$start_end_ix 1\]\]\] \[bp2ix $w.textarea \[ix2bp $w.textarea \[lindex \$start_end_ix 0\]\]\] ; focus .; focus $w.textarea; unset -nocomplain start_end_ix"

    ## add primer sequences
    seq_tooltip_add_primer_seq $to_canvas $w $start $end $tag $line_width
    
    ## add translation lines
    if {[dict exists $info($w,trans_dict) $tag]  && [regexp {[^\s]} [string range [dict get $info($w,trans_dict) $tag] $start $end]]} {
      set transy [lindex [$to_canvas bbox $tag] 1]
      if {$transy ne {} } {
	    set transline [$to_canvas create text [expr {0}] [expr {$transy}] -anchor sw -text [string range [dict get $info($w,trans_dict) $tag] $start $end] -font dnafont -fill $info(text_fg_color) -tags [list $tag feature]]
		$to_canvas bind $transline <Button-1> "inline_canvas_trans_link $w $start $char_width $tag %x" 
      }
      #incr transy [expr {1+[font metrics dnafont -linespace]}]
      #$to_canvas create text [expr {0}] [expr {$transy}] -anchor nw -text [string range [dict get $info($w,cds_dict) $tag] $start $end]] -font dnafont -fill $info(text_fg_color) -tags [list $tag feature]
    }


    lassign [$to_canvas bbox $tag] fx0 fy0 fx1 fy1
    if {$fx0 ne {}} {
      set top_edge 0
      foreach {x0 y0 x1 y1} $drawn_ranges {
        if {$fx0 >= $x1 || $fx1 <= $x0} {continue}
        set top_edge [expr {max($top_edge, $y1)}]
      }
      $to_canvas move $tag 0 [expr {$top_edge-$fy0}]

      lappend drawn_ranges {*}[$to_canvas bbox $tag]
    }
  }


  ## move features to top edge at 0
  if {[$to_canvas bbox feature]!= {}} {
    $to_canvas move feature 0 [expr {$feature_top-[lindex [$to_canvas bbox feature] 1]}]
  }



  set bbox [$to_canvas bbox all]
  if {$bbox == [list]} {
    set bbox [list 0 0 $seq_width 0]
  } else {
    set bbox [list 0 [lindex $bbox 1] $seq_width [lindex $bbox 3]]

  }

  ##add Phred trace 
  if {[info exists info($w,phred_string)] && $info($w,phred_string) ne {}} {
    set sub_phred [string range $info($w,phred_string) $start $end]
    $to_canvas create polygon  {*}[create_phred_string_coords $sub_phred $line_width]  -fill blue -outline black -width 1 -tags [list phred]
    $to_canvas move phred 0 [expr {[lindex $bbox 3] + 60}]
    $to_canvas create line 0  [expr {[lindex $bbox 3] + 60 - 20}] $seq_width [expr {[lindex $bbox 3] + 60 - 20}] 
    $to_canvas create line 0  [expr {[lindex $bbox 3] + 60 - 40}] $seq_width [expr {[lindex $bbox 3] + 60 - 40}] 
    $to_canvas create line 0  [expr {[lindex $bbox 3] + 60 - 60}] $seq_width [expr {[lindex $bbox 3] + 60 - 60}] 
  }
  
  # make a background rectangle to capture mouse clicks and set the bottom spacing
  set bbox [$to_canvas bbox all]
  if {$bbox == [list]} {
    set bbox [list 0 0 $seq_width 0]
  } else {
    set bbox [list 0 [lindex $bbox 1] $seq_width [expr {[lindex $bbox 3] + [font metrics dnafont -linespace] * $info(inline_canvas_space_height)}]]
  }
  
  $to_canvas create rectangle -1 [expr {[lindex $bbox 1] -1}] [expr {[lindex $bbox 2] +1}] [expr {[lindex $bbox 3] +1}] -fill {} -outline blue -tags spacer
  $to_canvas lower spacer
  $to_canvas bind spacer <Button-1> "event generate $to_canvas <<Button-1>> -rooty %Y -x %x"



  $to_canvas xview moveto 0
  $to_canvas configure -scrollregion $bbox -width $seq_width -height [expr {[lindex $bbox 3]-[lindex $bbox 1]}]
  return [list [expr {[lindex $bbox 3]-[lindex $bbox 1]}] [expr {[lindex $bbox 2]-[lindex $bbox 0]}]]
} 

  } else {
 #########
## NON INLINE MODE HERE
#########
############
## quick cr inserter for a text window
############
proc reline {w newwidth} {
  set i 1
  while {[$w compare $i.end < end]} {
    set linelength [expr {[lindex [split [$w index $i.end] .] 1]}]
    if {($linelength < $newwidth)} {
      if {[$w compare $i.end+1c < end]} {
        $w delete $i.end
      } else {
        break
      }
    } elseif {$linelength > $newwidth}  {
      for {set j $i} {$j < [expr {$i+ $linelength/ $newwidth}]} {incr j} {
        $w insert $j.$newwidth \n
      }
      set i $j
    } else {
      incr i
    }
  }
}

##########
## scale the map if height changes
##########
proc textarea_set_map_selection {w} {
  set dna_length [ix2bp $w.textarea end]
  if {[$w.map coords frame] == {}} {
    textarea_fill_map $w
  }
  if {[$w.map coords frame] == {}} {
  sputs no map frame $w
    return
  }
  if {$dna_length > 0 && [$w.map_zoom coord frame] != {}} {
    set c_scale [expr {[lindex [$w.map coords frame] 3]/ $dna_length}]
    set c_zoom_scale [expr {[lindex [$w.map_zoom coords frame] 3]/ $dna_length}]
  } else {
    set c_scale 0
    set c_zoom_scale 0
  }
  set sel_coords [$w.map coords selection]
  set sel_zoom_coords  [$w.map_zoom coords selection]
  if {$sel_coords == {} || $sel_zoom_coords == {}} {return}
  if {[$w.textarea tag ranges sel] != ""} {
    set first [ix2bp $w.textarea [$w.textarea index sel.first]]
    set last [ix2bp $w.textarea [$w.textarea index sel.last]]
  } else {
    set first [ix2bp $w.textarea [$w.textarea index insert]]
    set last [ix2bp $w.textarea [$w.textarea index insert]]
  }
  lset sel_coords 1 [expr {$first * $c_scale}]
  lset sel_coords 3 [expr {$last * $c_scale}]
  lset sel_zoom_coords 1 [expr {$first * $c_zoom_scale}]
  lset sel_zoom_coords 3 [expr {$last * $c_zoom_scale}]
  $w.map coords selection {*}$sel_coords
  $w.map_zoom coords selection {*}$sel_zoom_coords
}


############
## convert a bp integer to a textarea index
############
proc bp2ix {t base_position} {
    if {$base_position <= 0 || ![winfo exists $t]} {
      return 1.0
    }
    set width [lindex [split [$t index 1.end] .] 1]
    if {$width == 0} {
      for {set i 2.0} {($width ==0) && [$t compare $i < end]} {set i [$t index $i+2lines]} {
        set width [lindex [split [$t index "$i lineend"] .] 1]
      }
      if {$width == 0} {
        return 1.0
      }
    }
    return [expr {($base_position)/($width)+1}].[expr {(($base_position) % ($width)) }]
    return [expr {($base_position-1)/($width)+1}].[expr {(($base_position-1) % ($width)) +1}]
}

############
## convert a textarea index to a bp integer
############
proc ix2bp {t index} {
    set width [lindex [split [$t index 1.end] .] 1]
    set index [$t index $index]
    if {[$t compare $index > end-1c]} {set index [$t index end-1c]}
    return [expr {$width*([lindex [split $index .] 0]-1)+[lindex [split $index .] 1]}]
}

############
## return the index of the last bp
############
proc end_ix {t} {
  return [$t index end-1c]
}

#######
##  makes the index numbers along the left edge and scrollbar match the text box
## if width hasn't changed, just synch the scrollbar, vertindex and map_zoom to the text
#######
proc vertindexbalancer {w} {
  global info

  if {![winfo exists $w]} {return}
  set textend [expr {round (([set textlen [ix2bp $w.textarea end]]) / ($info($w,textwidth)) )+1}]
  set vertend [lindex [split [$w.vertindex index end-1chars] .] 0]
  #$w.vertindex configure -state normal
  if {$vertend < $textend} { 
    set templist [list]
    while {$vertend < $textend} {
      lappend templist [expr $vertend*($info($w,textwidth))+1]
      incr vertend
    }
    $w.vertindex insert end \n allvertindex
    $w.vertindex insert end [join $templist \n] allvertindex

  }
  if {($vertend > $textend) && ($vertend > 1)} {
    $w.vertindex delete [expr ($textend > 1 ? $textend : 1)+1].0 end
  }



  $w.vertindex yview moveto [lindex [$w.textarea yview] 0]

# make the scrollbar  and map_zoom match the text view
# yview isn't guaranteed to be updated correctly after a reline, so calculate based on number of lines
  set wheight [expr {([winfo height $w.textarea]/ [font metrics dnafont -linespace])}]
  ####bug on the mac- when scrolling to the end, the top line is not properly gridded- first line is at 5 pixels down (hopefully not more)
  set firstline [expr {([ix2bp $w.textarea [$w.textarea index @0,5]])/$info($w,textwidth)}]
  set numlines [expr {([ix2bp $w.textarea end] - 1)/$info($w,textwidth)+1}]
  if {$numlines > $wheight} {
    set lastline [expr {$wheight+$firstline}]
  } else {
    set lastline $numlines
  }

  $w.vertindex configure -width [expr {$textlen < 10 ? 2 : int(.0000000001+log($textlen)/log(10))+1}] 

  if {($numlines == 0.0) || (($firstline == 0) && ($lastline == $numlines))} {
    if {[grid info $w.vertscroll] != {}} {
      grid remove $w.vertscroll
    }
  } else {
    if {[grid info $w.vertscroll] == "" && !$info(hide_scrollbar)} {
      grid configure $w.vertscroll
      update idletasks
    } 
    $w.vertscroll set [expr {1.0*$firstline/$numlines}] [expr {1.0*$lastline/$numlines}]
  }
  if {$numlines > 0} {
    $w.map_zoom yview moveto [expr {1.0*$firstline/$numlines}]
  }
}

#######
## sends the scrollbar commands to both the index box and the text box
#######
proc vertscrollmanager {w args} {
  global info
  if {![winfo exists $w.textarea]} return
  if {[$w.textarea compare insert == end]} {
    $w.textarea mark set insert [end_ix $w.textarea]
  }
  if {[lindex $args 0] == "moveto"} {
    set numlines [expr {([ix2bp $w.textarea end]-1)/$info($w,textwidth)+1.0}]
    set numlines [expr {$numlines +1}]
    set toline [expr {int([lindex $args 1]*$numlines)}]
    $w.textarea yview [bp2ix $w.textarea [expr {$toline*$info($w,textwidth)+1}]]
    $w.vertindex yview "[expr {$toline+1}].0" 
    $w.map_zoom yview {*}$args
  } else {
    $w.textarea yview {*}$args
    $w.vertindex yview {*}$args
    $w.map_zoom yview {*}$args
  }
  if {$info(hide_scrollbar)} {
    grid configure $w.vertscroll
    after cancel "grid remove $w.vertscroll"
    after 750 "grid remove $w.vertscroll"
  }
  $w.vertscroll set {*}[$w.textarea yview]
  #vertindexbalancer $w
}

##########
## scale the map if height changes
##########
proc textarea_height_changed {w} {
  global info
  if {![winfo exists $w.map] || [winfo height $w.map] <= 1 || [$w.map bbox all] == ""} {
    return
  }

  if {![info exists info($w,textheight)] || [winfo height $w.map] != $info($w,textheight)} {
    set c_height [winfo height $w.map]
    set c_width [winfo width $w.map]
    $w.map scale all 0 0 1.0 [expr {1.0 * $c_height / ([lindex [$w.map coords frame] 3])}]
    $w.map coords frame 0 0 $c_width $c_height
    $w.map configure -scrollregion [list 0 0 $c_width $c_height]
    set info($w,textheight) $c_height
  }
}

##########
## change the vertical balance if width changes
##########
proc textarea_width_changed {w} {
  global info

  if {![winfo exists $w]} {return}
  if {[winfo width $w.textarea] <= 1} {
    set width $info(default_textarea_width)
  } else {  
    set width [expr {int(([winfo width $w.textarea]-4)/[lindex [wm grid $w] 2])}]
    #set width [expr {int([winfo width $w.textarea]*100.0/[font measure dnafont [string repeat 0 100]])}]
  }
  if {$width != $info($w,textwidth)} {
    set info($w,textwidth) $width
    $w.textarea mark set templinestart [$w.textarea index @0,0]
    reline $w.textarea [expr {$width}]
    ####redo the top and bottom numbers
    set iline ""
    set count 10
    while {[string length $iline] < $width} {
      set iline "$iline    *[string repeat " " [expr {5-[string length $count]}]]$count"
      incr count 10
    }


    $w.horzindex delete 1.0 end
    $w.horzindex insert 1.0 $iline

    $w.horzindex2 delete 1.0 end
    $w.horzindex2 insert 1.0 $iline

    ####redo the left side numbers
    $w.vertindex delete 2.0 end 

    resize_infoframe_fonts $w

    ## adjust the map_zoom pixels per line
    set dna_length [ix2bp $w.textarea end]
    if {$dna_length > 0 && [$w.map_zoom coord frame] != {}} {
      set c_zoom_scale [expr {1.0 * [lindex [wm grid $w] 3]/$width}]
      $w.map_zoom scale all 0 0 1.0 [expr {$c_zoom_scale * $dna_length / [lindex [$w.map_zoom coord frame] 3]}]
      $w.map_zoom configure -scrollregion [$w.map_zoom coords frame] -yscrollincrement [lindex [wm grid $w] 3]
    }
  }
  vertindexbalancer $w
}

#########
## END OF SET INLINE MODE
#########
  }  
}


################
## try to use tile widgets where possible
################
set info(use_tile) 0
proc use_tile {} {
  global info
  if {1 || ( ([tk windowingsystem] == "aqua") || ([tk windowingsystem] == "win32")) && (![catch {package require tile}])} {
    set info(use_tile) 1
  } else {
    if {[catch {ttk::notebook .blank_notebook}]} {
      #sputs tile not used- using standard widgets
      #rename configure_preferences tile_configure_preferences
      #rename non_tile_configure_preferences configure_preferences
      tk_messageBox -message [mc "ApE now requires Tk 8.6"]
      exit
      set info(use_tile) 0
    } else {
      destroy .blank_notebook
      set info(use_tile) 1
    }
  }
  
  if {[tk windowingsystem] == "aqua"} {
  #  ttk::style theme create ape_green -parent aqua
  } elseif {[tk windowingsystem] eq "win32"} {
  # ttk::style theme create ape_green -parent winnative
  } else {
    #ttk::style theme create ape_green -parent alt
  }
 # ttk::style theme use ape_green

  if {$info(use_tile)} {
    ###use tile scale widgets (only used in abi window for now)
    ###
    rename scale tk_scale
    proc scale {name args} {
     set new_args [list]
     foreach {arg value} $args {
       if {[lsearch {-from -to -command -variable -value -length -orient} $arg] > -1} {
         lappend new_args $arg $value
       } else {
         sputs ttk::scale doesn't accept $arg $value
       }
     }
      ttk::scale $name {*}$new_args
    }

    ##fix bug- $State(activeWidget) might not exist if the Treview <Leave> isn't fired and the window is closed
    proc ttk::treeview::ActivateHeading {w heading} {
      variable State
      if {$w != $State(activeWidget) || $heading != $State(activeHeading)} {
	  if {$State(activeHeading) != {} && [info exists $State(activeWidget)]} {
	      $State(activeWidget) heading $State(activeHeading) state !active
	  }
	  if {$heading != {}} {
	      $w heading $heading state active
	  }
	  set State(activeHeading) $heading
	  set State(activeWidget) $w
      }
    }

    if {$info(android) && [lsearch [ttk::style theme names] "droid"] > -1 } {
      ttk::style theme use droid
      ###use tile menubutton widgets (in Android)
      ###
      rename menubutton tk_menubutton
      proc menubutton {name args} {
        set new_args [list]
        foreach {arg value} $args {
          if {[lsearch { -class -compound -cursor -image -state -style -takefocus -text -textvariable -underline -width -direction -menu  } $arg] > -1} {
            lappend new_args $arg $value
          } else {
          # sputs ttk::menubutton doesn't accept $arg $value
          }
        }
         ttk::menubutton $name {*}$new_args
        rename $name tk_$name
        proc $name {command args} "
          if {\[string range \$command 0 3\] == \"conf\"} {
            if {\[llength \$args\] == 1} {
              if {\[lsearch {-text -cursor -image -default -width -command -textvariable  -takefocus -style} \[lindex \$args 0\]\] > -1} {
                return \[tk_$name configure \$args\]
              } else {
                foreach i {{-activebackground activeBackground Foreground systemButtonFacePressed $info(bg_color)} {-activeforeground activeForeground Background systemPushButtonPressedText black} {-anchor anchor Anchor center center} {-background background Background systemWindowBody $info(bg_color)} {-bd -borderwidth} {-bg -background} {-bitmap bitmap Bitmap {} {}} {-borderwidth borderWidth BorderWidth 2 2} {-cursor cursor Cursor {} {}} {-direction direction Direction below below} {-disabledforeground disabledForeground DisabledForeground #a3a3a3 #a3a3a3} {-fg -foreground} {-font font Font TkDefaultFont TkDefaultFont} {-foreground foreground Foreground Black Black} {-height height Height 0 0} {-highlightbackground highlightBackground HighlightBackground systemWindowBody $info(bg_color)} {-highlightcolor highlightColor HighlightColor Black Black} {-highlightthickness highlightThickness HighlightThickness 0 0} {-image image Image {} {}} {-indicatoron indicatorOn IndicatorOn 1 1} {-justify justify Justify left left} {-menu menu Menu {} {}} {-padx padX Pad 4 4} {-pady padY Pad 3 3} {-relief relief Relief flat flat} {-compound compound Compound none none} {-state state State normal normal} {-takefocus takeFocus TakeFocus 0 0} {-text text Text {} {}} {-textvariable textVariable Variable {} {}} {-underline underline Underline -1 -1} {-width width Width 0 0} {-wraplength wrapLength WrapLength 0 0}} {
                  if {\[lsearch \$i \[lindex \$args 0\]\] > -1} {
                    return \$i
                  }
                }
              }
            } else {
              set new_args \[list\]
              foreach {arg value} \$args {
                if {\[lsearch {-text -image -cursor -width -compound -textvariable -state -direction -menu} \$arg] > -1} {
                  lappend new_args \$arg \$value
                 #sputs $name \$arg \$value
                } else {
                 #sputs **reject** $name \$arg \$value
                } 
              }
              #sputs * $name configure \$new_args
               tk_$name configure {*}\$new_args
            }
          } elseif {\$command == \"invoke\"} {
            #sputs doing:tk_$name \$command \$args
            uplevel #0 tk_$name invoke
          } else {
            uplevel #0 tk_$name \$command \$args
          } 
        "
        return $name
      }

      ttk::style layout NoIndicator.TMenubutton {
        Menubutton.background
        Menubutton.button -children {
          Menubutton.focus -children {
            Menubutton.padding -children {
              Menubutton.label -expand true
            }
          }
        }
      }

      ttk::style layout Box.NoIndicator.TMenubutton {
        Menubutton.background
        Menubutton.button -children {
          Menubutton.focus -children {
            Menubutton.padding -children {
              Menubutton.label -expand true
            }
          }
        }
      }
      ttk::style configure Box.NoIndicator.TMenubutton -font {helvetica 8}

    }


    ###use tile button, checkbutton and radiobutton widgets in windows
    if {1|| ([tk windowingsystem] eq "win32") || $info(android)} {
      ###
      ### ok to use these on aqua, but info(bg_color) has to be set to gray93- using tile buttons after 2015 cocoa updates
      if {([tk windowingsystem] eq "aqua")} {
        #set info(bg_color) systemDialogBackgroundActive
      }
      ## need to set takefocus values back to default of 0- tile sets the default to true via a procedure ttk::takefocus
      rename ttk::takefocus ttk::takefocus_old
      proc ttk::takefocus {w} {return 0}

      rename button tk_button
      proc button {name args} {
        set new_args [list]
        foreach {arg value} $args {
          if {[lsearch {-text -cursor -image -default -width -command -textvariable -state} $arg] > -1} {
            lappend new_args $arg $value
          } else {
          # sputs ttk::button doesn't accept $arg $value
          }
        }
         ttk::button $name {*}$new_args
        rename $name tk_$name
        proc $name {command args} "
          if {(\[string range \$command 0 3\] == \"conf\")} {
            if {\[llength \$args\] == 1} {
              if {\[lsearch {-text -cursor -image -default -width -command -textvariable -takefocus -style -state} \[lindex \$args 0\]\] > -1} {
                return \[tk_$name configure \$args\]
              } else {
                foreach i {{-activebackground activeBackground Foreground systemButtonText gray85} {-activeforeground activeForeground Background systemButtonFace black} {-anchor anchor Anchor center center} {-background background Background White gray85} {-bd -borderwidth} {-bg -background} {-bitmap bitmap Bitmap {} {}} {-borderwidth borderWidth BorderWidth 2 2} {-command command Command {} {}} {-compound compound Compound none none} {-cursor cursor Cursor {} {}} {-default default Default disabled disabled} {-disabledforeground disabledForeground DisabledForeground #a3a3a3 #a3a3a3} {-fg -foreground} {-font font Font system labelfont} {-foreground foreground Foreground Black black} {-height height Height 0 0} {-highlightbackground highlightBackground HighlightBackground White gray85} {-highlightcolor highlightColor HighlightColor systemButtonFrame black} {-highlightthickness highlightThickness HighlightThickness 4 4} {-image image Image {} {}} {-justify justify Justify center center} {-overrelief overRelief OverRelief {} {}} {-padx padX Pad 12 12} {-pady padY Pad 3 3} {-relief relief Relief flat flat} {-repeatdelay repeatDelay RepeatDelay 0 0} {-repeatinterval repeatInterval RepeatInterval 0 0} {-state state State normal normal} {-takefocus takeFocus TakeFocus {} {}} {-text text Text {} {}} {-textvariable textVariable Variable {} {}} {-underline underline Underline -1 -1} {-width width Width 0 0} {-wraplength wrapLength WrapLength 0 0}} {
                  if {\[lsearch \$i \[lindex \$args 0\]\] > -1} {
                    return \$i
                  }
                }
                ##config otion not found- return an error
                error \"\[lindex \$args 0\] isn't an option for tk_$name\"
              }
            } else {
              set new_args \[list\]
              foreach {arg value} \$args {
                if {\[lsearch {-text -cursor -image -default -width -command -textvariable -takefocus -style -state} \$arg] > -1} {
                  lappend new_args \$arg \$value
                 #sputs $name \$arg \$value
                } else {
                 #sputs **reject** $name \$arg \$value
                } 
              }
              #sputs * $name configure \$new_args
               tk_$name configure {*}\$new_args
            }
          } elseif {\$command == \"invoke\"} {
            uplevel #0 tk_$name invoke
          } elseif  {(\[string range \$command 0 3\] == \"cget\")} {
            uplevel #0 tk_$name \$command \$args
          } else {
            #sputs $name \$command \$args
            uplevel #0 tk_$name \$command \$args
          } 
        "
        return $name
      }

      ###use tile menubutton widgets
      ###
      rename menubutton tk_menubutton
      proc menubutton {name args} {
        set new_args [list]
        foreach {arg value} $args {
          if {[lsearch {-text -cursor -image -menu -default -width -command -textvariable -state} $arg] > -1} {
            lappend new_args $arg $value
          } else {
          # sputs ttk::button doesn't accept $arg $value
          }
        }
         ttk::menubutton $name {*}$new_args
        rename $name tk_$name
        proc $name {command args} "
          if {(\[string range \$command 0 3\] == \"conf\")} {
            if {\[llength \$args\] == 1} {
              if {\[lsearch {-text -cursor -image -menu -default -width -command -textvariable -takefocus -style -state} \[lindex \$args 0\]\] > -1} {
                return \[tk_$name configure \$args\]
              } else {
                foreach i {{-activebackground activeBackground Foreground systemButtonText gray85} {-activeforeground activeForeground Background systemButtonFace black} {-anchor anchor Anchor center center} {-background background Background White gray85} {-bd -borderwidth} {-bg -background} {-bitmap bitmap Bitmap {} {}} {-borderwidth borderWidth BorderWidth 2 2} {-command command Command {} {}} {-compound compound Compound none none} {-cursor cursor Cursor {} {}} {-default default Default disabled disabled} {-disabledforeground disabledForeground DisabledForeground #a3a3a3 #a3a3a3} {-fg -foreground} {-font font Font system labelfont} {-foreground foreground Foreground Black black} {-height height Height 0 0} {-highlightbackground highlightBackground HighlightBackground White gray85} {-highlightcolor highlightColor HighlightColor systemButtonFrame black} {-highlightthickness highlightThickness HighlightThickness 4 4} {-image image Image {} {}} {-justify justify Justify center center} {-overrelief overRelief OverRelief {} {}} {-padx padX Pad 12 12} {-pady padY Pad 3 3} {-relief relief Relief flat flat} {-repeatdelay repeatDelay RepeatDelay 0 0} {-repeatinterval repeatInterval RepeatInterval 0 0} {-state state State normal normal} {-takefocus takeFocus TakeFocus {} {}} {-text text Text {} {}} {-textvariable textVariable Variable {} {}} {-underline underline Underline -1 -1} {-width width Width 0 0} {-wraplength wrapLength WrapLength 0 0}} {
                  if {\[lsearch \$i \[lindex \$args 0\]\] > -1} {
                    return \$i
                  }
                }
                ##config otion not found- return an error
                error \"\[lindex \$args 0\] isn't an option for tk_$name\"
              }
            } else {
              set new_args \[list\]
              foreach {arg value} \$args {
                if {\[lsearch {-text -cursor -image -menu -default -width -command -textvariable -takefocus -style -state} \$arg] > -1} {
                  lappend new_args \$arg \$value
                 #sputs $name \$arg \$value
                } else {
                 #sputs **reject** $name \$arg \$value
                } 
              }
              #sputs * $name configure \$new_args
               tk_$name configure {*}\$new_args
            }
          } elseif {\$command == \"invoke\"} {
            uplevel #0 tk_$name invoke
          } elseif  {(\[string range \$command 0 3\] == \"cget\")} {
            uplevel #0 tk_$name \$command \$args
          } else {
            #sputs $name \$command \$args
            uplevel #0 tk_$name \$command \$args
          } 
        "
        return $name
      }
      
      ###use tile checkbutton widgets
      ###
      rename checkbutton tk_checkbutton
      proc checkbutton {name args} {
        set new_args [list]
        foreach {arg value} $args {
          if {[lsearch {-text -image -cursor -compound -padding -state -underline -width -command -textvariable  -onvalue -offvalue -variable  -takefocus -style} $arg] > -1} {
            lappend new_args $arg $value
          } else {
          # sputs ttk::button doesn't accept $arg $value
          }
        }
         ttk::checkbutton $name {*}$new_args
        rename $name tk_$name
        proc $name {command args} "
          if {\[string range \$command 0 3\] == \"conf\"} {
            if {\[llength \$args\] == 1} {
              if {\[lsearch {-text -image -cursor -compound -padding -state -underline -width -command -textvariable  -onvalue -offvalue -variable  -takefocus -style} \[lindex \$args 0\]\] > -1} {
                return \[tk_$name configure \$args\]
              } else {
                foreach i {{-activebackground activeBackground Foreground systemButtonText gray85} {-activeforeground activeForeground Background systemButtonFace black} {-anchor anchor Anchor center center} {-background background Background White gray85} {-bd -borderwidth} {-bg -background} {-bitmap bitmap Bitmap {} {}} {-borderwidth borderWidth BorderWidth 2 2} {-command command Command {} {}} {-compound compound Compound none none} {-cursor cursor Cursor {} {}} {-disabledforeground disabledForeground DisabledForeground #a3a3a3 #a3a3a3} {-fg -foreground} {-font font Font system labelfont} {-foreground foreground Foreground Black black} {-height height Height 0 0} {-highlightbackground highlightBackground HighlightBackground White gray85} {-highlightcolor highlightColor HighlightColor systemButtonFrame black} {-highlightthickness highlightThickness HighlightThickness 4 4} {-image image Image {} {}} {-indicatoron indicatorOn IndicatorOn 1 1} {-justify justify Justify center center} {-offrelief offRelief OffRelief flat flat} {-offvalue offValue Value 0 0} {-onvalue onValue Value 1 1} {-overrelief overRelief OverRelief {} {}} {-padx padX Pad 1 1} {-pady padY Pad 1 1} {-relief relief Relief flat flat} {-selectcolor selectColor Background #b03060 #b03060} {-selectimage selectImage SelectImage {} {}} {-state state State normal normal} {-takefocus takeFocus TakeFocus {} {}} {-text text Text {} {}} {-textvariable textVariable Variable {} {}} {-underline underline Underline -1 -1} {-variable variable Variable {} c} {-width width Width 0 0} {-wraplength wrapLength WrapLength 0 0}} {
                  if {\[lsearch \$i \[lindex \$args 0\]\] > -1} {
                    return \$i
                  }
                }
              }
            } else {
              set new_args \[list\]
              foreach {arg value} \$args {
                if {\[lsearch {-text -image -cursor -compound -padding -state -underline -width -command -textvariable  -onvalue -offvalue -variable  -takefocus -style} \$arg] > -1} {
                  lappend new_args \$arg \$value
                 #sputs $name \$arg \$value
                } else {
                 #sputs **reject** $name \$arg \$value
                } 
              }
              #sputs * $name configure \$new_args
               tk_$name configure {*}\$new_args
            }
          } elseif {\$command == \"invoke\"} {
            #sputs doing:tk_$name \$command \$args
            uplevel #0 tk_$name invoke
          } else {
            uplevel #0 tk_$name \$command \$args
          } 
        "
        return $name
      }
      ###use tile radiobutton widgets
      ###
      rename radiobutton tk_radiobutton
      proc radiobutton {name args} {
        set new_args [list]
        foreach {arg value} $args {
          if {[lsearch {-text -image -cursor -width -command -textvariable -value -variable} $arg] > -1} {
            lappend new_args $arg $value
          } else {
          # sputs ttk::button doesn't accept $arg $value
          }
        }
         ttk::radiobutton $name {*}$new_args
        rename $name tk_$name
        proc $name {command args} "
          if {\[string range \$command 0 3\] == \"conf\"} {
            if {\[llength \$args\] == 1} {
              if {\[lsearch {-text -cursor -image -default -width -command -textvariable} \[lindex \$args 0\]\] > -1} {
                return \[tk_$name configure \$args\]
              } else {
                foreach i {{-activebackground activeBackground Foreground systemButtonText gray85} {-activeforeground activeForeground Background systemButtonFace black} {-anchor anchor Anchor center center} {-background background Background White gray85} {-bd -borderwidth} {-bg -background} {-bitmap bitmap Bitmap {} {}} {-borderwidth borderWidth BorderWidth 2 2} {-command command Command {} {}} {-compound compound Compound none none} {-cursor cursor Cursor {} {}} {-disabledforeground disabledForeground DisabledForeground #a3a3a3 #a3a3a3} {-fg -foreground} {-font font Font system labelfont} {-foreground foreground Foreground Black black} {-height height Height 0 0} {-highlightbackground highlightBackground HighlightBackground White gray85} {-highlightcolor highlightColor HighlightColor systemButtonFrame black} {-highlightthickness highlightThickness HighlightThickness 4 4} {-image image Image {} {}} {-indicatoron indicatorOn IndicatorOn 1 1} {-justify justify Justify center center} {-offrelief offRelief OffRelief flat flat} {-overrelief overRelief OverRelief {} {}} {-padx padX Pad 1 1} {-pady padY Pad 1 1} {-relief relief Relief flat flat} {-selectcolor selectColor Background #b03060 #b03060} {-selectimage selectImage SelectImage {} {}} {-state state State normal normal} {-takefocus takeFocus TakeFocus {} {}} {-text text Text {} {}} {-textvariable textVariable Variable {} {}} {-underline underline Underline -1 -1} {-value value Value {} {}} {-variable variable Variable selectedButton selectedButton} {-width width Width 0 0} {-wraplength wrapLength WrapLength 0 0}} {
                  if {\[lsearch \$i \[lindex \$args 0\]\] > -1} {
                    return \$i
                  }
                }
              }
            } else {
              set new_args \[list\]
              foreach {arg value} \$args {
                if {\[lsearch {-text -image -cursor -width -command -textvariable -value -variable} \$arg] > -1} {
                  lappend new_args \$arg \$value
                 #sputs $name \$arg \$value
                } else {
                 #sputs **reject** $name \$arg \$value
                } 
              }
              #sputs * $name configure \$new_args
               tk_$name configure {*}\$new_args
            }
          } elseif {\$command == \"invoke\"} {
            #sputs doing:tk_$name \$command \$args
            uplevel #0 tk_$name invoke
          } else {
            uplevel #0 tk_$name \$command \$args
          } 
        "
        return $name
      }
    }
  }
}



################
## set up file type associations on Windows
################
proc file_typer {{on_extensions {}} {off_extensions {}} {clear_type 0}} {
  global possible_extensions
  global info argv0

  if {($clear_type) && ([registry keys "HKEY_LOCAL_MACHINE\\Software\\Classes\\" ApE.DNA.file] != "")} {
    #remove all extensions
    registry delete HKEY_LOCAL_MACHINE\\ApE.DNA.file
  } elseif {($on_extensions != [list]) && ([registry keys "HKEY_LOCAL_MACHINE\\Software\\Classes\\" "ApE.DNA.file"] == "")} {
      #set up file description
      set classpath "HKEY_LOCAL_MACHINE\\Software\\Classes\\ApE.DNA.file"
      if {![catch {registry set $classpath {} "ApE DNA File" sz}]} {
        registry set "$classpath\\DefaultIcon" {} "[file nativename [file join $info(Accdir) "Icons and images" "APE_icon.ico"]],0" sz
        if {(![catch {package require starkit}]) && [info exists ::starkit::mode] && ($::starkit::mode == "starpack")} {
          registry set "$classpath\\Shell\\open\\command" {} "\"[file nativename [info nameofexecutable]]\" \"%1\"" sz
        } else {
          registry set "$classpath\\Shell\\open\\command" {} "\"[file nativename [info nameofexecutable]]\" \"[file nativename $argv0]\" \"%1\"" sz
        }
        registry set $classpath\\Shell\\open\\ddeexec {} "catch {open_file {%1}}" sz
        registry set $classpath\\Shell\\open\\ddeexec\\ifexec {} "#" sz
        registry set $classpath\\Shell\\open\\ddeexec\\application {} "TclEval" sz
        registry set $classpath\\Shell\\open\\ddeexec\\topic {} "readDNAfiles" sz
        if {![catch {registry get HKEY_LOCAL_MACHINE\\Software\\Classes\\txtfile\\Shell\\open\\command {}} eCmd]} {
          registry set $classpath\\Shell\\edit\\command {} $eCmd sz
          registry set $classpath\\Shell\\edit {} &Edit sz
        }
      } else {
        if {[tk_messageBox -message [mc "There was an error writing to the registry. You may need administrator priveledges."] -type ok] == "ok"} {
          return
        }
      }
  }
  foreach extension $on_extensions {
    if {([registry keys "HKEY_LOCAL_MACHINE\\Software\\Classes\\" $extension] == "")} {
      registry set "HKEY_LOCAL_MACHINE\\Software\\Classes\\$extension" {} "ApE.DNA.file" sz
    } else {
      set type [registry get "HKEY_LOCAL_MACHINE\\Software\\Classes\\[registry get "HKEY_LOCAL_MACHINE\\Software\\Classes\\$extension" {}]" {}]
      if {[tk_messageBox -message [mc "The extension %1\$s is already registered as type: %2\$s.\n Are you sure you want to replace it?" $extension $type] -type okcancel -default cancel] == "ok"} {
        registry set "HKEY_LOCAL_MACHINE\\Software\\Classes\\$extension" {} "ApE.DNA.file" sz
      }
    }
  }
  foreach extension $off_extensions {
    registry delete "HKEY_LOCAL_MACHINE\\Software\\Classes\\$extension"
  }
}

################
## returns filetypes that are registered on windows as ApE.DNA.file and files that are registered as other types
################
proc get_registered_types {{file_descriptor ApE.DNA.file}} {
  global possible_extensions

  set r [list]
  set b [list]
  set a [list]
  foreach extension $possible_extensions {
    set hive ""
    if {([registry keys "HKEY_CURRENT_USER\\Software\\Classes\\" $extension] != [list]) && (![catch {registry get  "HKEY_CURRENT_USER\\Software\\Classes\\$extension" {}}]) && ([registry get  "HKEY_CURRENT_USER\\Software\\Classes\\$extension" {}] != [list])} {
      set hive HKEY_CURRENT_USER
    } elseif {([registry keys "HKEY_LOCAL_MACHINE\\Software\\Classes\\" $extension] != [list]) && (![catch {registry get  "HKEY_LOCAL_MACHINE\\Software\\Classes\\$extension" {}}]) && ([registry get  "HKEY_LOCAL_MACHINE\\Software\\Classes\\$extension" {}] != [list])} {
      set hive HKEY_LOCAL_MACHINE
    }
    if {$hive != ""} {
      if {[set descript [registry get "$hive\\Software\\Classes\\$extension" {}]] == $file_descriptor} {
        lappend r $extension
      } else {
        lappend a $extension 
        if {![catch {set temp [registry get "$hive\\Software\\Classes\\$descript" {}]}]} {
          lappend b $temp
        } else {
          lappend b "Unknown Program:$descript"
        }
      }
    }
  }
  return [list $r $a $b]
}

################
## maintain the windows menu
################
proc update_windows_menu {} {
  global info tk_patchLevel
  global toolbar_images global_true modstring
  if {$info(android)} {android_update_windows_menu; return}
  set global_true 1
  foreach window [winfo children .] {
    if {($window == ".menubar")} {
      set window ""
    }
    if {[winfo exists $window.menubar.windows]} {
      $window.menubar.windows delete 0 end

      ####add in the window management commands
      if {[tk windowingsystem] == "aqua"} {
        $window.menubar.windows add command -label [mc "Minimize"] -command "catch {aqua_minimize $window}" -accelerator "$modstring+M"
        if {( $window == "")} {
          $window.menubar.windows entryconfigure 0 -state disabled 
        }
        $window.menubar.windows add separator
        $window.menubar.windows add command -label [mc "Bring All to Front"] -command "catch {foreach wx \[wm stackorder .\] {raise \$wx}; unset -nocomplain wx}"
        $window.menubar.windows add command -label [mc "Close All Other Windows"] -command "catch {foreach wx \[wm stackorder .\] {sputs \[wm stackorder .\] \$wx $window; if {\$wx ne \"$window\"} {sputs close; closewindow \$wx}; unset -nocomplain wx}}"
        $window.menubar.windows add separator
      }

      if {![winfo exists $window.menubar.windows.darkmodemenu]} {
        menu $window.menubar.windows.darkmodemenu
        $window.menubar.windows.darkmodemenu add radiobutton -label [mc "Dark Mode"] -variable info(user_set_dark_mode) -value 1 -command "darkmode_set -1"
        $window.menubar.windows.darkmodemenu add radiobutton -label [mc "Light Mode"] -variable info(user_set_dark_mode) -value 0 -command "darkmode_set -1"
        if {([tk windowingsystem] == "aqua" && [bind . <<DarkAqua>> ] ne {}) || ([tk windowingsystem] == "win32" && ![catch {registry get {HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Themes\Personalize} "AppsUseLightTheme"}])} {
          $window.menubar.windows.darkmodemenu add radiobutton -label [mc "Match System Mode"] -variable info(user_set_dark_mode) -value -1 -command "darkmode_set -1"
        }
      }
      $window.menubar.windows add cascade -label [mc "Dark Mode"] -menu $window.menubar.windows.darkmodemenu
      $window.menubar.windows add separator

## if windows are minimized on mac add unicode \u2662 to the label
      ####add in the sequence windows
      foreach windowelement [dnawindows_list 1] {
        #for PATC tool
        if {([llength [info proc patc_make_features]] > 0) && [catch {$windowelement.menubar.tools index "Highlight PATC Features"}]} {
          $windowelement.menubar.tools add command -label [mc "Highlight PATC Features"] -command "patc_make_features $windowelement"
        }
        if {($windowelement != $window)} {
          $window.menubar.windows add command -label "[wm title $windowelement]" -command "wm withdraw $windowelement; wm deiconify $windowelement; raise $windowelement; focus $windowelement.textarea";# -compound left -image $toolbar_images(dna_win)  
        } else {
          $window.menubar.windows add checkbutton -variable global_true -label [wm title $windowelement] -command "set global_true 1;wm withdraw $windowelement;wm deiconify $windowelement; event generate $windowelement <<TraverseIn>>; focus $windowelement.textarea";# -compound left -image $toolbar_images(dna_win)  
        }
        ##add the analysis children of the window
        set analysiswindows [regexp -all -inline "$windowelement\_analysis\[0-9\]+" [winfo children .]]
        foreach awindow $analysiswindows {
          if {$window != $awindow} {
            $window.menubar.windows add command -label "     [wm title $awindow]" -command "wm withdraw $awindow; wm deiconify $awindow; raise $awindow; focus $awindow; event generate $awindow <Button-1> ";#  -compound left -image $toolbar_images(ana_win)
          } else {
            $window.menubar.windows add checkbutton -variable global_true -label "     [wm title $awindow]" -command "set global_true 1; wm withdraw $awindow; wm deiconify $awindow; raise $awindow; event generate $awindow <Button-1> ";#  -compound left -image $toolbar_images(ana_win)
          }
        }
      }

      ####add in the abi windows
      set abiwindows [lsearch -all -inline -regexp [winfo children .] {.abi_window[0-9]+$}]
      if {$abiwindows != [list]} {
        $window.menubar.windows add separator
      }
      foreach abwindow $abiwindows {
        if {($abwindow != $window)} {
          $window.menubar.windows add command -label "[wm title $abwindow]" -command "wm withdraw $abwindow; wm deiconify $abwindow; raise $abwindow; focus $abwindow";#-compound left -image $toolbar_images(abi_win)
        }  else {
          $window.menubar.windows add checkbutton -variable global_true -label [wm title $abwindow] -command "set global_true 1;wm withdraw $abwindow; wm deiconify $abwindow; raise $abwindow; focus $abwindow.c";# -compound left -image $toolbar_images(abi_win)  
        }
        ##add the analysis children of the window
        set analysiswindows [regexp -all -inline "$abwindow\_analysis\[0-9\]+" [winfo children .]]
        foreach awindow $analysiswindows {
          if {$window != $awindow} {
            $window.menubar.windows add command -label "     [wm title $awindow]" -command "wm withdraw $awindow; wm deiconify $awindow; raise $awindow; focus $awindow; event generate $awindow <Button-1> ";#  -compound left -image $toolbar_images(ana_win)
          } else {
            $window.menubar.windows add checkbutton -variable global_true -label "     [wm title $awindow]" -command "set global_true 1; wm withdraw $awindow; wm deiconify $awindow; raise $awindow; event generate $awindow <Button-1> ";#  -compound left -image $toolbar_images(ana_win)
          }
        }
      }
      
      ###add orphaned analysis windows
      set ping 0
      set awindows [regexp -all -inline {([^[:space:]]+)_analysis[0-9]+} [winfo children .]]
      foreach {awindow parent} $awindows {
        if {![winfo exists $parent]} {
          if {!$ping} {
            $window.menubar.windows add separator
            set ping 1
          }
          if {$window != $awindow} {
            $window.menubar.windows add command -label "     [wm title $awindow]" -command "wm withdraw $awindow; wm deiconify $awindow; raise $awindow; focus $awindow; event generate $awindow <Button-1> ";#  -compound left -image $toolbar_images(ana_win)
          } else {
            $window.menubar.windows add checkbutton -variable global_true -label "     [wm title $awindow]" -command "set global_true 1; wm withdraw $awindow; wm deiconify $awindow; raise $awindow; event generate $awindow <Button-1> ";#  -compound left -image $toolbar_images(ana_win)
          }
        }
      }
    }
  }
}


################
## lsort command for sorting windows by stackorder
################
proc is_window_below {w1 w2} {
  if {$w1 == $w2} {
    return 0
  } elseif {![winfo ismapped $w1]} {
    if {![winfo ismapped $w2]} {
      return 0
    } else {
      return 1
    }
  } elseif {![winfo ismapped $w2]} {
      return -1
  } else {
    return [expr {2*[wm stackorder $w1 isbelow $w2]-1}]
  }
}

################
## return all DNA windows that exist and are not withdrawn
################
proc dnawindows_list {{sort 0}} {
  set temp [list]
  foreach window [lsearch -all -inline -regexp [winfo children .] {.dna_window[0-9]+$}] {
    if {[winfo exists $window] && ([wm state $window] ne "withdrawn")} {lappend temp $window}
  }
  if {$sort} {
    return [lsort -command is_window_below $temp]
  } else {
    return $temp
  }
}


################
## return all abi windows that exist and are not withdrawn
################
proc abiwindows_list {} {
  set temp [list]
  foreach window [lsearch -all -inline -regexp [winfo children .] {.abi_window[0-9]+$}] {
    if {[winfo exists $window] && ([wm state $window] ne "withdrawn")} {lappend temp $window}
  }
  return $temp
}

################
## maintain the windows menu on Android
################
proc android_update_windows_menu {} {
  global info 

  set window_count 0
  foreach window [winfo children .] {
    if {[winfo exists $window.windowsmenu]} {
      $window.windowsmenu delete 0 end
      incr window_count
      ####add in the sequence windows
      foreach windowelement [dnawindows_list] {
        if {([wm state $windowelement] == "withdrawn")} {
          continue
        }
        if {($windowelement != $window)} {
          $window.windowsmenu add command -label [wm title $windowelement] -command "raise $windowelement; focus $windowelement.textarea"
        }

        ##add the analysis children of the window
        set analysiswindows [regexp -all -inline "$windowelement\_analysis\[0-9\]+" [winfo children .]]
        foreach awindow $analysiswindows {
          if {$window != $awindow} {
            if {($windowelement != $window)} {
              $window.windowsmenu add command -label "     [wm title $awindow]" -command " raise $awindow; focus $awindow; event generate $awindow <Button-1> "
            } else {
              $window.windowsmenu insert 0 command -label "[wm title $awindow]" -command " raise $awindow; focus $awindow; event generate $awindow <Button-1> "
            }
          } 
        }
      }

      ####add in the abi windows
      set abiwindows [lsearch -all -inline -regexp [winfo children .] {.abi_window[0-9]+$}]
      if {$abiwindows != [list]} {
        $window.windowsmenu add separator
      }
      foreach abwindow $abiwindows {
        if {($abwindow != $window)} {
          $window.windowsmenu add command -label "[wm title $abwindow]" -command "raise $abwindow; focus $abwindow"
        } 
        ##add the analysis children of the window
        set analysiswindows [regexp -all -inline "$abwindow\_analysis\[0-9\]+" [winfo children .]]
        foreach awindow $analysiswindows {
          if {$window != $awindow} {
            if {($abwindow != $window)} {
              $window.windowsmenu add command -label "     [wm title $awindow]" -command "raise $awindow; focus $awindow; event generate $awindow <Button-1> "
            } else {
              $window.windowsmenu insert 0 command -label "[wm title $awindow]" -command "raise $awindow; focus $awindow; event generate $awindow <Button-1> "
            }
          }
        }
      }
      
      ###add orphaned analysis windows
      set ping 0
      set awindows [regexp -all -inline {([^[:space:]]+)_analysis[0-9]+} [winfo children .]]
      foreach {awindow parent} $awindows {
        if {![winfo exists $parent]} {
          if {!$ping} {
            $window.windowsmenu add separator
            set ping 1
          }
          if {$window != $awindow} {
            $window.windowsmenu add command -label "     [wm title $awindow]" -command "raise $awindow; focus $awindow; event generate $awindow <Button-1> "
          }
        }
      }
    }
  }
  set info(window_count) $window_count
}

################
## Remove menu accelerators on systems that don't need them
################
proc remove_menu_accelerators {m} {
  if {[$m index end] == "" || [$m index end] == "none"} {return}
  for {set i 0} {$i <= [$m index end]} {incr i} {
    if {[$m type $i] == "separator"} {continue}
    $m entryconfigure $i -accelerator {}
    if {[$m type $i] == "cascade"} {
      remove_menu_accelerators [$m entrycget $i -menu]
    } 
  } 
}

################
##  Android replace main menu with modified menubar and overflow menu
################
proc android_main_menu {w} {
  global info
  set bugdelay 0
  $w.menubar delete 0 end
  
  #define file menu
  $w.menubar.filemenu  delete 0 end
  $w.menubar add cascade -menu $w.menubar.filemenu -label [mc "File"] 
  $w.menubar.filemenu add command -label [mc "New"] -command "create_window"
  $w.menubar.filemenu add command -label [mc "Open..."] -command "open_file_dialog"
  #menu $w.menubar.filemenu.open_previous 
  $w.menubar.filemenu add cascade -label [mc "Open Recent Files"] -menu $w.menubar.filemenu.open_previous
  $w.menubar.filemenu add command -label [mc "Duplicate Selection"]    -command "duplicate_window $w selection" 
  $w.menubar.filemenu add command -label [mc "Duplicate Full Sequence"]   -command "duplicate_window $w all"
  $w.menubar.filemenu add command -label [mc "Close"]  -command "closewindow $w"
  $w.menubar.filemenu add separator
  $w.menubar.filemenu add command -label [mc "Save"]  -command "save_file $w Save"
  $w.menubar.filemenu add command -label [mc "Save As..."]  -command "save_file $w Save_as"
  $w.menubar.filemenu add separator

  
  ## dummy edit menu for the menu update procedures- this is not displayed
  $w.menubar.edit  delete 0 end
  $w.menubar.edit  add command -label [mc "Undo"] 
  $w.menubar.edit  add command -label [mc "Redo"] 
  $w.menubar.edit  add separator
  $w.menubar.edit  add command -label  [mc "Set Origin"]
  $w.menubar.edit  add command -label  [mc "Linearize @ insert site"]

  #add enzymes menu
  $w.menubar.enzymes  delete 0 end
  $w.menubar add cascade -menu $w.menubar.enzymes -label [mc "Enzymes"]
  $w.menubar.enzymes add command -label [mc "Enzyme Selector..."] -command "after $bugdelay enzyme_selection_dialog $w"
  $w.menubar.enzymes add separator
  $w.menubar.enzymes add command -label [mc "Graphic Map"]  -command "after $bugdelay enz_graphic_map $w"
  $w.menubar.enzymes add command -label [mc "Graphic Map +U"]  -command "after $bugdelay enz_graphic_map $w {==1}"
  $w.menubar.enzymes add separator
  $w.menubar.enzymes add command -label [mc "Digestion"]  -command "after $bugdelay {enz_digest $w \$info(enz_currently_selected) \$info(analyze_selection)}"
$w.menubar.enzymes add command -label [mc "Digestion Dialog..."]  -command "after $bugdelay enz_digest_dialog2 $w"
  #$w.menubar.enzymes add cascade -label [mc "Ladder"] -menu [menu $w.menubar.enzymes.ladders]
  $w.menubar.enzymes add separator
  $w.menubar.enzymes add command -label [mc "List Enzymes..."] -command "after $bugdelay list_enzymes_dialog $w"
  $w.menubar.enzymes.lists  delete 0 end
    $w.menubar.enzymes.lists add command -label [mc "Site Usage"] -command "after $bugdelay findenzymes $w; list_enzymes_window $w 1 all"
    $w.menubar.enzymes.lists add command -label [mc "Unique Sites"] -command "after $bugdelay findenzymes $w; list_enzymes_window $w 0 unique"
    $w.menubar.enzymes.lists add command -label [mc "Absent Sites"] -command "after $bugdelay findenzymes $w; list_enzymes_window $w 0 absent"
  $w.menubar.enzymes add cascade -label [mc "Quick Lists"] -menu $w.menubar.enzymes.lists
  $w.menubar.enzymes add separator
  $w.menubar.enzymes add command -label [mc "Silent Sites"]  -command "after $bugdelay {silent_sites $w \$info(enz_currently_selected)}"
  $w.menubar.enzymes add command -label [mc "Find Diagnostic Site"]  -command "after $bugdelay {add_daignostic_site_dialog $w}"
  $w.menubar.enzymes add separator
  $w.menubar.enzymes add command -label [mc "Text Map..."]  -command "after $bugdelay enz_text_map $w "
  
  #add ORFs menu
  $w.menubar.orf  delete 0 end
  $w.menubar add cascade -menu $w.menubar.orf -label [mc "ORFs"]
    $w.menubar.orf add command -label [mc "Translate..."]  -command "after $bugdelay translation_window $w"
    $w.menubar.orf add command -label [mc "ORF map"] -command "after $bugdelay orf_map $w \$info(analyze_selection)"
  set info($w,selection_shows_Trans) 1


  #add Tools menu
  $w.menubar.tools  delete 0 end
  $w.menubar add cascade -menu $w.menubar.tools -label [mc "Tools"]
    $w.menubar.tools add command -label [mc "List Features"] -command "after $bugdelay list_features $w"
    $w.menubar.tools add command -label [mc "Find PCR Primers..."] -command "after $bugdelay primer_window $w"
    $w.menubar.tools add separator
    $w.menubar.tools add command -label [mc "Align Sequences..."]  -command "after $bugdelay align_dialog2 $w"
    #$w.menubar.tools add command -label [mc "Align Two Sequences..."] -command "after $bugdelay align_dialog $w"
    $w.menubar.tools add separator
    $w.menubar.tools add command -label [mc "Recombination Assembler..."]  -command "after $bugdelay recombination_window $w"
    $w.menubar.tools add command -label [mc "Recombination Reaction Editor..."] -command "after $bugdelay recomb_dialog $w"
    $w.menubar.tools add separator
    #$w.menubar.tools add command -label [mc "Gibson Reaction"] -command "after $bugdelay gibson_dialog $w"
    $w.menubar.tools add command -label [mc "Gibson Designer..."] -command "after $bugdelay gibson_wizard_dialog $w"
    $w.menubar.tools add separator
    $w.menubar.tools add command -label [mc "PCR"] -command "after $bugdelay pcr_dialog $w"
    $w.menubar.tools add separator
    $w.menubar.tools add command -label [mc "Golden Gate Designer..."] -command "after $bugdelay gg_wizard_dialog $w"
    $w.menubar.tools add command -label [mc "Golden Gate Assembler..."] -command "after $bugdelay golden_gate_dialog $w"
    $w.menubar.tools add separator
    $w.menubar.tools add command -label [mc "dCAPS Calculator..."] -command "after $bugdelay dcaps_dialog $w"
    $w.menubar.tools add separator
    $w.menubar.tools add command -label [mc "Calculator..."] -accelerator "$modstring+1" -command "calc" 
    $w.menubar.tools add command -label [mc "Molecular Reaction Calculator..."] -accelerator "$modstring+2" -command "mol_calc" 
    $w.menubar.tools add separator
    $w.menubar.tools add command -label [mc "BLAST Sequences At NCBI..."]  -command "after $bugdelay NCBI_Blast $w"
    $w.menubar.tools add command -label [mc "Download Sequences From NCBI..."] -command "after $bugdelay entrez_dialog $w"
    $w.menubar.tools add separator
    $w.menubar.tools add command -label [mc "Random Palette Generator"] -command "after $bugdelay palette_test $w"
    $w.menubar.tools add separator
    # $w.menubar.tools add command -label [mc "Annotate Features Using FASTA Search File..."] -command "multi_search_dialog $w"
    # $w.menubar.tools add separator
    $w.menubar.tools add command -label [mc "sgRNA Analysis"] -command "after $bugdelay sg_RNA_analysis $w" 
    $w.menubar.tools add separator
    $w.menubar.tools add command -label [mc "Insert Repeat Sequence..."] -command "after $bugdelay insert_repeat $w"
    menu  $w.menubar.tools.insert_re -postcommand "insert_enzyme_fill_cascade $w $w.menubar.tools.insert_re"
    $w.menubar.tools add cascade -label [mc "Insert Restriction Enzyme Recognition Sequence..."] -menu $w.menubar.tools.insert_re 
    $w.menubar.tools add separator
    $w.menubar.tools add command -label [mc "Multi-Cre Recombination..."] -command "after $bugdelay lox_recombination_window $w" 
    $w.menubar.tools add separator
    $w.menubar.tools add command -label [mc "Digest All Open Windows"] -command "after $bugdelay digest_open_windows" 


    $w.menubar add command -label [mc "Standard Genetic Code"] -command "genetic_code_dialog $w"
    $w.menubar add command -label [mc "Amino Acid Info"] -command "aa_info_dialog $w"

    $w.menubar add command -label [mc "Console"] -command "set ::w $w; console show;console eval {raise . }"
    $w.menubar add command -label [mc "Preferences..."]  -command "configure_preferences $w" 
    $w.menubar add command -label [mc "About ApE..."] -command "about_dialog $w"

  #menu $w.windowsmenu

  if {[catch {update_windows_menu} err]} {tk_messageBox  -message [mc "windows menu: %s" $err]}
  if {[catch {update_open_previous_menu} err]} {tk_messageBox  -message [mc "open previous: %s" $err]}
  if {[catch {update_ladders_menu $w} err]} {tk_messageBox  -message [mc "ladders menu: %s" $err]}

    #define overflow menu
    menu  $w.overflow
  
  menu $w.overflow.copy_special
  $w.overflow  add cascade -menu $w.overflow.copy_special -label [mc "Copy Special"]
    $w.overflow.copy_special add command -label [mc "Copy All as GenBank"] -accelerator "$modstring+B" -command "clipboard clear;clipboard_append -displayof $w \[genbank_text $w\]"
  $w.overflow.copy_special add separator
  $w.overflow.copy_special add command -label [mc "Copy Uppercase"] -command "clip_copy_special $w upper"
  $w.overflow.copy_special add command -label [mc "Copy Uppercase Rev-Com"] -command "clip_copy_special $w upper rev_com"
  $w.overflow.copy_special add separator
  $w.overflow.copy_special add command -label [mc "Copy Translated"] -command "clip_copy_special $w translated"
  $w.overflow.copy_special add command -label [mc "Copy Uppercase Translated"] -command "clip_copy_special $w translated_uc"
  $w.overflow.copy_special add command -label [mc "Copy Translated Rev-Com"] -command "clip_copy_special $w translated rev_com"
  $w.overflow.copy_special add command -label [mc "Copy Uppercase Translated Rev-Com"] -command "clip_copy_special $w translated_uc rev_com"
  $w.overflow.copy_special add separator
  $w.overflow.copy_special add command -label [mc "Copy as FASTA"] -command "clip_copy_special $w fasta"
  $w.overflow.copy_special add separator
  $w.overflow.copy_special add command -label [mc "Copy Reverse (NOT A GOOD IDEA)"] -command "clip_copy_special $w reverse"
  $w.overflow.copy_special add command -label [mc "Copy Complement (NOT A GOOD IDEA)"] -command "clip_copy_special $w complement"
  $w.overflow add separator
  $w.overflow add command -label [mc "Set Origin"]   -command "set_origin $w"
  $w.overflow add separator
  $w.overflow add command -label [mc "Highlight Enzymes"] -command "highlight_enzymes $w \$info(enz_currently_selected)";#uses selected
  $w.overflow add command -label [mc "Clear Enz Highlighting"] -command "highlight_enzymes_clear $w"

  #add features menu
    #menu  $w.overflow.features
    #$w.overflow add cascade -menu $w.overflow.features -label [mc "Features"]
    #$w.overflow add command -label [mc "New Feature..."] -command "add_sel_feature_file $w"
    #$w.overflow.features add separator
    #$w.overflow.features add command -label [mc "Edit Feature Library..."] -command "after $bugdelay edit_feature_library $w"
    #$w.overflow.features add command -label [mc "New Feature in Library..."] -command "after $bugdelay add_sel_feature_library $w"
    #$w.overflow.features add command -label [mc "Open Feature Library..."] -command "after $bugdelay {open_feature_library \{\} new 1}"
    $w.overflow add command -label [mc "Annotate Features using Library"] -command "feature_scan $w"

}

################
## add Android action bar to a window (requires .windowsmenu and .menubar menus to be defined)
################
## main menu items: File: Open.., New (How to save and name?), Close, Save, Dup, Dup Full		Enzymes: Selector, Map, Map+U, Digest, Digest with all?, Mutiple Digest, List, Quick List?, Silent Sites, Text map		ORF: Translate, ORF Map		Features:  List, Open Library	Tools: All		Show aa		Show codons		Preferences		About

# Overflow: Copy Special, Select all?, Set Origin, Enz Highlight, Clear Enz Highlight, New Feature, Clear features, Anotate from Library, 
# Set selction translate always on
# Find tab: clear highlight, features from higlight

## Enzyme Selector has back arrow
## Enzyme Selector hamburger: Map, Map+U, Digest, Digest with All, Highlight, Text Map, List (remove from main hamburger??)
## Overflow: Load Enzymes File, Save (how?), New/ Delete Enzyme, New/ Delete Groups?

proc android_action_bar {w {back 0}} {
  global toolbar_images
    frame $w.toolbar -borderwidth 0 -height 400 -relief flat
    
    # back arrow
     if {$back} {
       grid [label $w.toolbar.back -text "\u2190" -font {Roboto 24} -width 2] -row 0 -column 0 -sticky nsw
       if {[tk windowingsystem] == "aqua"} {
         bind $w.toolbar.back <Button-1> "event generate $w <<Cancel>>"
       }
       bind $w.toolbar.back <<FingerUp>> "event generate $w <<Cancel>>"
     }
 
    # hamburger
     grid [label $w.toolbar.hamburger -text "\u2261" -font {Roboto 24} -width 2] -row 0 -column 1 -sticky nsw
     if {[tk windowingsystem] == "aqua"} {
       bind $w.toolbar.hamburger <Button-1> "post_menu_hamburger $w"
     }
     bind $w.toolbar.hamburger <<FingerUp>> "post_menu_hamburger $w"

    grid [label $w.toolbar.title -text "[wm title $w]" -font "helvetica 14"] -row 0 -column 2 -sticky nsw


    #bind $w.toolbar.title <Button-1>  "$w.windowsmenu post \[expr {\[winfo screenwidth .\] - \[winfo reqwidth $w.windowsmenu\]}\] 0"
    #grid [button $w.toolbar.window_menu_post -command "$w.windowsmenu post 0 0"] -row 0 -column 3 -sticky nse

    grid [frame $w.toolbar.extra_icons] -row 0 -column 3 -sticky nsw
    grid rowconfigure $w.toolbar.extra_icons 0 -weight 1

    if {[winfo exists $w.windowsmenu]} {
      #grid [button $w.toolbar.window_menu_post -command "$w.windowsmenu post 0 0"] -row 0 -column 4 -sticky nse
      grid [frame $w.toolbar.window_menu_post -borderwidth 0] -row 0 -column 4 -sticky nswe
      grid [label $w.toolbar.window_menu_post.win_count -textvariable info(window_count)  -font "helvetica 8" -relief solid -borderwidth 4 -padx 10] -row 0 -column 0 
      # grid [ttk::menubutton $w.toolbar.window_menu_post.win_count -textvariable info(window_count) -style Box.NoIndicator.TMenubutton -menu $w.toolbar.window_menu_post.win_count.menu] -row 0 -column 0 
      # $w.windowsmenu clone $w.toolbar.window_menu_post.win_count.menu
      grid columnconfigure $w.toolbar.window_menu_post 0 -weight 1
      grid rowconfigure $w.toolbar.window_menu_post 0 -weight 1

      #bind $w.toolbar.window_menu_post <ButtonRelease-1> "$w.windowsmenu post \[expr {\[winfo screenwidth .\] - \[winfo reqwidth $w.windowsmenu\]}\] 100"
      #bind $w.toolbar.window_menu_post <ButtonRelease-2> "$w.windowsmenu post \[expr {\[winfo screenwidth .\] - \[winfo reqwidth $w.windowsmenu\]}\] 100"
      #bind $w.toolbar.window_menu_post.win_count <ButtonRelease-1> "$w.windowsmenu post \[expr {\[winfo screenwidth .\] - \[winfo reqwidth $w.windowsmenu\]}\] 100"
      #bind $w.toolbar.window_menu_post.win_count <ButtonRelease-2> "$w.windowsmenu post \[expr {\[winfo screenwidth .\] - \[winfo reqwidth $w.windowsmenu\]}\] 100"
      bind $w.toolbar.window_menu_post <<FingerUp>> "$w.windowsmenu post \[expr {\[winfo screenwidth .\] - \[winfo reqwidth $w.windowsmenu\]}\] 100"
      if {[tk windowingsystem] == "aqua"} {
        bind $w.toolbar.window_menu_post <Button-1> "$w.windowsmenu post \[expr {\[winfo screenwidth .\] - \[winfo reqwidth $w.windowsmenu\]}\] 100"
      }
      bindtags $w.toolbar.window_menu_post [list $w.toolbar.window_menu_post]
      bindtags $w.toolbar.window_menu_post.win_count [list $w.toolbar.window_menu_post]
    }

    if {[winfo exists $w.overflow]} {
      grid [frame $w.toolbar.overflow_menu_post] -row 0 -column 5 -sticky nswe
      #grid [ttk::menubutton $w.toolbar.overflow_menu_post.menubutton -image $toolbar_images(more_vert,4x) -style NoIndicator.TMenubutton -menu $w.toolbar.overflow_menu_post.menubutton.menu] -row 0 -column 0
      #$w.menubar clone $w.toolbar.overflow_menu_post.menubutton.menu
      grid [label $w.toolbar.overflow_menu_post.icon -image $toolbar_images(more_vert,4x) -padx 10] -row 0 -column 0 
      grid columnconfigure $w.toolbar.overflow_menu_post 0 -weight 1
      grid rowconfigure $w.toolbar.overflow_menu_post 0 -weight 1
      #bind $w.toolbar.overflow_menu_post <Any-Enter> "$w.overflow post \[expr {\[winfo screenwidth .\] - \[winfo reqwidth $w.menubar\]}\] 100"
      ##bind $w.toolbar.overflow_menu_post <ButtonRelease-1> "$w.overflow post \[expr {\[winfo screenwidth .\] - \[winfo reqwidth $w.menubar\]}\] 100"
      ##bind $w.toolbar.overflow_menu_post <ButtonRelease-2> "$w.overflow post \[expr {\[winfo screenwidth .\] - \[winfo reqwidth $w.menubar\]}\] 100"
      ##bind $w.toolbar.overflow_menu_post.icon <ButtonRelease-1> "$w.overflow post \[expr {\[winfo screenwidth .\] - \[winfo reqwidth $w.menubar\]}\] 100"
      ##bind $w.toolbar.overflow_menu_post.icon <ButtonRelease-2> "$w.overflow post \[expr {\[winfo screenwidth .\] - \[winfo reqwidth $w.menubar\]}\] 100"
      bind $w.toolbar.overflow_menu_post <<FingerUp>> "$w.overflow post \[expr {\[winfo screenwidth .\] - \[winfo reqwidth $w.menubar\]}\] 100"
      if {[tk windowingsystem] == "aqua"} {
      bind $w.toolbar.overflow_menu_post <Button-1> "$w.overflow post \[expr {\[winfo screenwidth .\] - \[winfo reqwidth $w.menubar\]}\] 100"
      }
      bindtags $w.toolbar.overflow_menu_post [list $w.toolbar.overflow_menu_post]
      bindtags $w.toolbar.overflow_menu_post.icon [list $w.toolbar.overflow_menu_post]
    }

    grid columnconfigure $w.toolbar 2 -weight 1
    grid columnconfigure $w.toolbar 4 -minsize 70
    grid columnconfigure $w.toolbar 5 -minsize 100
    grid rowconfigure $w.toolbar 0 -minsize 100
    grid $w.toolbar -row 0 -column 0 -columnspan 3 -sticky new
}

###########
## DNA keyboard
###########
proc DNA_keyboard {w} {

  if {[winfo exists $w.dna_keyboard]} {return}

  set window_width [winfo width $w]
  bind $w <<KeyboardInfo>> "if {\[dict get \[borg keyboardinfo\] hidden\] != 1} {DNA_keyboard_destroy $w}"
  grid [frame $w.dna_keyboard -width $window_width ] -row 9 -column 0 -columnspan 3 -sticky nwe  -padx 5 

  #set key_list [list {{left \u2190 <Left> sel_left \u2347 <Shift-Left>} 1 1}  {{up \u2191 <Up> sel_up \u2350 <Shift-Up>} 1 2} {{a a <a> a_up A <A> star * <asterisk> star_up * <asterisk> b b <b> b_up B <B> } 1 3} {{c c  <c> c_up C <C> n n <n> n_up N <N> d d <d> d_up D <D>} 1 4} {{g g <g> g_up G <G> k k <k> k_up K <K> h h <h> h_up H <H>} 1 5}  {{t t <t> t_up T <T> m m <m> m_up M <M> v v <v> v_up V <V>} 1 6}  {{down \u2193 <Down> sel_down \u2357 <Shift-Down>} 2 1}  {{right \u2192 <Right> sel_right \u2348 <Shift-Right>} 2 2}  {{degen \u21F3 <Shift-Left>} 2 3}  {{bksp \u232B <BackSpace> del \u2326 <Delete>} 2 4}  {{shift \u21EA <Shift-Left>} 2 5} {{dism \u25BD <Shift-Left>} 2 6} ]

## 3 row x 6 col with <^acgt/bdhv over v>*nry/wsmk over dism _ del bksp alt shift
#  set key_list [list {{left \u2190 <Left> sel_left \u2347 <Shift-Left>} 1 1}  {{up \u2191 <Up> sel_up \u2350 <Shift-Up>} 1 2}  {{c c  <c> c_up C <C>  d d <d> d_up D <D>} 1 4} {{g g <g> g_up G <G> h h <h> h_up H <H>} 1 5}  {{t t <t> t_up T <T>  v v <v> v_up V <V>} 1 6}  {{down \u2193 <Down> sel_down \u2357 <Shift-Down>} 2 1}  {{right \u2192 <Right> sel_right \u2348 <Shift-Right>} 2 2}  {{degen \u21F3 <Shift-Left>} 2 3}  {{bksp \u232B <BackSpace> del \u2326 <Delete>} 2 4}  {{shift \u21EA <Shift-Left>} 2 5} {{dism \u25BD <Shift-Left>} 2 6} ]


## 2 row x 9 col 
set key_list [list {{shift \u21EA <Shift-Left>} 1 1} {{left \u2190 <Left> sel_left \u2347 <Shift-Left>} 1 2}  {{up \u2191 <Up> sel_up \u2350 <Shift-Up>} 1 3} {{n n <n> n_up N <N> k k <k> k_up K <K>  m m <m> m_up M <M>} 1 4} {{a a <a> a_up A <A>  w w <w> w_up W <W>  b b <b> b_up B <B> } 1 5} {{c c  <c> c_up C <C> s s <s> s_up S <S> d d <d> d_up D <D>} 1 6} {{g g <g> g_up G <G> r r <r> r_up R <R> h h <h> h_up H <H>} 1 7}  {{t t <t> t_up T <T> y y <y> y_up Y <Y> v v <v> v_up V <V>} 1 8} {{degen \u2026 <Shift-Left>} 1 9}   {{dism \u25BD <Shift-Left>} 2 1}  {{down \u2193 <Down> sel_down \u2357 <Shift-Down>} 2 2}  {{right \u2192 <Right> sel_right \u2348 <Shift-Right>} 2 3}  {{undo \u24E9 <Control-z> redo \u24CF <Control-Shift-z>} 2 4} {{cut \u24E7 <Control-x> cut_rc \u24CD <Control-Shift-x>} 2 5} {{copy \u24D2 <Control-c> copy_rc \u24B8 <Control-Shift-c>} 2 6} {{paste \u24E5 <Control-v> paste_rc \u24CB <Control-Shift-v>} 2 7} {{rc \u21BB <Control-slash> up_lower \u21F3 <Control-equal> to_up \u21D1 <Control-Shift-equal> to_lower \u21D3 <Control-minus>} 2 8} {{bksp \u232B <BackSpace> del \u2326 <Delete>} 2 9}  ]

  foreach key $key_list {
    foreach {name_list row col} $key {}
    foreach {name label event} $name_list {
      grid [label $w.dna_keyboard.$name -text $label -font {Roboto 14} -bg gray90] -row $row -column $col
      bind $w.dna_keyboard.$name <Button-1> "DNA_keyboard_keypress $w.dna_keyboard.$name $event"
      bind $w.dna_keyboard.$name <Button-3> "DNA_keyboard_keypress_repeat $w.dna_keyboard.$name $event"
      bind $w.dna_keyboard.$name <ButtonRelease-3> "DNA_keyboard_keypress_repeat_cancel $w.dna_keyboard.$name $event"
    }
  }

  $w.dna_keyboard.shift configure -font  "helvetica 16"
  bind $w.dna_keyboard.shift <Button-1>  "bind $w.dna_keyboard <<Shift>> \[expr {!\[bind $w.dna_keyboard <<Shift>>\]}\]; DNA_keyboard_shift $w"
  bind $w.dna_keyboard.degen <Button-1>  "bind $w.dna_keyboard <<Degen>> \[expr {(1 +\[bind $w.dna_keyboard <<Degen>>\]) %% 3}\]; DNA_keyboard_shift $w"
  bind $w.dna_keyboard.dism <Button-1> "DNA_keyboard_destroy $w"
  bind $w.dna_keyboard.shift <Button-3>  ""
  bind $w.dna_keyboard.degen <Button-3>  ""
  bind $w.dna_keyboard.dism <Button-3>  ""
  bind $w.dna_keyboard.shift <ButtonRelease-3>  ""
  bind $w.dna_keyboard.degen <ButtonRelease-3>  ""
  bind $w.dna_keyboard.dism <ButtonRelease-3>  ""

  bind $w.dna_keyboard <<Shift>> 0
  bind $w.dna_keyboard <<Degen>> 0
  bind $w.dna_keyboard <<StateMap>> [dict create {0 0} {left right up down a c g t n undo cut copy paste rc bksp} {1 0} {sel_left sel_right sel_up sel_down a_up c_up g_up t_up n_up up_lower cut_rc redo copy_rc paste_rc del}  {0 1} {left right up down m w s r y undo cut copy paste to_lower bksp} {1 1} {sel_left sel_right sel_up sel_down m_up w_up s_up r_up y_up to_up cut_rc redo copy_rc paste_rc del}  {0 2} {left right up down k b d h v undo cut copy paste to_lower bksp} {1 2} {sel_left sel_right sel_up sel_down k_up b_up d_up h_up v_up to_up cut_rc redo copy_rc paste_rc del}]


  for {set row 1} {$row <=2} {incr row} {
    grid rowconfigure $w.dna_keyboard $row -weight 1 -minsize 35
  }
  for {set col 1} {$col <=9} {incr col} {
    grid columnconfigure $w.dna_keyboard $col -weight 1 -uniform 1
  }
  DNA_keyboard_shift $w
}

###########
##
###########
proc DNA_keyboard_destroy {w} {
  if {[winfo exists $w.dna_keyboard]} {
    foreach ch [winfo children $w.dna_keyboard] {
      destroy $ch
    }
    destroy $w.dna_keyboard
  }
}

###########
##
###########
proc DNA_keyboard_keypress {label event} {
  global modifier
  set w [winfo toplevel $label]
  if {[regexp {<(Shift-|Control-|Control-Shift-|Shift-Control-)?(.*)>} $event -- mod key]} {

    if {$mod == "" && [string length $key] == 1} {
      keyevent_manager $w None $key
    } else {
      regsub "Control" $mod $modifier mod
      event generate $w.textarea "<$mod\KeyPress-$key>"
    }
  }
}

###########
##
###########
proc DNA_keyboard_keypress_repeat {label event} {
  global info
  set w [winfo toplevel $label]
  if {[regexp {<(Shift-|Control-|Control-Shift-|Shift-Control-)?(.*)>} $event -- mod key]} {
    if {$mod == "" || $mod == "Shift-"} {
      event generate $w.textarea "<$mod\KeyPress-$key>"
      set info(key_repeat_cancel) [after 250 DNA_keyboard_keypress_repeat $label $event]
    }
  }
}

###########
##
###########
proc DNA_keyboard_keypress_repeat_cancel {label event} {
  global info
  if {[info exists info(key_repeat_cancel)]} {
     after cancel $info(key_repeat_cancel)
  }
 unset -nocomplain info(key_repeat_cancel)
}

###########
##
###########
proc DNA_keyboard_shift {w} {
  global info
  set statemap [bind $w.dna_keyboard <<StateMap>> ]
  set shift [bind $w.dna_keyboard <<Shift>>]
  set degen [bind $w.dna_keyboard <<Degen>>]
  set key [list $shift $degen]
  if {[dict exists $statemap $key]} {
    set key_list [dict get $statemap $key]
    foreach key $key_list {
      grid configure $w.dna_keyboard.$key
      set info_dict [grid info $w.dna_keyboard.$key]
      set row [dict get $info_dict -row]
      set col [dict get $info_dict -column]
      foreach sl [grid slaves  $w.dna_keyboard -row $row -column $col] {
        if {$sl !=  "$w.dna_keyboard.$key"} {
          grid remove $sl
        }
      }
    }
  }
  if {[winfo exists $w.dna_keyboard.shift]} {
    #$w.dna_keyboard.shift configure -bg [expr {$shift?"white":$info(bg_color)}]
    $w.dna_keyboard.shift configure -text [expr {$shift?"\u2B06":"\u21E7"}]
  }
}

################
## maintain the open_previous menu
################
proc update_open_previous_menu {} {
  global info
  set templist [list]
  set i 0
  if {![string is list $info(open_previous)]} {set info(open_previous) [list]}
  foreach entry $info(open_previous) {
    if {$i == $info(max_open_previous)} {break}
    if {[file exists $entry] && ([lsearch -exact $templist $entry] == -1)} {
      lappend templist $entry
      incr i
    }
  }
  set info(open_previous) $templist

  foreach w [winfo children .] {

    if {$w == ".menubar"} {set w ""}
    if {[winfo exists $w.menubar.filemenu.open_previous]} {
      $w.menubar.filemenu.open_previous delete 0 end
      foreach entry $info(open_previous) {
        if {$info(use_cocoa)} {
          ##cocoa bug: can't unpost a window fast enough and gets stuck trying to make the new window
          $w.menubar.filemenu.open_previous add command -label "$entry" -command "after 150 {catch {open_file {$entry}}}"
        } else {
          $w.menubar.filemenu.open_previous add command -label "$entry" -command "catch {open_file {$entry}}"
        }
      }
      if {[llength $info(open_previous)] == 0} {
        catch {$w.menubar.filemenu entryconfigure [mc "Open Recent Files"] -state disabled}
      } else {
        catch {$w.menubar.filemenu entryconfigure [mc "Open Recent Files"] -state normal}
      }
    }
  }
  save_defaults
}

###########
##About ApE dialog
###########
proc about_dialog {{w .}} {
  global info tcl_platform modifier
  global version dialogblock menu_temp_text
  if {$dialogblock == 1} {return}
  set dialogblock 1

  toplevel .about_dialog  -bg {light steel blue}
  #wm withdraw .about_dialog
  wm title .about_dialog [mc "About ApE"]
  wm protocol .about_dialog WM_DELETE_WINDOW "event generate .about_dialog <<OK>>"
  bind .about_dialog <KeyPress-Escape>  "event generate .about_dialog <<OK>>"
  bind . <<RaiseDialogs>> "wm deiconify .about_dialog; raise .about_dialog"
  #update
  if {[winfo exists $w] && [winfo ismapped $w]} {
    regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $w] wgeom winx winy
    wm geometry .about_dialog "+[expr (($winx<0)?0:$winx)+3]+[expr (($winy<0)?0:$winy)+50]"
  }

  if {[winfo exists $w] && [winfo viewable [winfo toplevel $w]]} {
    wm transient .about_dialog $w
  }
  if {[tk windowingsystem] == "aqua"} {
    ::tk::unsupported::MacWindowStyle style .about_dialog document {closeBox}
      add_menubar_to_dialog_mac $w .about_dialog
  }
  #wm deiconify .about_dialog
  #raise .about_dialog


  #load images here
  foreach {filename image_name} [list "gibbons.gif" "gibbons_image" "pwrdLogo75.gif" "Tcl_image" "pwrdLogo200.gif" "Tcl_image_big" "paypal.gif" "paypal_image"] {
    set filename [file join $info(Accdir) "Icons and images" $filename]
    if {[file exists $filename]} {
      image create photo $image_name -file $filename
    } else {
      image create photo $image_name -height 1 -width 1
    }
    lappend image_list $image_name
  }

  ##add frames to window here
  grid [canvas .about_dialog.t -relief flat -bg {light steel blue} -width 550 -height 250 -highlightthickness 0] -row 1 -column 0  -sticky n
  grid columnconfigure .about_dialog 0 -weight 1

  if {$info(android)} {
    ### ANDROID
    wm attributes .about_dialog  -fullscreen 1
    grid [frame .about_dialog.toolbar -borderwidth 0 -height 400 -relief flat -bg {light steel blue}] -row 0 -column 0 -sticky nswe
    grid columnconfigure .about_dialog.toolbar 1 -weight 1
    grid [label .about_dialog.toolbar.back -text "\u2190" -font {Roboto 24} -width 2 -bg {light steel blue}] -row 0 -column 0 -sticky nsw
    bind .about_dialog.toolbar.back <<FingerUp>> "event generate .about_dialog <<OK>>"
    if {[tk windowingsystem] == "aqua"} {
      bind .about_dialog.toolbar.back <Button-1> "event generate .about_dialog <<OK>>"
    }
    ##draw canvas items here

    .about_dialog.t create text 250 10 -text [mc "ApE- A plasmid Editor v%s" $version] -anchor n -font "Helvetica 14 bold" -justify center -anchor n -tag title
    foreach {x0 y0 x1 y1} [.about_dialog.t bbox title] {}
    set item [.about_dialog.t create text 250 [expr {$y1+5}] -text "Copyright \u00A9 2003-2023 by M. Wayne Davis" -anchor n  -font "Helvetica 10 bold" -justify center -tag copyright]
    .about_dialog.t create image [lindex [.about_dialog.t bbox copyright] 2] 10 -image "Tcl_image_big" -anchor nw
    set y [expr {[lindex [.about_dialog.t bbox copyright] 3] + 10}]
  } else {

    ### NON_ANDROID
    grid [frame .about_dialog.f3 -relief ridge -bd 0 -bg {light steel blue}] -row 2 -column 0 -sticky nswe
    if { ([info commands tk_button] != {})} {
      grid [tk_button .about_dialog.f3.ok -command "event generate .about_dialog <<OK>>" -text [mc "OK"] -width 10 -default active -highlightbackground "light steel blue" -highlightthickness 0] -pady 10 -row 1 -column 0 -padx 10
   } else {

      grid [button .about_dialog.f3.ok -command "event generate .about_dialog <<OK>>" -text [mc "OK"] -width 10 -default active] -pady 10 -row 1 -column 0 -padx 10
    }
    grid columnconfigure .about_dialog.f3 0 -weight 1
    bind .about_dialog <Key-Return> ".about_dialog.f3.ok invoke"
    #bind .about_dialog <$modifier-KeyPress-w> ".about_dialog.f3.ok invoke"
    focus .about_dialog.f3.ok

    ##draw canvas items here
    set y 10
    .about_dialog.t create text 250 $y -text [mc "ApE- A plasmid Editor v%s" $version] -anchor n -font "Helvetica 24 bold" -justify center -anchor n -tag title
    incr y 36
    .about_dialog.t create text 250 $y -text "Copyright \u00A9 2003-2025 by M. Wayne Davis" -anchor n  -font boldlabelfont -justify center -tag copyright
    incr y [expr {[font metrics labelfont -linespace]+5}]
   .about_dialog.t create text 250 $y -text "ApE, A Plasmid Editor: " -anchor n  -font website -justify left -fill blue -tag {pubtext linktext}
    incr y [expr {[font metrics labelfont -linespace]+5}]
   .about_dialog.t create text 250 $y -text [mc "A Freely Available DNA Manipulation and Visualization Program"] -anchor n  -font website -justify left -fill blue -tag {pubtext linktext}
    incr y [expr {[font metrics labelfont -linespace]+5}]
    .about_dialog.t create image [expr {max([lindex [.about_dialog.t bbox copyright] 2],[lindex [.about_dialog.t bbox title] 2])}] 10 -image "Tcl_image" -anchor nw
  }

  incr y [font metrics labelfont -linespace]

  set text ""
  if {[info exists starkit::topdir]} {
    append text  "Running with Tclkit([info patchlevel]) by Jean-Claude Wippler (equi4 software) \nusing Tcl/Tk, IncrTcl, TclVFS, Zlib, and Metakit software.\n"
  } else {
    append text  "Running with Tcl/Tk([info patchlevel]).\n"
  }

  append text  "Tcl/Tk \u00a9 Regents of the University of California, Sun Microsystems, Inc.,Scriptics Corporation, ActiveState Corporation and other parties.\n"
  set textwidth [font measure labelfont "Tcl/Tk Aqua port by Jim Ingham & Ian Reid \u00A9 2001-2002 Apple Computer."]
  append text   "Windows icon \u00A9 Matthew Crook .\n" 
  append text   "IncrTcl \u00A9 Cadence Design Systems, Inc., and other parties.\n" 
  append text   "TclVFS \u00A9 Vince Darley, and other parties.\n"
  append text   "Zlib \u00A9 1995-2003 Jean-loup Gailly and Mark Adler.\n"
  append text   "Metakit \u00A9 1996-2004 Jean-Claude Wippler.\n"
  if {[tk windowingsystem] == "aqua"} {
      append text   "Tcl/Tk Aqua port by Jim Ingham & Ian Reid \u00A9 2001-2002 Apple Computer\n"
      append text   "Wishkit for Aqua \u00A9 2003-2004, Daniel A. Steffen\n"
    if  {([lsearch -glob [info loaded] "*MacCarbonPrint.dylib*"] > -1)} {
      append text  "OSX carbon printing extensions \u00A9 Mats Bengtsson and other parties.\n"
    }
  } else {
    if  {([lsearch -exact [package names] "printer"] > -1)} {
      append text  "Windows printing and metafile extensions \u00A9 Michael I. Schwartz.\n"
    }
    if  {([lsearch -exact [package names] "tkdnd"] > -1)} {
      append text   "Drag and drop extensions \u00A9 George Petasis and Laurent Riesterer.\n"
    }
  }
  #append text   "Icons from http://www.famfamfam.com/lab/icons/silk/, http://gentleface.com/free_icon_set.html, http://www.fatcow.com/free-icons\n"
  append text   "Icons inspired by https://feathericons.com/\n"

  if {[mc "Translation by:"] != "Translation by:"} {
   # .about_dialog.t create text 250 $y -text [mc "Locale:%s. Translation by:" [mclocale]] -anchor n  -font labelfont -justify center
    append text [mc "Locale:%s. Translation by:" [mclocale]]
  } else {
   # .about_dialog.t create text 250 $y -text [mc "Locale:%s" [mclocale]] -anchor n  -font labelfont -justify center
    append text [mc "Locale:%s." [mclocale]]
  }

  .about_dialog.t create text 250 $y -text $text -anchor n -width [expr {min($textwidth,800)}] -font labelfont -justify left -tag maintext
  if {$info(android)} {
    .about_dialog.t itemconfigure maintext -font {Helvetica 10}
  }

  if {"website" ni [font names]} {
    font create website -family Helvetica -size 12 -underline true
  }
  foreach {x0 y0 x1 y} [.about_dialog.t bbox maintext] {}
  .about_dialog.t create text 250 $y -text "jorgensen.biology.utah.edu/wayned/ape/" -anchor n -width [expr {min($textwidth,800)}] -font website -justify left -fill blue -tag {websitetext linktext}

  .about_dialog.t bind linktext <Enter> {
    if {[tk windowingsystem] == "aqua"} {
      .about_dialog.t configure -cursor pointinghand
    } else {
      .about_dialog.t configure -cursor hand2
    }
  }
  .about_dialog.t bind linktext <Leave> {
    .about_dialog.t configure -cursor arrow
  }
  .about_dialog.t bind websitetext <Any-Button> {
    open_url {https://jorgensen.biology.utah.edu/wayned/ape/}
  }
  .about_dialog.t bind pubtext <Any-Button> {
    open_url {https://www.frontiersin.org/articles/10.3389/fbinf.2022.818619/full}
  }

  foreach {gib_x0 gib_y0 gib_x1 y} [.about_dialog.t bbox websitetext] {}
  #.about_dialog.t create image 250 [expr {$y + 10}] -image "gibbons_image" -anchor n -tag gibbons
  #foreach {gib_x0 gib_y0 gib_x1 y} [.about_dialog.t bbox gibbons] {}


  if {(![file exists [file join $info(Accdir) "I donated.txt"]]) && (![file exists [file join $info(user_defaults_dir) "I donated.txt"]])} {
    .about_dialog.t create image 250 [expr {$y + 10}] -image "paypal_image" -anchor n -tag {paypal_image d_mouseover}
    foreach {payp_x0 payp_y0 payp_x1 y} [.about_dialog.t bbox paypal_image] {}
    .about_dialog.t create rectangle [expr {$payp_x0-2}] [expr {$payp_y0-2}] [expr {$payp_x1+2}] [expr {$y+2}] -outline blue -width 2 -tag {donate_box d_mouseover}
    foreach {payp_x0 payp_y0 payp_x1 y} [.about_dialog.t bbox donate_box] {}

    .about_dialog.t create text 250 [expr {$y+10}] -text [mc "Click here to donate and support the development of ApE"] -anchor n -font boldlabelfont -justify center -fill blue -tag {donate_text d_mouseover}
    incr y [font metrics boldlabelfont -linespace]
    .about_dialog.t bind d_mouseover <Enter> {
      .about_dialog.t itemconfigure donate_box -outline red
      .about_dialog.t itemconfigure donate_text -fill red
      if {[tk windowingsystem] == "aqua"} {
        .about_dialog.t configure -cursor pointinghand
      } else {
        .about_dialog.t configure -cursor hand2
      }
    }
    .about_dialog.t bind d_mouseover <Leave> {
      .about_dialog.t itemconfigure donate_box -outline blue
      .about_dialog.t itemconfigure donate_text -fill black
      .about_dialog.t configure -cursor arrow
    }
    .about_dialog.t bind d_mouseover <Any-Button> {
      open_url {http://jorgensen.biology.utah.edu/wayned/ape/Donations.html}
    }
  } else {
    .about_dialog.t create text 250 $y -text [mc "This user is a generous suporter of ApE- Thank you."] -anchor n -font boldlabelfont -justify center -fill blue -tag {donate_text d_mouseover}
    incr y [font metrics boldlabelfont -linespace]
  }

  .about_dialog.t create text 250 [expr {$y+10}] -text [mc "Click here to save a copy of the source code."] -anchor n -font boldlabelfont -justify center -fill blue -tag {source_text s_mouseover}
   incr y [font metrics boldlabelfont -linespace]
    .about_dialog.t bind s_mouseover <Enter> {
      .about_dialog.t itemconfigure source_text -fill red
      if {[tk windowingsystem] == "aqua"} {
        .about_dialog.t configure -cursor pointinghand
      } else {
        .about_dialog.t configure -cursor hand2
      }
    }
    .about_dialog.t bind s_mouseover <Leave> {
      .about_dialog.t itemconfigure source_text -fill black
      .about_dialog.t configure -cursor arrow
    }
    .about_dialog.t bind s_mouseover <Any-Button> {
      save_source
    }




  bind .about_dialog <<OK>> "
    set dialogblock 0
    #grab release .about_dialog
    destroy .about_dialog
    foreach image \[list $image_list\] {
      image delete \$image
    }
    bind . <<RaiseDialogs>> {}
    "

  .about_dialog.t configure -width [expr {40+[lindex [.about_dialog.t bbox all] 2]-[lindex [.about_dialog.t bbox all] 0]}] -height [expr {10+[lindex [.about_dialog.t bbox all] 3]}] -scrollregion [list [expr {[lindex [.about_dialog.t bbox all] 0] -20}] -10 500 400]
  wm resizable .about_dialog 0 0
  update idletasks
  regexp {([0-9]*)x([0-9]*)\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry .about_dialog] wgeom winw winh winx winy
  if {[expr {$winx+$winw}] > [winfo screenwidth .]} {set winx [expr {[winfo screenwidth .]-$winw}]}
  if {$winx < 0} {set winx 0}
  if {[expr {$winy+$winh}] > [winfo screenheight .]} {set winy [expr {[winfo screenheight .]-$winh}]}
  if {$winy < 0} {set winy 0}
  wm geometry .about_dialog "+$winx+$winy"

  catch {wm attributes .about_dialog -alpha 0.0}
  wm deiconify .about_dialog
  raise .about_dialog


  for {set alpha 1} {$alpha <= 10} {incr alpha 1} {
    if {(![catch {wm attributes .about_dialog -alpha [expr {0.1 * $alpha-.00001}]}]) && ($tcl_platform(os) != "Windows 95" )} {
      after 50
      update idletasks
    }
  }


}

###########
## Save the current source code as a file
###########
proc save_source {} {
  global argv0 info

  set filename [tk_getSaveFile -title [mc "Save Tcl Source File"]  -filetypes {{"Tcl Source File" ".tcl"}}]
 
  if {$filename ne {}} {
    if {[catch {file copy $argv0 $filename} err]} {
      warning_dialog $err
    } elseif {[catch {file copy $info(Accdir) [file join [file dirname $filename] "Accessory Files"]} err]} {
      warning_dialog $err
    }
  }

}

###########
## Codon Table Help Window
###########
proc genetic_code_dialog {w} {
  global info
  if {[winfo exists .gen_code]} {
    wm deiconify .gen_code
    raise .gen_code
  } else {
    toplevel .gen_code  -bg white 

    wm title .gen_code [mc "Standard Genetic Code..."]
    wm protocol .gen_code WM_DELETE_WINDOW ".gen_code.f3.ok invoke"
    regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $w] wgeom winx winy
    wm geometry .gen_code "+[expr (($winx<0)?0:$winx)+3]+[expr (($winy<0)?0:$winy)+50]"

    add_help_menubar .gen_code

    grid [text .gen_code.t -wrap none -width 55 -height 25 -font dnafont -setgrid 1 -highlightthickness 0] -row 1 -column 0  -sticky nwe
    .gen_code.t  configure -background $info(text_bg_color) -foreground $info(text_fg_color) -selectforeground $info(text_select_fg_color) -selectbackground $info(text_select_bg_color) -inactiveselectbackground $info(text_select2_bg_color)
    grid columnconfigure .gen_code 0 -weight 1
    grid rowconfigure .gen_code 1 -weight 1

    if {$info(android)} {
      menu .gen_code.menubar
      .gen_code.menubar add command -label [mc "Close"]  -command "closewindow .gen_code"
      android_action_bar .gen_code
      wm attributes .gen_code  -fullscreen 1
    } else {
      grid [frame .gen_code.f3 -relief flat ] -row 2 -column 0 -sticky nswe
      grid [button .gen_code.f3.ok -command "destroy .gen_code" -text [mc "OK"]] -row 0 -column 0 -sticky n
      grid columnconfigure .gen_code.f3 0 -weight 1
    }

    .gen_code.t insert end "               Second Position\n" topline
    .gen_code.t insert end "        T         C         A          G\n" midlines
    .gen_code.t insert end "   T | TTT Phe | TCT Ser | TAT Tyr  | TGT Cys  | T\n" midlines
    .gen_code.t insert end "F  T | TTC Phe | TCC Ser | TAC Tyr  | TGC Cys  | C  T\n" midlines
    .gen_code.t insert end "i  T | TTA Leu | TCA Ser | TAA Stop | TGA Stop | A  h\n" midlines
    .gen_code.t insert end "r  T | TTG Leu | TCG Ser | TAG Stop | TGG Trp  | G  i\n" midlines
    .gen_code.t insert end "s    +---------+---------+----------+----------+--- r\n" midlines

    .gen_code.t insert end "t  C | CTT Leu | CCT Pro | CAT His  | CGT Arg  | T  d\n" midlines
    .gen_code.t insert end "   C | CTC Leu | CCC Pro | CAC His  | CGC Arg  | C   \n" midlines
    .gen_code.t insert end "P  C | CTA Leu | CCA Pro | CAA Gln  | CGA Arg  | A  P\n" midlines
    .gen_code.t insert end "o  C | CTG Leu | CCG Pro | CAG Gln  | CGG Arg  | G  o\n" midlines
    .gen_code.t insert end "s    +---------+---------+----------+----------+--- s\n" midlines

    .gen_code.t insert end "i  A | ATT Ile | ACT Thr | AAT Asn  | AGT Ser  | T  i\n" midlines
    .gen_code.t insert end "t  A | ATC Ile | ACC Thr | AAC Asn  | AGC Ser  | C  t\n" midlines
    .gen_code.t insert end "i  A | ATA Ile | ACA Thr | AAA Lys  | AGA Arg  | A  i\n" midlines
    .gen_code.t insert end "o  A | ATG Met | ACG Thr | AAG Lys  | AGG Arg  | G  o\n" midlines
    .gen_code.t insert end "n    +---------+---------+----------+----------+--- n\n" midlines

    .gen_code.t insert end "   G | GTT Val | GCT Ala | GAT Asp  | GGT Gly  | T   \n" midlines
    .gen_code.t insert end "   G | GTC Val | GCC Ala | GAC Asp  | GGC Gly  | C   \n" midlines
    .gen_code.t insert end "   G | GTA Val | GCA Ala | GAA Glu  | GGA Gly  | A   \n" midlines
    .gen_code.t insert end "   G | GTG Val | GCG Ala | GAG Glu  | GGG Gly  | G   \n" midlines

    .gen_code.t insert end "\nTAA=Ochre, TAG=Amber, TGA=Opal"

    #.gen_code.t tag configure topline -font dnafont -tabs {5c center}
    #.gen_code.t tag configure midlines -font dnafont -tabs {1c 2c center 3c 4c center 5c 6c center 7c 8c center 9c 10c}

    .gen_code.t configure -state disabled

    #wm resizable .gen_code 0 0
    bind .gen_code <Key-Return> ".gen_code.f3.ok invoke"
    if {$info(android)} {
      bind .gen_code.t <<PinchToZoom>> "android_pinch_text_analysis_font %x %s .gen_code.t "
      bind .gen_code <Button-1> ".gen_code.t scan mark \[expr {%x}\]  \[expr {%y}\]"
      bind .gen_code <Button1-Motion> ".gen_code.t scan dragto \[expr {%x}\]  \[expr {%y}\]"
      bind .gen_code <Button-2> ".gen_code.t scan mark \[expr {%x}\]  \[expr {%y}\]"
      bind .gen_code <Button2-Motion> ".gen_code.t scan dragto \[expr {%x}\]  \[expr {%y}\]"
    }
    update idletasks
    regexp {([0-9]*)x([0-9]*)\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry .gen_code] wgeom winw winh winx winy
    if {[expr {$winx+$winw}] > [winfo screenwidth .]} {set winx [expr {[winfo screenwidth .]-$winw}]}
    if {$winx < 0} {set winx 0}
    if {[expr {$winy+$winh}] > [winfo screenheight .]} {set winy [expr {[winfo screenheight .]-$winh}]}
    if {$winy < 0} {set winy 0}
    wm geometry .gen_code "+$winx+$winy"
  }
}

###########
##Amino Acid Info help window
###########
proc aa_info_dialog {w} {
  global info

  if {[winfo exists .aa_data]} {
    wm deiconify .aa_data
    raise .aa_data
  } else {
    set aa_names [list Glycine Alanine Serine Threonine Cysteine Valine Leucine Isoleucine Methionine Proline Phenylalanine Tyrosine Tryptophan "Aspartic Acid" "Glutamic Acid" Asparagine Glutamine Histidine Lysine Arginine]
    set aa_3let [list Gly Ala Ser Thr Cys Val Leu Ile Met Pro Phe Tyr Trp Asp Glu Asn Gln His Lys Arg]
    set aa_1let [list G A S T C V L I M P F Y W D E N Q H K R]
    set aa_MW [list 57.05 71.09 87.08 101.11 103.15 99.14 113.16 113.16 131.19 97.12 147.18 163.18 186.21 115.09 129.12 114.11 128.14 137.14 128.17 156.19]

   #read in gif images if available. If not, make blank images
    if {[lsearch [image names] Glycine_image] == -1} {
      set dirname [file join $info(Accdir) "Icons and images" "Amino Acids"]
      foreach aa $aa_names {
        set filename [file join $dirname "$aa.gif"]
        if {[file exists $filename] == 1} {
          image create photo "$aa\_image" -file $filename
        } else {
          image create photo "$aa\_image" -height 1 -width 1
        }
      }
    }
    toplevel .aa_data 

    wm title .aa_data [mc "Amino Acids Data..."]
    wm protocol .aa_data WM_DELETE_WINDOW ".aa_data.f3.ok invoke"
    regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $w] wgeom winx winy
    wm geometry .aa_data "+[expr (($winx<0)?0:$winx)+3]+[expr (($winy<0)?0:$winy)+50]"

    add_help_menubar .aa_data
    grid [canvas .aa_data.c -bg wheat -bd 0 -highlightthickness 0 -width 200 -height 300 -yscrollcommand ".aa_data.ys set" ] -row 1 -column 0  -sticky nswe
    grid [scrollbar .aa_data.ys -command ".aa_data.c yview"] -row 1 -column 1 -rowspan 1 -sticky nsw

    if {$info(android)} {
      menu .aa_data.menubar
      .aa_data.menubar add command -label [mc "Close"]  -command "closewindow .aa_data"
      android_action_bar .aa_data
      wm attributes .aa_data  -fullscreen 1
    } else {
      grid [frame .aa_data.f3 -relief flat -bg $info(bg_color) -bd 0] -row 2 -column 0 -columnspan 2 -sticky nswe
      grid [button .aa_data.f3.ok -command "destroy .aa_data" -text [mc "OK"]] -row 0 -column 0 -sticky n
      grid columnconfigure .aa_data.f3 0 -weight 1
    }

    grid rowconfigure .aa_data 1 -weight 1
    grid columnconfigure .aa_data 0 -weight 1

    set y 10
    foreach aa $aa_names 3let $aa_3let 1let $aa_1let MW $aa_MW {
    set img [.aa_data.c create image 10 $y -image "$aa\_image" -anchor nw]
    set imgy [lindex [.aa_data.c bbox $img] 3]
    set imgx [lindex [.aa_data.c bbox $img] 0]
    set txt [.aa_data.c create text $imgx $imgy -text "$aa ($3let, $1let)\nMW: $MW" -anchor nw -font "Helvetica 10 bold" -fill black]
    set txty [lindex [.aa_data.c bbox $txt] 3]
    set y [expr {$txty+50}]
    }

    .aa_data.c configure -scrollregion [.aa_data.c bbox all]
    bindtags .aa_data.c .aa_data.c
    bind .aa_data.c <MouseWheel> {.aa_data.c yview scroll [expr {int(1.0 * %D / $info(mousewheelunits)) * -4}] units}
    bind .aa_data <MouseWheel> {.aa_data.c yview scroll [expr {int(1.0 * %D / $info(mousewheelunits)) * -4}] units}
    if {$info(android)} {
      bind .aa_data.c <Button-1> ".aa_data.c scan mark \[expr {%x}\]  \[expr {%y}\]"
      bind .aa_data.c <Button1-Motion> ".aa_data.c scan dragto \[expr {%x}\]  \[expr {%y}\]"
      bind .aa_data.c <Button-2> ".aa_data.c scan mark \[expr {%x}\]  \[expr {%y}\]"
      bind .aa_data.c <Button2-Motion> ".aa_data.c scan dragto \[expr {%x}\]  \[expr {%y}\]"
    }
   # wm resizable .aa_data 0 1
    bind .aa_data <Key-Return> ".aa_data.f3.ok invoke"
    update idletasks
    regexp {([0-9]*)x([0-9]*)\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry .aa_data] wgeom winw winh winx winy
    if {[expr {$winx+$winw}] > [winfo screenwidth .]} {set winx [expr {[winfo screenwidth .]-$winw}]}
    if {$winx < 0} {set winx 0}
    if {[expr {$winy+$winh}] > [winfo screenheight .]} {set winy [expr {[winfo screenheight .]-$winh}]}
    if {$winy < 0} {set winy 0}
    wm geometry .aa_data "+$winx+$winy"
    wm deiconify .aa_data
  }
}

#################
## initialize special bindings 
#################
proc setup_special_bindings {} {
  global modifier modstring info tcl_platform modifier2 modstring2

  foreach win [list Toplevel Text AnalysisText Entry TEntry List Treeview Canvas] {
    if {[tk windowingsystem] == "aqua"} {
      bind $win <Control-Button-1> "event generate %W <<RightClick>> -rootx %X -rooty %Y -x %x -y %y"
      if {[info procs tk::MouseWheel] eq {}} {
        bind $win <Button-2> "event generate %W <<RightClick>> -rootx %X -rooty %Y -x %x -y %y"
      } else {
        bind $win <Button-3> "event generate %W <<RightClick>> -rootx %X -rooty %Y -x %x -y %y"
      }
    } else {
      bind $win <Button-3> "event generate %W <<RightClick>> -rootx %X -rooty %Y -x %x -y %y"
      if {$tcl_platform(platform) == "windows"} {
        bind $win <Shift-Key-F10>  "event generate %W <<RightClick>> -rootx %X -rooty %Y -x %x -y %y"
      }
    }
  }
  if {$tcl_platform(platform) == "windows"} {
    set modifier Control
    set modstring "Ctrl"
    set modifier2 Alt
    set modstring2 "Alt"


    if {($tcl_platform(os) == "Windows NT") && ($tcl_platform(osVersion) == "6.1")} {
      # Windows 7 has mousewheel delta of 30
      set info(mousewheelunits) 30
    }
  } elseif {$tcl_platform(platform) == "unix"} {
      set modstring "Meta"
      set modifier Meta
      set modstring2 "Ctrl"
      set modifier2 Control
      if {$tcl_platform(os) == "Linux"} {
        set modifier Control
        set modstring "Ctrl"
        set modifier2 Meta
        set modstring2 "Meta"
      }
      if {$info(android)} {
        bind Menu <Button-1>  "if {\[info exists info(button_cancel)\]} {after cancel \$info(button_cancel); unset -nocomplain  info(button_cancel)} else {[bind Menu <Button>]}"
        bind Menu <ButtonRelease-1> "set info(button_cancel) \[after 50 {[bind Menu <ButtonRelease>]; unset -nocomplain  info(button_cancel)}\]"
        bind Menu <Button-3>  "if {\[info exists info(button_cancel)\]} {after cancel \$info(button_cancel); unset -nocomplain  info(button_cancel)}"
        bind Menu <ButtonRelease-3>  "if {\[info exists info(button_cancel)\]} {after cancel \$info(button_cancel); unset -nocomplain  info(button_cancel)} else {[bind Menu <Button>]}"
        bind Menu <Button-2>  [bind Menu <Button>]
        bind Menu <ButtonRelease-2>  [bind Menu <ButtonRelease>]
        ##bind Menu <<FingerDown>> [bind Menu <Button>]
        ##bind Menu <<FingerUp>> [bind Menu <ButtonRelease>]
        bind Menu <Button> ""
        bind Menu <ButtonRelease> ""
        #console eval {pack [button .b1 -text up -command "event generate .console <KeyPress> -keysym Up"]}
        #console eval {pack [button .b2 -text down -command "event generate .console <KeyPress> -keysym Down"]}
        #console eval {pack [button .b3 -text left  -command "event generate .console <KeyPress> -keysym Left"]}
        #console eval {pack [button .b4 -text right -command "event generate .console <KeyPress> -keysym Right"]}
        #console eval {wm geometry . [expr {int(0.9* ([winfo screenwidth .]-200) / [font measure [.console cget -font] M])}]x20}
        ttk::style configure Button -font {Helvetica 12}
        borg onintent android_handle_intent
        sdltk touchtranslate 3
        set info(android_pinch_start_zoom) 0
        set info(android_pinch_start_font) 3
        set info(feature_table_minsize) 1

      }
      if {[tk windowingsystem] == "aqua"} {
        set modifier "Command"
        set modstring "Cmd"
        set modifier2 "Option"
        set modstring2 "Option"
        set info(mousewheelunits) 4
        if {[string is integer [regexp -inline {[0-9]*} $tcl_platform(osVersion)]] && ([regexp -inline {[0-9]*} $tcl_platform(osVersion)] > 11)} {
          if {[info procs tk::MouseWheel] eq {}} {
            set info(mousewheelunits) 1
          } else {
            set info(mousewheelunits) 120
          }
        }
        #bind Listbox <Command-Button-1> [bind Listbox <Control-Button-1>]
        bind Text <Control-Button-1> "event generate %W <Button-2> -rootx %X -rooty %Y -x %x -y %y"
        bind AnalysisText <Control-Button-1> "event generate %W <Button-2> -rootx %X -rooty %Y -x %x -y %y"
        bind Entry <Button-2> ""
        #bind Treeview <Command-Button-1> [bind Treeview <Control-Button-1>]
        set ttk::Cursors(hresize) resizeleftright
        set ttk::Cursors(vresize) resizeupdown
      }
      bind Entry <$modifier-Key-v> "event generate %W <<Paste>>"
      bind Text <$modifier-Key-v> "event generate %W <<Paste>>"
      #bind Text <Button-5> [list %W yview scroll 1 units]
      #bind Text <Button-4> [list %W yview scroll -1 units]
      bind all <Button-4> {event generate [focus -displayof %W] <MouseWheel> -delta  120}
      bind all <Button-5>  {event generate [focus -displayof %W] <MouseWheel> -delta  -120}
  } else {
      set modifier Control
      set modstring "Ctrl"
      #sputs "tcl_platform(os):$tcl_platform(os)"
      #sputs "tcl_platform(machine):$tcl_platform(machine)"
  }


  bind Entry <$modifier-Key-V> "event generate %W <<Paste>>"
  bind Entry <$modifier-Key-a> "%W selection range 0 end"
  if {$info(use_cocoa)} {
    bind Text <<Paste>> "tk_textPaste %W"
  }
  bind Entry <<Paste>> {
    global tcl_platform
    catch {
	    catch {
		%W delete sel.first sel.last
	    }
	%W insert insert [regsub -all {\n} [::tk::GetSelection %W CLIPBOARD] ""]
	tk::EntrySeeInsert %W
    }
  }
  if {$info(use_cocoa)} {
    bind all <$modifier2-$modifier-Key-q> {sputs all key q;set option_q 1}
  }
  bind . <$modifier-Key-q> "exit"
  bind . <$modifier-Key-o> open_file_dialog
  bind . <$modifier-Key-n> create_window

  bind Toplevel <Map> update_windows_menu
  bind Toplevel <Unmap> update_windows_menu
  # Aqua bug 1/18 Jan 2018, window activate after a window is closed can't do everything in the update proc (not sure what)
  #bind Toplevel <Activate> "after 200 update_windows_menu"

  #set default binding for Button-Mouse wheel events for all text boxes
  if {[tk windowingsystem] != "aqua"} {
    bind Text <B1-MouseWheel> "[bind Text <MouseWheel>]
      [bind Text <Shift-Button-1>]"
  } else {
    bind Text <B1-MouseWheel> [bind Text <MouseWheel>]
  }

  #setup AnalysisText bindigs
  bind AnalysisText <$modifier-Key-a> "%W tag add sel 1.0 end"
  bind AnalysisText <Double-Button-1> "%W tag add sel @%x,%y"
  foreach action [list <B1-MouseWheel> <MouseWheel> <<Copy>> <B1-Motion> <Button-1> <B1-Leave> <B1-Enter> <Shift-Button-1> <ButtonRelease-1> <Key-Next> <Key-Prior> <$modifier-Key-Home>  <$modifier-Key-End>] {
    bind AnalysisText $action [bind Text $action]
  }
  if {[tk windowingsystem] eq "aqua"} {
    # \c etc characters in rtf format are misinterpreted by echo as control characters, so direct piping of rtf isn't possible.
    #bind AnalysisText <<CopyFormatted>> "exec echo \" \[text_to_rtf %W 1 {*}\[%W tag ranges sel\]\]\" | pbcopy"
    bind AnalysisText <<CopyFormatted>> "exec echo \" <html><body>\[text_to_clipboard_html %W \[%W tag ranges sel\]\]</body></html>\" | textutil -stdin -format html -convert rtf -stdout | pbcopy"
  } elseif {[info exists info(twapi_cf_html)]} {
    bind AnalysisText <<CopyFormatted>> "clip_copy_analysis_text_windows %W"
  }

  # eliminate scan-dragging in listboxes, so item drag and drop can work
  # could do it with Button-1 looking for selection- if button-1 event happens on selected element, don't change selection- wait for button-up or Button-Motion, button up does select only that element, motion moves the elements.
  bind Listbox <B1-Motion> {}
  #take the ListboxMotion out so that there is no selection scannig on button-1-leave
  proc tk::ListboxAutoScan1 {w} {
    variable ::tk::Priv    
     if {![winfo exists $w]} return    
     set x $Priv(x)    
     set y $Priv(y)    
     if {$y >= [winfo height $w]} {
	$w yview scroll 1 units
     } elseif {$y < 0} {
       $w yview scroll -1 units
    } elseif {$x >= [winfo width $w]} {
      $w xview scroll 2 units
    } elseif {$x < 0} {
      $w xview scroll -2 units
    } else {
      return
    }
    #ListboxMotion $w [$w index @$x,$y]    set Priv(afterId) [after 50 [list tk::ListboxAutoScan $w]]
  }
  if {[tk windowingsystem] == "aqua"} {
    ttk::style configure Heading -font {Helvetica 11 bold} -foreground gray40
  }

  if {0 && [tk windowingsystem] eq "aqua"} {
 #aqua bug
    bind Toplevel <Destroy> {
      if {[lindex [tk::unsupported::MacWindowStyle style %W] 0] ne "help" && ![wm overrideredirect %W] && [set next_wind [lindex [wm stackorder .] end-1]] != {}} {
        wm withdraw $next_wind
        wm deiconify $next_wind
        #sputs destroy window bug %W  $next_wind
        unset next_wind
      }
    }
  ## aqua cocoa bug- command tilde doesn't raise the correct window
    bind Toplevel <Activate> {
      if {[lindex [tk::unsupported::MacWindowStyle style %W] 0] ne "help" && ![wm overrideredirect %W]} {
        raise %W
      }
      update_windows_menu
    }

  }
}


#################
## Hndle actions sent in Android (file open, for example)
#################
proc android_handle_intent {args} {
  sputs borg onintent: $args
}

#################
## Hndle pinch zooms in Android 
###############
proc android_pinch_seq_font {x state t} {
  global info
  # State values: 0:Motion, 1:Start, 2:End 1st Finger, 2:End Both Fingers
  if {$state == 1} {
      set info(android_pinch_start_zoom) $x
      set info(android_pinch_start_font) [font actual dnafont -size]
  } else {
    set new_size [expr { max(($info(android_pinch_start_font) + ($x - $info(android_pinch_start_zoom)) * 10 / [winfo screenwidth .]) , 3) }]
    set font [$t cget -font]
    $t configure -font [list [font actual $font -family] $new_size [font actual $font -weight] [font actual $font -slant]]
    foreach tag [$t tag names] {
      if {[set font [$t tag cget $tag -font]] != ""} {
        $t tag configure $tag -font [list [font actual $font -family] $new_size [font actual $font -weight] [font actual $font -slant]]
      }
    }
  }
}

#################
## Hndle pinch zooms in Android 
###############
proc android_pinch_text_analysis_font {x state t} {
  global info

  # State values: 0:Motion, 1:Start, 2:End 1st Finger, 3:End 2nd Fingers
  if {$state == 1} {
    set info(android_pinch_start_zoom) $x
    set info(android_pinch_start_font) [font actual [$t cget -font] -size]
  } else {
    set new_size [expr { max(($info(android_pinch_start_font) + ($x - $info(android_pinch_start_zoom)) * 10 / [winfo screenwidth .]) , 3) }]
    set font [$t cget -font]
    $t configure -font [list [font actual $font -family] $new_size [font actual $font -weight] [font actual $font -slant]]
    foreach tag [$t tag names] {
      if {[set font [$t tag cget $tag -font]] != ""} {
        $t tag configure $tag -font [list [font actual $font -family] $new_size [font actual $font -weight] [font actual $font -slant]]
      }
    }
  }
}

#################
## Hndle pinch zooms in Android 
###############
proc android_pinch_circular_map_scale {dist state c} {
  global info
sputs circular pinch $c $dist $state
  if {$state == 1} {
  } else {
     set new_scale [expr { 1.0* $dist /$info(android_pinch_start_zoom)}]
    if {$new_scale == 0} {return}
    $c scale all 0 0 $new_scale $new_scale
    $c configure -scrollregion [$c bbox all]

    foreach tag [$c bind 1 <<Feature_list>>] {
      if {[set exon [lindex [$c find withtag $tag&&exon] 0]] != {}} {
         #change_radius $c $tag [lindex [$c coords $exon] 2] 
        change_radius $c $tag {}
      }
      if {[set circ_label [lindex [$c find withtag $tag&&circular_label] 0]] != {}} {
        canvas_circular_text $c $tag [expr {sqrt([lindex [$c coords $circ_label] 0]*[lindex [$c coords $circ_label] 0] + [lindex [$c coords $circ_label] 1]*[lindex [$c coords $circ_label] 1])}]
      }
    }
  }
  set info(android_pinch_start_zoom) $dist

 }

#################
## Hndle pinch zooms in Android 
###############
proc android_pinch_linear_map_scale {dist state c} {
  global info
  if {$state == 1} {

  } else {
    set new_scale [expr {1.0*  $dist /$info(android_pinch_start_zoom)}]
    if {$new_scale == 0} {return}
    $c scale all 0 350 $new_scale 1
    $c configure -scrollregion [$c bbox all]
    foreach boxlabel [$c find withtag moveableboxlabel] {
      $c coords $boxlabel.box {*}[$c bbox $boxlabel]
      #$c itemconfigure $boxlabel.box
    }
    foreach fea [$c find withtag feature&&label] {
      linear_feature_draw_arrow $c [lsearch -regexp -inline [$c gettags $fea] {f[0-9]+#}]
    }
    linear_map_reset_all_features $c
    linear_map_bump_all_features $c
    linear_map_reset_all_boxlabels $c
    linear_map_bump_all_boxlabels $c
  }
  set info(android_pinch_start_zoom) $dist
}


#################
## if a process is already running, pass off to it (only on windows so far)
#################
proc check_for_running_process {} {
  global argv argv0 tcl_platform version errorCode current_free_server_named_pipe_channel

  ##if on windows, check for running version and pass the file off, else register dde to catch new instances
  if {$tcl_platform(platform) == "windows"} {
    if {[catch {package require twapi}]} {return}
    set client_chan ""
    if {[catch {set client_chan [::twapi::namedpipe_client {\\.\pipe\ape_dna_pipe_to_watch_for_open_files}]} err]} {
      set client_errorCode $errorCode
      set lock_chan ""
      set lock_err ""
      if {[lindex $client_errorCode 0] eq "TWAPI_WIN32" && [lindex $client_errorCode 1] == 2 && ![catch {set lock_chan [::twapi::namedpipe_server {\\.\pipe\ape_dna_pipe_to_lock} -denyremote -maxinstances 1]} lock_err]} {
        ## error opening client channel- channel doesn't exist
        ## FIrst instance- set up listener server_chan
        ## set up dde server as a backup
        package require dde
        dde servername "readDNAfiles"
        if {[catch {set server_chan [::twapi::namedpipe_server {\\.\pipe\ape_dna_pipe_to_watch_for_open_files} -denyremote -maxinstances 100] } err]} {
          sputs named pipe server err #1:$err - $client_errorCode
        } else {
          ## was able to open the server named pipe- set up listener
          fconfigure $server_chan -blocking 1 -buffering line
          fileevent $server_chan readable "callback_for_opening_files $server_chan"
          set current_free_server_named_pipe_channel $server_chan
          #sputs named pipe started
          return
        }
      } elseif {([lindex $client_errorCode 0] eq "TWAPI_WIN32" && [lindex $client_errorCode 1] == 231) || $lock_chan eq ""} { 
        ## pipe exists and is busy, retry 20 times every 100ms
        sputs named pipe error #2b: $err - $client_errorCode
        sputs lock_chan $lock_chan $lock_err $errorCode
        for {set i 0} {$i < 1000} {incr i} {
          if {![catch {set client_chan [::twapi::namedpipe_client {\\.\pipe\ape_dna_pipe_to_watch_for_open_files}]} err]} {
            break
          }
          after 100
        }
        ## still failed
        sputs named pipe error #3b: $err - $client_errorCode
      } else {
        ## some other error
        sputs named pipe error #4: $err - $client_errorCode
      }
    }
    if {$client_chan ne {}} {
    ## NOT the first instance- send the argv and exit
     if {$argv eq {}} {
       puts $client_chan "create_window"
     } else {
         puts $client_chan [lindex $argv 0]
     }
     flush $client_chan
     close $client_chan
     final_exit
    } else {
        sputs named pipe error #5: $err -$errorCode
    }
  } elseif {($tcl_platform(platform) == "unix") && ([tk windowingsystem] != "aqua")} {
    #sputs checking for running process
    if {[set aname [tk appname "dna_ape"]] != "dna_ape"} {
      #sputs I'm #2 appname: $aname
      if {[llength $argv] == 0} {
        #sputs send1 [send dna_ape "create_window"]
        send dna_ape "create_window"
      } else {
        #sputs send2 [send dna_ape "uplevel #0 \{open_file \{[lindex $argv 0]\}\}"]
        send dna_ape "uplevel #0 \{open_file \{[lindex $argv 0]\}\}"
      }
      final_exit
    } else {
      #sputs I'm #1
    }
  }
}

#################
## callback for listening on the server named channel
#################
proc callback_for_opening_files {chan} {
  global current_free_server_named_pipe_channel
   sputs "reading from server named pipe:$chan"
  if {$chan eq $current_free_server_named_pipe_channel} {
    #reading is happening on the current free pipe, set up a new listener
    if {[catch {set server_chan [::twapi::namedpipe_server {\\.\pipe\ape_dna_pipe_to_watch_for_open_files} -denyremote -maxinstances 100] } err]} {
        sputs server err:$err
    } else {
      ## was able to open the server named pipe- set up listener
      fconfigure $server_chan -blocking 1 -buffering line
      fileevent $server_chan readable "callback_for_opening_files $server_chan"
      set current_free_server_named_pipe_channel $server_chan
      #sputs named pipe re-started
    }
  }

  if {[chan names $chan] eq {}} {
    sputs "channel:$chan doesn't exist"
    return
  }
  while {[chan names $chan] ne {} && ![eof $chan]} {
    set file [gets $chan]
    #sputs read data from named pipe: $file
    if {$file eq "create_window"} {
      create_window
    } elseif {$file ne ""} {
      if {[file exists $file] && [file readable $file]} {
        catch {open_file $file 0}
      } else {
        sputs file open error [file exists $file] [file readable $file]: $file
      }
    }
  }
  catch {close $chan}
  #sputs named pipe closed

}

#################
##returns a 3 byte hex number (24 bits), each base has 4 bits a=0111, c=1011, g=1101, t=1110 , n=0000
#################
proc validation_code {p} {
  set p [string map {" " "" ^ "" ( "" - "" ) "" / ""} $p]
  regsub -all {([0-9])*} $p "" p
  set p [string trim $p "N"] 
  if {[string length $p] < 7} {
    if {$p eq [revcom $p]} {
      return [list [expr {"0x[string map "A 7 B 8 C b D 4 G d H 2 K c M 3 N 0 R 5 S 9 T e V 1 W 6 Y a" [string range [append p "NNNNN"] 0 5]]"}]]
    } else {
      set q [revcom $p]
      set fwd [expr {"0x[string map "A 7 B 8 C b D 4 G d H 2 K c M 3 N 0 R 5 S 9 T e V 1 W 6 Y a" [string range [append p "NNNNN"] 0 5]]"}]
      set rev [expr {"0x[string map "A 7 B 8 C b D 4 G d H 2 K c M 3 N 0 R 5 S 9 T e V 1 W 6 Y a" [string range [append q "NNNNN"] 0 5]]"}]
      return [list $fwd $rev]
    }
  } else {
    return {}
  }
}

#################
##adds compatible enzymes to a list at enzinfo(compat,$enzyme)
#################
proc add_compatibles {} {
  global enzymes
  global enzinfo

  foreach enzyme $enzymes {
    set enzinfo(compat,$enzyme) ""
    set len [string length $enzinfo(flatpat,$enzyme)]
    set caret [string first ^ $enzinfo(enz_pattern,$enzyme)]
    if {($caret != -1) && ([set oh [expr {$len/2.0-$caret}]] != 0)} {
      if {$oh > 0} {
        set overhang [string range $enzinfo(flatpat,$enzyme) $caret [expr {$len-$caret-1}]]
        if {([regexp {[^ACGT]} $overhang] == 0)} {
          lappend h(+$overhang) $enzyme
        }
      } else {
        set overhang [string range $enzinfo(flatpat,$enzyme) [expr {$len-$caret}] [expr {$caret-1}]]
        if {([regexp {[^ACGT]} $overhang] == 0)} {
          lappend h(-$overhang) $enzyme 
        }  
      }
    } 
  }

  foreach ov [array names h] {
    if {[llength $h($ov)] > 1} {
      set i 0
      foreach enz $h($ov) {
        #sputs "$enz:[lreplace $h($ov) $i $i]"
        set enzinfo(compat,$enz) [lreplace $h($ov) $i $i]
        incr i
      }
    }
  }
}

#############
## return all aa encoded by a potentially degenerate 3 base sequence
#############
proc triplet_transl {t} {
  set s [string map {b [cgt] d [agt] h [act] k [gt] m [ac] n ? r [ag] s [gc] v [acg] w [at] y [ct]} $t] 
  array set aa {ttt F ttc F tta L ttg L tct S tcc S tca S tcg S tat Y tac Y taa * tag * tgt C tgc C tga * tgg W ctt L ctc L cta L ctg L cct P ccc P cca P ccg P cat H cac H caa Q cag Q cgt R cgc R cga R cgg R att I atc I ata I atg M act T acc T aca T acg T aat N aac N aaa K aag K agt S agc S aga R agg R gtt V gtc V gta V gtg V gct A gcc A gca A gcg A gat D gac D gaa E gag E ggt G ggc G gga G ggg G}
  set result [list]
  foreach i [array names aa $s] {
    lappend result $aa($i)
  }
  set result [lsort -unique $result]
  if {[llength $result] < 21} {
    return "\[[join $result ""]\]"
  } else {
    return .
  }
}

#############
## return all possible peptides encoded in all three frames of a sequence
#############
proc degen_transl {p} {
  set p [string tolower $p]
  regsub -all -- {[^abcdghkmnrstvwy]} $p {} p
  set p "nn$p"
  append p "nn"
  set r [list]
  for {set i 0} {$i < 3} {incr i} {
    set k ""
    for {set j $i} {$j < [expr [string length $p]-2]} {incr j 3} {
      append k "[triplet_transl [string range $p $j [expr $j+2]]]"
    }
  lappend r $k
  }
return $r
}

#############
## read the enzymes file
#############
proc read_enzymes {enzfilename} {
  global longnamelist
  global hexlist
  global enzymes
  global enzinfo
  global info

  set error 0
  set enzinfo(enz_groups_list) {All {Mem Recall} {Difference...}}
  set enzinfo(enz_groups,All) [list]
  set enzinfo(enz_groups,Mem\ Recall) [list]
  set enzinfo(enz_groups,Difference...) "Difference..."
  set hexlist [list]
  set enzymes [list]
  if {($enzfilename == "") || ([file exists $enzfilename] == 0)} {
    warning_dialog "Can't find the enzymes file"
    set error 1
  } else {
    if {[catch { set fileid [open $enzfilename r]} error_msg]} {
      set enzfilename  [file join $info(Accdir) "Enzymes" "Default_Enzymes.txt"]
      if {[catch { set fileid [open $enzfilename r]} error_msg]} {
        tk_messageBox -message $error_msg
        return 1
      }
    } 
    set header [gets $fileid]

    if {$header == "tkDNAview enzymes file type 2"} {
      #array unset enzinfo; leave enzinfo data in the array, just overwrite it, so that highlighting and overhang data are available

      set templongnamelist [gets $fileid]
      set longnamelist [list]
      foreach e $templongnamelist {
        if {[string first | [lindex $e 1]] > -1} {
          lappend longnamelist [list [lindex $e 0] {*}[split [lindex $e 1] |]]
        } else {
          lappend longnamelist [list [lindex $e 0] [lindex $e 1] {}]
        }
      }
      set hexlist [gets $fileid]
      set enzymes [gets $fileid]
      set pats [gets $fileid]
      set enzcomments [gets $fileid]

      set enzinfo(enz_groups_list) {All {Mem Recall} {Difference...}}
      set enzinfo(enz_groups,All) $enzymes
      set enzinfo(enz_groups,Mem\ Recall) [list]
      set enzinfo(enz_groups,Difference...) "Difference..."
      set newgroups [gets $fileid]
      set enzinfo(enz_groups_list) [concat $enzinfo(enz_groups_list) $newgroups]
      foreach group $newgroups {
        set enzinfo(enz_groups,$group) [gets $fileid] 
      }
      if {[winfo exists .enz_selector.groupsframe.groups_button]} {
        .enz_selector.groupsframe.groups_button.menu delete 0 end
        foreach element $enzinfo(enz_groups_list) {
          .enz_selector.groupsframe.groups_button.menu add radiobutton -label $element -variable enz_select_groups -value $element 
        }
      }
      unset newgroups

      #read list of Dam and Dcm blocked enzymes
      set enzinfo(enz_methylaselist) [gets $fileid]

      #make list of all enzymes blocked by any methylase
      set info(blocked_enzymes) [list]
      foreach methylase $enzinfo(enz_methylaselist) {
        foreach blocked_enzyme [lindex $methylase 1] {
          lappend info(blocked_enzymes) [lindex $blocked_enzyme 0]
        }
      }
      #add DpnI specifically
      #AbaSI AoxI BisI BlsI DpnI FspEI GlaI GluI KroI LpnPI MalI MspJI MteI PcsI PkrI SgeI
      foreach z [list DpnI MalI] {
        if {$z in $enzymes} {
          lappend info(blocked_enzymes) $z
        }
      }

      set info(blocked_enzymes) [lsort -unique $info(blocked_enzymes)]

      set info(enz_currently_selected) [list]

      foreach enzyme $enzymes pattern $pats comment $enzcomments {
        set pattern [string toupper $pattern]
        set enzinfo(enz_vcode,$enzyme) [validation_code $pattern]
        set enzinfo(enz_pattern,$enzyme) $pattern
        set enzinfo(enz_comment,$enzyme) $comment
        regsub -all {[^ACGTNWSYRKMBDHV]} $pattern "" flatpattern
        set flatpattern [string trim $flatpattern "N"]
        set enzinfo(flatpat,$enzyme) $flatpattern
        if {[regexp {(-?[0-9]+)[[:space:]]*.[[:space:]]*(-?[0-9]+)} $pattern x d1 d2]} {
          set enzinfo(enz_cut_sites,$enzyme) [list [expr {[string length $flatpattern]+$d1}] [expr {[string length $flatpattern]+$d2}]]
        } elseif {[regexp -all {[|^/\\]} $pattern] > 0} {
          if {1 || [revcom $flatpattern] == $flatpattern} {
             ## actually always do this if there is a ^ in the pattern, even if it's assymetric. See AciI and BssSI as examples
            set char [lindex [lindex [regexp -inline -indices {[|^/\\]} $pattern] 0] 0]
            set enzinfo(enz_cut_sites,$enzyme) [list $char [expr {[string length $flatpattern]-$char}]]
          } else {
            set bottom [lindex [lindex [regexp -inline -indices {[_/\\]} $pattern] 0] 0]
            set top [lindex [lindex [regexp -inline -indices {[^|]} $pattern] 0] 0]
            set enzinfo(enz_cut_sites,$enzyme) [list 0 0]
          }
        } else {
          set enzinfo(enz_cut_sites,$enzyme) [list 0 0]
        }

      }
      add_compatibles
      set enzinfo(enz_vcode,MDam) [validation_code GATC]
      set enzinfo(enz_vcode,MDcm) [validation_code CCWGG]
      set enzinfo(flatpat,MDam) "GATC"
      set enzinfo(flatpat,MDcm) "CCWGG"
      set info(enzymes_saved) 1
    } else {
      tk_messageBox -message [mc "Wrong enzyme file type- no enzymes read"] -type ok -icon warning -default ok
      set error 1
    }
    close $fileid
  }
  return $error
}

#############
## reload the enzymes file
#############
proc reload_enzymes {} {
  global enz_select_window
  global info

  if {$info(enzymes_saved) != 1} {
    if {[tk_messageBox -message [mc "Do you want to save changes to the enzyme set?"] -type yesno -icon question] == "yes"} {
      save_enzymes "" 0
    }
  }
    if {[file isdir $info(default_enzymedir)] && [file readable $info(default_enzymedir)]} {
      set filename [tk_getOpenFile -initialdir $info(default_enzymedir) -title [mc "Open An Enzyme File"] -defaultextension ".txt" -filetypes {{{Text Files} {.txt}} {{All Files} *}}]
    } else {
      set filename [tk_getOpenFile -title [mc "Open An Enzyme File"] -defaultextension ".txt" -filetypes {{{Text Files} {.txt}} {{All Files} *}}]
    }

  if {($filename != "") && ([file exists $filename] == 1)} {
    set error [read_enzymes $filename]
    if {($error == 0)} {
      foreach window [dnawindows_list] {
        set info($window,scanned) 0
        findenzymes $window
      }

      if {[winfo exists .enz_selector.textframe.textbox] == 1} {
        fill_enzymes_box .enz_selector.textframe.textbox .enz_selector.enz_comment $enz_select_window
        wm deiconify .enz_selector
      }
    }
  }
}

#############
## save a copy of the enzymes file
#############
proc save_enzymes {{filename ""} {default 0}} {
  global longnamelist
  global hexlist
  global enzymes
  global enzinfo
  global info

  if {[winfo exists .enz_selector]} {
    set parent_win .enz_selector
  } else {
    set parent_win .
  }

  if {$default} {set filename [file join $info(default_enzymedir) Default_Enzymes.txt]}
  if {($filename == "")} {
    if {[file isdir $info(default_enzymedir)]} {
      set filename [tk_getSaveFile -title [mc "Save Enzymes File"] -parent $parent_win -initialdir $info(default_enzymedir) -defaultextension ".txt"  -filetypes {{"Text File" ".txt"}}]
    } else {
      set filename [tk_getSaveFile -title [mc "Save Enzymes File"] -parent $parent_win -defaultextension ".txt"  -filetypes {{"Text File" ".txt"}}]
    }
  }
  while {($filename != "") && ([catch {set fileid [open $filename w]}])} {
    catch {close $fileid}
    warning_dialog "$filename\nFile isn't writable"
    if {[file isdir $info(default_enzymedir)]} {
      set filename [tk_getSaveFile -title [mc "Save Enzymes File"] -parent $parent_win -initialdir $info(default_enzymedir) -defaultextension ".txt"  -filetypes {{"Text File" ".txt"}}]
    } else {
      set filename [tk_getSaveFile -title [mc "Save Enzymes File"] -parent $parent_win -defaultextension ".txt"  -filetypes {{"Text File" ".txt"}}]
    }

  }

  if {$filename == ""} return

  puts $fileid "tkDNAview enzymes file type 2"
  set templongnamelist [list]
  foreach e $longnamelist {
    foreach {na pf pr} $e {}
    if {$pr != {}} {
      lappend templongnamelist [list $na "$pf|$pr"]
    } else {
      lappend templongnamelist [list $na $pf]
    } 
  }
  puts $fileid $templongnamelist 
  puts $fileid $hexlist
  puts $fileid $enzymes

  foreach enzyme $enzymes {
    lappend pats $enzinfo(enz_pattern,$enzyme)
    lappend enzcomments $enzinfo(enz_comment,$enzyme)
  }
  puts $fileid $pats
  puts $fileid $enzcomments

  set groupslist [list]
  foreach group $enzinfo(enz_groups_list) {
    if {($group != "All") && ($group != "Mem Recall") && ($group != "Difference...")} {
      lappend groupslist $group
    }
  }
  puts $fileid $groupslist
  foreach group $groupslist {
    puts $fileid $enzinfo(enz_groups,$group)
      }

  puts $fileid $enzinfo(enz_methylaselist)
  close $fileid
  set info(enzymes_saved) 1
}


#################
##return the hexlist address for a pattern
#################
proc hexmult {pattern} {
set n [list 0]
foreach c [split $pattern ""] {
  set newlist [list]
  switch $c {
    "A" {foreach m $n {set newlist [concat $newlist [expr $m*4]]}}
    "B" {foreach m $n {set newlist [concat $newlist  [expr $m*4+1] [expr $m*4+2] [expr $m*4+3]]}}
    "C" {foreach m $n {set newlist [concat $newlist  [expr $m*4+1]]}}
    "D" {foreach m $n {set newlist [concat $newlist [expr $m*4]  [expr $m*4+2] [expr $m*4+3]]}}
    "G" {foreach m $n {set newlist [concat $newlist  [expr $m*4+2]]}}
    "H" {foreach m $n {set newlist [concat $newlist [expr $m*4] [expr $m*4+1] [expr $m*4+3]]}}
    "K" {foreach m $n {set newlist [concat $newlist  [expr $m*4+2] [expr $m*4+3]]}}
    "M" {foreach m $n {set newlist [concat $newlist [expr $m*4] [expr $m*4+1]] }}
    "N" {foreach m $n {set newlist [concat $newlist [expr $m*4] [expr $m*4+1] [expr $m*4+2] [expr $m*4+3]]}}
    "R" {foreach m $n {set newlist [concat $newlist [expr $m*4]  [expr $m*4+2]]}}
    "S" {foreach m $n {set newlist [concat $newlist [expr $m*4+1]  [expr $m*4+2]]}}
    "T" {foreach m $n {set newlist [concat $newlist [expr $m*4+3]]}}
    "V" {foreach m $n {set newlist [concat $newlist [expr $m*4] [expr $m*4+1] [expr $m*4+2]]}}
    "W" {foreach m $n {set newlist [concat $newlist [expr $m*4] [expr $m*4+3]]}}
    "Y" {foreach m $n {set newlist [concat $newlist [expr $m*4+1] [expr $m*4+3]]}}
   }
  set n $newlist
}
return $n
}

#################
##return a pattern with degenerate code substituted with regexp equivalents
#################
proc regsubpattern {pattern} {
  regsub -all " " $pattern "" pattern
  regsub -all {[\,\;\|]} $pattern "|" pattern
  return [string map {b [cgtbsky] d [agdtkrw] h [acthryw] k [gtk] m [acm] n . r [agr] s [cgs] v [acgvmrs] w [atw] y [cty] B [CGTBSKY] D [AGDTKRW] H [ACTHRYW] K [GTK] M [ACM] N . R [AGR] S [CGS] V [ACGVMRS] W [ATW] Y [CTY]} $pattern]
}

#################
##proc K returns a variable and allows it to be deleted at the same time
##by calling "[K $var [set var ""]]
#################
proc K { x y } { set x }


#################
##add a pattern to either the longnamelist or hexlist
#################
proc addhexarray {name pattern} {
  global longnamelist
  global hexlist


  regsub -all {\(([0-9]|[/-])*\)} $pattern "" spattern
  regsub "\\^" $spattern "" spattern
  set spattern [string trim $spattern "N"] 
  set rpattern [revcom $spattern]
  if {[string length $spattern] >6} {
    if {$rpattern == $spattern} {
      lappend longnamelist [list $name [regsubpattern $spattern] {}]
    } else {
      ###other option is to add the enzyme twice, same name both patterns
      lappend longnamelist [list $name [regsubpattern $spattern] [regsubpattern $rpattern]]
    }
  } else {
    if {$rpattern == $spattern} {
      set spattern [string range [join "$spattern NNNNN" ""] 0 5]
      set patternlist [hexmult $spattern]
    } else {
      set spattern [string range [join "$spattern NNNNN" ""] 0 5]
      set rpattern [string range [join "$rpattern NNNNN" ""] 0 5]
      set patternlist [concat [hexmult $spattern] [hexmult $rpattern]]
    }
    foreach location $patternlist {
      set newlist [concat [lindex $hexlist $location] [list $name]]
      set hexlist [lreplace [K $hexlist [set hexlist {}]] $location $location $newlist]
    }
  }
}

###############
## delete an enzyme
###############
proc delete_enzyme {enzyme} {
  proc K { x y } { set x }
  global longnamelist
  global hexlist
  global enzymes
  global enzinfo
  global info
  global enz_select_window

  set listpos [lsearch -exact $enzymes $enzyme]
  if {$listpos == -1} {return}

  ##take the enzyme out of the enzyme list
  set enzymes [lreplace [K $enzymes [set enzymes {}]] $listpos $listpos]

  
  ##take the enzyme out of the currently selected list
  set info(enz_currently_selected) [lsearch -exact -not -inline -all $info(enz_currently_selected) $enzyme]
  ##take the enzyme out of the longname list or hexlist
  set spattern $enzinfo(flatpat,$enzyme)
  if {[string length $spattern] >6} {
    set longlistpos [lsearch -glob $longnamelist "$enzyme *"]
    set longnamelist [lreplace [K $longnamelist [set longnamelist {}]] $longlistpos $longlistpos]
  } else {
    set rpattern [revcom $spattern]
    if {$rpattern == $spattern} {
      set spattern [string range [join "$spattern NNNNN" ""] 0 5]
      set patternlist [hexmult $spattern]
    } else {
      set spattern [string range [join "$spattern NNNNN" ""] 0 5]
      set rpattern [string range [join "$rpattern NNNNN" ""] 0 5]
      set patternlist [concat [hexmult $spattern] [hexmult $rpattern]]
    }
    foreach location $patternlist {
      set newlist [lindex $hexlist $location]
      set pos [lsearch -exact $newlist $enzyme]
      set newlist [lreplace [K $newlist [set newlist {}]] $pos $pos]
      set hexlist [lreplace [K $hexlist [set hexlist {}]] $location $location $newlist] 
    }
  }

  ##take the enzyme out of the info and enzinfo arrays
  #array unset enzinfo "enz_vcode,$enzyme"
  #array unset enzinfo "enz_pattern,$enzyme"
  #array unset enzinfo "enz_comment,$enzyme"
  #array unset enzinfo "flatpat,$enzyme"
  #foreach element [array names enzinfo "*,$enzyme"] {
  #  array unset enzinfo $element
  #}
#leave in the enzinfo array so that overhang info is still available 

  foreach element [array names info "*,$enzyme"] {
    array unset info $element
  }

  ##take the enzyme out of the groups list
  foreach group $enzinfo(enz_groups_list) {
    set pos [lsearch -exact $enzinfo(enz_groups,$group) $enzyme]
    if {$pos > -1} {
      set enzinfo(enz_groups,$group) [lreplace [K $enzinfo(enz_groups,$group) [set enzinfo(enz_groups,$group) {}]] $pos $pos]
    }
  }

  ##take the enzyme out of the metlist
  set newmetlists [list]
  foreach metlist $enzinfo(enz_methylaselist) {
    set tempmetlist1 [list]   
    foreach enz_met_set [lindex $metlist 1] {
      if {[lindex $enz_met_set 0] != $enzyme} {
        lappend  tempmetlist1 $enz_met_set
      }
    }
    lappend newmetlists [list [lindex $metlist 0]  $tempmetlist1]
  }
  set enzinfo(enz_methylaselist) $newmetlists
  set info(blocked_enzymes) [list]
  foreach methylase $enzinfo(enz_methylaselist) {
    foreach blocked_enzyme [lindex $methylase 1] {
      lappend info(blocked_enzymes) [lindex $blocked_enzyme 0]
    }
  }
  #add DpnI specifically
   #AbaSI AoxI BisI BlsI DpnI FspEI GlaI GluI KroI LpnPI MalI MspJI MteI PcsI PkrI SgeI
  foreach z [list DpnI MalI] {
    if {$z in $enzymes} {
      lappend info(blocked_enzymes) $z
    }
  }
  set info(blocked_enzymes) [lsort -unique $info(blocked_enzymes)]

  ##remake the compatibles elements 
  add_compatibles

  foreach window [dnawindows_list] {
    set info($window,scanned) 0
    findenzymes $window
  }

  if {[winfo exists .enz_selector.textframe.textbox] == 1} {
    .enz_selector.textframe.textbox tag delete $enzyme
    fill_enzymes_box .enz_selector.textframe.textbox .enz_selector.enz_comment $enz_select_window
  }

}

#################
## return which groups pattern belogs to
#################
proc pattern_groups {pattern} {
  set result [list All]
  regsub  {^[^ABCDGHKMNRSTVWY]*?\)} $pattern "" pattern ;#remove leading parens
  set caret [string first ^ $pattern]
  if {$caret > -1} {
    set length [expr {[string length $pattern] -1.0}]    
    set site [expr {$caret * 2 - $length}]
    if {[regexp -nocase "\[bdhkmnrsvwy\]" [string range $pattern [expr {int($length/2 - abs($caret-$length/2))}] [expr {int($length/2 + abs($caret-$length/2))}]]] == 1} {lappend result "degenerate cut"}
  } else {
    if {[regexp {(.*)\(([\-0-9]*)/([\-0-9]*)} $pattern -- pattern top bottom] == 1} {
      if {$top != $bottom} {lappend result "degenerate cut"}
      set site [expr {$top -$bottom} ]
    } else {
      set site nosite
      #sputs "Can't understand pattern: $pattern, no groups added."
    }
    set length [string length $pattern]
  }
  regsub -all {\^} $pattern "" recognition_sequence
  if {$recognition_sequence eq [revcom $recognition_sequence]} {
    lappend result "symmetric"
  } else {
    lappend result "asymmetric"
  }
  if {[string first N $pattern] > -1} {set length -1}
  if {[regexp -nocase "\[bdhkmnrsvwy\]" $pattern] == 1} {lappend result "degenerate"}
  if {$length == 4} {lappend result "four cutter"}
  if {$length  == 5} {lappend result "five cutter"}
  if {$length  == 6} {lappend result "six cutter"}
  if {$length  > 6} {lappend result ">six cutter"}

  if {$site != "nosite"} {  
    if {$site < 0} {
      lappend result "5 prime"
    } elseif {$site == 0} {
      lappend result "blunt"
    } else {
      lappend result "3 prime"
    }
  }

  return $result
}

#################
## dialog window for adding a new enzyme
#################
proc add_enzyme_dialog {parent_win} {
  global enzymes 
  global info
  global enz_select_window
  global edit_new_enz
  global ok2

  set edit_new_enz 1
  toplevel .new_enzyme
  wm protocol .new_enzyme WM_DELETE_WINDOW "set ok2 -1"
  bind .new_enzyme <KeyPress-Escape>  "set ok2 -1"
  wm title .new_enzyme [mc "New Enzyme"]
  set raisedialog_store [bind . <<RaiseDialogs>>]
  bind . <<RaiseDialogs>> "wm deiconify .new_enzyme; raise .new_enzyme"
  regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $parent_win] wgeom winx winy
  wm geometry .new_enzyme "+[expr (($winx<0)?0:$winx)+20]+[expr (($winy<0)?0:$winy)+50]"
  wm transient .new_enzyme $parent_win
  if {[tk windowingsystem] == "aqua"} {
    ::tk::unsupported::MacWindowStyle style .new_enzyme document {closeBox}
  }
  wm deiconify .new_enzyme
  set ok2 0

  label .new_enzyme.namelabel -text [mc "Name:"]
  entry .new_enzyme.name
  label .new_enzyme.patternlabel -text [mc "Site:"]
  entry .new_enzyme.pattern
  label .new_enzyme.commentlabel -text [mc "Comment:"]
  entry .new_enzyme.comment
  grid columnconfigure .new_enzyme 1 -weight 1
  grid .new_enzyme.namelabel -row 0 -column 0 -sticky w
  grid .new_enzyme.name -row 0 -column 1 -sticky ew
  grid .new_enzyme.patternlabel -row 1 -column 0 -sticky w
  grid .new_enzyme.pattern -row 1 -column 1 -sticky ew
  grid .new_enzyme.commentlabel -row 2 -column 0 -sticky w
  grid .new_enzyme.comment -row 2 -column 1 -sticky ew
  grid [checkbutton .new_enzyme.edit_check -text [mc "Edit Groups and Methylation"] -variable edit_new_enz -selectcolor white] -row 3 -column 1 -columnspan 2 -sticky nw
  grid [frame .new_enzyme.okframe -relief ridge] -row 4 -column 0 -columnspan 2
  grid [button .new_enzyme.okframe.cancel -text [mc "Cancel"] -command "set ok2 -1"] -row 0 -column 1 -padx 12 -pady 3 -sticky nw
  grid [button .new_enzyme.okframe.ok -text [mc "OK"] -command "set ok2 1" -default active] -row 0 -column 0 -padx 12 -pady 3 -sticky nw
  bind .new_enzyme <Key-Return> ".new_enzyme.okframe.ok invoke"
  #grab set .new_enzyme
  wm deiconify .new_enzyme
  vwait ok2
 

  if {$ok2 == 1} {
    set enzyme [.new_enzyme.name get]
    set comment [.new_enzyme.comment get]
    set pattern [string toupper [.new_enzyme.pattern get]]
    regsub -all {\s} $pattern "" pattern
    if {[lsearch -exact $enzymes $enzyme] != -1} {
      tk_messageBox -message [mc "An enzyme with that name already exists"] -type ok -icon warning -default ok
    } elseif {($enzyme != "" ) && ([string length [.new_enzyme.pattern get]] > 3)} {
      if {$comment == ""} {
        set comment $pattern
      }
      add_enzyme $enzyme [string toupper $pattern] $comment

      if {($edit_new_enz == 1)} {
        edit_enzyme [.new_enzyme.name get] .new_enzyme
      }

      add_compatibles

      foreach window [dnawindows_list] {
        set info($window,scanned) 0
        findenzymes $window
      }

      if {[winfo exists .enz_selector.textframe.textbox] == 1} {
        fill_enzymes_box .enz_selector.textframe.textbox .enz_selector.enz_comment $enz_select_window
      }
      set info(enzymes_saved) 0
    }
  }
  #grab release .new_enzyme
  destroy .new_enzyme
  bind . <<RaiseDialogs>> $raisedialog_store
  wm deiconify $parent_win
  return $ok2
}

###############
## Quick add Golden Gate enzyme 
###############
proc enz_add_gg {parent_win} {
  global enzymes 
  global info temp_info
  global enz_select_window

  global ok2

  set gg_enz_dict [dict create  AarI CACCTGC(4/8) BbsI GAAGAC(2/6) BpiI GAAGAC(2/6) BsaI GGTCTC(1/5) BsmBI CGTCTC(1/5) BspQI GCTCTTC(1/4) BtgZI GCGATG(10/14) Esp3I CGTCTC(1/5) PaqCI CACCTGC(4/8) SapI GCTCTTC(1/4)]
  set edit_new_enz 1
  toplevel .new_enzyme
  wm protocol .new_enzyme WM_DELETE_WINDOW "set ok2 -1"
  bind .new_enzyme <KeyPress-Escape>  "set ok2 -1"
  wm title .new_enzyme [mc "New Enzyme"]
  set raisedialog_store [bind . <<RaiseDialogs>>]
  bind . <<RaiseDialogs>> "wm deiconify .new_enzyme; raise .new_enzyme"
  regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $parent_win] wgeom winx winy
  wm geometry .new_enzyme "+[expr (($winx<0)?0:$winx)+20]+[expr (($winy<0)?0:$winy)+50]"
  if {[tk windowingsystem] != "aqua"} {
    wm transient .new_enzyme $parent_win
  } else {
    ::tk::unsupported::MacWindowStyle style .new_enzyme document {closeBox}
  }
  wm deiconify .new_enzyme
  set ok2 0

  grid [set f [frame .new_enzyme.enz_frame -relief ridge]] -row 1 -column 0 -columnspan 2 -sticky nswe
  set row 0  
  dict for {name site} $gg_enz_dict {
    grid [ttk::checkbutton $f.ch_$row -text "$name $site" -variable temp_info($name)] -row $row -column 0 -sticky w
    set temp_info($name) 0
    if {[lsearch -exact $enzymes $name] != -1} {
      $f.ch_$row state disabled
    }
    incr row
  }

  grid [frame .new_enzyme.okframe -relief ridge] -row 4 -column 0 -columnspan 2
  grid [button .new_enzyme.okframe.cancel -text [mc "Cancel"] -command "set ok2 -1"] -row 0 -column 1 -padx 12 -pady 3 -sticky nw
  grid [button .new_enzyme.okframe.ok -text [mc "OK"] -command "set ok2 1" -default active] -row 0 -column 0 -padx 12 -pady 3 -sticky nw
  bind .new_enzyme <Key-Return> ".new_enzyme.okframe.ok invoke"
  #grab set .new_enzyme
  wm deiconify .new_enzyme
  vwait ok2
 

  if {$ok2 == 1} {
    dict for {name site} $gg_enz_dict {
      if {$temp_info($name)} {
        set enzyme $name
        set comment $site
        set pattern $site
        add_enzyme $enzyme [string toupper $pattern] $comment
        add_compatibles
      }
    }

    foreach window [dnawindows_list] {
      set info($window,scanned) 0
      findenzymes $window
    }

    if {[winfo exists .enz_selector.textframe.textbox] == 1} {
      fill_enzymes_box .enz_selector.textframe.textbox .enz_selector.enz_comment $enz_select_window
    }
    set info(enzymes_saved) 0

  }
  #grab release .new_enzyme
  destroy .new_enzyme
  bind . <<RaiseDialogs>> $raisedialog_store
  wm deiconify $parent_win
  return $ok2
}

################
##
################
proc format_cut_site {seq cut5 cut3} {
  if {[catch {expr {$cut5 + $cut3}}]} {
    if {[regexp {([\-0-9]+),([\-0-9]+)} $cut5 - a5 b5] && [regexp {([\-0-9]+),([\-0-9]+)} $cut3 - a3 b3]} {
      return [join [list  ( [expr {-1 * ([string length $seq] + $a5)}] / [expr {-1 * ([string length $seq] + $a3)}] ) $seq ( $b5 / $b3 )] ""]
    } else {
      sputs err $seq $cut5 $cut3
      return [join [list $seq ( $cut5 / $cut3 )] ""]
    }
  } elseif {$cut5 <= 0 && $cut3 <= 0} {
    if {[expr {-1*([string length $seq] + $cut5)}] == $cut3 } {
      return "[string range $seq 0 [expr {[string length $seq]-1 + $cut5}] ]^[string range $seq [expr {[string length $seq] + $cut5}] end]"
    } else {
      sputs err $seq $cut5 $cut3
      return [join [list $seq ( $cut5 / $cut3 )] ""]
    }
  } else {
    if {[expr {-1*([string length $seq] + $cut5)}] == $cut3 } {
      if {$cut5 <  0} {
        return [join [list ^ [string repeat "N" [expr {-1*([string length $seq] + $cut5)}]] $seq ] ""]
      } else {
        return [join [list $seq [string repeat "N" $cut5] ^ ] ""]
      }
    } else {
      return [join [list $seq ( $cut5 / $cut3 )] ""]
    }
  }
}

################
##
################
proc enz_edit_curent_enzymes {s} {
  global info enzinfo current_supplier_frame enz_check enzymes enz_data

  #add to Msbuffmore:
  #MalI;GATC;-2;-2;Dam:required;IIM;I;I:SibEnzyme MalI;I:37;
  #DpnI;GATC;-2;-2;Dam:required;IIM;BEKMNOQRSX;E:Stratagene Universal Buffer 1X,N:rCutSmart Buffer,R:Promega B,M:Boehringer A;E:37,N:37,R:37,M:37;

  set filename [file join $info(Accdir) "msbuffmore.txt"]
  set iso [dict create]
  set neo [dict create]
  set supplier_code_dict [dict create]
  if {!([catch {open $filename r} fileid err])} {
    while {[eof $fileid] != 1} {
      set line [gets $fileid]
      set temps ""
      if {[regexp {([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);} $line - enz seq cut5 cut3 met type suppliers buffers temps] || [regexp {([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);([^;]*);} $line - enz seq cut5 cut3 met type suppliers buffers]} {
        if {[regexp {[\s#]} $enz]} {continue}
        if {$suppliers eq ""} {
          ## add in an enzyme that is in the current set, even if there are no suppliers (Use supplier code * for None)
          if {$enz in $enzymes} {
            set suppliers "*"
          } else {
            continue
          }
        }
        if {$seq eq ""} {continue}
        set buffer_list [split $buffers {[,:]}]
        set temps_list [split $temps {[,:]}]
        if {![catch {dict values $temps_list}]} {
          set consens_temp [lsort -unique [dict values $temps_list]]
        } else {
          set consens_temp ""
          sputs err: consens_temp $enz $temps_list
        }
        if {[lindex $consens_temp 0] eq "-"} {
          set consens_temp [lrange $consens_temp 1 end]
        }
        #set met_list [list]
        #if {[regexp {Dam:([^,]+)} $met - dam]} {
        #  lappend met_list Dam $dam
        #}
        #if {[regexp {Dcm:([^,]+)} $met - dcm]} {
        #  lappend met_list Dcm $dcm
        #}
        set met [join [regexp -all -inline {Dam:[^,;]+|Dcm:[^,;]+} $met] " "]
        regsub -all -- "-" $met "not tested" met
        dict lappend iso "$seq $cut5 $cut3" $enz
        dict lappend neo $seq $enz
        set enz_data($enz) [dict create seq $seq cut5 $cut5 cut3 $cut3 met $met sup $suppliers buf $buffer_list temp $temps_list c_temp $consens_temp]
        set enz_check($enz) [expr {$enz in $enzymes ? 1 : 0}]
      } elseif {[regexp {                ([A-Z])        (.*) \([0-9]+/[0-9]+\)} $line - code supplier]} {
        dict set supplier_code_dict $code $supplier
      } else {
        #sputs line_err: $line
      }
    }
  }
  close $fileid
  if {$supplier_code_dict eq {}} {
    ## make a default dict
    sputs using default supplier codes
    set supplier_code_dict {B "Thermo Fisher Scientific" C "Minotech Biotechnology"  E "Agilent Technologies" I "SibEnzyme Ltd." J "Nippon Gene Co., Ltd." K "Takara Bio Inc." N "New England Biolabs" O "Toyobo Biochemicals" Q "Molecular Biology Resources - CHIMERx" R "Promega Corporation" S "Sigma Chemical Corporation" V "Vivantis Technologies" X "EURx Ltd." Y "SinaClon BioScience Co."}
  }
  dict set supplier_code_dict "*" "None" 

  ## add in enzymes that are not in msbuffmore
  foreach enz $enzymes {
    if {![info exists enz_data($enz)]} {
        lassign {"" * "" "" ""}  met suppliers buffer_list temps_list consens_temp
        set seq $enzinfo(flatpat,$enz)
        set cut5 [expr { [lindex $enzinfo(enz_cut_sites,$enz)  0] - [string length $seq] }]
        set cut3 [expr { [lindex $enzinfo(enz_cut_sites,$enz)  1] - [string length $seq] }]
        dict lappend iso "$seq $cut5 $cut3" $enz
        dict lappend neo $seq $enz
        set enz_data($enz) [dict create seq $seq cut5 $cut5 cut3 $cut3 met $met sup $suppliers buf $buffer_list temp $temps_list c_temp $consens_temp]
        set enz_check($enz) 1
    }
  }

  set a [toplevel .edit_current_enzymes]
  wm title $a [mc "Edit Current Enzyme Set"]
  wm transient $a $s
  if {[tk windowingsystem] == "aqua"} {
    ::tk::unsupported::MacWindowStyle style $a document {closeBox}
  }
  if {[regexp {([0-9]*)x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $s] -- winw winx winy]} {
    wm geometry $a "+[expr {20+$winx}]+[expr {5+$winy}]"
  } else {
    return
  }
  wm protocol $a WM_DELETE_WINDOW "event generate $a <<Cancel>>"
  bind $a <KeyPress-Escape>  "event generate $a <<Cancel>>"
  set bindstore [bind . <<RaiseDialogs>>]
  bind . <<RaiseDialogs>> "wm deiconify $a; raise $a"
  bind $a <<Cancel>> "destroy $a; bind . <<RaiseDialogs>> [list $bindstore]; unset -nocomplain ok2 current_supplier_frame enz_check enz_data"
  bind $a <<OK>> "enz_edit_curent_enzymes_apply $a"

  grid [set nb [ttk::notebook $a.nb1]] -row 1 -column 1 -sticky nswe
  grid columnconfigure $a 1 -weight 1
  grid rowconfigure $a 1 -weight 1

  if {$info(bg_color) eq "systemWindowBackgroundColor"} {
    set text_bg_color "systemWindowBackgroundColor1"
  } else {
    set text_bg_color $info(bg_color)
  }

  grid [set f [frame $a.okframe]] -row 2 -column 1 -sticky nswe
  grid [ttk::button $a.okframe.cancel -text [mc "Cancel"] -command "event generate $a <<Cancel>>"] -row 1 -column 1 -sticky n
  grid [ttk::button $a.okframe.ok -default active -text [mc "OK"] -command "event generate $a <<OK>>"] -row 1 -column 2 -sticky n
  grid columnconfigure $a.okframe 1 -weight 1
  grid columnconfigure $a.okframe 2 -weight 1

  $nb add [ttk::frame $nb.f1] -text [mc "Alphabetical"] 
  grid [text $nb.f1.t -background $text_bg_color -foreground $info(label_fg_color) -highlightthickness 0 -yscrollcommand "optionscrollbar $nb.f1.s"] -row 1 -column 1 -sticky nswe
  grid [scrollbar $nb.f1.s -command "$nb.f1.t yview"] -row 1 -column 2 -sticky ns
  grid columnconfigure $nb.f1 1 -weight 1
  grid rowconfigure $nb.f1 1 -weight 1
  set i 0
  foreach e [lsort -increasing -dictionary [array names enz_data]] {
    $nb.f1.t window create end -window [ttk::checkbutton $nb.f1.t.w$i -variable enz_check($e)]
    $nb.f1.t  insert end "$e [format_cut_site [dict get $enz_data($e) seq] [dict get $enz_data($e) cut5] [dict get $enz_data($e) cut3]]  [dict get $enz_data($e) sup] [dict get $enz_data($e) c_temp] [dict get $enz_data($e) met]\n"
    incr i
  }

  $nb add [ttk::frame $nb.f2] -text [mc "Recognition"] 
  grid [text $nb.f2.t -bg $text_bg_color -fg $info(label_fg_color) -highlightthickness 0 -yscrollcommand "optionscrollbar $nb.f2.s"] -row 1 -column 1 -sticky nswe
  grid [scrollbar $nb.f2.s  -command "$nb.f2.t yview"] -row 1 -column 2 -sticky ns
  grid columnconfigure $nb.f2 1 -weight 1
  grid rowconfigure $nb.f2 1 -weight 1
  set i 0
  foreach seq [lsort -increasing -dictionary [dict keys $neo]] {
   if {$seq eq {}} {continue}
    $nb.f2.t  insert end "$seq\n"
    foreach e [dict get $neo $seq] {
      $nb.f2.t  insert end "     "
      $nb.f2.t window create end -window [ttk::checkbutton $nb.f2.t.w$i -variable enz_check($e)]
      $nb.f2.t  insert end "$e [format_cut_site [dict get $enz_data($e) seq] [dict get $enz_data($e) cut5] [dict get $enz_data($e) cut3]]  [dict get $enz_data($e) sup] [dict get $enz_data($e) c_temp] [dict get $enz_data($e) met]\n"
      incr i
    }
  }


  $nb add [ttk::frame $nb.f3] -text [mc "Isoschizomer"] 
  grid [text $nb.f3.t -bg $text_bg_color  -fg $info(label_fg_color) -highlightthickness 0 -yscrollcommand "optionscrollbar $nb.f3.s"] -row 1 -column 1 -sticky nswe
  grid [scrollbar $nb.f3.s  -command "$nb.f3.t yview"] -row 1 -column 2 -sticky ns
  grid columnconfigure $nb.f3 1 -weight 1
  grid rowconfigure $nb.f3 1 -weight 1
  set i 0
  foreach e [lsort -increasing -dictionary [array names enz_data]] {
    set seq  "[dict get $enz_data($e) seq] [dict get $enz_data($e) cut5] [dict get $enz_data($e) cut3]"
    if {[llength [dict get $neo [dict get $enz_data($e) seq]]] > 1} {
      set ref_cut [format_cut_site [dict get $enz_data($e) seq] [dict get $enz_data($e) cut5] [dict get $enz_data($e) cut3]] 
      $nb.f3.t window create end -window [ttk::checkbutton $nb.f3.t.w$i -variable enz_check($e)]
      $nb.f3.t  insert end "$e $ref_cut [dict get $enz_data($e) sup]  [dict get $enz_data($e) c_temp] [dict get $enz_data($e) met]\n"
      incr i
      foreach e2 [dict get $neo [dict get $enz_data($e) seq]] {
        if {$e2 ne $e} {
          $nb.f3.t  insert end "  "
          $nb.f3.t window create end -window [ttk::checkbutton $nb.f3.t.w$i -variable enz_check($e2)]
          set new_cut [format_cut_site [dict get $enz_data($e2) seq] [dict get $enz_data($e2) cut5] [dict get $enz_data($e2) cut3]]
          if {$new_cut eq $ref_cut} {
            $nb.f3.t  insert end "$e2 $new_cut  [dict get $enz_data($e2) sup]  [dict get $enz_data($e2) c_temp] [dict get $enz_data($e2) met]\n"
          } else {
            $nb.f3.t  insert end "$e2 "
            $nb.f3.t  insert end "$new_cut " underline
            $nb.f3.t  insert end "  [dict get $enz_data($e2) sup]  [dict get $enz_data($e2) c_temp] [dict get $enz_data($e2) met]\n"
          }
          incr i
        }
      }
      $nb.f3.t  insert end \n
    }
  }
  $nb.f3.t tag configure underline -underline 1


  $nb add [ttk::frame $nb.f4] -text [mc "Type IIS/Golden Gate"] 
  grid [text $nb.f4.t -bg $text_bg_color  -fg $info(label_fg_color) -highlightthickness 0 -yscrollcommand "optionscrollbar $nb.f4.s"] -row 1 -column 1 -sticky nswe
  grid [scrollbar $nb.f4.s -command "$nb.f4.t yview"] -row 1 -column 2 -sticky ns
  grid columnconfigure $nb.f4 1 -weight 1
  grid rowconfigure $nb.f4 1 -weight 1
  set i 0
  foreach e [lsort -increasing -dictionary [array names enz_data]] {
    set cut5 [dict get $enz_data($e) cut5] 
    set cut3 [dict get $enz_data($e) cut3]
    if {$cut5 > 0 && $cut5 < 6 && $cut3 > 0 && [expr {abs($cut3 -$cut5)}] >=3 } {
      $nb.f4.t window create end -window [ttk::checkbutton $nb.f4.t.w$i -variable enz_check($e)]
      $nb.f4.t  insert end "$e [format_cut_site [dict get $enz_data($e) seq] [dict get $enz_data($e) cut5] [dict get $enz_data($e) cut3]]  [dict get $enz_data($e) sup] [dict get $enz_data($e) c_temp] [dict get $enz_data($e) met]\n"
      incr i
    }
  }

  $nb add [ttk::frame $nb.f5] -text [mc "Supplier"] 
  grid [ttk::menubutton $nb.f5.mb -menu $nb.f5.mb.menu -textvariable current_supplier_name] -row 1 -column 1 -sticky nw
  menu $nb.f5.mb.menu
  grid columnconfigure $nb.f5 1 -weight 1
  grid rowconfigure $nb.f5 2 -weight 1
  set snum 1
  set current_supplier_frame $nb.f5.f1
  foreach {letter name} $supplier_code_dict {
      grid [ttk::frame $nb.f5.f$snum] -row 2 -column 1 -sticky nswe
      grid [text $nb.f5.f$snum.t -bg $text_bg_color  -fg $info(label_fg_color) -highlightthickness 0 -yscrollcommand "optionscrollbar $nb.f5.f$snum.s"] -row 1 -column 1 -sticky nswe
      grid [scrollbar $nb.f5.f$snum.s -command "$nb.f5.f$snum.t yview"] -row 1 -column 2 -sticky ns
      grid columnconfigure $nb.f5.f$snum 1 -weight 1
      grid rowconfigure $nb.f5.f$snum 1 -weight 1
      $nb.f5.mb.menu add radiobutton -label "$name: $letter" -command "grid remove \$current_supplier_frame; set current_supplier_frame $nb.f5.f$snum;  grid configure $nb.f5.f$snum" -variable current_supplier_name -value "$name: $letter"
      set i 0
      foreach e [lsort -increasing -dictionary [array names enz_data]] {
        set sup  [dict get $enz_data($e) sup]
        if {[string first $letter $sup] > -1} {
          $nb.f5.f$snum.t window create end -window [ttk::checkbutton $nb.f5.f$snum.t.w$i -variable enz_check($e)]
          $nb.f5.f$snum.t  insert end "$e [format_cut_site [dict get $enz_data($e) seq] [dict get $enz_data($e) cut5] [dict get $enz_data($e) cut3]] [dict get $enz_data($e) met]\n"
          incr i
        }
      }
      grid remove $nb.f5.f$snum
      incr snum
    }
    $nb.f5.mb.menu invoke 0
}


################
##
################
proc enz_edit_curent_enzymes_apply {a} {
  global current_supplier_frame   enz_check enzymes  enz_data
  global info enzinfo enz_select_window

  set damlist [lindex [lindex $enzinfo(enz_methylaselist) 0] 1]
  set dcmlist [lindex [lindex $enzinfo(enz_methylaselist) 1] 1]

  foreach enzyme [array names enz_check] {
    if {!$enz_check($enzyme) && $enzyme in $enzymes} {
      #delete enzymes here
      delete_enzyme $enzyme
      if {[set pos [lsearch -exact -index 0 $damlist $enzyme]] > -1} {
        set damlist [lreplace $damlist $pos $pos]
      }
      if {[set pos [lsearch -exact -index 0 $dcmlist $enzyme]] > -1} {
        set dcmlist [lreplace $dcmlist $pos $pos]
      }
    } elseif {$enz_check($enzyme) && $enzyme ni $enzymes} {
      ## add new enzymes here
      set pattern [format_cut_site [dict get $enz_data($enzyme) seq] [dict get $enz_data($enzyme) cut5] [dict get $enz_data($enzyme) cut3]]
      add_enzyme $enzyme [string toupper $pattern] $pattern

      ##add Dam and Dcm
      set metdata [dict get $enz_data($enzyme) met]
      if {[string first "Dam:blocked" $metdata] > -1} {
        set pattern $enzinfo(flatpat,$enzyme)
        regsub -all {\(([0-9]|[/-])*\)} $pattern "" pattern
        regsub "\\^" $pattern "" pattern
        set pattern [string trim $pattern "N"]
        set pattern "NN[append pattern NN]"
        if {[set found [regexp -all -inline -indices {(?:[GBDKNRSV][ADHMRVW][TBDHKNWY][CBHMNSVY])|(?:[GBDKNRSV][ADHMNRVW][TBDHKWY][CBHMNSVY])} $pattern]] != "" } {
          set metlist [list]
          foreach index $found {
            lappend metlist [lsort -integer [list [expr {[lindex $index 0]-2}] [expr {[string length $pattern]-[lindex $index 0]-6}]]]
          }
          set metlist [lsort -unique $metlist]
          foreach dam_index $metlist {
            lappend damlist [list $enzyme [lindex $dam_index 0] [lindex $dam_index 1]]
          }

        }
      }
      if {[string first "Dcm:blocked" $metdata] > -1} {
        set pattern $enzinfo(enz_pattern,$enzyme)
        regsub -all {\(([0-9]|[/-])*\)} $pattern "" pattern
        regsub "\\^" $pattern "" pattern
        set pattern [string trim $pattern "N"]
        set pattern "NNN[append pattern NNN]"
        if {[set found [regexp -inline -all -indices {(?:[CBHMNSVY][CBHMSVY][ATBDHKMNRVWY][GBDKNRSV][GBDKNRSV])|(?:[CBHMNSVY][CBHMNSVY][ATBDHKMNRVWY][GBDKRSV][GBDKNRSV])} $pattern]] != ""} {
          set metlist [list]
          foreach index $found {
            lappend metlist [lsort -integer [list [expr {[lindex $index 0]-3}] [expr {[string length $pattern]-[lindex $index 0]-8}]]]
          }
          set metlist [lsort -unique $metlist]
          foreach dam_index $metlist {
            lappend damlist [list $enzyme [lindex $dam_index 0] [lindex $dam_index 1]]
          }
          set metlist [lsort -unique $metlist]
          foreach dcm_index $metlist {
            lappend dcmlist [list $enzyme [lindex $dcm_index 0] [lindex $dcm_index 1]]
          }
        }
      }
    }
  }
  set damlist [lsort -index 0 $damlist]
  set dcmlist [lsort -index 0 $dcmlist]
  set enzinfo(enz_methylaselist) [list [list MDam $damlist] [list MDcm $dcmlist]] 
  set info(blocked_enzymes) [list]
  foreach methylase $enzinfo(enz_methylaselist) {
    foreach blocked_enzyme [lindex $methylase 1] {
      lappend info(blocked_enzymes) [lindex $blocked_enzyme 0]
    }
  }
  #add DpnI specifically
  #AbaSI AoxI BisI BlsI DpnI FspEI GlaI GluI KroI LpnPI MalI MspJI MteI PcsI PkrI SgeI
  foreach z [list DpnI MalI] {
    if {$z in $enzymes} {
      lappend info(blocked_enzymes) $z
    }
  }
  set info(blocked_enzymes) [lsort -unique $info(blocked_enzymes)]
  #rescan
  foreach window [dnawindows_list] {
    set info($window,scanned) 0
    findenzymes $window
  }
  add_compatibles
  set info(enzymes_saved) 0
  #re-fill the selector box
  if {[winfo exists .enz_selector.textframe.textbox]} {
    fill_enzymes_box .enz_selector.textframe.textbox .enz_selector.enz_comment $enz_select_window
  }
  event generate $a <<Cancel>>
}

###############
## add an enzyme 
###############
proc add_enzyme {enzyme pattern comment} {
  global enzymes
  global enzinfo
  global info


  ##add enzyme to the enzymes list
  set enzymes [lsort [lappend enzymes $enzyme]]
  set pattern [string toupper $pattern]

  ##add enzyme to the info array
  set enzinfo(enz_vcode,$enzyme) [validation_code $pattern]
  set enzinfo(enz_pattern,$enzyme) $pattern
  set enzinfo(enz_comment,$enzyme) $comment
  set p [string map {^ "" ( "" - "" ) "" / ""} $pattern]
  regsub -all {([0-9])*} $p "" p
  set p [string trim $p "N"] 
  set enzinfo(flatpat,$enzyme) $p
  set flatpattern $p
  if {[regexp {(-?[0-9]+)[[:space:]]*.[[:space:]]*(-?[0-9]+)} $pattern x d1 d2]} {
    set enzinfo(enz_cut_sites,$enzyme) [list [expr {[string length $flatpattern]+$d1}] [expr {[string length $flatpattern]+$d2}]]
  } elseif {[regexp -all {[|^/\\]} $pattern] > 0} {
    if {[revcom $flatpattern] == $flatpattern} {
      set char [lindex [lindex [regexp -inline -indices {[|^/\\]} $pattern] 0] 0]
      set enzinfo(enz_cut_sites,$enzyme) [list $char [expr {[string length $flatpattern]-$char}]]
    } else {
      set bottom [lindex [lindex [regexp -inline -indices {[_/\\]} $pattern] 0] 0]
      set top [lindex [lindex [regexp -inline -indices {[^|]} $pattern] 0] 0]
      set enzinfo(enz_cut_sites,$enzyme) [list 0 0]
    }
  } else {
    set enzinfo(enz_cut_sites,$enzyme) [list 0 0]
  }



  ##add enzyme to the longname list or hexlist
  addhexarray $enzyme $p

  ##add enzyme to the groups list
  set grouplist [pattern_groups $pattern]
  foreach group $grouplist {
    if {[array names enzinfo "enz_groups,$group"] != {}} {
      set enzinfo(enz_groups,$group) [lsort [lappend enzinfo(enz_groups,$group) $enzyme]]
    } else {
      set enzinfo(enz_groups,$group) [list $enzyme]
   }
  }
}

###############
## edit an enzyme (comment, groups, methylation)
###############
proc edit_enzyme {enzyme parent_win} {
  global ok2
  global enzinfo enzymes
  global info
  global group_editenzyme
  global dam
  global dcm
  global new_comment
  global enz_select_window

  set maxcols 4
  if {[winfo exists .edit_enzyme]} {
    destroy .edit_enzyme 
    array unset group_editenzyme
    array unset dam
    array unset dcm
    unset -nocomplain new_comment
  }
  toplevel .edit_enzyme 
  wm protocol .edit_enzyme WM_DELETE_WINDOW "set ok2 -1"
  bind .edit_enzyme <KeyPress-Escape>  "set ok2 -1"
  wm title .edit_enzyme "[mc "Edit enzyme:"] $enzyme"
  set raisedialog_store [bind . <<RaiseDialogs>>]
  bind . <<RaiseDialogs>> "wm deiconify .edit_enzyme; raise .edit_enzyme"
  regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $parent_win] wgeom winx winy
  wm geometry .edit_enzyme "+[expr (($winx<0)?0:$winx)+20]+[expr (($winy<0)?0:$winy)+50]"
  wm transient .edit_enzyme $parent_win
  if {[tk windowingsystem] == "aqua"} {
    ::tk::unsupported::MacWindowStyle style .edit_enzyme document {closeBox}
  }
  wm deiconify .edit_enzyme
  set ok2 0

  grid [label .edit_enzyme.enzlabel -text [mc "Enzyme: %s" $enzyme]] -row 0 -column 0 -columnspan 2 -sticky nw
  grid [label .edit_enzyme.patlabel -text [mc "Site: %s" $enzinfo(enz_pattern,$enzyme)]] -row 1 -column 0 -columnspan 2 -sticky nw
  grid [label .edit_enzyme.comlabel -text [mc "Comment:"]] -row 2 -column 0 -sticky nw
  grid [entry .edit_enzyme.comentry -textvariable new_comment] -row 2 -column 1 -sticky nwe
  set new_comment $enzinfo(enz_comment,$enzyme)
  grid columnconfigure .edit_enzyme 1 -weight 1

  #groups frame
  grid [labelframe .edit_enzyme.groups -text Groups] -row 3 -column 0 -columnspan 2 -sticky nwe
  set r 0
  set c 0
  set gcb 0
  foreach group $enzinfo(enz_groups_list) {
    if {($group != "Mem Recall") && ($group != "All") && ($group != "Difference...")} {
      incr gcb
      set group_editenzyme($group) [expr {([lsearch $enzinfo(enz_groups,$group) $enzyme]>-1)}]
      grid [checkbutton .edit_enzyme.groups.cb$gcb -text $group -variable group_editenzyme($group) -selectcolor white] -row $r -column $c -sticky w
      incr c
      if {$c >= $maxcols} {
        set c 0
        incr r
      }
    }
  }

  #Dam/Dcm metylation frame
  grid [labelframe .edit_enzyme.met -text [mc "Methylation"]] -row 4 -column 0 -columnspan 2 -sticky nwe
  set r 0
  set pattern $enzinfo(enz_pattern,$enzyme)
  regsub -all {\(([0-9]|[/-])*\)} $pattern "" pattern
  regsub "\\^" $pattern "" pattern
  set pattern [string trim $pattern "N"]
  set pattern "NN[append pattern NN]"
  set metlist [list]
  set damlist [lindex [lindex $enzinfo(enz_methylaselist) 0] 1]
  set dcmlist [lindex [lindex $enzinfo(enz_methylaselist) 1] 1]
  if {$enzyme in [list DpnI MalI]} {
    grid [label .edit_enzyme.met.damlabel -text [mc "%s Requires Methylation." $enzyme]] -row $r -column 0 -columnspan 2 -sticky nw
  } elseif {[set found [regexp -all -inline -indices {(?:[GBDKNRSV][ADHMRVW][TBDHKNWY][CBHMNSVY])|(?:[GBDKNRSV][ADHMNRVW][TBDHKWY][CBHMNSVY])} $pattern]] != "" } {
    set metlist [list]
    foreach index $found {
      lappend metlist [lsort -integer [list [expr {[lindex $index 0]-2}] [expr {[string length $pattern]-[lindex $index 0]-6}]]]
    }
    set metlist [lsort -unique $metlist]
    #sputs $metlist
    grid [label .edit_enzyme.met.damlabel -text [mc "Potential %s Methylation:" Dam(GATC)]] -row $r -column 0 -columnspan 2 -sticky nw
    incr r
    foreach met $metlist {
      grid [checkbutton .edit_enzyme.met.m$r -variable dam($met) -selectcolor white] -row $r -column 0 -sticky nw
      if {[lsearch $damlist [list $enzyme [lindex $met 0] [lindex $met 1]]] > -1} {
        set dam($met) 1
      } else {
        set dam($met) 0
      }
      grid [text .edit_enzyme.met.t$r -height 1 -relief flat -wrap none -background $info(bg_color)] -row $r -column 1 -sticky nw
      .edit_enzyme.met.t$r insert 1.0 $pattern
      .edit_enzyme.met.t$r tag add bold 1.[expr {[lindex $met 0]+2}] 1.[expr {[lindex $met 0]+6}] 1.[expr {[lindex $met 1]+2}] 1.[expr {[lindex $met 1]+6}]
      .edit_enzyme.met.t$r tag configure bold -background red 
      bindtags .edit_enzyme.met.t$r [list all .]
      incr r
    }
  }
  set pattern "N[append pattern N]"
  set metlist [list]
  if {[set found [regexp -inline -all -indices {(?:[CBHMNSVY][CBHMSVY][ATBDHKMNRVWY][GBDKNRSV][GBDKNRSV])|(?:[CBHMNSVY][CBHMNSVY][ATBDHKMNRVWY][GBDKRSV][GBDKNRSV])} $pattern]] != ""} {
    foreach index $found {
      lappend metlist [lsort -integer [list [expr {[lindex $index 0]-3}] [expr {[string length $pattern]-[lindex $index 0]-8}]]]
    }
    set metlist [lsort -unique $metlist]
    grid [label .edit_enzyme.met.dcmlabel -text [mc "Potential %s Methylation:" Dcm(CCWGG)] ] -row $r -column 0 -columnspan 2 -sticky nw
    incr r
    foreach met $metlist {
      grid [checkbutton .edit_enzyme.met.m$r -variable dcm($met) -selectcolor white] -row $r -column 0 -sticky nw
      if {[lsearch $dcmlist  [list $enzyme [lindex $met 0] [lindex $met 1]]] >-1} {
        set dcm($met) 1
      } else {
        set dcm($met) 0
      }
      grid [text .edit_enzyme.met.t$r -height 1 -relief flat -wrap none -background $info(bg_color)] -row $r -column 1 -sticky nw
      .edit_enzyme.met.t$r insert 1.0 $pattern
      .edit_enzyme.met.t$r tag add bold 1.[expr {[lindex $met 0]+3}] 1.[expr {[lindex $met 0]+8}] 1.[expr {[lindex $met 1]+3}] 1.[expr {[lindex $met 1]+8}] 
      .edit_enzyme.met.t$r tag configure bold -background red 
      bindtags .edit_enzyme.met.t$r [list all .]
      incr r
    }
  }

  grid [button .edit_enzyme.cancel -text [mc "Cancel"] -command "set ok2 -1"] -row 5 -column 1 -sticky nw -padx 10 -pady 3
  grid [button .edit_enzyme.ok -text [mc "OK"] -command "set ok2 1" -default active] -row 5 -column 0 -sticky nw -padx 10 -pady 3
  bind .edit_enzyme <Key-Return> ".edit_enzyme.ok invoke"
  #grab set .edit_enzyme
  wm deiconify .edit_enzyme
  vwait ok2
 
  #grab release .edit_enzyme
  destroy .edit_enzyme
  bind . <<RaiseDialogs>> $raisedialog_store

##if ok button pressed, accept changes
  if {$ok2 == 1} {
    #change comment
    set enzinfo(enz_comment,$enzyme) $new_comment

    #change groups
    foreach group $enzinfo(enz_groups_list) {
      if {($group != "Mem Recall") && ($group != "All") && ($group != "Difference...")} {
        if {$group_editenzyme($group) == 1} {
          if {[lsearch -exact $enzinfo(enz_groups,$group) $enzyme] == -1} {
            lappend enzinfo(enz_groups,$group) $enzyme
          }
        } else {
          set pos [lsearch -exact $enzinfo(enz_groups,$group) $enzyme]
          if {$pos > -1} {
            set enzinfo(enz_groups,$group) [lreplace $enzinfo(enz_groups,$group) $pos $pos]
          }
        }
      }
    }

    #change methylation 
    foreach dam_index [array names dam] {
      set pos [lsearch $damlist [list $enzyme [lindex $dam_index 0] [lindex $dam_index 1]]]
      if {($dam($dam_index) == 0) && ($pos > -1)} {
        set damlist [lreplace $damlist $pos $pos]
      } elseif {($dam($dam_index) == 1) && ($pos == -1)} {
        lappend damlist [list $enzyme [lindex $dam_index 0] [lindex $dam_index 1]]
      }
    }
    set damlist [lsort -index 0 $damlist]
    foreach dcm_index [array names dcm] {
      set pos [lsearch $dcmlist [list $enzyme [lindex $dcm_index 0] [lindex $dcm_index 1]]]
      if {($dcm($dcm_index) == 0) && ($pos > -1)} {
        set dcmlist [lreplace $dcmlist $pos $pos]
      } elseif {($dcm($dcm_index) == 1) && ($pos == -1)} {
        lappend dcmlist [list $enzyme [lindex $dcm_index 0] [lindex $dcm_index 1]]
      }
    }
    set dcmlist [lsort -index 0 $dcmlist]
    set enzinfo(enz_methylaselist) [list [list MDam $damlist] [list MDcm $dcmlist]] 
    set info(blocked_enzymes) [list]
    foreach methylase $enzinfo(enz_methylaselist) {
      foreach blocked_enzyme [lindex $methylase 1] {
        lappend info(blocked_enzymes) [lindex $blocked_enzyme 0]
      }
    }
    #add DpnI specifically
     #AbaSI AoxI BisI BlsI DpnI FspEI GlaI GluI KroI LpnPI MalI MspJI MteI PcsI PkrI SgeI
    foreach z [list DpnI MalI] {
      if {$z in $enzymes} {
        lappend info(blocked_enzymes) $z
      }
    }
    set info(blocked_enzymes) [lsort -unique $info(blocked_enzymes)]
    #rescan
    foreach window [dnawindows_list] {
      set info($window,scanned) 0
      findenzymes $window
    }
    #re-fill the selector box
    if {([winfo exists .enz_selector.textframe.textbox]) && ($parent_win == ".enz_selector")} {
      fill_enzymes_box .enz_selector.textframe.textbox .enz_selector.enz_comment $enz_select_window
    }
  }

  array unset group_editenzyme
  array unset dam
  array unset dcm
  unset -nocomplain new_comment
  return $ok2
}

###############
## add an enzyme group
###############
proc add_enz_group {parent_win enzyme_list} {
  global enz_select_groups
  global info
  global enzinfo
  global ok2

  toplevel .new_group
  wm title .new_group [mc "New Enzyme Group..."]
  wm protocol .new_group WM_DELETE_WINDOW "set ok2 -1"
  bind .new_group <KeyPress-Escape>  "set ok2 -1"
  set raisedialog_store [bind . <<RaiseDialogs>>]
  bind . <<RaiseDialogs>> "wm deiconify .new_group; raise .new_group"
  regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $parent_win] wgeom winx winy
  wm geometry .new_group "+[expr (($winx<0)?0:$winx)+20]+[expr (($winy<0)?0:$winy)+50]"
  wm transient .new_group $parent_win
  if {[tk windowingsystem] == "aqua"} {
    ::tk::unsupported::MacWindowStyle style .new_group document {closeBox}
  }
  set ok2 0

  label .new_group.namelabel -text [mc "Name:"]
  entry .new_group.name
  grid columnconfigure .new_group 1 -weight 1
  grid .new_group.namelabel -row 0 -column 0 -sticky w
  grid .new_group.name -row 0 -column 1 -sticky ew
 
  grid [button .new_group.cancel -text [mc "Cancel"] -command "set ok2 -1"] -row 3 -column 1 -sticky nw -padx 10 -pady 3
  grid [button .new_group.ok -text [mc "OK"] -command "set ok2 1" -default active] -row 3 -column 0 -sticky nw -padx 10 -pady 3
  bind .new_group <Key-Return> ".new_group.ok invoke"
  #grab set .new_group
  wm deiconify .new_group
  focus .new_group.name

  vwait ok2
  
  if {$ok2 == 1} {
    set newname [.new_group.name get]
    if {($newname == "All") || ($newname == "Mem Recall") || ($newname == "Difference...")} {
      tk_messageBox -default ok -title [mc "Unmodifyable Group..."] -message [mc "The group %s can't be modified." $newname]  -type ok -icon warning -default ok
    } elseif {[lsearch -exact $enzinfo(enz_groups_list) $newname] > -1} {
      if {[tk_messageBox -default no -title [mc "Group Exists..."] -message [mc "The group %s already exists. Should I replace the contents of the group with the curently selected enzymes?" $newname] -type yesno -icon warning -default no] == "yes" } {
        set enzinfo(enz_groups,$newname) $enzyme_list
      }  
    } else {
      set enzinfo(enz_groups_list) [lappend enzinfo(enz_groups_list) $newname]
      set enzinfo(enz_groups,$newname) $enzyme_list
      if {[winfo exists .enz_selector.groupsframe.groups_button] == 1} {
        .enz_selector.groupsframe.groups_button.menu delete 0 end
        foreach element $enzinfo(enz_groups_list) {
          .enz_selector.groupsframe.groups_button.menu add radiobutton -label $element -variable enz_select_groups -value $element 
        }
      }
      set info(enzymes_saved) 0
    }
  }

  destroy .new_group
  unset ok2
  wm deiconify $parent_win
  bind . <<RaiseDialogs>> $raisedialog_store
} 

###############
## delete an enzyme group
###############
proc delete_enz_group {parent_win} {
  global enz_select_groups
  global info
  global enzinfo
  global ok2

  toplevel .dialog
  wm protocol .dialog WM_DELETE_WINDOW "set ok2 -1"
  bind .dialog <KeyPress-Escape>  "set ok2 -1"
  wm title .dialog [mc "Delete Enzyme Groups..."]
  set raisedialog_store [bind . <<RaiseDialogs>>]
  bind . <<RaiseDialogs>> "wm deiconify .dialog; raise .dialog"
  regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $parent_win] wgeom winx winy
  wm geometry .dialog "+[expr (($winx<0)?0:$winx)+20]+[expr (($winy<0)?0:$winy)+50]"
  wm transient .dialog $parent_win
  if {[tk windowingsystem] == "aqua"} {
    ::tk::unsupported::MacWindowStyle style .dialog document {closeBox}
  }
  set ok2 0

  label .dialog.namelabel -text [mc "Groups:"]
  set h [llength $enzinfo(enz_groups_list)]
  if {$h > 10} {set h 10}
  listbox .dialog.grouplistbox -height $h -activestyle none -selectmode multiple -yscrollcommand ".dialog.groupscroll set"
  scrollbar .dialog.groupscroll -command ".dialog.grouplistbox yview"
  grid columnconfigure .dialog 0 -weight 1
  grid rowconfigure .dialog 1 -weight 1
  grid .dialog.namelabel -row 0 -column 0 -sticky w
  grid .dialog.grouplistbox -row 1 -column 0 -sticky nsew -columnspan 2
  grid .dialog.groupscroll -row 1 -column 2 -sticky nsw
 
  grid [button .dialog.cancel -text [mc "Cancel"] -command "set ok2 -1"] -row 2 -column 1 -sticky nw
  grid [button .dialog.ok -text [mc "Delete"] -command "set ok2 1"] -row 2 -column 0 -sticky nw

  foreach element $enzinfo(enz_groups_list) {
    if {($element != "All") && ($element != "Mem Recall") && ($element != "Difference...")} {
      .dialog.grouplistbox insert end $element 
    }
  }
  #grab set .dialog
  wm deiconify .dialog
  focus .dialog.grouplistbox

  vwait ok2
 
  #grab release .dialog
  
  if {$ok2 == 1} {
    set selection [.dialog.grouplistbox curselection]
    if {[llength $selection] > 0} {
      if {[llength $selection] > 1} {
        if {[tk_messageBox -default no -title [mc "Multiple Group Delete"] -message [format [mc {Are you sure you want to delete these %1$s groups?}] [llength $selection]] -type yesno -icon warning -default no] == "yes" } {
          foreach element $selection {  
            set groupname [.dialog.grouplistbox get $element]
            set index [lsearch -exact $enzinfo(enz_groups_list) $groupname]
            array unset enzinfo "enz_groups,$groupname" 
            set enzinfo(enz_groups_list) [lreplace $enzinfo(enz_groups_list) $index $index]
          }
        }  
      } else {
        set groupname [.dialog.grouplistbox get [lindex $selection 0]]
        set index [lsearch -exact $enzinfo(enz_groups_list) $groupname]
        array unset enzinfo "enz_groups,$groupname" 
        set enzinfo(enz_groups_list) [lreplace $enzinfo(enz_groups_list) $index $index]
      }
      if {[winfo exists .enz_selector.groupsframe.groups_button]} {
        .enz_selector.groupsframe.groups_button.menu delete 0 end
        foreach element $enzinfo(enz_groups_list) {
          .enz_selector.groupsframe.groups_button.menu add radiobutton -label $element -variable enz_select_groups -value $element 
        }
      }
      set info(enzymes_saved) 0
    }
  }

  destroy .dialog
  unset ok2
  wm deiconify $parent_win
  bind . <<RaiseDialogs>> $raisedialog_store
} 

###############
## load enzyme groups from file
###############
proc read_enz_groups {parent_win {filename ""}} {
  global info enzinfo enzymes

  if {$filename == ""} {
    if {[file isdir $info(default_enzymedir)]} {
      set filename [tk_getOpenFile -title [mc "Open Group List File"] -initialdir $info(default_enzymedir) -parent $parent_win -filetypes {{{Text Files} {.txt}} {{All Files} *}}]
    } else {
      set filename [tk_getOpenFile -title [mc "Open Group List File"] -parent $parent_win -filetypes {{{Text Files} {.txt}} {{All Files} *}}]
    }

    wm deiconify $parent_win; raise $parent_win
  }
  if {[file exists $filename]} {
    set f [open $filename r]
    set error 0
    while {([gets $f nextline] !=-1) && (!$error)} {
      if {([llength $nextline] == 2)} {
        set newname [lindex $nextline 0]
        set enzyme_list [lindex $nextline 1]
        
        set not_found [list]
        set found [list]
        foreach enz $enzyme_list {
          if {[lsearch -exact $enzymes $enz] == -1} {
            lappend not_found $enz
          } else {
            lappend found $enz
          }
        }
        if {[llength $not_found]} {
          tk_messageBox -title [mc "Enzymes Not Found..."] -message [mc "Group: %1\$s\nThe enzymes: %2\$s\nare not currently in the set of known enzymes." $newname $not_found] -type ok -icon warning
        }
        if {($newname == "All") || ($newname == "Mem Recall") || ($newname == "Difference...")} {
          tk_messageBox -default ok -title [mc "Unmodifyable Group..."] -message [mc "The group \%s can't be modified." $newname] -type ok -icon warning -default ok
        } elseif {[lsearch -exact $enzinfo(enz_groups_list) $newname] > -1} {
          if {[tk_messageBox -title [mc "Group Exists..."] -message [mc "The group %s already exists. Should I replace the contents of the group with the curently selected enzymes?" $newname] -type yesno -icon warning -default no] == "yes" } {
            set enzinfo(enz_groups,$newname) $found
          }  
        } else {
          set enzinfo(enz_groups_list) [lappend enzinfo(enz_groups_list) $newname]
          set enzinfo(enz_groups,$newname) $found
          set info(enzymes_saved) 0
        }
      } elseif {[regexp {[^[:space:]]} $nextline]} {
        set errorline $nextline
        set error 1
      }
    }
    if {(!$error)} {
      if {([winfo exists .enz_selector.groupsframe.groups_button])} {
        .enz_selector.groupsframe.groups_button.menu delete 0 end
        foreach element $enzinfo(enz_groups_list) {
          .enz_selector.groupsframe.groups_button.menu add radiobutton -label $element -variable enz_select_groups -value $element 
        }
      }
    } else {
      tk_messageBox -title [mc "Bad Group File Format"] -message "The file is improperly formatted starting at line:[string range $errorline 0 15]...\nThe file should contain a group name (with quotes if the name has spaces), a space, a brace {, a list of enzymes with spaces between, a brace }, a return. No tabs, no returns, except between groups.\nFor example: \n\"test group\" {EcoRI XbaI BamHI}\n\"test group2\" {SalI XmaI}" -type ok -icon warning
    }
  }
}


###############
## Save all enzyme groups to a file
###############
proc save_enz_groups {parent_win {filename ""}} {
  global enzinfo enzymes

  if {![file exists $filename]} {
    set filename [tk_getSaveFile -title [mc "Save Enzyme Groups File"] -parent $parent_win -defaultextension ".txt"  -filetypes {{"Text File" ".txt"}}]
  }
  while {($filename != "") && ([catch {set groups_file [open $filename w]}])} {
    catch {close $groups_file}
    tk_messageBox -title [mc "Feature File not Writable"] -message [mc "The file %s is not writable. It may be locked." $filename] -type ok -icon warning -default ok
    set filename [tk_getSaveFile -title [mc "Save Enzyme Groups File"] -defaultextension ".txt"  -filetypes {{"Text File" ".txt"}}]
  }

  if {$filename != ""} {
    foreach n [array names enzinfo enz_groups,*] {
      if {$n !={enz_groups,All} && $enzinfo($n) != {} && [lsearch -exact $enzymes [lindex $enzinfo($n) 0]] > -1} {
        puts $groups_file "\"[regsub "enz_groups," $n ""]\"\t\{$enzinfo($n)\}"
      }
    }
    close $groups_file
  }
}

###############
## import enzymes from a DNA Strider format enzyme file
###############
proc import_strider_enzymes {parent_win {filename ""}} {
  global info
  global enzymes
  global enzinfo
  global enz_select_window

  set newenz [list]

  if {$filename == ""} {
    if {[file isdir $info(default_enzymedir)]} {
      set filename [tk_getOpenFile -title [mc "Open DNA Strider enzymes file"] -initialdir $info(default_enzymedir) -parent $parent_win -filetypes {{{Text Files} {.txt}} {{All Files} *}}]
    } else {
      set filename [tk_getOpenFile -title [mc "Open DNA Strider enzymes file"] -parent $parent_win -filetypes {{{Text Files} {.txt}} {{All Files} *}}]
    }
    wm deiconify $parent_win; raise $parent_win
  }
  if {[file exists $filename]} {
    set f [open $filename r]
    while {([gets $f nextline] !=-1) && ([string index $nextline 0] !="%")} {
      if {([string index $nextline 0]!= ";") && ([regexp  {([^,]*),([^,]*),(.*)} $nextline line enzyme pattern comment] == 1)} {
        set enzyme [string trimleft $enzyme "#"]
        set pattern [string toupper $pattern]
        set pattern [string trimleft $pattern " N"]
        set pattern [string map "/ ^" $pattern]
        if {[regexp  {([-0-9]*),([-0-9]*),(.*)} $comment fill top bottom comment]} {
          set pattern "$pattern\($top/$bottom\)"
        }
        set comment "$comment $pattern"
        if {[lsearch $enzymes $enzyme] == -1} {
          add_enzyme $enzyme $pattern $comment
          lappend newenz $enzyme
        }
       
      }
    }
    tk_messageBox -message [mc "%s enzymes added." [llength $newenz] ] -type ok -icon info -default ok
    wm deiconify $parent_win; raise $parent_win
    if {[llength $newenz] > 0} {
      add_compatibles
      set enzinfo(enz_methylaselist) [met_list $enzymes $parent_win] 
      set info(blocked_enzymes) [list]
      foreach methylase $enzinfo(enz_methylaselist) {
        foreach blocked_enzyme [lindex $methylase 1] {
          lappend info(blocked_enzymes) [lindex $blocked_enzyme 0]
        }
      }
      #add DpnI specifically
      #AbaSI AoxI BisI BlsI DpnI FspEI GlaI GluI KroI LpnPI MalI MspJI MteI PcsI PkrI SgeI
      foreach z [list DpnI MalI] {
        if {$z in $enzymes} {
          lappend info(blocked_enzymes) $z
        }
      }
      set info(blocked_enzymes) [lsort -unique $info(blocked_enzymes)]
      #rescan
      foreach window [dnawindows_list] {
        set info($window,scanned) 0
        findenzymes $window
      }
      #re-fill the selector box
      if {[winfo exists .enz_selector.textframe.textbox] == 1} {
        fill_enzymes_box .enz_selector.textframe.textbox .enz_selector.enz_comment $enz_select_window
      }
      set info(enzymes_saved) 0
    }
    close $f
  }
  return $newenz
}


#################
## Copy selected enzyme data to clipboard, used by paste_enz_seleted
#################
proc copy_enz_seleted {s} {
  global enzinfo info
 
  set result [list]
  foreach enzyme $info(enz_currently_selected) {
    set r [list $enzyme $enzinfo(enz_pattern,$enzyme) $enzinfo(enz_comment,$enzyme)]
    set groups [list]
    foreach group $enzinfo(enz_groups_list) {
      if {$enzyme in $enzinfo(enz_groups,$group)} {
        lappend groups $group
      }
    }
    lappend r $groups
    set met_list [list]
    foreach met_data $enzinfo(enz_methylaselist) {
      foreach {met data} $met_data {
        lappend met_list [list $met [lsearch -all -exact -inline -index 0 $data $enzyme]]
      }
    }
    lappend r $met_list
    lappend result $r
  }
  clipboard clear;clipboard_append -displayof $s $result
  return $result
}


#################
## Add enzymes to the current set using data from clipboard, added using copy_enz_seleted
#################
proc paste_enz_seleted {s} {
  global enzinfo info enz_select_window enzymes
 
  if {[catch {set enz_list [selection get -displayof $s -selection CLIPBOARD]}]} {return}
  foreach e $enz_list {
    if {[llength $e] != 5} {
      tk_messageBox -message [mc "Clipboard is not in the correct format. Use Copy to Clipboard function first."] -type ok -icon warning -default ok
      break
    }
    foreach {enzyme pattern comment grouplist met_data} $e {}
sputs e $enzyme $pattern $comment $grouplist $met_data
    if {$enzyme in $enzymes} {
      continue
    } elseif {($enzyme != "" ) && ([string length $pattern] > 3) && ([lindex $grouplist 0] eq "All")} {
      if {$comment == ""} {
        set comment $pattern
      }
      add_enzyme $enzyme [string toupper $pattern] $comment

      add_compatibles

      foreach group $grouplist {
        if {[info exists enzinfo(enz_groups,$group)] && ($enzyme ni $enzinfo(enz_groups,$group))} {
          set enzinfo(enz_groups,$group) [lsort [lappend enzinfo(enz_groups,$group) $enzyme]]
        }
      }
      if {[lindex $met_data 0 0] eq "MDam" && [lindex $met_data 0 1] ne ""} {
        set new_list [lsort -index 0 -dictionary -unique [linsert [lindex $enzinfo(enz_methylaselist) 0 1] end {*}[lindex $met_data 0 1]]]
        lset enzinfo(enz_methylaselist) 0 1 $new_list
      }
      if {[lindex $met_data 1 0] eq "MDcm" && [lindex $met_data 1 1] ne ""} {
        set new_list [lsort -index 0 -dictionary -unique [linsert [lindex $enzinfo(enz_methylaselist) 1 1] end {*}[lindex $met_data 1 1]]]
        lset enzinfo(enz_methylaselist) 1 1 $new_list
      }
    }
  }
  foreach window [dnawindows_list] {
    set info($window,scanned) 0
    findenzymes $window
  }
  if {[winfo exists .enz_selector.textframe.textbox]} {
   fill_enzymes_box .enz_selector.textframe.textbox .enz_selector.enz_comment $enz_select_window
  }
  set info(enzymes_saved) 0
}

#################
## take selection and list those that overlap methylation sites
#################
proc met_list {selectedenzymes parent_win} {
  global enzymes
  global info
  global enzinfo
  global ok2

  set damenz [list AccIII AlwI BcgI BclI Bsa29I BsaBI BscFI BscI BseAI BseCI Bsh1365I BsiBI BsiMI BsiQI BsiXI Bsp106I BspDI BspEI BspHI BspPI BspXi BsrBRI BstENII BstKTI Bsu15I ClaI DpnII FbaI HphI Hpy188I Hpy188III Ksp22I MamI MboI MboII MflI NdeII NruI TaqI TthHB8I XbaI]
  set dcmenz [list AatI Acc65I AccB7I AlwNI ApaI Asp718I AvaII BalI BanI Bme1390I BpmI BsaI BsaHI BseLI BshNI BslI BsmFI Bsp120I BssKI BstXI CaiI Cfr13I CfrI DraII EaeI Eco31I Eco47I EcoO109I EcoRII GsuI MlsI MscI MspR9I NlaIV PflMI PpuMI PspGI PspOMI PspPI Sau96I ScrFI SexAI SfoI StuI StyD4I VpaK11BI]

  set a [toplevel .methylation_dialog]
  wm protocol .methylation_dialog WM_DELETE_WINDOW "set ok2 1"
  bind .methylation_dialog <KeyPress-Escape>  "set ok2 -1"
  wm title .methylation_dialog [mc "Verify Methylation..."]
  set raisedialog_store [bind . <<RaiseDialogs>>]
  bind . <<RaiseDialogs>> "wm deiconify .methylation_dialog; raise .methylation_dialog"
  regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $parent_win] wgeom winx winy
  wm geometry .methylation_dialog "+[expr (($winx<0)?0:$winx)+20]+[expr (($winy<0)?0:$winy)+50]"
  wm transient .methylation_dialog $parent_win
  if {[tk windowingsystem] == "aqua"} {
    ::tk::unsupported::MacWindowStyle style .methylation_dialog document {closeBox}
  }

  set ok2 0


  grid [label .methylation_dialog.label1 -text [mc {Dam blocked:}]] -row 0 -column 1 -sticky nw
  grid [listbox $a.damlist -yscrollcommand "$a.damscroll set" -selectmode multiple] -row 1 -column 1 -sticky nwe
  grid [scrollbar $a.damscroll -command "$a.damlist yview" -orient vertical] -row 1 -column 2 -sticky nswe
 # bind $a <MouseWheel> "event generate $a.damlist <MouseWheel> -delta %D"
  grid [label .methylation_dialog.label2 -text [mc {Dcm blocked:}]] -row 0 -column 4 -sticky nw
  grid [listbox $a.dcmlist -yscrollcommand "$a.dcmscroll set" -selectmode multiple] -row 1 -column 4 -sticky nwe
  grid [scrollbar $a.dcmscroll -command "$a.dcmlist yview" -orient vertical] -row 1 -column 5 -sticky nswe
  grid [button $a.ok -text [mc OK] -command "set ok2 1"] -row 2 -column 1 -sticky n
  grid columnconfigure $a.damlist 0 -weight 0
  grid columnconfigure $a.damlist 1 -weight 1
  grid columnconfigure $a.damlist 2 -weight 0
  grid columnconfigure $a.damlist 3 -weight 0
  grid columnconfigure $a.damlist 4 -weight 1
  grid columnconfigure $a.damlist 5 -weight 0

  foreach element $selectedenzymes {
    set pattern $enzinfo(flatpat,$element) 
    #regsub -all {\(([0-9]|[/-])*\)} $pattern "" pattern
    #regsub "\\^" $pattern "" pattern
    #set pattern [string trim $pattern "N"]

    set pattern "NN[append pattern NN]"
    set metlist [list]
    if {[set found [regexp -all -inline -indices {(?:[GBDKNRSV][ADHMRVW][TBDHKNWY][CBHMNSVY])|(?:[GBDKNRSV][ADHMNRVW][TBDHKWY][CBHMNSVY])} $pattern]] != 0 } {
      foreach index $found {
        set metlist [list]
        lappend metlist [expr {[lindex $index 0]-2}] [expr {[string length $pattern]-[lindex $index 0]-6}]
        set metlist [lsort -integer $metlist]
        if {[$a.damlist get end] != "$element $metlist" } {
          $a.damlist insert end "$element $metlist"
          if {[lsearch $damenz $element] > -1} {$a.damlist selection set end}
        }
      }
    }
    set pattern "N[append pattern N]"
    set metlist [list]
    if {[set found [regexp -inline -all -indices {(?:[CBHMNSVY][CBHMSVY][ATBDHKMNRVWY][GBDKNRSV][GBDKNRSV])|(?:[CBHMNSVY][CBHMNSVY][ATBDHKMNRVWY][GBDKRSV][GBDKNRSV])} $pattern]] !=0} {
      foreach index $found {
        set metlist [list]
        lappend metlist [expr {[lindex $index 0]-3}] [expr {[string length $pattern]-[lindex $index 0]-8}]
        set metlist [lsort -integer $metlist]
        if {[$a.dcmlist get end] != "$element $metlist" } {
          $a.dcmlist insert end "$element $metlist"
          if {[lsearch $dcmenz $element] > -1} {$a.dcmlist selection set end}
        }
      }
    }
  }

  #grab set $a
  wm deiconify $a; raise $a
  focus $a.damlist

  vwait ok2

  #grab release $a
  foreach element [$a.damlist curselection] {
    lappend dam_methylated_enzymes [$a.damlist get $element]
  }
  foreach element [$a.dcmlist curselection] {
    lappend dcm_methylated_enzymes [$a.dcmlist get $element]
  }
  set methylated_enzymes [list [list MDam $dam_methylated_enzymes] [list MDcm $dcm_methylated_enzymes]]
  destroy .methylation_dialog
  set ok2 0
  bind . <<RaiseDialogs>> $raisedialog_store
  return $methylated_enzymes
}

###############
## edit the DNA ladders file
###############
proc edit_ladders {w} {
  global info temp_info ok dialogblock
  if {$dialogblock == 1} {return}
  set dialogblock 1

  set temp_info(current_ladder) $info(current_ladder)
  set temp_info(ladderlist) $info(ladderlist)

  toplevel .dialog
  wm title .dialog [mc "Ladders..."]
  wm protocol .dialog WM_DELETE_WINDOW "set ok -1"
  bind .dialog <KeyPress-Escape>  "set ok -1"
  bind . <<RaiseDialogs>> "wm deiconify .dialog; raise .dialog"
  regexp {[0-9]*x[0-9]*\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry $w] wgeom winx winy
  wm geometry .dialog "+[expr (($winx<0)?0:$winx)+3]+[expr (($winy<0)?0:$winy)+50]"
  wm transient .dialog $w
  if {[tk windowingsystem] == "aqua"} {
    ::tk::unsupported::MacWindowStyle style .dialog document {closeBox}
  }
  set ok 0

  grid [frame .dialog.listframe -relief ridge -borderwidth 2] -row 0 -column 1 -sticky nswe
  grid [frame .dialog.ladderframe -relief ridge -borderwidth 2] -row 0 -column 2 -sticky nswe
  grid [frame .dialog.okframe -relief ridge -borderwidth 2] -row 1 -column 1 -columnspan 2 -sticky nswe
  grid rowconfigure .dialog 0 -weight 1
  grid columnconfigure .dialog 1 -weight 1

  grid [listbox .dialog.listframe.list -selectmode single -bg $info(text_bg_color) -yscrollcommand "optionscrollbar .dialog.listframe.scroll"  -width 40] -row 0 -column 0 -columnspan 2 -sticky nswe
  grid [scrollbar .dialog.listframe.scroll -command ".dialog.listframe.list yview"] -row 0 -column 2 -sticky nsw
  grid [button .dialog.listframe.add -text [mc "Add New"] -command "event generate .dialog.listframe.list <<add>>"] -row 1 -column 0 -sticky we
  grid [button .dialog.listframe.delete -text [mc "Delete"] -command "event generate .dialog.listframe.list <<delete>>"] -row 1 -column 1 -sticky we
  grid [button .dialog.listframe.raise -text [mc "Raise"] -command "event generate .dialog.listframe.list <<raise>>"] -row 2 -column 0 -sticky we
  grid [button .dialog.listframe.lower -text [mc "Lower"] -command "event generate .dialog.listframe.list <<lower>>"] -row 2 -column 1 -sticky we
  grid [button .dialog.listframe.load -text [mc "Load..."] -command "event generate .dialog.listframe.list <<load>>"] -row 3 -column 0 -sticky we
  grid [button .dialog.listframe.save_as -text [mc "Save As"] -command "event generate .dialog.listframe.list <<save_as>>"] -row 3 -column 1 -sticky we
  grid rowconfigure .dialog.listframe 0 -weight 1
  grid columnconfigure .dialog.listframe 0 -weight 1
  grid columnconfigure .dialog.listframe 1 -weight 1

  grid [label .dialog.ladderframe.l1 -text [mc "Ladder:"]] -row 0 -column 0 -columnspan 2 -stick nwe
  grid [entry .dialog.ladderframe.ladd_name -bg $info(text_bg_color) -textvariable temp_info(ladder_entry) -width 40] -row 1 -column 0 -columnspan 2 -stick nwe
  grid [canvas .dialog.ladderframe.ladder -bg $info(graphic_bg_color) -height 300 -width 10] -row 2 -column 0 -columnspan 2 -sticky nsew
  grid [label .dialog.ladderframe.l2 -text [mc "Band:"]] -row 3 -column 0 -columnspan 2 -stick nwe
  grid [entry .dialog.ladderframe.band -bg $info(text_bg_color) -validate key -validatecommand {expr {![regexp {[^0-9]} %P]}}] -row 4 -column 0 -columnspan 2 -sticky nwe
  grid [button .dialog.ladderframe.add -text [mc "Add"] -command {if {[.dialog.ladderframe.band get] != ""} {set temp_info(ladder,$temp_info(current_ladder)) [lsort -decreasing -integer [lappend temp_info(ladder,$temp_info(current_ladder)) [.dialog.ladderframe.band get]]]; event generate .dialog <<update_ladder>>}}] -row 5 -column 0 -sticky we
  grid [button .dialog.ladderframe.delete -text [mc "Delete"] -command {set temp_info(ladder,$temp_info(current_ladder)) [lsort -decreasing -integer [lsearch -inline -not -all $temp_info(ladder,$temp_info(current_ladder)) [.dialog.ladderframe.band get]]]; event generate .dialog <<update_ladder>>}] -row 5 -column 1 -sticky we
  grid rowconfigure .dialog.ladderframe 2 -weight 1



  bind .dialog.ladderframe.band <Key-Return> {if {[.dialog.ladderframe.band get] != ""} {set temp_info(ladder,$temp_info(current_ladder)) [lsort -decreasing -integer [lappend temp_info(ladder,$temp_info(current_ladder)) [.dialog.ladderframe.band get]]]; event generate .dialog <<update_ladder>>}}

  grid [button .dialog.okframe.ok -text [mc "OK"] -command "set ok 1"] -row 0 -column 0 -sticky n
  grid columnconfigure .dialog.okframe 0 -weight 1

##binding to re-draw the ladder
  bind .dialog <<update_ladder>> {
    .dialog.ladderframe.ladder delete bands
    if {([.dialog.listframe.list size] > 0)} {
      if {($temp_info(ladder,$temp_info(current_ladder)) != "")} {
        .dialog.ladderframe.delete configure -state normal
        #redraw the current ladder in the canvas
        set longfrag [lindex $temp_info(ladder,$temp_info(current_ladder)) 0]
        set shortfrag [lindex $temp_info(ladder,$temp_info(current_ladder)) end]
        while {$shortfrag < 1} {
          set temp_info(ladder,$temp_info(current_ladder)) [lrange $temp_info(ladder,$temp_info(current_ladder)) 0 end-1]
          set shortfrag [lindex $temp_info(ladder,$temp_info(current_ladder)) end]
        }
        if {$shortfrag != ""} {
          if {$shortfrag != $longfrag} {
            set gelscale [expr {210.0/(log10($longfrag)- log10($shortfrag))}]
            set gelorigin [expr {30.0 + $gelscale * log10($longfrag) }]
          } else {
            set gelscale 0
            set gelorigin 30
          }

          #draw ladder
          set lastladderband 0

          foreach band $temp_info(ladder,$temp_info(current_ladder)) {
            if {$lastladderband != $band} {
              if {[lindex $band 0] > 0} {
                .dialog.ladderframe.ladder create line [expr {5}] [expr {$gelorigin - $gelscale * log10($band)}] [expr {55}] [expr {$gelorigin - $gelscale *log10($band)}] -width 3 -capstyle round -fill black -tags [list bands ladderband$band scalable]
              }
              .dialog.ladderframe.ladder bind ladderband$band <Any-Enter> ".dialog.ladderframe.ladder itemconfigure laddertext -text [string range $band 0 end-3][expr {([string length $band]>3)?",":{}}][string range $band end-2 end]"
              .dialog.ladderframe.ladder bind ladderband$band <Any-Leave> ".dialog.ladderframe.ladder itemconfigure laddertext -text {}"
              .dialog.ladderframe.ladder bind ladderband$band <Button-1> ".dialog.ladderframe.band delete 0 end;.dialog.ladderframe.band insert 0 $band"
              set lastladderband $band
            } else {
              .dialog.ladderframe.ladder itemconfigure ladderband$band -width [expr {[.dialog.ladderframe.ladder itemcget ladderband$band -width]+1}]
            }
          }
        }
      } else {
        .dialog.ladderframe.delete configure -state disabled
      }
    }     
  } 

##binding to change to a different ladder in listbox
  bind .dialog.listframe.list <<ListboxSelect>> {
    if {[.dialog.listframe.list curselection] != ""} {
      set temp_info(ladder_entry) [.dialog.listframe.list get [.dialog.listframe.list curselection]]
    } else {
      set temp_info(ladder_entry) ""
    }
    set temp_info(current_ladder) $temp_info(ladder_entry)
    event generate .dialog <<update_ladder>> 
  }

##binding to raise a ladder in the list
  bind .dialog.listframe.list <<raise>> {
    if {[.dialog.listframe.list size] > 0} {
      set i [.dialog.listframe.list curselection]
      if {$i > 0} {
        set item1 [.dialog.listframe.list get $i]
        .dialog.listframe.list delete $i
        incr i -1
        set item2 [.dialog.listframe.list get $i]
        .dialog.listframe.list insert $i $item1
        .dialog.listframe.list selection set $i
        set temp_info(ladderlist) [lreplace $temp_info(ladderlist) $i [expr {$i+1}] $item1 $item2]
        event generate .dialog <<update_ladder>>
      } else {bell}
    }
  }
##binding to lower a ladder in the list
  bind .dialog.listframe.list <<lower>> {
    if {[.dialog.listframe.list size] > 0} {
      set i [.dialog.listframe.list curselection]
      if {$i < [expr {[.dialog.listframe.list size]-1}]} {
        set item1 [.dialog.listframe.list get $i]
        .dialog.listframe.list delete $i
        set item2 [.dialog.listframe.list get $i]
        incr i 1
        .dialog.listframe.list insert $i $item1
        .dialog.listframe.list selection set $i
        set temp_info(ladderlist) [lreplace $temp_info(ladderlist) [expr {$i-1}] $i $item2 $item1]
        event generate .dialog <<update_ladder>>
      } else {bell}
    }
  }
##binding to delete a ladder in the list
  bind .dialog.listframe.list <<delete>> {
    if {[.dialog.listframe.list size] > 0} {
      set i [.dialog.listframe.list curselection]
      .dialog.listframe.list delete $i
      set temp_info(ladderlist) [lreplace $temp_info(ladderlist) $i $i]
      array unset temp_info "ladder,$temp_info(current_ladder)"
      if {$i == [.dialog.listframe.list size]} {incr i -1}
      .dialog.listframe.list selection set $i
      set temp_info(ladder_entry) [.dialog.listframe.list get $i]
      set temp_info(current_ladder) $temp_info(ladder_entry)
      event generate .dialog <<update_ladder>>
    }
    if {[.dialog.listframe.list size] == 0} {
      .dialog.listframe.delete configure -state disabled
      .dialog.ladderframe.add configure -state disabled
      .dialog.ladderframe.delete configure -state disabled
      .dialog.ladderframe.ladd_name configure -state disabled
      .dialog.ladderframe.band configure -state disabled
    }
    if {[.dialog.listframe.list size] <= 1} {
      .dialog.listframe.raise configure -state disabled
      .dialog.listframe.lower configure -state disabled
    }
  }
##binding to add a new ladder to the list
  bind .dialog.listframe.list <<add>> {
    if {[.dialog.listframe.list size] == 0} {
      .dialog.listframe.delete configure -state normal
      .dialog.ladderframe.add configure -state normal
      .dialog.ladderframe.delete configure -state normal
      .dialog.ladderframe.ladd_name configure -state normal
      .dialog.ladderframe.band configure -state normal
      set i 0
    } else {
      set i [.dialog.listframe.list curselection]
    }
    set new_name "New Ladder"
    set j 0
    while {[lsearch -exact $temp_info(ladderlist) $new_name] > -1} {incr j; set new_name "New Ladder($j)"}
    .dialog.listframe.list insert $i $new_name
    .dialog.listframe.list selection clear 0 end
    .dialog.listframe.list selection set $i
    set temp_info(ladder_entry) $new_name
    set temp_info(current_ladder) $new_name
    set temp_info(ladderlist) [linsert $temp_info(ladderlist) $i $new_name]
    set temp_info(ladder,$new_name) [list]
    event generate .dialog <<update_ladder>>
    if {[.dialog.listframe.list size] > 1} {
      .dialog.listframe.raise configure -state normal
      .dialog.listframe.lower configure -state normal
    }
  }
##binding to load ladders from a file
  bind .dialog.listframe.list <<load>> {
    set was_empty 0
    if {[.dialog.listframe.list size] == 0} {
      set was_empty 1
    }
    if {[file exists [file join $info(user_defaults_dir) "DNA_ladders"]]} {set initdir [file join $info(user_defaults_dir) "DNA_ladders"]} else {set initdir $info(user_defaults_dir)}
    set filename [tk_getOpenFile -parent .dialog -title [mc "Load ladder file"] -initialdir $initdir -filetypes {{{Text Files} {.txt}} {{All Files} *}}]
    if {[file exists $filename] == 1} {
      set fileid [open $filename r]
      set i [.dialog.listframe.list size]
      while {[eof $fileid] != 1} {
        set a [gets $fileid]
        if {([string index $a 0] != "#") && ($a !="")} {
          set name [lindex [split $a "\t"] 0]
          set new_name $name
          set j 0
          while {[lsearch -exact $temp_info(ladderlist) $new_name] > -1} {incr j; set new_name "$name\($j)"}
          .dialog.listframe.list insert $i $new_name
          set sizes [lindex [split $a "\t"] 1]
          if {[llength $sizes] > 0} {
            if {[catch {set sizes [lsort -decreasing -integer $sizes]}] != 0} {
              warning_dialog "Misformatted ladder file" $name $sizes
            } else {
              lappend temp_info(ladderlist) $new_name
              set temp_info(ladder,$new_name) $sizes
              incr i
            }
          }
        }
      }
      close $fileid
    } 
    event generate .dialog <<update_ladder>>
    if {[.dialog.listframe.list size] > 1} {
      .dialog.listframe.delete configure -state normal
      .dialog.ladderframe.add configure -state normal
      .dialog.ladderframe.delete configure -state normal
      .dialog.ladderframe.ladd_name configure -state normal
      .dialog.ladderframe.band configure -state normal
      .dialog.listframe.raise configure -state normal
      .dialog.listframe.lower configure -state normal
      if {$was_empty == 1} {
        .dialog.listframe.list selection set 0
        set temp_info(ladder_entry) [.dialog.listframe.list get 0]
        set temp_info(current_ladder) [.dialog.listframe.list get 0]
      }
    }
  }
##binding to save current state into a file
  bind .dialog.listframe.list <<save_as>> {
    set filename [tk_getSaveFile -title [mc "Save Ladders File"] -defaultextension ".txt"  -filetypes {{"Text File" ".txt"}}]
    if {$filename == ""} break
    set err [catch {set temp_ladder_file [open $filename w]} save_err]
    if {![file writable $filename] || $err} {close $filename; tk_messageBox -message [mc "Can't save the ladders file- possibly locked."] -type ok -icon error; break}
    puts $temp_ladder_file "#comment lines start with #"
    puts $temp_ladder_file "#enter each new ladder on a new line"
    puts $temp_ladder_file "#start with the name of the ladder"
    puts $temp_ladder_file "#THEN A TAB"
    puts $temp_ladder_file "#then the fragment sizes (decreasing order), separated by a space"
    puts $temp_ladder_file "#no commas in the sizes."
    puts $temp_ladder_file "#enter a band twice or more to make it drawn thicker"
    foreach ladder $temp_info(ladderlist) {
      puts $temp_ladder_file "$ladder\t$temp_info(ladder,$ladder)"
    }
    close $temp_ladder_file
  }
##binding to change the name of a ladder
  bind .dialog.ladderframe.ladd_name <Key-Return> {
    if {[.dialog.listframe.list size] > 0} {
      set pos [.dialog.listframe.list curselection]
      if {[.dialog.listframe.list get $pos] != $temp_info(ladder_entry)} {
        if {[lsearch -exact $temp_info(ladderlist) $temp_info(ladder_entry)] == -1} {
          .dialog.listframe.list delete $pos
          .dialog.listframe.list insert $pos $temp_info(ladder_entry)
          .dialog.listframe.list selection set $pos
          set temp_info(ladderlist) [lreplace $temp_info(ladderlist) $pos $pos $temp_info(ladder_entry)]

          set temp_info(ladder,$temp_info(ladder_entry)) $temp_info(ladder,$temp_info(current_ladder))
          array unset temp_info "ladder,$temp_info(current_ladder)"
          set temp_info(current_ladder) $temp_info(ladder_entry)
        } else {
          bell
          set temp_info(ladder_entry) [.dialog.listframe.list get $pos]
        }
      }
    }
  }

  bind .dialog.ladderframe.ladd_name <FocusOut> [bind .dialog.ladderframe.ladd_name <Key-Return>]

  .dialog.ladderframe.ladder create text 10 10 -text "" -tags laddertext -fill $info(graphic_fg_color) -anchor nw

  foreach ladder $temp_info(ladderlist) {
    .dialog.listframe.list insert end $ladder
    set temp_info(ladder,$ladder) $info(ladder,$ladder)
  }
  .dialog.listframe.list selection set [lsearch $temp_info(ladderlist) $temp_info(current_ladder)]
  update idletasks
  event generate .dialog.listframe.list <<ListboxSelect>>
  if {[.dialog.listframe.list size] == 0} {
    .dialog.listframe.delete configure -state disabled
    .dialog.ladderframe.add configure -state disabled
    .dialog.ladderframe.delete configure -state disabled
    .dialog.ladderframe.ladd_name configure -state disabled
    .dialog.ladderframe.band configure -state disabled
  }
  if {[.dialog.listframe.list size] <= 1} {
    .dialog.listframe.raise configure -state disabled
    .dialog.listframe.lower configure -state disabled
  }

  regexp {([0-9]*)x([0-9]*)\+(-?[0-9]*)\+(-?[0-9-]*)} [wm geometry .dialog] wgeom winw winh winx winy
  if {[expr {$winx+$winw}] > [winfo screenwidth .]} {set winx [expr {[winfo screenwidth .]-$winw}]}
  if {$winx < 0} {set winx 0}
  if {[expr {$winy+$winh}] > [winfo screenheight .]} {set winy [expr {[winfo screenheight .]-$winh}]}
  if {$winy < 0} {set winy 0}
  wm geometry .dialog "+$winx+$winy"
  update idletasks

  focus .dialog
  vwait ok 
  set dialogblock 0
  destroy .dialog
  bind . <<RaiseDialogs>> ""

  ###execute changes
  if {$ok == 1} {
    set info(current_ladder) $temp_info(current_ladder)
    set info(ladderlist) $temp_info(ladderlist)
    array unset info "ladder,*"
    foreach ladder $temp_info(ladderlist) {
      set info(ladder,$ladder) $temp_info(ladder,$ladder)
    }
    ###need to update the ladder menus on all dna windows
    update_ladders_menu
    ###need to save the new ladder list
    set temp_ladder_file [open [file join $info(user_defaults_dir) temp_ladderq_qqrx.txt] w]
    
    puts $temp_ladder_file "#comment lines start with #"
    puts $temp_ladder_file "#enter each new ladder on a new line"
    puts $temp_ladder_file "#start with the name of the ladder"
    puts $temp_ladder_file "#THEN A TAB"
    puts $temp_ladder_file "#then the fragment sizes (decreasing order), separated by a space"
    puts $temp_ladder_file "#no commas in the sizes."
    puts $temp_ladder_file "#enter a band twice or more to make it drawn thicker"
    foreach ladder $info(ladderlist) {
      puts $temp_ladder_file "$ladder\t$info(ladder,$ladder)"
    }
    close $temp_ladder_file
    if {[file exists [file join $info(user_defaults_dir) DNA_ladders.txt]]} {
      file delete [file join $info(user_defaults_dir) DNA_ladders.txt]
      file rename [file join $info(user_defaults_dir) temp_ladderq_qqrx.txt] [file join $info(user_defaults_dir) DNA_ladders.txt]
    }
  }
  unset ok
  array unset temp_info
}

proc update_ladders_menu {{window_list {}}} {
  global info modstring
  if {$window_list == {}} {
    set window_list [lsearch -inline -all -regexp -not [winfo children .] {abi|analysis|menubar|dialog}]
  }
  foreach win $window_list {
    if {[catch {$win.menubar.enzymes.ladders delete 0 end} err]} {
      sputs ladder menu error $err
      continue
    }
    foreach entry $info(ladderlist) {
      $win.menubar.enzymes.ladders add radiobutton -label $entry -value $entry -variable info(current_ladder)
    }
    $win.menubar.enzymes.ladders add separator
    $win.menubar.enzymes.ladders add command -label [mc "Edit Ladders..."] -command "edit_ladders $win"
  }
}

###############
## read the DNA ladders file
###############
proc read_ladders {{filename ""}} {
  global info
  set info(ladderlist) [list]

  if {$filename == ""} {
    set filename [file join $info(user_defaults_dir) "DNA_ladders.txt"]
  }
  if {[file exists $filename]} {
    set fileid [open $filename r]
    while {[eof $fileid] != 1} {
      set a [gets $fileid]
      if {([string index $a 0] != "#") && ($a !="")} {
        set name [lindex [split $a "\t"] 0]
        set sizes [lindex [split $a "\t"] 1]
        if {[llength $sizes] > 0} {
          if {[catch {set sizes [lsort -decreasing -integer $sizes]}] != 0} {
            warning_dialog "Misformatted ladder file" $name $sizes
          } else {
            lappend info(ladderlist) $name
            set info(ladder,$name) $sizes
          }
        }
      }
    }
    close $fileid
  } 
  if {[llength $info(ladderlist)] == 0} {
    set info(ladder,) [list]
    set info(current_ladder) ""
  } else {
    set info(current_ladder) [lindex $info(ladderlist) 0]
  }
}

###############
## read the arrow data file
###############
proc read_arrow_data {{filename ""}} {
  global info
  set info(arrowlist) [list]
  set info(arrow_dict) [list]

  if {$filename == ""} {
    #set filename [file join $info(user_defaults_dir) "Arrow_List.txt"]
    set filename [file join $info(Accdir) "Arrow_List.txt"]
  }
  set r [list]
  if {[file exists $filename] && [file readable $filename]} {
    set fileid [open $filename r]
    set r [list]
    while {[eof $fileid] != 1} {
      set a [string trim [gets $fileid] " "]
      if {([string index $a 0] != "#") && ($a != "")} {
        lappend r $a
      }
    }
    close $fileid
  } 

   #set r {H1 >d1 >d2 d3 H2 >d4}
   #set r {H1 >d1 >d2 d3 H2 >H3 >>d4 >H4 >>d5 d6}
   #set r {H1 d1 d2 d3 H2 d4}
  set result [list]
  set header_list {-1}
  foreach line $r {
    if {[regexp {^([>]*)(.*)} $line - depth data]} {
      if {[string first \t $data] >-1} {
        set data [split $data \t]
      }
      set data [lrange $data 0 1]

      if {[llength $data] == 2} {
        set pts_data [lindex $data 0]
        if {[dict exists $pts_data pts]} {
          set pts_data [dict get $pts_data pts]
        }
        if {[llength $pts_data] % 2} {
          sputs odd number of arrow data: $line
          continue
        } 
        set bad 0
        foreach d $pts_data {
          if {![string is double $d]} {set bad 1;break}
        }
        if {$bad} {
          sputs bad arrow data: $line
          continue
        }
        lappend info(arrow_dict) {*}$data
      } else {
        set data [list $data]
      }
      set depth [string length $depth]
      if {$depth == [expr {[llength $header_list]-1}]} {
        lset header_list $depth [expr {1 + [lindex $header_list $depth]}]
      } elseif {$depth < [expr {[llength $header_list]-1}]} {
        set header_list [lrange $header_list 0 $depth]
        lset header_list $depth [expr {1 + [lindex $header_list $depth]}]
      } else {
        lappend header_list 1
      }
      lset result {*}$header_list $data
    } else {
      sputs bad data in arrow file $line
    }
     #sputs $header_list $result
  }

  set info(arrowlist) $result
  return {}
}


###############
## Put arrow data into a menu form
###############
proc fill_arrow_menu {m arrow_list variable textvariable command} {
  set value [uplevel #0 set $variable]
  set n 0
  foreach e $arrow_list {
    if {[llength [lindex $e 0]] == 1} {
      $m add cascade -menu [menu $m.menu$n] -label [lindex $e 0 0]
      fill_arrow_menu $m.menu$n [lrange $e 1 end] $variable $textvariable $command
      incr n
    } else {
      $m add radiobutton -label [lindex $e 1] -variable $textvariable -value [lindex $e 1] -command "set $variable [list [lindex $e 0]]; $command"
      if {$value eq [lindex $e 0]} {
        uplevel #0 set $textvariable [list [lindex $e 1]]
      }
    }
  }
}

###############
## read the global defaults file
###############
proc read_defaults {} {
  global info

  set filename [file join $info(user_defaults_dir) "ApE_Defaults.txt"]
  if {[file exists $filename] && [file readable $filename]} {
    set fileid [open $filename r]
    while {[eof $fileid] != 1} {
      set a [gets $fileid]
      if {([string index $a 0] != "#") && ([llength [set b [split $a \t]]] == 2)} {
        set info([lindex $b 0]) [lindex $b 1]
      } elseif {([string index $a 0] != "#") && ($a != "")} {
        sputs error in defaults file: $a
      }
    }
    close $fileid
  } 

  if ![font metrics \{$info(textfontfamily)\} -fixed] {
   set info(textfontfamily) [font actual courier -family]
  }
  if {[expr {[llength $info(keysubstmap)] % 2}] != 0} {
    set info(keysubstmap) [list]
  }
  #a windows pref file on mac looks awful
  set replace [expr {([tk windowingsystem] !="win32") && ($info(bg_color) == "SystemButtonFace")}]

  foreach {index color} $info(system_default_colors) {
    if {$replace || [catch {winfo rgb . $info($index)}]} {
      sputs bad color in defaults:$index $info($index), set to: $color
      set info($index) $color
    }
    set info($index\,light) $info($index)
  }
  foreach {index color} $info(system_default_colors,dark) {
    if {$replace || [catch {winfo rgb . $info($index\,dark)}]} {
      sputs bad color in defaults:$index $info($index,dark), set to: $color
      set info($index,dark) $info($index)
    }
  }
}

###############
## shows a msg box for debugging values
###############
proc warning_dialog {args} { 
  tk_messageBox -message [join [join [list $args] ""] ""] -icon warning -type ok
}


#################################
## main ########################
#################################
## initialize globals
set winum 0
set abiwinum 0
set longnamelist [list]
set hexlist [list]
set enzymes [list]
set info(empty_genbank_header) [list {LOCUS       } {} {DEFINITION  } {.} {ACCESSION   } {} {VERSION     } {} {SOURCE      } {.} {  ORGANISM  } {.}]

array set info [list]
set info(enzymes_saved) 1
set info(mac_antialias_limit) 0
set info(cancel_scroll) ""
set info(mousewheelunits) 120
set info(hide_scrollbar) 0
set info(clock_format) "%a %b %d, %Y %k:%M %Z"
set info(last_update_check) {}
##bug in file writable for windows - set to 1 if windows is reporting wrong values for file writable
set info(lock_bug) 0
#set info(update_check_interval) -1
#set info(clock_format) "%c"

if {[tk windowingsystem] eq "aqua"} {
  set info(use_png_images) 1
  set info(bbedit_bug) 1
} else {
  set info(use_png_images) 1
  set info(bbedit_bug) 0
}


set info(max_open_previous) 5
set info(open_previous) [list]
set info(open_at_close) [list]
set info(restore_on_startup) 1
set info(use_aqua_system_windows_menu) 1

set info(seguid_mode) 1
set info(seguid_notify_on_invalid) 0
set info(seguid_copy_mode) 1

### set up system default colors from system widget defaults
if {![catch {winfo rgb .  systemWindowBackgroundColor}]} {
  ## Moden Mac Semantic color values
  set info(bg_color) systemWindowBackgroundColor
  set info(label_fg_color) systemLabelColor
  set info(label_disabled_fg_color) systemDisabledControlTextColor
  set info(menu_bg_color) #FFFFFF
  set info(menu_fg_color) #000000
  set info(menu_select_bg_color) #FF0000
  set info(menu_select_fg_color) #000000
  set info(text_bg_color) systemTextBackgroundColor
  set info(text_fg_color) systemTextColor
  set info(graphic_bg_color) systemTextBackgroundColor
  set info(graphic_fg_color) systemTextColor
  set info(text_select_bg_color) systemSelectedTextBackgroundColor
  #set info(text_select_fg_color) systemSelectedTextColor
  set info(text_select_fg_color) white
  set info(text_select2_bg_color) systemHighlightSecondary
  set info(text_select2_fg_color) white
  set info(dnafontsize) [lindex [font actual TkDefaultFont] 3] ;#[lindex [.temp cget -font] 0]
} else {
  if {[tk windowingsystem] != "aqua"} {
    set info(bg_color) [. cget -background]
  } else {
    set info(bg_color) systemDialogBackgroundActive
  }
  label .temp
  set info(label_fg_color) [.temp cget -foreground]
  set info(label_disabled_fg_color) [.temp cget -disabledforeground]
  set info(dnafontsize) [lindex [font actual [.temp cget -font]] 3] ;#[lindex [.temp cget -font] 0]
  destroy .temp
  menu .m
  set info(menu_bg_color) [.m cget -background]
  set info(menu_fg_color) [.m cget -foreground]
  set info(menu_select_bg_color) [.m cget -activebackground]
  set info(menu_select_fg_color) [.m cget -activeforeground]
  destroy .m
  text .t
  set info(text_bg_color) [.t cget -background]
  set info(text_fg_color) [.t cget -foreground]
  set info(graphic_bg_color) [.t cget -background]
  set info(graphic_fg_color) [.t cget -foreground]
  set info(text_select_bg_color) [.t tag cget sel -background]
  set info(text_select_fg_color) [.t tag cget sel -foreground]
  if {$info(text_select_fg_color) == {}} {
    set info(text_select_fg_color) white
  }
  if {[tk windowingsystem] == "aqua"} {
    set info(text_select2_bg_color) systemHighlightSecondary
  } else {
    set info(text_select2_bg_color)  [.t tag cget sel -background]
  }
  set info(text_select2_fg_color) $info(text_select_fg_color)
  destroy .t
}

set info(system_default_colors) [list]
foreach value [list bg_color menu_bg_color menu_fg_color menu_select_bg_color menu_select_fg_color text_bg_color text_fg_color text_select_bg_color text_select_fg_color text_select2_bg_color text_select2_fg_color graphic_fg_color graphic_bg_color label_fg_color label_disabled_fg_color] {
  lappend info(system_default_colors) $value $info($value)
  set info($value\,light) $info($value)
  set info($value\,dark) $info($value)
}
unset value

## Set some potential default dark mode colors here, if not on a modern mac with semantic colors
if {[catch {winfo rgb .  systemWindowBackgroundColor}] || [catch {tk::unsupported::MacWindowStyle appearance . [tk::unsupported::MacWindowStyle appearance .]}]} {
  set info(bg_color,dark) #334
  set info(label_fg_color,dark) #d1d2d3
  set info(label_disabled_fg_color) #b1b2b3
  set info(menu_bg_color,dark) #555
  set info(menu_select_bg_color,dark) [mix_color $info(menu_select_bg_color,light) #000 70]
  if {[tk windowingsystem] != "aqua"} {
    set info(menu_fg_color,dark) #d1d2d3
    set info(menu_select_fg_color,dark) #fff
  } else {
    set info(menu_fg_color,dark) $info(menu_fg_color)
    set info(menu_select_fg_color,dark) $info(menu_select_fg_color)
  }
  set info(text_bg_color,dark)  #1a1d21
  set info(text_fg_color,dark) #FFF
  set info(graphic_bg_color,dark)  #1a1d21
  set info(graphic_fg_color,dark) #FFF
  set info(text_select_bg_color,dark) [mix_color $info(text_select_bg_color,light) #000 70]
  set info(text_select_fg_color,dark) #000
  set info(text_select2_bg_color,dark) gray50
  set info(text_select2_fg_color,dark) $info(text_select_fg_color,dark)
} else {
  set info(text_select_fg_color,dark) black
  set info(text_select2_fg_color,dark) $info(text_select_fg_color,dark)
}

set info(system_default_colors,dark) [list]
foreach value [dict keys $info(system_default_colors)] {
  lappend info(system_default_colors,dark) $value $info($value,dark)
}

set info(dark_mode) 0
set info(user_set_dark_mode) -1


set info(toolbar_size) 16
set info(toolbar_compound) image
set info(toolbar_label_font) "Helvetica"
set info(toolbar_label_size) 10
set info(default_textarea_width) 75
set info(feature_table_minsize) 5
set info(seq_tooltip_alpha) .8
set info(enzyme_highlight_color) red
set info(ui_icon_color) Green
set info(enzyme_highlight_font) dnafont
set info(enzyme_highlight_underline) 0
set info(enzyme_highlight_transparent) 0
set info(color_feature_table_tags) 0
set info(sequence_transparency_mode) overlap
set info(sequence_transparency) 0
set info(find_forward_highlight) gray75
set info(find_reverse_highlight) gray50
set info(find_wrap) 1
set info(show_comment) 1
set info(comment_height) 3
set info(graphic_map_properties) ""
set info(circ_map_radius) 100
set info(circ_map_feature_names_centered) 1
set info(linear_map_bump_label) 0
set info(enz_currently_selected) [list]
set info(enz_selector_keep_open) 0
set info(enz_selector_width) 8
set info(recomb_keep_open) 0
set info(ligation_wizard_keep_open) 0
set info(golden_gate_assembler_keep_open) 0
set info(golden_gate_assembler_allow_linear) 0
set info(golden_gate_assembler_treat_circular) 0
set info(golden_gate_assembler_oligos_frags) [list]
set info(enz_text_dialog_order) [list index enzymes dna translation sec_strand genes features space]
set info(enz_text_dna_numbers) "Both"
set info(enz_text_show_index) 1
set info(enz_text_index_char1) "*"
set info(enz_text_index_spacing1) 10
set info(enz_text_index_nums) 1
set info(enz_text_index_char2) "*"
set info(enz_text_index_spacing2) 5
set info(enz_text_index_char3) " "
set info(enz_text_show_features) 1
set info(enz_text_show_hidden_features) 0
set info(enz_text_crop_features) 0
set info(enz_text_2nd) 0
set info(enz_text_genes) 0
set info(enz_text_graphic_map) 0
set info(enz_text_show_trans) 0
set info(enz_text_trans) "1_1"
set info(enz_text_show_enz) 0
set info(enz_text_enz) "all"
set info(enz_text_show_space) 1
set info(enz_text_space) 2
set info(enz_text_width) 100
set info(enz_text_copy_highlight) 1
set info(enz_digest_dialog_preserve_info) 1
set info(enz_list_enz) "all"
set info(enz_list_mode_number) 0
set info(enz_list_columns) 6
set info(enz_make_diag_enz) "selected"
set info(enz_make_diag_mm) 1
set info(gel_min_gray) 10
set info(find_casens) 0
set info(find_revcom) 1
set info(find_as_aa) 0
set info(find_as_literal) 0
set info(find_pattern) ""
set info(find_allow_mm_number) 0
set info(find_action) "next"
set info(find_max_3_bases) "All"
set info(allowedkeys) "ACGTNacgtn*"
set info(graphicfontfamily) [font actual Helvetica -family]
set info(textfontfamily) [font actual TkFixedFont -family]
set info(fixedfontlist) [list]
set info(allfontlist) [lsearch -inline -all -regexp -not [lsort -dictionary [font families]] {[^a-z,0-9,A-Z,\ ,\}\{\_\(\)\-]}]
set info(graphicfontsize) $info(dnafontsize); #10
set info(print_font_size) 8
set info(print_formatted) 0
set info(tk_ps_fonts) [list] 
set info(draw_graphic_connectors) 1
set info(strider_incompatible_warning) 1
set info(methylated_default) 1
set info(translation_window_code) 1
set info(translation_window_spacing) 0
set info(translation_window_revcom) 0
set info(translation_window_width) 20
set info(translation_window_line_numbers) none
set info(translation_window_index_line) 0
set info(translation_window_dna_line) none
set info(translation_window_copy_highlight) 1
set info(clipboard_tags) [list]
set info(show_FeatureTable) 1
set info(selection_shows_Trans) 0
set info(selection_shows_Trans_upper) 0
set info(selection_shows_Trans_dir) 0
set info(selection_shows_Tm) 0
#set info(selection_shows) "None"
set info(clipboard_text) ""
set info(keysubstmap) {}
set info(find_orf_starts) "Met"
set info(find_orf_strand) 1
set fea_info(library) [list]
set info(feature_default_fcolor) cyan
set info(feature_default_rcolor) green
## bezier arrow data change here
set info(feature_default_gformat) [list arrow_data [list [list 0 0.5 0 1 2 0 0 -1 0 -0.5] [list 0 .5 .1 .5 .1 -.5 0 -.5] 0] width 5 offset 0]

if {[tk windowingsystem] != "aqua"} {
  set info(antialias_show) 1
} else {
  set info(antialias_show) 0
}
set info(antialias_percent) 30
set info(antialias_width) 1

set info(inline_mode) 1
set info(inline_canvas_fixed_height) 0

set info(selection_on_top) 1
set info(inline_canvas_space_height) 1 
set info(inline_show_second_strand) 1
set info(feature_transparency) 0
set info(feature_default_type_colors) [list V_segment {cyan green} repeat_unit {{#ff6666} #ff6666} promoter {{#346ee0} #346ee0} SNP {{#7e59d5} #7e59d5} misc_signal {{#008040} #008040} polyA_signal {{#ff3eee} #ff3eee}  LTR {#86f71d #d7336f} primer_bind {{#14c0bd} #4ec02b} misc_recomb {{#8080ff} #da6a3b} repeat_region {{#0dfff7} #0dfff7} enhancer {{#5ac3fa} #5ac3fa} full_transcript {{#ff2074} #ff2074} coding_exon {{#ae1e5f} #ae1e5f} variation {{#ff9e39} #ff9e39} misc_binding {{#ff4809} #ff4809} rep_origin {{#999999} #999999} mRNA {cyan cyan} misc_feature {{#7eff74} #7eff74} gene {{#ff797d} #ff102f} RBS {cyan cyan} five_prime_UTR {{#d1d5ca} #d1d5ca} prim_transcript {{#ffe34b} #ffe34b} polyA_site {cyan cyan} exon {{#c83a90} #c83a90} CDS {{#e9d024} #e9d024} intron {{#eb606c} #eb606c} -35_signal {cyan green} UTR {{#526ba2} #526ba2} modified_base {{#92ff65} #92ff65} misc_structure {{#ff6462} #ff6462} deletion {{#1f5250} #1f5250} 3'UTR {{#f76ca1} #008040} terminator {{#9d1b1c} #9d1b1c} substitution {{#ff6ff1} #ff6ff1} ncRNA_primary_transcript {{#ff29a8} #5fd5a3} three_prime_UTR {{#c5c0c6} #c5c0c6} 5'UTR {{#ffd327} #ffd327} primer {{#00ffff} #80ff00}]
set info(feature_default_type_gformat) [list]
set info(feature_color_favorites) [list]
set info(transp_feature_color) "#FFFFFF"
set info(feature_scan_on_close) 1
set info(align_select_window2) ""
set info(align_select_region1) all
set info(align_select_region2) all
set info(align_select_rc1) "forward"
set info(align_select_rc2) "forward"
set info(align_linewidth) 100
set info(align_phredtrim) 0
set info(align_trim_to_alignment) 0
set info(align_show_seq_names) 0
set info(mm_penalty) -0.1
set info(gap_penalty) -1
set info(gap_extension_penalty) -0.2
set info(NWmax) 5000
set info(ignore_NWmax) 1
set info(align_blocksize) 15
set info(align_copy_highlight) 0
set info(align_windows_dict) [dict create]
set info(default_dnadir) [valid_default_dir]
set info(pieces_dir_list) [list]
set info(dnadir_follows_open) 1
set info(default_featuredir) ""
set info(featuredir_follows_open) 1
set info(default_file_extension) .ape
set info(fasta_search_file) ""
set info(default_file_format) GenBank
set info(genbank_strict_genbank) 0
set info(genbank_skip_blank) 0
set info(save_file_format_warning) 1
set info(ApE_version) ""
set info(leopard_dialog_bug) 0
if {$info(android)} {
  set info(aqua_active_bg_color) gray78
} else {
  if {$tcl_platform(osVersion) < 22} {
    set info(aqua_active_bg_color) systemButtonFrameInactive
  } else {
    set info(aqua_active_bg_color) gray98
  }
}

set info(autosave_max_bkp_files) 4
set info(autosave_max_dir_files) 200
#set info(autosave_max_dir_mb) 300; not implemented
set info(autosave_max_age_days) 366
set info(autosave_minutes) 2
set info(autosave_on) 0
set info(autosave_dir) ""
set info(autosave_after) [list]

set info(ncbi_blast,program) "blastn"
set info(ncbi_blast,low_filter) 1
set info(ncbi_blast,expect) 100
set info(ncbi_blast,database) "nr"

set info(wb_blast,program) "blastn"

set info(speak_use_aqua) 1
set info(speak_use_words) 0
set info(speak_voice) {}
set info(speak_delay) 500

set info(entrez,max_hits) 25

set info(wb_blast,expect) 0.01
set info(wb_blast,database) "C. elegans genomic"


set info(rev_gg_max_mismatch) 1
set info(rev_gg_max_ry_mismatch) 0

set info(gib_min_overlap) 12
set info(gib_max_overlap) 100
set info(gib_max_nonhom) 0
set info(gib_double_nonhom) 0
set info(gib_require_circ) 1
set info(gib_max_fragments) 10

set info(pcr_primer_database) [list]

set info(gibson_wizard_default_tm) 59
set info(gibson_wizard_default_g_tm) 55
set info(gibson_wizard_default_tail) 0
set info(gibson_wizard_default_tail_side) 1
set info(gibson_wizard_default_add_linkers) 1
set info(gibson_wizard_default_gibson_deletion) 1
set info(gibson_wizard_exo_side) 5
set info(gibson_wizard_exo_side) 5
set info(gibson_wizard_add_amplicon_features) 0

##########
## Read a file of "/allowed_subtype (tab) type" lines and build list
## of type (allowed_types_list)
##########
## This contains old data
proc read_genbank_subtypes {} {
  set f {C:/My documents/programming/ApE/genbank_subfeatures.txt}
  set fileid [open $f r]
  while {[eof $fileid] != 1} {lappend lines [gets $fileid]}
  close $fileid

  set type ""
  regexp {/(.*)\t(.*)} [lindex $lines 0] line a b
  set type $b
  set proplist [list $a]
  foreach line [lrange $lines 1 end] {
    regexp {/(.*)\t(.*)} $line line a b
    if {$type ne $b} {
      lappend result [list $type $proplist]
      set type $b
      set proplist [list $a]
    } else {
      lappend proplist $a
    }
  }
lappend result [list $type $proplist]
set resultlist {{-10_signal {allele citation db_xref evidence gene label locus_tag map note old_locus_tag operon standard_name usedin}} {-35_signal {allele citation db_xref evidence gene label locus_tag map note old_locus_tag operon standard_name usedin}} {3'clip {allele citation db_xref evidence function gene label locus_tag map note old_locus_tag standard_name usedin}} {3'UTR {allele citation db_xref evidence function gene label locus_tag map note old_locus_tag standard_name usedin}} {5'clip {allele citation db_xref evidence function gene label locus_tag map note old_locus_tag standard_name usedin}} {5'UTR {allele citation db_xref evidence function gene label locus_tag map note old_locus_tag standard_name usedin}} {attenuator {allele citation db_xref evidence gene label locus_tag map note old_locus_tag operon phenotype usedin}} {C_region {allele citation db_xref evidence gene label locus_tag map note old_locus_tag product pseudo standard_name usedin}} {CAAT_signal {allele citation db_xref evidence gene label locus_tag map note old_locus_tag usedin}} {CDS {allele citation codon codon_start db_xref EC_number evidence exception function gene label locus_tag map note number old_locus_tag operon product protein_id pseudo standard_name transl_except transl_table translation usedin}} {conflict {allele citation compare db_xref evidence gene label locus_tag map note old_locus_tag replace usedin}} {D_segment {allele citation db_xref evidence gene label locus_tag map note old_locus_tag product pseudo standard_name usedin}} {D-loop {allele citation db_xref evidence gene label locus_tag map note old_locus_tag usedin}} {enhancer {allele bound_moiety citation db_xref evidence gene label locus_tag map note old_locus_tag standard_name usedin}} {exon {allele citation db_xref EC_number evidence function gene label locus_tag map note number old_locus_tag product pseudo standard_name usedin}} {gap {estimated_length map note}} {GC_signal {allele citation db_xref evidence gene label locus_tag map note old_locus_tag usedin}} {gene {allele citation db_xref evidence function gene label locus_tag map note old_locus_tag operon phenotype product pseudo standard_name usedin}} {iDNA {allele citation db_xref evidence function gene label locus_tag map note number old_locus_tag standard_name usedin}} {intron {allele citation cons_splice db_xref evidence function gene label locus_tag map note number old_locus_tag standard_name usedin}} {J_segment {allele citation db_xref evidence gene label locus_tag map note old_locus_tag product pseudo standard_name usedin}} {LTR {allele citation db_xref evidence function gene label locus_tag map note old_locus_tag standard_name usedin}} {mat_peptide {allele citation db_xref EC_number evidence function gene label locus_tag map note old_locus_tag product pseudo standard_name usedin}} {misc_binding {allele bound_moiety citation db_xref evidence function gene label locus_tag map note old_locus_tag usedin}} {misc_difference {allele citation clone compare db_xref evidence gene label locus_tag map note old_locus_tag phenotype replace standard_name usedin}} {misc_feature {allele citation db_xref evidence function gene label locus_tag map note number old_locus_tag phenotype product pseudo standard_name usedin}} {misc_recomb {allele citation db_xref evidence gene label locus_tag map note old_locus_tag organism standard_name usedin}} {misc_RNA {allele citation db_xref evidence function gene label locus_tag map note old_locus_tag operon product standard_name usedin}} {misc_signal {allele citation db_xref evidence function gene label locus_tag map note old_locus_tag operon phenotype standard_name usedin}} {misc_structure {allele citation db_xref evidence function gene label locus_tag map note old_locus_tag standard_name usedin}} {modified_base {allele citation db_xref evidence frequency gene label locus_tag map mod_base note old_locus_tag usedin}} {mRNA {allele citation db_xref evidence exception function gene label locus_tag map note old_locus_tag operon product pseudo standard_name usedin}} {N_region {allele citation db_xref evidence gene label locus_tag map note old_locus_tag product pseudo standard_name usedin}} {old_sequence {allele citation compare db_xref evidence gene label locus_tag map note old_locus_tag replace usedin}} {operon {allele citation db_xref evidence function label map note operon phenotype pseudo standard_name usedin}} {oriT {allele bound_moiety citation db_xref direction evidence gene label locus_tag map note old_locus_tag rpt_family rpt_type rpt_unit standard_name usedin}} {polyA_signal {allele citation db_xref evidence gene label locus_tag map note old_locus_tag usedin}} {polyA_site {allele citation db_xref evidence gene label locus_tag map note old_locus_tag usedin}} {precursor_RNA {allele citation db_xref evidence function gene label locus_tag map note old_locus_tag operon product standard_name usedin}} {prim_transcript {allele citation db_xref evidence function gene label locus_tag map note old_locus_tag operon standard_name usedin}} {primer_bind {allele citation db_xref evidence gene label locus_tag map note old_locus_tag PCR_conditions standard_name usedin}} {promoter {allele bound_moiety citation db_xref evidence function gene label locus_tag map note old_locus_tag operon phenotype pseudo standard_name usedin}} {protein_bind {allele bound_moiety citation db_xref evidence function gene label locus_tag map note old_locus_tag standard_name usedin}} {RBS {allele citation db_xref evidence gene label locus_tag map note old_locus_tag standard_name usedin}} {rep_origin {allele citation db_xref direction evidence gene label locus_tag map note old_locus_tag standard_name usedin}} {repeat_region {allele citation db_xref evidence function gene insertion_seq label locus_tag map note old_locus_tag rpt_family rpt_type rpt_unit standard_name transposon usedin}} {repeat_unit {allele citation db_xref evidence function gene label locus_tag map note old_locus_tag rpt_family rpt_type rpt_unit usedin}} {rRNA {allele citation db_xref evidence function gene label locus_tag map note old_locus_tag product pseudo standard_name usedin}} {S_region {allele citation db_xref evidence gene label locus_tag map note old_locus_tag product pseudo standard_name usedin}} {satellite {allele citation db_xref evidence gene label locus_tag map note old_locus_tag rpt_family rpt_type rpt_unit standard_name usedin}} {scRNA {allele citation db_xref evidence function gene label locus_tag map note old_locus_tag product pseudo standard_name usedin}} {sig_peptide {allele citation db_xref evidence function gene label locus_tag map note old_locus_tag product pseudo standard_name usedin}} {snoRNA {allele citation db_xref evidence function gene label locus_tag map note old_locus_tag product pseudo standard_name usedin}} {snRNA {allele citation db_xref evidence function gene label locus_tag map note old_locus_tag product pseudo standard_name usedin}} {source {cell_line cell_type chromosome citation clone clone_lib country cultivar db_xref dev_stage ecotype environmental_sample focus frequency germline haplotype isolate isolation_source lab_host label macronuclear map mol_type note organelle organism plasmid pop_variant proviral rearranged segment serotype serovar sex specific_host specimen_voucher strain sub_clone sub_species sub_strain tissue_lib tissue_type transgenic usedin variety virion}} {stem_loop {allele citation db_xref evidence function gene label locus_tag map note old_locus_tag operon standard_name usedin}} {STS {allele citation db_xref evidence gene label locus_tag map note old_locus_tag standard_name usedin}} {TATA_signal {allele citation db_xref evidence gene label locus_tag map note old_locus_tag usedin}} {terminator {allele citation db_xref evidence gene label locus_tag map note old_locus_tag operon standard_name usedin}} {transit_peptide {allele citation db_xref evidence function gene label locus_tag map note old_locus_tag product pseudo standard_name usedin}} {tRNA {allele anticodon citation db_xref evidence function gene label locus_tag map note old_locus_tag product pseudo standard_name usedin}} {unsure {allele citation compare db_xref evidence gene label locus_tag map note old_locus_tag replace usedin}} {V_region {allele citation db_xref evidence gene label locus_tag map note old_locus_tag product pseudo standard_name usedin}} {V_segment {allele citation db_xref evidence gene label locus_tag map note old_locus_tag product pseudo standard_name usedin}} {variation {allele citation compare db_xref evidence frequency gene label locus_tag map note old_locus_tag phenotype product replace standard_name usedin}}}
}


## global variables for genbank type structures
## see http://www.insdc.org/documents/feature_table.html#3.3 for qualifiers (need to be able to edit qualifiers with - boxes, + at the end and a re-order)

set genbank_typelist [list -10_signal -35_signal 3'UTR 3'clip 5'UTR 5'clip CAAT_signal CDS C_region D-loop D_segment GC_signal J_segment LTR N_region RBS STS S_region TATA_signal V_region V_segment assembly_gap attenuator centromere conflict enhancer exon gap gene iDNA intron mRNA mat_peptide misc_RNA misc_binding misc_difference misc_feature misc_recomb:meiotic misc_recomb:mitotic misc_recomb:non_allelic_homologous misc_recomb:chromosome_breakpoint misc_recomb:other misc_signal misc_structure mobile_element modified_base ncRNA ncRNA:antisense_RNA ncRNA:autocatalytically_spliced_intron ncRNA:ribozyme ncRNA:hammerhead_ribozyme ncRNA:lncRNA ncRNA:RNase_P_RNA ncRNA:RNase_MRP_RNA ncRNA:telomerase_RNA ncRNA:guide_RNA ncRNA:sgRNA ncRNA:rasiRNA ncRNA:scRNA ncRNA:scaRNA ncRNA:siRNA ncRNA:pre_miRNA ncRNA:miRNA ncRNA:piRNA ncRNA:snoRNA ncRNA:snRNA ncRNA:SRP_RNA ncRNA:vault_RNA ncRNA:Y_RNA ncRNA:circRNA ncRNA:other old_sequence operon oriT polyA_signal polyA_site precursor_RNA prim_transcript primer_bind promoter propeptide protein_bind rRNA regulatory regulatory:attenuator regulatory:CAAT_signal regulatory:DNase_I_hypersensitive_site regulatory:enhancer regulatory:enhancer_blocking_element regulatory:GC_signal regulatory:imprinting_control_region regulatory:insulator regulatory:locus_control_region regulatory:matrix_attachment_region regulatory:minus_35_signal regulatory:minus_10_signal regulatory:polyA_signal_sequence regulatory:promoter regulatory:recoding_stimulatory_region regulatory:replication_regulatory_region regulatory:response_element regulatory:ribosome_binding_site regulatory:riboswitch regulatory:silencer regulatory:TATA_box regulatory:terminator regulatory:transcriptional_cis_regulatory_region regulatory:other rep_origin repeat_region repeat_unit satellite scRNA sig_peptide snRNA snoRNA source stem_loop tRNA telomere terminator tmRNA transit_peptide unsure variation] 

set genbank_divided_typelist [list Genes [list CDS exon intron gene 5'UTR 3'UTR polyA_site mRNA operon prim_transcript regulatory:promoter regulatory:ribosome_binding_site regulatory:polyA_signal_sequence precursor_RNA propeptide ] Regulatory [list regulatory:attenuator regulatory:CAAT_signal regulatory:DNase_I_hypersensitive_site regulatory:enhancer regulatory:enhancer_blocking_element regulatory:GC_signal regulatory:imprinting_control_region regulatory:insulator regulatory:locus_control_region regulatory:matrix_attachment_region regulatory:minus_35_signal regulatory:minus_10_signal regulatory:polyA_signal_sequence regulatory:promoter regulatory:recoding_stimulatory_region regulatory:replication_regulatory_region regulatory:response_element regulatory:ribosome_binding_site regulatory:riboswitch regulatory:silencer regulatory:TATA_box regulatory:terminator regulatory:transcriptional_cis_regulatory_region regulatory:other] Signals [list rep_origin  polyA_site sig_peptide transit_peptide mat_peptide] Binding [list primer_bind protein_bind misc_binding] Variation [list variation assembly_gap gap unsure STS unsure modified_base misc_difference old_sequence] RNA [list mRNA rRNA tRNA tmRNA ncRNA:antisense_RNA ncRNA:autocatalytically_spliced_intron ncRNA:ribozyme ncRNA:hammerhead_ribozyme ncRNA:lncRNA ncRNA:RNase_P_RNA ncRNA:RNase_MRP_RNA ncRNA:telomerase_RNA ncRNA:guide_RNA ncRNA:sgRNA ncRNA:rasiRNA ncRNA:scRNA ncRNA:scaRNA ncRNA:siRNA ncRNA:pre_miRNA ncRNA:miRNA ncRNA:piRNA ncRNA:snoRNA ncRNA:snRNA ncRNA:SRP_RNA ncRNA:vault_RNA ncRNA:Y_RNA ncRNA:circRNA ncRNA:other misc_RNA] Misc [list source misc_feature misc_binding  repeat_region misc_recomb:meiotic misc_recomb:mitotic misc_recomb:non_allelic_homologous misc_recomb:chromosome_breakpoint misc_recomb:other misc_recomb misc_structure mobile_element centromere telomere iDNA stem_loop D-loop oriT] Deprecated [list  enhancer promoter RBS CAAT_signal TATA_signal -35_signal -10_signal GC_signal polyA_signal terminator attenuator misc_signal  LTR  repeat_unit satellite conflict scRNA snRNA snoRNA ncRNA 5'clip 3'clip] Ig [list C_region D_segment J_segment N_region S_region V_region V_segment]] 


set genbank_unquoted_qualifiers [list codon_start transl_table direction mod_base anticodon citation compare estimated_length number protein_id rpt_unit_range translation transl_except]

set genbank_mandatory_qualifiers [list assembly_gap {estimated_length gap_type} gap estimated_length misc_binding bound_moiety mobile_element mobile_element_type modified_base mod_base operon operon protein_bind bound_moiety source {organism mol_type}]

set genbank_qualifier_values [list allele text altitude text anticodon "pos:<location>,aa:<amino_acid>,seq:<text>" artificial_location {{heterogeneous population sequenced} {low-quality sequence region}} bio_material {[<institution-code>:[<collection-code>:]]<material_id>} bound_moiety text cell_line text cell_type text chromosome text circular_RNA none citation {[integer-number]} clone text clone_lib text codon_start {1 2 3} collected_by text collection_date {DD-Mmm-YYYY Mmm-YYYY YYYY} compare {[accession-number.sequence-version]} country {<country_value>[:<region>][, <locality>]} cultivar text culture_collection {<institution-code>:[<collection-code>:]<culture_id>} db_xref <database:identifier> dev_stage text direction {left right both} EC_number text ecotype text environmental_sample none estimated_length {"unknown or <integer>"} exception {{RNA editing} {reasons given in citation} {rearrangement required for product} {annotated by transcript or proteomic data}} experiment {[CATEGORY:]text} focus none frequency text function text gap_type {{between scaffolds} {within scaffold} telomere centromere {short arm} heterochromatin {repeat within scaffold} {repeat between scaffolds} contamination unknown} gene text gene_synonym text germline none haplogroup text haplotype text host text identified_by text inference {[CATEGORY:]TYPE[ (same species)][:EVIDENCE_BASIS]} isolate text isolation_source text lab_host text lat_lon text linkage_evidence {pcr paired-ends {align genus} {align xgenus} {align trnscpt} {within clone} {clone contig} map strobe {proximity ligation} unspecified} locus_tag text macronuclear none map text mating_type text metagenome_source text mobile_element_type {<mobile_element_type>[:<mobile_element_name>]} mod_base modified_base mol_type {"genomic DNA" "genomic RNA" "mRNA" "tRNA" "rRNA" "other RNA" "other DNA" "transcribed RNA" "viral cRNA" "unassigned DNA" "unassigned RNA"} ncRNA_class {antisense_RNA autocatalytically_spliced_intron ribozyme hammerhead_ribozyme lncRNA RNase_P_RNA RNase_MRP_RNA telomerase_RNA guide_RNA sgRNA rasiRNA scRNA scaRNA siRNA pre_miRNA miRNA piRNA snoRNA snRNA SRP_RNA vault_RNA Y_RNA circRNA other} note text number {unquoted text (single token)} old_locus_tag text operon text organelle {chromatophore hydrogenosome mitochondrion nucleomorph plastid mitochondrion:kinetoplast plastid:chloroplast plastid:apicoplast plastid:chromoplast plastid:cyanelle plastid:leucoplast plastid:proplastid} organism text partial none PCR_conditions text PCR_primers {{[fwd_name: XXX1, ]fwd_seq: xxxxx1,[fwd_name: XXX2,]fwd_seq: xxxxx2, [rev_name: YYY1, ]rev_seq: yyyyy1,[rev_name: YYY2, ]rev_seq: yyyyy2}} phenotype text plasmid text pop_variant text product text protein_id <identifier> proviral none pseudo none pseudogene {processed unprocessed unitary allelic unknown} rearranged none recombination_class {meiotic mitotic non_allelic_homologous chromosome_breakpoint other} regulatory_class {attenuator CAAT_signal DNase_I_hypersensitive_site enhancer enhancer_blocking_element GC_signal imprinting_control_region insulator locus_control_region matrix_attachment_region minus_35_signal minus_10_signal polyA_signal_sequence promoter recoding_stimulatory_region replication_regulatory_region response_element ribosome_binding_site riboswitch silencer TATA_box terminator transcriptional_cis_regulatory_region other} replace text ribosomal_slippage none rpt_family text rpt_type {tandem direct inverted flanking nested dispersed terminal long_terminal_repeat non_ltr_retrotransposon_polymeric_tract centromeric_repeat telomeric_repeat x_element_combinatorial_repeat y_prime_element other} rpt_unit_range <base_range> rpt_unit_seq text satellite {<satellite_type>[:<class>][ <identifier>]} segment text serotype text serovar text sex text specimen_voucher {[<institution-code>:[<collection-code>:]]<specimen_id>} standard_name text strain text sub_clone text submitter_seqid text sub_species text sub_strain text tag_peptide <base_range> tissue_lib text tissue_type text transgenic none translation {IUPAC one-letter amino acid abbreviation, "X" is to be used for AA exceptions.} transl_except (pos:<location>,aa:<amino_acid>) transl_table {<integer> 1-31 1=universal table 1;2=non-universal table 2;...} trans_splicing none type_material text variety text]


set genbank_feature_key_qualifiers {assembly_gap {estimated_length gap_type linkage_evidence} C_region {allele citation db_xref experiment gene gene_synonym inference locus_tag map note old_locus_tag product pseudo pseudogene standard_name} CDS {allele artificial_location circular_RNA citation codon_start db_xref EC_number exception experiment function gene gene_synonym inference locus_tag map note number old_locus_tag operon product protein_id pseudo pseudogene ribosomal_slippage standard_name translation transl_except transl_table trans_splicing} centromere {citation db_xref experiment inference note standard_name} D-loop {allele citation db_xref experiment gene gene_synonym inference locus_tag map note old_locus_tag} D_segment {allele citation db_xref experiment gene gene_synonym inference locus_tag map note old_locus_tag product pseudo pseudogene standard_name} exon {EC_number allele citation db_xref experiment function gene gene_synonym inference locus_tag map note number old_locus_tag product pseudo pseudogene standard_name trans_splicing} gap {estimated_length experiment inference map note} gene {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype product pseudo pseudogene standard_name trans_splicing} iDNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note number old_locus_tag standard_name} intron {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note number old_locus_tag pseudo pseudogene standard_name trans_splicing} J_segment {allele citation db_xref experiment gene gene_synonym inference locus_tag map note old_locus_tag product pseudo pseudogene standard_name} mat_peptide {EC_number allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag product pseudo pseudogene standard_name} misc_binding {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag} misc_difference {allele citation clone compare db_xref experiment gene gene_synonym inference locus_tag map note old_locus_tag phenotype replace standard_name} misc_feature {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note number old_locus_tag phenotype product pseudo pseudogene standard_name} misc_recomb {allele citation db_xref experiment gene gene_synonym inference locus_tag map note old_locus_tag recombination_class standard_name} misc_RNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} misc_structure {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag standard_name} mobile_element {allele citation db_xref experiment function gene gene_synonym inference locus_tag map mobile_element_type note old_locus_tag rpt_family rpt_type standard_name} modified_base {allele citation db_xref experiment frequency gene gene_synonym inference locus_tag map mod_base note old_locus_tag} mRNA {allele artificial_location circular_RNA citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} ncRNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map ncRNA_class note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} N_region {allele citation db_xref experiment gene gene_synonym inference locus_tag map note old_locus_tag product pseudo pseudogene standard_name} old_sequence {allele citation compare db_xref experiment gene gene_synonym inference locus_tag map note old_locus_tag replace} operon {allele citation db_xref experiment function inference map note operon phenotype pseudo pseudogene standard_name} oriT {allele bound_moiety citation db_xref direction experiment gene gene_synonym inference locus_tag map note old_locus_tag rpt_family rpt_type rpt_unit_range rpt_unit_seq standard_name} polyA_site {allele citation db_xref experiment gene gene_synonym inference locus_tag map note old_locus_tag} precursor_RNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product standard_name trans_splicing} prim_transcript {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon standard_name} primer_bind {PCR_conditions allele citation db_xref experiment gene gene_synonym inference locus_tag map note old_locus_tag standard_name} propeptide {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag product pseudo pseudogene standard_name} protein_bind {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon standard_name} regulatory {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene regulatory_class standard_name} repeat_region {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag rpt_family rpt_type rpt_unit_range rpt_unit_seq satellite standard_name} rep_origin {allele citation db_xref direction experiment function gene gene_synonym inference locus_tag map note old_locus_tag standard_name} rRNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name} S_region {allele citation db_xref experiment gene gene_synonym inference locus_tag map note old_locus_tag product pseudo pseudogene standard_name} sig_peptide {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag product pseudo pseudogene standard_name} source {altitude bio_material cell_line cell_type chromosome citation clone clone_lib collected_by collection_date country cultivar culture_collection db_xref dev_stage ecotype environmental_sample focus germline haplogroup haplotype host identified_by isolate isolation_source lab_host lat_lon macronuclear map mating_type metagenome_source mol_type note organelle organism PCR_primers plasmid pop_variant proviral rearranged segment serotype serovar sex specimen_voucher strain sub_clone sub_species sub_strain submitter_seqid tissue_lib tissue_type transgenic type_material variety} stem_loop {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon standard_name} STS {allele citation db_xref experiment gene gene_synonym inference locus_tag map note old_locus_tag standard_name} telomere {citation db_xref experiment inference note rpt_type rpt_unit_range rpt_unit_seq standard_name} tmRNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag product pseudo pseudogene standard_name tag_peptide} transit_peptide {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag product pseudo pseudogene standard_name} tRNA {allele anticodon circular_RNA citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} unsure {allele citation compare db_xref experiment gene gene_synonym inference locus_tag map note old_locus_tag replace} V_region {allele citation db_xref experiment gene gene_synonym inference locus_tag map note old_locus_tag product pseudo pseudogene standard_name} V_segment {allele citation db_xref experiment gene gene_synonym inference locus_tag map note old_locus_tag product pseudo pseudogene standard_name} variation {allele citation compare db_xref experiment frequency gene gene_synonym inference locus_tag map note old_locus_tag phenotype product replace standard_name} 3'UTR {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag standard_name trans_splicing} 5'UTR {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag standard_name trans_splicing}}

## add in class::subclass feature types
lappend genbank_feature_key_qualifiers  regulatory:attenuator {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:CAAT_signal {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:DNase_I_hypersensitive_site {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:enhancer {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:enhancer_blocking_element {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:GC_signal {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:imprinting_control_region {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:insulator {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:locus_control_region {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:matrix_attachment_region {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:minus_35_signal {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:minus_10_signal {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:polyA_signal_sequence {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:promoter {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:recoding_stimulatory_region {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:replication_regulatory_region {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:response_element {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:ribosome_binding_site {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:riboswitch {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:silencer {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:TATA_box {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:terminator {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:transcriptional_cis_regulatory_region {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} regulatory:other {allele bound_moiety citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon phenotype pseudo pseudogene standard_name} 
lappend genbank_feature_key_qualifiers  nc_RNA:antisense_RNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:autocatalytically_spliced_intron {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:ribozyme {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:hammerhead_ribozyme {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:lncRNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:RNase_P_RNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:RNase_MRP_RNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:telomerase_RNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:guide_RNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:sgRNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:rasiRNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:scRNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:scaRNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:siRNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:pre_miRNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:miRNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:piRNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:snoRNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:snRNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:SRP_RNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:vault_RNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:Y_RNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:circRNA {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing} nc_RNA:other {allele citation db_xref experiment function gene gene_synonym inference locus_tag map note old_locus_tag operon product pseudo pseudogene standard_name trans_splicing}
lappend genbank_feature_key_qualifiers  misc_recomb:meiotic {allele citation db_xref experiment gene gene_synonym inference locus_tag map note old_locus_tag standard_name} misc_recomb:mitotic {allele citation db_xref experiment gene gene_synonym inference locus_tag map note old_locus_tag standard_name} misc_recomb:non_allelic_homologous {allele citation db_xref experiment gene gene_synonym inference locus_tag map note old_locus_tag standard_name} misc_recomb:chromosome_breakpoint {allele citation db_xref experiment gene gene_synonym inference locus_tag map note old_locus_tag standard_name} misc_recomb:other {allele citation db_xref experiment gene gene_synonym inference locus_tag map note old_locus_tag standard_name}

## add in old qualifier values for compatibility
lappend genbank_feature_key_qualifiers 5'clip {allele citation db_xref function gene locus_tag map note old_locus_tag standard_name} 3'clip {allele citation db_xref function gene locus_tag map note old_locus_tag standard_name} RBS {allele citation db_xref gene locus_tag map note old_locus_tag standard_name} conflict {allele citation compare db_xref gene locus_tag map note old_locus_tag replace} LTR {allele citation db_xref function gene locus_tag map note old_locus_tag standard_name} repeat_unit {allele citation db_xref function gene locus_tag map note old_locus_tag rpt_family rpt_type} satellite {allele citation db_xref gene locus_tag map note old_locus_tag rpt_family rpt_type standard_name} scRNA {allele citation db_xref function gene locus_tag map note old_locus_tag product pseudo standard_name} snRNA {allele citation db_xref function gene locus_tag map note old_locus_tag product pseudo standard_name} snoRNA {allele citation db_xref function gene locus_tag map note old_locus_tag product pseudo standard_name} promoter {allele bound_moiety citation db_xref function gene locus_tag map note old_locus_tag operon phenotype pseudo standard_name} enhancer {allele bound_moiety citation db_xref gene locus_tag map note old_locus_tag standard_name} polyA_signal {allele citation db_xref gene locus_tag map note old_locus_tag} terminator {allele citation db_xref gene locus_tag map note old_locus_tag operon standard_name} CAAT_signal {allele citation db_xref gene locus_tag map note old_locus_tag} TATA_signal {allele citation db_xref gene locus_tag map note old_locus_tag} -35_signal {allele citation db_xref gene locus_tag map note old_locus_tag operon standard_name} -10_signal {allele citation db_xref gene locus_tag map note old_locus_tag operon standard_name} GC_signal {allele citation db_xref gene locus_tag map note old_locus_tag} attenuator {allele citation db_xref gene locus_tag map note old_locus_tag operon phenotype} misc_signal {allele citation db_xref function gene locus_tag map note old_locus_tag operon phenotype standard_name}

set SOFA_dict {SO:0000000 Sequence_Ontology SO:0000001 region SO:0000004 interior_coding_exon SO:0000006 PCR_product SO:0000007 read_pair SO:0000013 scRNA SO:0000038 match_set SO:0000039 match_part SO:0000050 gene_part SO:0000057 operator SO:0000101 transposable_element SO:0000102 expressed_sequence_match SO:0000103 clone_insert_end SO:0000104 polypeptide SO:0000358 SO:0000109 sequence_variant_obs SO:0000110 sequence_feature SO:0000112 primer SO:0000113 proviral_region SO:0000114 methylated_C SO:0000120 protein_coding_primary_transcript SO:0000139 ribosome_entry_site SO:0000140 attenuator SO:0000141 terminator SO:0000143 assembly_component SO:0000147 exon SO:0000148 supercontig SO:0000149 contig SO:0000150 read SO:0000151 clone SO:0000159 deletion SO:0000161 methylated_A SO:0000162 splice_site SO:0000163 five_prime_cis_splice_site SO:0000164 three_prime_cis_splice_site SO:0000165 enhancer SO:0000167 promoter SO:0000177 cross_genome_match SO:0000178 operon SO:0000179 clone_insert_start SO:0000181 translated_nucleotide_match SO:0000183 non_transcribed_region SO:0000185 primary_transcript SO:0000187 repeat_family SO:0000188 intron SO:0000193 RFLP_fragment SO:0000196 five_prime_coding_exon_coding_region SO:0000197 {three_prime_coding exon_coding_region} SO:0000198 noncoding_exon SO:0000203 UTR SO:0000204 five_prime_UTR SO:0000205 three_prime_UTR SO:0000233 mature_transcript SO:0000234 mRNA SO:0000235 TF_binding_site SO:0000236 ORF SO:0000239 flanking_region SO:0000252 rRNA SO:0000253 tRNA SO:0000274 snRNA SO:0000275 snoRNA SO:0000276 miRNA SO:0000289 microsatellite SO:0000294 inverted_repeat SO:0000296 origin_of_replication SO:0000303 clip SO:0000305 modified_base_site SO:0000306 methylated_base_feature SO:0000307 CpG_island SO:0000314 direct_repeat SO:0000315 TSS SO:0000316 CDS SO:0000318 start_codon SO:0000319 stop_codon SO:0000324 tag SO:0000326 SAGE_tag SO:0000330 conserved_region SO:0000331 STS SO:0000332 coding_conserved_region SO:0000333 exon_junction SO:0000334 nc_conserved_region SO:0000336 pseudogene SO:0000337 RNAi_reagent SO:0000340 chromosome SO:0000341 chromosome_band SO:0000343 match SO:0000344 splice_enhancer SO:0000345 EST SO:0000347 nucleotide_match SO:0000349 protein_match SO:0000353 sequence_assembly SO:0000360 codon SO:0000366 insertion_site SO:0000368 transposable_element_insertion_site SO:0000370 small_regulatory_ncRNA SO:0000372 enzymatic_RNA SO:0000374 ribozyme SO:0000375 rRNA_5_8S SO:0000380 hammerhead_ribozyme SO:0000385 RNase_MRP_RNA SO:0000386 RNase_P_RNA SO:0000390 telomerase_RNA SO:0000391 U1_snRNA SO:0000392 U2_snRNA SO:0000393 U4_snRNA SO:0000394 U4atac_snRNA SO:0000395 U5_snRNA SO:0000396 U6_snRNA SO:0000397 U6atac_snRNA SO:0000398 U11_snRNA SO:0000399 U12_snRNA SO:0000403 U14_snoRNA SO:0005839 SO:0000404 vault_RNA SO:0000405 Y_RNA SO:0000407 rRNA_18S SO:0000409 binding_site BS:00033 SO:0000412 restriction_fragment SO:0000413 sequence_difference SO:0000418 signal_peptide BS:00159 SO:0000419 mature_protein_region BS:00149 SO:0000436 ARS SO:0000454 rasiRNA SO:0000462 pseudogenic_region SO:0000464 decayed_exon SO:0000468 golden_path_fragment SO:0000472 tiling_path SO:0000474 tiling_path_fragment SO:0000483 nc_primary_transcript SO:0000484 three_prime_coding_exon_noncoding_region SO:0000486 five_prime_coding_exon_noncoding_region SO:0000499 virtual_sequence SO:0000502 transcribed_region SO:0000551 polyA_signal_sequence SO:0000553 polyA_site SO:0000577 centromere SO:0000581 cap SO:0000587 group_I_intron SO:0000588 autocatalytically_spliced_intron SO:0000590 SRP_RNA SO:0000602 guide_RNA SO:0000603 group_II_intron SO:0000605 intergenic_region SO:0000610 polyA_sequence SO:0000611 branch_site SO:0000612 polypyrimidine_tract SO:0000616 transcription_end_site SO:0000624 telomere SO:0000625 silencer SO:0000627 insulator SO:0000628 chromosomal_structural_element SO:0000643 minisatellite SO:0000644 antisense_RNA SO:0000645 antisense_primary_transcript SO:0000646 siRNA SO:0000649 stRNA SO:0000650 small_subunit_rRNA SO:0000651 large_subunit_rRNA SO:0000652 rRNA_5S SO:0000653 rRNA_28S SO:0000655 ncRNA SO:0000657 repeat_region SO:0000658 dispersed_repeat SO:0000662 spliceosomal_intron SO:0000667 insertion SO:0000668 EST_match SO:0000673 transcript SO:0000684 nuclease_sensitive_site SO:0000687 deletion_junction SO:0000688 golden_path SO:0000689 cDNA_match SO:0000694 SNP SO:0000695 reagent SO:0000696 oligo SO:0000699 junction SO:0000700 remark SO:0000701 possible_base_call_error SO:0000702 possible_assembly_error SO:0000703 experimental_result_region SO:0000704 gene SO:0000705 tandem_repeat SO:0000706 trans_splice_acceptor_site SO:0000714 nucleotide_motif SO:0000717 reading_frame SO:0000719 ultracontig SO:0000724 oriT SO:0000725 transit_peptide BS:00055 SO:0000730 gap SO:0000752 gene_group_regulatory_region SO:0000777 pseudogenic_rRNA SO:0000778 pseudogenic_tRNA SO:0000830 chromosome_part SO:0000831 gene_member_region SO:0000833 transcript_region SO:0000834 mature_transcript_region SO:0000835 primary_transcript_region SO:0000836 mRNA_region SO:0000837 UTR_region SO:0000839 polypeptide_region BS:00124 BS:00331 SO:0000841 spliceosomal_intron_region SO:0000842 gene_component_region SO:0000851 CDS_region SO:0001000 rRNA_16S SO:0001001 rRNA_23S SO:0001002 rRNA_25S SO:0005836 regulatory_region SO:0005855 gene_group SO:1000002 substitution SO:1000005 complex_substitution SO:1000008 point_mutation SO:1000036 inversion SO:1001284 regulon SO:2000061 databank_entry}


set info(NCBI_translation_code_list) {{The Standard Code} FFLLSSSSYY**CC*WLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG {The Vertebrate Mitochondrial Code} FFLLSSSSYY**CCWWLLLLPPPPHHQQRRRRIIMMTTTTNNKKSS**VVVVAAAADDEEGGGG
{The Yeast Mitochondrial Code} FFLLSSSSYY**CCWWTTTTPPPPHHQQRRRRIIMMTTTTNNKKSSRRVVVVAAAADDEEGGGG {The Mold, Protozoan, and Coelenterate Mitochondrial Code and the Mycoplasma/Spiroplasma Code} FFLLSSSSYY**CCWWLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG {The Invertebrate Mitochondrial Code} FFLLSSSSYY**CCWWLLLLPPPPHHQQRRRRIIMMTTTTNNKKSSSSVVVVAAAADDEEGGGG
 {The Ciliate, Dasycladacean and Hexamita Nuclear Code} FFLLSSSSYYQQCC*WLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG
 {The Echinoderm and Flatworm Mitochondrial Code} FFLLSSSSYY**CCWWLLLLPPPPHHQQRRRRIIIMTTTTNNNKSSSSVVVVAAAADDEEGGGG
 {The Euplotid Nuclear Code} FFLLSSSSYY**CCCWLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG
 {The Bacterial, Archaeal and Plant Plastid Code} FFLLSSSSYY**CC*WLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG
 {The Alternative Yeast Nuclear Code} FFLLSSSSYY**CC*WLLLSPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG
 {The Ascidian Mitochondrial Code} FFLLSSSSYY**CCWWLLLLPPPPHHQQRRRRIIMMTTTTNNKKSSGGVVVVAAAADDEEGGGG
 {The Alternative Flatworm Mitochondrial Code} FFLLSSSSYYY*CCWWLLLLPPPPHHQQRRRRIIIMTTTTNNNKSSSSVVVVAAAADDEEGGGG
 {Blepharisma Nuclear Code} FFLLSSSSYY*QCC*WLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG
 {Chlorophycean Mitochondrial Code} FFLLSSSSYY*LCC*WLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG
 {Trematode Mitochondrial Code} FFLLSSSSYY**CCWWLLLLPPPPHHQQRRRRIIMMTTTTNNNKSSSSVVVVAAAADDEEGGGG
 {Scenedesmus Obliquus Mitochondrial Code} FFLLSS*SYY*LCC*WLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG
 {Thraustochytrium Mitochondrial Code} FF*LSSSSYY**CC*WLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG}
set info(translation_code) FFLLSSSSYY**CC*WLLLLPPPPHHQQRRRRIIIMTTTTNNKKSSRRVVVVAAAADDEEGGGG
set info(start_codons) ATG



set dialogblock 0

array set info {primer_len_min 20 primer_len_max 25 primer_Tm_min 55 primer_Tm_max 60 primer_gc_min 45 primer_gc_max 60 primer_clamp_min 1 primer_clamp_max 2 primer_consec_max 3 primer_scomp_tot_max 10 primer_scomp_adj_max 5 primer_scomp_3_max 3 primer_hcomp_tot_max 10 primer_hcomp_adj_max 5 primer_hcomp_3_max 3 primer_hcomp_oligo "" primer_check_sc 1 primer_salt 50 primer_dna 250 primer_scan "5'-->3'"}
array set info {primer_len_min 10 primer_len_max 100 primer_len_prefer 22 primer_len_wt_lt 100 primer_len_wt_gt 100 \
	  primer_Tm_min "" primer_Tm_max "" primer_Tm_prefer 59 primer_Tm_wt_lt 100 primer_Tm_wt_gt 100 \
	  primer_gc_min "" primer_gc_max "" primer_gc_prefer 50 primer_gc_wt_lt 100 primer_gc_wt_gt 100 \
	  primer_clamp_min "" primer_clamp_max "2" primer_clamp_prefer 1 primer_clamp_wt_lt 0 primer_clamp_wt_gt 0 \
	  primer_consec_max "" \
	  primer_use_wt_gt 0 primer_use_comp_filter 0 \
	  primer_tmdiff_max "" \
	  primer_scomp_tot_max "" primer_scomp_3_max "" primer_hcomp_tot_max "" primer_hcomp_3_max "" \
      primer_spacing_5_3 -1 primer_spacing_max 100 primer_spacing_in_out 1 numer_of_primers_to_show 10 primer_template_selection 0 primer_comp_filter_text {1 e -2 -1 -2 0 gc|cg; 1 i +1 -1 -1 6 s;1 i +1 -1 -1 6 w} \
      primer_name_string "oXX%#" primer_next_number 1 primer_user_default_parameters {}
      primer_incompatible_color_fg "#C0C0C0" primer_window_show_advanced 0 \
      primer_find_column_dict {.dialog.treeframe.tv {displaycolumns {Name Score 5' 3' Length Prod_Len Tm %GC } sort_column Score sort_direction 1} .dialog.treeframe2.tv {displaycolumns {Name Score 5' 3' Length Prod_Len Tm %GC } sort_column Score sort_direction 1}}
    }
set abi_info(last_find) ""
set abi_info(find_literal) 0
set abi_info(find_wrap) 0
set abi_info(find_revcom) 0
array set abi_info [list colors,C blue colors,T red colors,A green colors,G $info(graphic_fg_color) colors,N magenta colors,B magenta colors,D magenta colors,H magenta colors,K magenta colors,M magenta colors,R magenta colors,S magenta colors,V magenta colors,W magenta colors,Y magenta colors,- magenta]
set info(print_abi_lines_per_page) 5
set info(abi_default_canvas_height) 400
set info(abi_default_canvas_width) 650
set possible_extensions [list .gbk .ape .dna .str .seq .abi .ab1 .scf .gb .embl .gcc .gcs .gck]

if {$info(android)} {
  set info(tk_scaling) 5
  set info(menu_bg_color) white
  if {[catch {set info(pixels_per_dp) [dict get [borg displaymetrics] density]}]} {
    set info(pixels_per_dp)  .75
  }
} else {
  set info(tk_scaling) [tk scaling]
  set info(pixels_per_dp) .75
}


set info(toolbarlist) [list New Open Save separator Cut Copy Paste separator Find separator Uppercase Lowercase separator "Reverse Com" separator Enzymes separator "Graphic Map" "Text Map" "Highlight Enzymes" Digest separator PCR "Golden Gate" Gibson separator Align]


check_for_running_process


if {[info exists starkit::topdir]} {
  set info(topdir) $starkit::topdir
} else {
  set info(topdir) [file dirname [info script]]
}
##tk_messageBox -message "[info exists starkit::topdir] Top directory: $info(topdir)"

##FIND ACCESSORY DIRECTORIES
#tk_messageBox -type ok
set info(Accdir) [file join $info(topdir) "Accessory Files"]
while {![file isdirectory $info(Accdir)]} {
  set info(Accdir)  [tk_chooseDirectory -title [mc "Please locate the Accessory Files Directory"]]
  if {$info(Accdir) == ""} {
    final_exit
  }
}


## this makes package require look in the lib directory first
if {[file exists [file join $info(Accdir) lib]]} {
  set auto_path [linsert $auto_path 0 [file join $info(Accdir) lib]] 
}

if {[info exists starkit::topdir]} {
  ## look for a lib directory at the same level as the exe file in windows, in case you can't run from internal dll files copied into temp directory
  set auto_path [linsert $auto_path 0 [file join [file dirname [file nativename [info nameofexecutable]]] lib]] 
}


## Load patches
if {[file exists [file join $info(topdir) Patches]]} {
  foreach patch [glob -nocomplain -dir [file join $info(topdir) Patches] *.tcl] {
    sputs "sourcing patch: $patch"
    source $patch
  }
  unset -nocomplain patch
}


###need to: set these to null
##SET PROGRAM DEFAULT ENZYME AND FEATURE DIRECTORIES
set info(default_enzymedir) [file join $info(Accdir) "Enzymes"]
set info(default_featuredir) [file join $info(Accdir) "Features"]


##set program default language locale (may be read from default file later)
namespace import msgcat::mclocale
if {[string match -nocase c [mclocale]]} {mclocale en_US}
if {1} {mclocale en_US}
set info(locale) [mclocale]

##initialize http package
package require http
::http::config -useragent "Mozilla/4.75 (X11; U; Linux 2.2.17; i586; Nav)"

set err "no errors"
###INITIALIZE LOCATION OF USER DEFAULTS DIRECTORY
if {$tcl_platform(platform) == "windows"} {
  ##set user defaults directory
  if {$tcl_platform(os) == "Windows 95"} {
   ##Windows 95/98
    if {![initilize_windows_user_defauts [registry get {HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders} AppData]]} {
      sputs "Can't get the user defaults dir from registry, using internal: $err"
      set info(user_defaults_dir) $info(Accdir)
    }
  } else {
   ##NT, XP and Vista
    if {(![catch {set env(APPDATA)}]) && ([initilize_windows_user_defauts $env(APPDATA) "env var"])} {
      #APPDATA env gave a succssful result
    } elseif {(![catch {registry get {HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders} AppData}]) && ([initilize_windows_user_defauts [registry get {HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders} AppData] "registry"])} {
      #APPDATA registry gave a succssful result
    } elseif {(![catch {exec cmd.exe /c echo %APPDATA%}]) && ([initilize_windows_user_defauts [exec cmd.exe /c echo %APPDATA%] "cmd"])} {
      #APPDATA shell cmd gave a succssful result
    } else {
      sputs "Can't get the user defaults dir from environment variables, using internal"
      set info(user_defaults_dir) $info(Accdir)
    }
  }
} elseif {$tcl_platform(platform) == "unix"} {
    if {$tcl_platform(os) == "Linux"} {
      if {!$info(android)} {
        set info(user_defaults_dir) [file join $env(HOME) ".ApE"]
      } else {
         ##Android- needs to change this to /data/data/tk.tcl.wish/files when running from non the sd card
         global env
         set info(user_defaults_dir) $env(INTERNAL_STORAGE)
      }
    } elseif {[tk windowingsystem] == "aqua"} {
      if { [file exists [file join $env(HOME)  "Library/Preferences/ApE/"]] && ![file exists [file join $env(HOME) "Library/Application Support/ApE/"]] } {
        file copy [file join $env(HOME) "Library/Preferences/ApE/"] [file join $env(HOME) "Library/Application Support/ApE/"]
        file delete -force [file join $env(HOME) "Library/Preferences/ApE/"]
      }
      set info(user_defaults_dir) [file join $env(HOME) "Library/Application Support/ApE/"]
    }
}

## Store a set of default molar reaction values
set info(calc_molar_raction_dict) [list "HiFi 2-3 fragment" [list [list frag1 "" "" 1 frag2 "" "" 1 frag3 "" "" 1] 4 40 fmole 0.3 2 "6 to 40 fmole per 4ul. linear:equimolar, insertion:3-to-1,<200 bp ins:5-to-1"] "HiFi 4-6 fragment" [list [list frag1 "" "" 1 frag3 "" "" 1 frag2 "" "" 1 frag4 "" "" 1 frag5 "" "" 1 frag6 "" "" 1] 4 60 fmole 0.3 2 "40 to 100 fmol per 4ul. linear:equimolar, insertion:3-to-1,<200 bp ins:5-to-1"]  "Gibson 2-3 fragment" [list [list frag1 "" "" 1 frag2 "" "" 1 frag3 "" "" 1] 4 40 fmole 0.3 1.333 "6 to 40 fmole per 4ul. linear:equimolar, insertion:3-to-1,<200 bp ins:5-to-1"] "Gibson 4-6 fragment" [list [list frag1 "" "" 1 frag2 "" "" 1 frag3 "" "" 1 frag4 "" "" 1 frag5 "" "" 1 frag6 "" "" 1] 4 60 fmole 0.3 1.333 "40 to 200 fmole per 4ul. linear:equimolar, insertion:3-to-1,<200 bp ins:5-to-1"] "SapTrap" [list [list plasmid1 "" "" 1 plasmid2 "" "" 1 plasmid3 "" "" 1 oligo1 0.06 16.5 3 oligo2 0.06 16.5 3 oligo3 0.06 16.5  3] 2.5 30 nM 0.3 1.25 "oligos:plasmid at 3:1"]  "Golden Gate" [list [list frag1 "" "" 1 frag2 "" "" 1 frag3 "" "" 1 frag4 "" "" 1 frag5 "" "" 1] 10 6 nM 0.3 5 "adjust final conc. to 3 nM each fragment"] "T4 Ligation" [list [list vector "" "" 1 insert "" "" 3] 10 10 ng/ul 0.3 5 "DNA should be 1-10ng/ul. V:I reatio should be between 1:1 and 1:10."]  "NEB Quick Ligation" [list [list vector "" "" 1 insert "" "" 3] 20 10 ng/ul 0.3 2 "DNA should be 1-10ng/ul. V:I reatio should be between 1:2 and 1:6."]]
set info(calc_mm_raction_dict) [list "Phusion" [list primer .25 primer .25 enzyme .5 dNTP 1 water 38 buffer 10]]
set info(calc_defaults) [list molar_reaction_preserve_values 1 stock_conc 1 final_conc 1 final_volume 1  stock_units mM  final_conc_units mM  final_vol_units L molar_reaction_name "HiFi 2-3 fragment" mm_reaction_name "Phusion" num_reactions 1 add_perc 0 perc_ul "%" molar_first 1 molar_unit1 mmole molar_vol1 "/L" molar_unit2 g molar_vol2 /L mol_wt 1000 molar_unit_MW g/mol molar_vol 1 molar_unit_vol mL recipe_mult_vol 1]



##Create user defaults directory if it doesn't exist
if {![file isdirectory $info(user_defaults_dir)]} {
  if {[catch {file mkdir $info(user_defaults_dir)} err]} {
     tk_messageBox -message [mc "Can't create users directory in %1\$s\nError:\n%2\$s" $info(user_defaults_dir) $err] -type ok -icon info
  }
}
####make an empty user defaults file instead??
if {(![file exists [file join $info(user_defaults_dir) ApE_Defaults.txt]]) && ([file exists [file join $info(Accdir) ApE_Defaults.txt]])} {
  while {($info(user_defaults_dir) !="") && ([catch {file copy [file join $info(Accdir) ApE_Defaults.txt] [file join $info(user_defaults_dir) ApE_Defaults.txt]} err])} {
    tk_messageBox -message [mc "Can't create default user preferences"] -detail $err -type ok -icon error
    set info(user_defaults_dir) [tk_chooseDirectory -mustexist 1 -title [mc "Choose a user defaults directory"]]
  }
  if {$info(user_defaults_dir) == ""} {
    tk_messageBox -message [mc "User preferences cancelled"] -type ok -icon error
    final_exit
  }
}
if {(![file exists [file join $info(user_defaults_dir) DNA_ladders.txt]]) && ([file exists [file join $info(Accdir) DNA_ladders.txt]])} {
  catch {file copy [file join $info(Accdir) DNA_ladders.txt] [file join $info(user_defaults_dir) DNA_ladders.txt]}
}

if {(![file exists [file join $info(user_defaults_dir) Arrow_List.txt]]) && ([file exists [file join $info(Accdir) Arrow_List.txt]])} {
  catch {file copy [file join $info(Accdir) Arrow_List.txt] [file join $info(user_defaults_dir) Arrow_List.txt]}
}

#####READ DEFAULTS (REPLACE PROGRAM DEFAULTS WITH VALUES FROM FILE)
read_defaults


## Changing Genbank to GenBank 
if {$info(default_file_format) eq "Genbank"} {
  set info(default_file_format) GenBank
}

####need to: check for valid $info(default_enzymedir), if doesn't exist then copy from Accdir
#FIND VALID DEFAULT ENZYME DIRECTORY
#check for valid default_enzymedir from defaults file
#then copy $info(Accdir)/Enzymes to user preferences directory if that is valid
#else try asking 
if {$info(default_enzymedir) == [file join $info(Accdir) "Enzymes"] || ![file readable [file join $info(default_enzymedir) "Default_Enzymes.txt"]]} {
  if {![file exists [file join $info(user_defaults_dir) "Enzymes"]]} {
    catch {file copy [file join $info(Accdir) "Enzymes"] $info(user_defaults_dir)}
  }
  set info(default_enzymedir) [file join $info(user_defaults_dir) "Enzymes"]
}
if {![file readable [file join $info(default_enzymedir) "Default_Enzymes.txt"]]} {
  if {(![file exists [file join $info(Accdir) "Enzymes" "Default_Enzymes.txt"]])} {
    while {![file isdirectory $info(default_enzymedir)]} {
      set info(default_enzymedir)  [tk_chooseDirectory -title [mc "Please locate the Enzyme Files Directory"]]
      if {$info(default_enzymedir) == ""} {
        final_exit
      }
    }
  } else {
    if {$info(default_enzymedir) ne [file join $info(Accdir) "Enzymes"]} {
      tk_messageBox -message [mc "The default enzyme directory %1$\s is not readable.\nUsing internal" $info(default_enzymedir)] -type ok
    }
    set info(default_enzymedir) [file join $info(Accdir) "Enzymes"]
  }
}

####need to: check for valid $info(default_featuredir), if doesn't exist then copy from Accdir to user_defaults_dir and set it to be in user_defaults_dir
#FIND VALID DEFAULT FEATURE DIRECTORY
#check for defaults from file
#else copy info(Accdir)/Features to user pref folder 
if {$info(default_featuredir) == [file join $info(Accdir) "Features"]} {
  if {![file exists [file join $info(user_defaults_dir) "Features"]]} {
    file copy [file join $info(Accdir) "Features"] $info(user_defaults_dir)
  }
  set info(default_featuredir) [file join $info(user_defaults_dir) "Features"]
}
if {(![file isdirectory $info(default_featuredir)]) || (![file exists [file join $info(default_featuredir) "Default_Features.txt"]])} {
  if {(![file exists [file join $info(Accdir) "Features" "Default_Features.txt"]])} {
    while {![file isdirectory $info(default_featuredir)]} {
      set info(default_featuredir)  [tk_chooseDirectory -title [mc "Please locate the Feature Files Directory"]]
      if {$info(default_featuredir) == ""} {
        final_exit
      }
    }
  } elseif {![file isdirectory [set info(default_featuredir) [file join $info(user_defaults_dir) "Features"]]]} {
    #user_pref_dir/Features dir doesn't exist
    file copy [file join $info(Accdir) "Features"] $info(user_defaults_dir)
  } elseif {![file exist [file join $info(default_featuredir) "Default_Features.txt"]]} {
    #user_pref_dir/Features dir exists, but user_pref_dir/Features/Default_Features file doesn't exist
    file copy [file join $info(Accdir) "Features" "Default_Features.txt"] [file join $info(default_featuredir) "Default_Features.txt"]
  }
}


##check default_dnadir
while { (![file isdirectory $info(default_dnadir)])} {
  set info(default_dnadir) [file dirname $info(default_dnadir)]
  if {[file dirname $info(default_dnadir)] == $info(default_dnadir)} {
    set info(default_dnadir) [valid_default_dir]
  }
}


##copy Ladder files into user preferences
if {(![file exists [file join $info(user_defaults_dir) "DNA_ladders"]]) && ([file exists [file join $info(Accdir) "DNA_ladders"]])} {
  file copy [file join $info(Accdir) "DNA_ladders"] $info(user_defaults_dir)
}

read_ladders

read_arrow_data

#add recombination prototypes to the default list, if additional prototypes are added to the user defaults
if {[info exists info(recomb,prototypes,additional)]} {
  set info(recomb,prototypes) [concat $info(recomb,prototypes) $info(recomb,prototypes,additional)]
}



read_enzymes [file join $info(default_enzymedir) "Default_Enzymes.txt"]

#read default feature library
set fea_info(library) [list]
set fea_info(library_file) ""
if {[file exists [file join $info(default_featuredir) "Default_Features.txt"]]} {
  open_feature_library [file join $info(default_featuredir) "Default_Features.txt"] new 0
}

#verify all elements in enz_text_dialog_order (if upgrading from previous version)
foreach item [list index enzymes dna translation sec_strand genes features space] {
  if {[lsearch -exact $info(enz_text_dialog_order) $item] == -1} {
    lappend info(enz_text_dialog_order) $item
  }
}
unset item



#set up graphic map text element properties (needs to be after read_defaults)- only sets defaults if they are not read in from defaults file
if {$info(graphic_map_properties) == ""} {
  set info(graphic_map_properties) [list circular_baseline_bg_width 1 circular_baseline_fg_width 1 circular_baseline_bg_color black circular_baseline_fg_color white circular_crosshair_length 0.016 circular_crosshair_bg_width 1 circular_crosshair_bg_color black circular_crosshair_fg_width 1 circular_crosshair_fg_color white]
  lappend info(graphic_map_properties) circular_map_index_offset -.05 circular_map_index_max_tick_spacing 0 circular_map_index_max_at_zero 0 index_label_format "1,000" index_text_angle_format "h" circular_index_max_tick_color {} index_circular_text_color {} circular_index_max_tick_font graphicfont circular_index_max_tick_width 2 circular_index_max_tick_length .05 circular_index_min_tick_per_max 4 circular_index_min_tick_color {} circular_index_min_tick_width 1 circular_index_min_tick_length .02
  
  dict set info(graphic_map_properties) circ_enz_label_box_type rectangle
  dict set info(graphic_map_properties) circ_enz_label_box_fill_color white
  dict set info(graphic_map_properties) circ_enz_label_box_outline_color white
  dict set info(graphic_map_properties) circ_enz_label_box_outline_width 1
  dict set info(graphic_map_properties) linear_enz_label_box_type rectangle
  dict set info(graphic_map_properties) linear_enz_label_box_fill_color white
  dict set info(graphic_map_properties) linear_enz_label_box_outline_color white
  dict set info(graphic_map_properties) linear_enz_label_box_outline_width 1

  foreach tag {title seq_length file_comment enz_list feature_list} show {normal normal hidden hidden hidden} x {0 0 0 -500 500} y {-10 10 500 500 500} {
    dict set info(graphic_map_properties) circular_$tag\_font [list $info(graphicfontfamily) $info(graphicfontsize)]
    dict set info(graphic_map_properties) circular_$tag\_color black
    dict set info(graphic_map_properties) circular_$tag\_state $show
    dict set info(graphic_map_properties) circular_$tag\_x $x
    dict set info(graphic_map_properties) circular_$tag\_y $y
    dict set info(graphic_map_properties) circular_$tag\_width 0  } 
  foreach tag {title seqtext file_comment enz_list feature_list} show {normal normal hidden hidden hidden} x {0 0 0 -500 500} y {-20 0 500 500 500} {
    dict set info(graphic_map_properties) linear_$tag\_font [list $info(graphicfontfamily) $info(graphicfontsize)]
    dict set info(graphic_map_properties) linear_$tag\_color black
    dict set info(graphic_map_properties) linear_$tag\_state $show
    dict set info(graphic_map_properties) linear_$tag\_x $x
    dict set info(graphic_map_properties) linear_$tag\_y $y
    dict set info(graphic_map_properties) linear_$tag\_width 0  } 
  unset tag show x y
}
set outline_box_types_dict {none "None" rectangle "Rectangle"  r_rect "Round Rectangle" chip "Chip" parallelogram_l "Paralleleogram L" parallelogram_r "Paralleleogram R"  trapezoid_b "Trapezoid B" trapezoid_t "Trapezoid T" half_circle_l "Half circle L" half_circle_r "Half Circle R" arrow_l "Arrow L" arrow_r "Arrow R" hexagon "Hexagon" cloud "Cloud"  callout_lt "Callout Top L" callout_ct "Callout Top C" callout_rt "Callout Top R"}

if {$info(use_tile)} {

}


##LOAD LANGUAGE FILE
proc mcload {langdir} {
  set x 0
  foreach p [::msgcat::mcpreferences] {
    set langfile [file join $langdir $p.msg]
    if {[file exists $langfile]} {
      incr x
      set fid [open $langfile "r"]
      gets $fid line
      if {[regexp \xFE\xFF $line]||[regexp \xFF\xFE $line]} {
        sputs "reading unicode msg file"
        fconfigure $fid -encoding unicode
        seek $fid 0 start ;# rewind -- real reading is still to come
        set text [read $fid [file size $langfile]]
        regsub -all "\uFEFF|\uFFFE" $text "" text
        uplevel 1 $text
      } else {
        fconfigure $fid -encoding utf-8
        seek $fid 0 start
        set text [read $fid [file size $langfile]]
        if {[llength $text] != 3} {
          sputs "mcload err: not 3 parts in file"
        } elseif {[expr {[llength [lindex $text 2]] % 2}] != 0} {
          sputs "mcload err: translation list not even"
        } elseif {[catch {uplevel 1 $text} err]} {
          sputs error in mcload:$err
        }
      }
      close $fid
    } else {
    }
  }
  ::msgcat::mcset en_us {"insert@" "Insert@" linear Linear circular Circular}
  return $x
}

#if a locale exists in the preferences file, set that locale using mclocale
if {[array names info locale] eq "locale"} {
  mclocale $info(locale)
  #sputs setting locale using mclocale [file join $info(Accdir) Msgs]
} 

#######
#utility proc to convert msg files to tab separated lines msg 
#######
proc mcformatLangFile {} {
 global text
  set langfile [tk_getOpenFile]
  set fid [open $langfile "r"]
  fconfigure $fid -encoding utf-8
  seek $fid 0 start
  set text [read $fid [file size $langfile]]
  if {[llength $text] != 3} {
    sputs "mcload err: not 3 parts in file"
  } elseif {[expr {[llength [lindex $text 2]] % 2}] != 0} {
    sputs "mcload err: translation list not even"
    set testlist [lindex $text 2]
    lappend testlist {}
    foreach {a b} $testlist {
      sputs $a $b
    }
  } else {
    set outfile  [tk_getSaveFile]
    set fid2 [open $outfile "w"]
    fconfigure $fid2 -encoding utf-8
    foreach {a b} [lindex $text 2] {
      puts $fid2 "$a\t$b"
sputs $b
    }
    close $fid2
  }
  close $fid
}


#######
#utility proc to convert tab separated text files to msg files
#######
proc mcreformatLangFile {typestring} {
 global text
  set langfile [tk_getOpenFile]
  set fid [open $langfile "r"]
  fconfigure $fid -encoding utf-8
  seek $fid 0 start
  set text [read $fid [file size $langfile]]
  close $fid
    set outfile  [tk_getSaveFile]
    set fid2 [open $outfile "w"]
    fconfigure $fid2 -encoding utf-8
    puts $fid2 "::msgcat::mcmset $typestring [list [split $text "\t\n"]]"
    close $fid2
}



###INITIALIZE PLATFORM SPECIFIC PROCEDURES (aqua requires mc procedure be defined)
#loads png libraries, so needs to be before read_toolbar_images
if {$tcl_platform(platform) == "windows"} {
    initialize_win32
} elseif {$tcl_platform(platform) == "unix"} {
  if {$tcl_platform(os) == "Linux"} {
    initialize_linux
  } elseif {[tk windowingsystem] == "aqua"} {
    initialize_aqua
  }

}


if {$info(android)} {
  initialize_android
}


#need to add the more arrow buton to the toolbar list after possibly reading it from defaults
read_toolbar_images

toolbar_set_icons $info(toolbar_size)

setup_special_bindings


  #load the Msgs file (not required for en_us default)
  if {[catch {mcload [file join $info(Accdir) Msgs]} err]} {sputs "mcload err:$err"}

if {[info exists info(tk_scaling)] && $info(android)} {} {
  tk scaling $info(tk_scaling)
}
###CREATE DNAFONT AND LABELFONT
if {[lsearch -exact [font names] dnafont] == -1} {
  font create labelfont -family [lindex TkDefaultFont 1] -size $info(dnafontsize)
  font create labelfont_half -family [lindex TkDefaultFont 1] -size [expr {$info(dnafontsize) / 2}]
  font create boldlabelfont -family [lindex TkDefaultFont 1] -size $info(dnafontsize) -weight bold
  font create entryfont -family [lindex TkTextFont 1] -size $info(dnafontsize)
  font create dnafont -family $info(textfontfamily) -size $info(dnafontsize)
  font create bolddnafont -family $info(textfontfamily) -size $info(dnafontsize) -weight bold
  font create menufont -family [font configure TkMenuFont -family] -size [font configure TkMenuFont -size]
}
if {[lsearch -exact [font names] graphicfont] == -1} {
  font create graphicfont -family $info(graphicfontfamily) -size $info(graphicfontsize)
}

####list of tk font names to convert to postscript font names
set tk_fonts ""
set ps_fonts ""
foreach {tk_font ps_font} $info(tk_ps_fonts) {
  lappend tk_fonts "[string tolower $tk_font]_normal" "[string tolower $tk_font]_bold"
  lappend ps_fonts "$ps_font" "$ps_font\-Bold"
}


###comment this out to not use tile widgets (scale, checkbutton, button)
#this has to come before the option database is set up with colors- tile on aqua changes the default bg color
use_tile

####SET WIDGET DEFAULTS
option add *Checkbutton.font labelfont 40
option add *Radiobutton.font labelfont 40
option add *Label.font labelfont 40
option add *Labelframe.font labelfont 40
option add *Button.font labelfont 40
option add *TEntry.font entryfont 40
option add *TSpinbox.font entryfont 40

ttk::style configure TCheckbutton -font labelfont
ttk::style map TButton -font [list !pressed labelfont alternate boldlabelfont active boldlabelfont pressed boldlabelfont ] 
ttk::style map TMenubutton -font [list !pressed labelfont alternate boldlabelfont active boldlabelfont pressed boldlabelfont ]  
ttk::style configure TNotebook.Tab -font labelfont -padding {6 5 6 2}
ttk::style configure TNotebook -tabposition n
ttk::style configure TLabel -font labelfont
ttk::style configure TRadiobutton -font labelfont
ttk::style configure Treeview -font labelfont
#ttk::style configure Treeview -rowheight [expr {[font metrics labelfont -linespace] + 0}]
ttk::style configure Treeview -rowheight  [expr {[font metrics [ttk::style lookup Treeview -font] -linespace] + 1}]
#ttk::style configure Featuretable.Treeview -rowheight [expr {int($info(dnafontsize)*1.25)}]
ttk::style configure Featuretable.Treeview -rowheight  [expr {[font metrics [ttk::style lookup Featuretable.Treeview -font] -linespace] + 1}]

ttk::style configure InfoboxStyle.TCheckbutton -font labelfont
ttk::style configure InfoboxStyle.TLabel -font labelfont


if {[tk windowingsystem] == "aqua"} {
  ttk::style configure Heading -font {Helvetica 11 bold} -foreground gray40 
} elseif {$info(android)} {
  ttk::style configure Heading -font {Roboto 8} -foreground gray40
} else {
  ttk::style configure Heading -font boldlabelfont -foreground gray40
}

  ttk::style configure TButton -anchor center
  ttk::style configure Menubutton -anchor center
if {[tk windowingsystem] != "aqua"} {
  ttk::style configure TButton -font labelfont 
  ttk::style configure Menubutton -font labelfont
}


if {$info(use_cocoa)} {
#option add *Menu.font {{Lucida Grande} 15} 40
}

    if {$info(android)} {
      set fontsize [expr {[font configure labelfont -size] / 2}]
      set fontfamily  [font configure labelfont -family]
      set font [list $fontfamily $fontsize]
      ttk::style configure InfoboxStyle.TCheckbutton -font labelfont_half
      ttk::style configure InfoboxStyle.TLabel -font labelfont_half
      ttk::style configure Chip.TButton -font labelfont_half
    } else {
      ttk::style configure InfoboxStyle.TCheckbutton -font labelfont
      ttk::style configure InfoboxStyle.TLabel -font labelfont
      ttk::style configure Chip.TButton -font labelfont
    }


if {[tk windowingsystem] == "aqua"} {
 set info(menu_font_size) [font configure TkMenuFont -size]
}

if {[info exists info(menu_font_size)]} {
  #&#option add *Menu.font [list [font configure TkMenuFont -family] $info(menu_font_size)] 40
  font configure menufont -size $info(menu_font_size)
} else {
  set  info(menu_font_size) [font configure menufont -size]
  #&#option add *Menu.font [list [font configure TkMenuFont -family] $info(menu_font_size)] 40
}
option add *Menu.font menufont

if {$info(android)} {
  #&#option add *Menu.font [list [font configure TkMenuFont -family] 10] 40
  font configure menufont -size 10
  set  info(menu_font_size) 10
  option add *Menu.clickToFocus true 40
  option add *Scrollbar.width 16 40
}
option add *Listbox.font labelfont 40
option add *Entry.font entryfont 40
if {[tk windowingsystem] eq "aqua"} {
  option add *Button.padx 15 40
  option add *Button.pady 15 40
} else {
  option add *Menubutton.font labelfont 40
}

option add *Listbox.exportSelection 0
option add *Entry.exportSelection 0
option add *Text.exportSelection 0

option add *Menu*tearOff 0

#########
##Setup default colors

if {$info(dark_mode)} {
  foreach key [list bg_color menu_bg_color menu_fg_color menu_select_bg_color menu_select_fg_color text_bg_color text_fg_color text_select_bg_color text_select_fg_color text_select2_bg_color text_select2_fg_color graphic_fg_color graphic_bg_color label_fg_color label_disabled_fg_color] {
    set info($key) $info($key,dark)
  }
  unset key
}

recolor_app

###Generate the translation maps
set info(translation_map_lists) [gen_translation_map $info(translation_code)]

###if running as a starpack in windows, check for old style shortcut and file associations
if {([tk windowingsystem] == "win32") && (![catch {package require starkit}])  && [info exists ::starkit::mode] && ($::starkit::mode == "starpack")} {
  if {![catch {set regdata [registry get "HKEY_LOCAL_MACHINE\\Software\\Classes\\ApE.DNA.file\\Shell\\open\\command" ""]}]} {
    regsub -all \\\\ $regdata / regdata
    if {([llength $regdata] == 3)} {
      if {![catch {registry set "HKEY_LOCAL_MACHINE\\Software\\Classes\\ApE.DNA.file\\Shell\\open\\command" {} "\"[file nativename [info nameofexecutable]]\" \"%1\"" sz} errmsg]} {
        tk_messageBox -title [mc "ApE Association Format Changed"] -message [mc "The application file associations have been updated to the new format."] -type ok -icon info
      } else {
       sputs "Registry error $regdata : HKEY_LOCAL_MACHINE: $errmsg"
      }
    } elseif {[llength $regdata] == 2 && ([lindex $regdata 0] != [info nameofexecutable])} {
      if {![catch {registry set "HKEY_LOCAL_MACHINE\\Software\\Classes\\ApE.DNA.file\\Shell\\open\\command" {} "\"[file nativename [info nameofexecutable]]\" \"%1\"" sz} errmsg]} {
        tk_messageBox -title [mc "ApE Location Changed"] -message [mc "The application file associations have been updated to point to a new location of ApE."] -type ok -icon info
      } else {
        sputs "Registry error $regdata : HKEY_LOCAL_MACHINE: $errmsg"
      }
    }
  }
  if {[string first "AppMain.tcl" [lindex $argv 0]] > -1} {
    tk_messageBox -message [mc "The application shortcut needs to be changed. Try deleting the shortcut and making a new one."] -type ok -icon warning
    set argv [lrange $argv 1 end]
  }
}

######
if {[tk windowingsystem] == "aqua"} {
  ############
  proc ::tk::mac::OpenDocument {args} {
    global  info startup_status
    if {!$startup_status} {
      after 300 "::tk::mac::OpenDocument $args"
      return
    }
    if { 1} {
      foreach file $info(open_at_close) {
        if {[file exists $file] && [file readable $file]} {
         after 300
         catch {open_file $file 0}
        }
      }
      unset -nocomplain file
    }

    after 300
      foreach filename $args {
          catch {open_file $filename 1}
      }
    set info(open_at_close) [list]
  }
  ############
  proc ::tk::mac::OnShow {args} {
    puts "mac OnShow"
  }
  ############
  proc ::tk::mac::OpenApplication {args} {
    puts "opening  [winfo children .]  [llength [winfo children .]] "
  }
  ############
  proc ::tk::mac::PrintDocument {args} {
    foreach filename $args {
      catch {set w [open_file $filename]}
      if {[winfo exists $w]} {
        enz_text_map $w -1
      }
    }
  }
  ############
  proc ::tk::mac::OpenApplication {} {
    puts "mac OpenApplication"
  }
  ############
  proc ::tk::mac::ReopenApplication {} {
    # aqua bug- wm stackorder crashes when called immediately after switching between Yosemite desktops
    after 250 {
      if {[wm stackorder .] =={}} {
        catch {wm deiconify [lindex [winfo children .] 2]}
      }
    }
  }
}

##do update checks if set to run on startup
##take out the set to -1 if update is reinstalled
#set info(update_check_interval) -1

#if {($info(update_check_interval) >= 0) && ( ($info(last_update_check) == "")||([expr {[clock seconds] - $info(last_update_check)}] > $info(update_check_interval)))} web_version_check 

## Show about dialog if ApE has been updated
if {$info(ApE_version) != $version} {
  set info(ApE_version) $version
  if {!$info(android) } {
    about_dialog .
  }
}

set_inline_features

## create the first window (unless a window has been created by Apple open event)
#update
#sputs argv $argv
if {([lsearch [winfo children .] ".dna_window*"] == -1) && ([lsearch [winfo children .] ".abi_window*"] == -1)} {
  foreach file $info(open_at_close) {
    if {[file exists $file] && [file readable $file]} {
      catch {open_file $file 0}
    }
  }
  unset -nocomplain  file


  if {([llength $argv] == 0) || ($tcl_interactive == 1) || ([string index [lindex $argv 0] 0] == "-")} {
    if {$info(open_at_close) == [list]} {
      create_window -1
    } 
  } else {
    foreach filename $argv {
      if {([file extension $filename] != ".tcl") && ([file extension $filename] != ".exe")} {
          catch {open_file [file nativename $filename] 0}
      }
    }
  }
}
set info(open_at_close) [list]
if {$info(autosave_on)} {run_autosave}



sputs "ApE version $version"
set time1 [clock clicks -milliseconds]
unset time0
unset time1
set startup_status 1

