1#!/bin/sh
2# This line makes the next one a comment in Tcl \
3exec /usr/local/bin/wish8.6 "$0" -- ${1+"$@"}
4
5# eTKTab by Jason Sonnenschein jes_jm@yahoo.com
6# based on:
7
8# TkTab by Giovanni Chierico, chierico@writeme.com
9# You can do whatever you want with the code, as long as you leave my name and email address in it. Thanks
10
11# $Id: eTktab,v 1.355 2003/11/19 16:53:22 jsonn Exp $
12
13#######################################
14### SET CONSTANTS:
15###
16
17# create necessary root namespaces
18namespace eval WIN {}
19namespace eval defaults {}
20
21# move next line to initialization code when program pulls up new windows
22set version "3.2"
23set webpage {http://etktab.sourceforge.net}
24set author {Jason Sonnenschein (jes_jm@yahoo.com)}
25
26# Mac OS X calls itself Unix, but is really more mac-like
27array set my_platform [ array get tcl_platform ]
28if {$my_platform(os)=="Darwin"} {
29    set my_platform(platform) "macintosh"
30}
31# some O/S dependent stuff
32switch -- $my_platform(platform) {
33    {macintosh} {
34        set commandkey Command
35        set altkey Option
36        # Cloverleaf symbol in Chicago Font is ASCII 17 (HEX 11)
37        set displaycmd "\x11"
38        set displayalt Opt
39        set keynext Next
40        set keyprior Prior
41        array set mousebind {paste ButtonPress-3 extend Shift-ButtonPress-1 disable {Shift-Button1-Motion Shift-ButtonRelease-1 Shift-B1-Leave Shift-B1-Enter}}
42        set program_dir [ file dirname [ info nameofexecutable ] ]
43        if {$my_platform(os)=="MacOS"} {
44            set prefs_filename [file join $env(PREF_FOLDER) eTktab]
45            set tempdir $env(TEMP)
46            set cwd [pwd]
47        } else {
48            set prefs_filename [file join $env(HOME) .eTktabrc]
49            set tempdir /tmp
50            set cwd $env(HOME)
51        }
52    }
53    {windows} {
54        set altkey Alt
55        set commandkey Control
56        set displayalt Alt
57        set displaycmd Ctrl
58        set keynext Next
59        set keyprior Prior
60        array set mousebind {paste ButtonPress-3 extend Shift-ButtonPress-1 disable {Shift-Button1-Motion Shift-ButtonRelease-1 Shift-B1-Leave Shift-B1-Enter}}
61        set prefs_filename {HKEY_CURRENT_USER\Software\eTktab}
62        catch {set tempdir $env(TMP)}
63        catch {set tempdir $env(TEMP)}
64        set program_dir [ file dirname [ info nameofexecutable ] ]
65        set cwd [pwd]
66    }
67    default {
68        # Unix
69        set altkey Alt
70        set commandkey Control
71        set displayalt Alt
72        set displaycmd Ctrl
73        set keynext Page_Down
74        set keyprior Page_Up
75        array set mousebind {paste ButtonPress-2 extend ButtonPress-3 disable {}}
76        set prefs_filename [file join $env(HOME) .eTktabrc]
77        set tempdir /tmp
78        set program_dir [ file dirname [ info script ] ]
79        set cwd [pwd]
80    }
81}
82
83# number of redo/undo steps kept
84set histsteps 10
85
86# all possible notes
87set chromatic {D# {D } Db C# {C } {B } Bb A# {A } Ab G# {G } Gb F# {F } {E } Eb}
88
89# basefret stuff
90set maxbasefret 21
91
92# what embellishments are there
93array set embellish { 0 - 1 h 2 p 3 ^ 4 ~ 5 / 6 "\\" 7 s 8 b 9 r 10 t 20 x }
94
95# what non-fret symbols are there
96array set tab_symbols { -1 --- -2 -|- -6 o|- -10 -|o -14 o|o -16 {   }}
97
98# width of guitar tuning in chars
99set initial_col 3
100
101# chars per column of tab
102set col_width 3
103
104# max lines of lyrics
105set lyrics_max 10
106
107# font sizes and types to be made available in prefs
108set font_sizes { 6 7 8 9 10 12 14 18 24 }
109array set font_weights {regular {} bold bold italic italic bold_italic {bold italic}}
110
111# appearance of main window and statusbar
112array set default_prefs {color_tab_bg_default black color_tab_bg_sel grey60 color_tab_fg_default white color_tab_fg_currpos red color_tab_fg_currstring green font_help {Courier 10} font_tab {Courier 12} font_statusbar {Times 10 bold} color_menu_fg_left blue color_menu_fg_right green color_menu_bg black color_help_fg black color_help_bg lightgrey num_strings 6 row_sep_lines 3 score_width 75 window_height 40 window_width 80 page_length 58 }
113
114if {$my_platform(platform)=="windows"} {
115    # Courier 12 looks too big in main tab window under MS Windows
116    set default_prefs(font_tab) {Courier 10}
117    # prfile handles win printing... it sets page length to 74
118    set default_prefs(page_length) 74
119} elseif {$my_platform(platform)=="macintosh"} {
120    # Some macOS versions don't like certain colors and fonts being changed
121    array set default_prefs {color_menu_fg_left black color_menu_fg_right black color_menu_bg lightgrey}
122    set tabwin_options(*background) $default_prefs(color_menu_bg)
123    set default_prefs(print_command) {}
124} else {
125    set default_prefs(print_command) {lp}
126}
127
128# set up tk defaults for widgets
129array set tabwin_options "*Menubutton.relief raised *Menubutton.indicatorOn 1 *Menu.TearOff 0 *Dialog.msg.wrapLength 4i *Dialog.Button.underline 0 *Textwin.Text.setGrid 1 *Textwin.Text.wrap none *Textwin.Text.cursor left_ptr"
130
131# stuff related to number of strings
132set valid_numstrings "7 6 5 4"
133set default_prefs(tuning_4) { 0 {G } 1 {D } 2 {A } 3 {E } }
134set default_prefs(tun_presets_4) { \
135    bass-standard { 0 {G } 1 {D } 2 {A } 3 {E } } \
136    mandolin-standard { 0 {G } 1 {D } 2 {A } 3 {E }} \
137    violin-standard { 0 {G } 1 {D } 2 {A } 3 {E }} \
138    ukelele-standard { 0 {B } 1 {F#} 2 {D } 3 {A }} \
139}
140set default_prefs(tuning_5) { 0 {D } 1 {B } 2 {G } 3 {D } 4 {G }}
141set default_prefs(tun_presets_5) { \
142    {banjo-G (standard)} { 0 {D } 1 {B } 2 {G } 3 {D } 4 {G }} \
143    banjo-gm { 0 {D } 1 {Bb} 2 {G } 3 {D } 4 {G }} \
144    banjo-c { 0 {D } 1 {B } 2 {G } 3 {C } 4 {G }} \
145    {banjo-d (Reuben)} { 0 {D } 1 {A } 2 {F#} 3 {D } 4 {F#}} \
146    banjo-dm { 0 {D } 1 {A } 2 {F } 3 {D } 4 {A }} \
147    banjo-a { 0 {E } 1 {C#} 2 {A } 3 {E } 4 {A }} \
148    banjo-mountain.minor/sawmill { 0 {D } 1 {C } 2 {G } 3 {D } 4 {G }} \
149    banjo-double-C { 0 {D } 1 {C } 2 {G } 3 {C } 4 {G }} \
150    bass-5string { 0 {B } 1 {G } 2 {D } 3 {A } 4 {E } } \
151}
152set default_prefs(tuning_6) { 0 {E } 1 {B } 2 {G } 3 {D } 4 {A } 5 {E } }
153set default_prefs(tun_presets_6) { \
154    guitar-standard { 0 {E } 1 {B } 2 {G } 3 {D } 4 {A } 5 {E } } \
155    drop-D { 0 {E } 1 {B } 2 {G } 3 {D } 4 {A } 5 {D }} \
156    double-D { 0 {D } 1 {B } 2 {G } 3 {D } 4 {A } 5 {D }} \
157    open-G { 0 {D } 1 {B } 2 {G } 3 {D } 4 {B } 5 {D }} \
158    open-D { 0 {D } 1 {A } 2 {F#} 3 {D } 4 {A } 5 {D }} \
159    open-E { 0 {E } 1 {B } 2 {G#} 3 {E } 4 {B } 5 {E }} \
160    open-A { 0 {E } 1 {C#} 2 {A } 3 {E } 4 {A } 5 {E }} \
161    open-C { 0 {E } 1 {C } 2 {G } 3 {C } 4 {G } 5 {C }} \
162    open-Gm { 0 {D } 1 {B } 2 {G } 3 {D } 4 {Bb} 5 {D }} \
163    open-Dm { 0 {D } 1 {A } 2 {F } 3 {D } 4 {A } 5 {D }} \
164    open-Em { 0 {E } 1 {B } 2 {G } 3 {E } 4 {B } 5 {E }} \
165    open-Am { 0 {D } 1 {A } 2 {F } 3 {D } 4 {A } 5 {D }} \
166    Eb { 0 {Eb} 1 {Bb} 2 {Gb} 3 {Db} 4 {Ab} 5 {Eb}} \
167    D { 0 {D } 1 {A } 2 {F } 3 {C } 4 {G } 5 {D }} \
168    DADGAD { 0 {D } 1 {A } 2 {G } 3 {D } 4 {A } 5 {D }} \
169    BADGAD { 0 {D } 1 {A } 2 {G } 3 {D } 4 {A } 5 {B }} \
170    orkney { 0 {D } 1 {C } 2 {G } 3 {D } 4 {G } 5 {C }} \
171}
172set default_prefs(tuning_7) { 0 {D } 1 {G } 2 {C } 3 {F } 4 {A } 5 {D } 6 {G } }
173set default_prefs(tun_presets_7) { \
174    lute-7string { 0 {D } 1 {G } 2 {C } 3 {F } 4 {A } 5 {D } 6 {G }} \
175    guitar-7string { 0 {E } 1 {B } 2 {G } 3 {D } 4 {A } 5 {E } 6 {B }} \
176}
177# fill in numstring dependent stuff that doesn't need messages array
178set menu_ns 0
179foreach ns $valid_numstrings {
180    set gui_label(menu:${ns}string) "{msg_frame.left_frame.file.menu.new $menu_ns} {msg_frame.left_frame.edit.menu.option.numstrings $menu_ns} {msg_frame.left_frame.edit.menu.option.tun_default $menu_ns} {msg_frame.left_frame.edit.menu.option.tun_presets $menu_ns}"
181    set ext($ns) ".et$ns"
182    set macext($ns) "eTk$ns"
183    set blank_tab($ns) " { [lrange { -1 -1 -1 -1 -1 -1 -1 -1 } 0 [ expr $ns -1 ] ] } "
184    set whitespace($ns) " { [lrange { -16 -16 -16 -16 -16 -16 -16 -16 } 0 [ expr $ns -1 ] ] } "
185    set blank_asciitab($ns) [lrange { 0 {} 1 {} 2 {} 3 {} 4 {} 5 {} 6 {} 7 {} } 0 [ expr $ns * 2 - 1 ] ]
186    incr menu_ns
187}
188
189# back end commands for keybindings:
190
191array set keybind_funcs {
192    back back
193    forward forward
194    up_string up_string
195    down_string down_string
196    up_score up_score
197    down_score down_score
198    home home
199    end end
200    inc_base inc_basefret
201    dec_base dec_basefret
202    help help
203    mode toggle_insert_mode
204    mark toggle_mark
205    select_all select_all
206    del_note del_note
207    del_pos {del_pos -history}
208    backspace backspace
209    tuning {tuning_win current}
210    blanktab_before {add_blank -history -redraw}
211    blanktab_after {add_blank -advance -history -redraw}
212    whitespace_after {whitespace -history -redraw}
213    whitespace_to_endline {force_newline}
214    bar bar
215    repeat {toggle_repeat}
216}
217
218array set common_funcs {
219    copy {edit_menu copy}
220    cut {edit_menu cut}
221    paste {edit_menu paste}
222    undo history_undo
223    redo history_redo
224    new new_tab
225    open open_dialog
226    save save_tab
227    export export_tab
228    print print_tab
229    close close_tab
230    quit_safe quit_safe
231    exit __exit_now
232    redraw redraw_full
233    lyrics_mode toggle_lyrics_mode
234}
235
236array set lyrics_funcs {
237    lyr_left {text_cursor "- 1 chars"}
238    lyr_right {text_cursor "+ 1 chars"}
239    lyr_up {text_cursor "- 1 lines"}
240    lyr_down {text_cursor "+ 1 lines"}
241    lyr_home text_home
242    lyr_end text_end
243    lyr_upsection text_upsection
244    lyr_dnsection text_dnsection
245    lyr_delete text_delete
246    lyr_backspace text_backspace
247    lyr_enter "text_insert {\n}"
248}
249
250# widget names for each lang-specific message
251
252array set gui_text {
253    string:mode msg_frame.right_frame.chord_lead_legend
254    string:basefret msg_frame.right_frame.basefret_legend
255    button:help {msg_frame.left_frame.help}
256    button:tuning msg_frame.right_frame.tuning
257    menu:file msg_frame.left_frame.file
258    menu:edit msg_frame.left_frame.edit
259    menu:windows msg_frame.left_frame.windows
260}
261
262array set gui_label {
263    string:chord {{msg_frame.right_frame.chord_lead.menu 0}}
264    string:lead {{msg_frame.right_frame.chord_lead.menu 1}}
265    menu:new {{msg_frame.left_frame.file.menu 0}}
266    string:open {{msg_frame.left_frame.file.menu 1}}
267    string:save {{msg_frame.left_frame.file.menu 2}}
268    menu:save_as {{msg_frame.left_frame.file.menu 3}}
269    string:export {{msg_frame.left_frame.file.menu 4}}
270    string:print {{msg_frame.left_frame.file.menu 5}}
271    menu:close {{msg_frame.left_frame.file.menu 6}}
272    menu:quit {{msg_frame.left_frame.file.menu 7}}
273    menu:undo {{msg_frame.left_frame.edit.menu 0}}
274    menu:redo {{msg_frame.left_frame.edit.menu 1}}
275    menu:cut {{msg_frame.left_frame.edit.menu 3}}
276    menu:copy {{msg_frame.left_frame.edit.menu 4}}
277    menu:clear {{msg_frame.left_frame.edit.menu 5}}
278    menu:paste {{msg_frame.left_frame.edit.menu 6}}
279    menu:select_all {{msg_frame.left_frame.edit.menu 7}}
280    menu:format {{msg_frame.left_frame.edit.menu 9}}
281    menu:options {{msg_frame.left_frame.edit.menu 10}}
282    string:keybind {{msg_frame.left_frame.edit.menu.option 0}}
283    string:language {{msg_frame.left_frame.edit.menu.option 1}}
284    menu:font {{msg_frame.left_frame.edit.menu.option 2}}
285    menu:color {{msg_frame.left_frame.edit.menu.option 3}}
286    menu:default_numstrings {{msg_frame.left_frame.edit.menu.option 5}}
287    menu:default_tuning {{msg_frame.left_frame.edit.menu.option 6}}
288    string:tuning_presets {{msg_frame.left_frame.edit.menu.option 7}}
289    menu:default_format {{msg_frame.left_frame.edit.menu.option 8}}
290    menu:revert {{msg_frame.left_frame.edit.menu.option 10}}
291}
292
293# menu accelerator keys
294array set gui_accel {
295    open {msg_frame.left_frame.file.menu 1}
296    save {msg_frame.left_frame.file.menu 2}
297    export {msg_frame.left_frame.file.menu 4}
298    print {msg_frame.left_frame.file.menu 5}
299    close {msg_frame.left_frame.file.menu 6}
300    quit_safe {msg_frame.left_frame.file.menu 7}
301    undo {msg_frame.left_frame.edit.menu 0}
302    redo {msg_frame.left_frame.edit.menu 1}
303    cut {msg_frame.left_frame.edit.menu 3}
304    copy {msg_frame.left_frame.edit.menu 4}
305    paste {msg_frame.left_frame.edit.menu 6}
306    select_all {msg_frame.left_frame.edit.menu 7}
307}
308
309#######################################
310### INITIALIZE GLOBALS THAT DON'T GET RESET WITH NEW DOCUMENT
311###
312
313set newwin 0
314# clear out the paste buffer
315set pastebuf ""
316set settings_file_failures ""
317set print_counter 0
318set images(disabled.up) [image create bitmap -data "#define i_width 5\n#define i_height 3\nstatic char i_bits = {\n4,14,31}"]
319set images(disabled.dn) [image create bitmap -data "#define i_width 5\n#define i_height 3\nstatic char i_bits = {\n31,14,4}"]
320
321#######################################
322### GLOBAL FUNCTIONS:
323###
324
325# doing this to have save queries come up when using Quit from mac menus
326rename exit __exit_now
327proc exit {} {quit_safe}
328
329# we use some stuff that is typically hidden in tcl/tk 8.4 and above
330if {![llength [info commands tkCancelRepeat]]} {
331    tk::unsupported::ExposePrivateCommand tkCancelRepeat
332}
333if {![llength [info commands tkTextClosestGap]]} {
334    tk::unsupported::ExposePrivateCommand tkTextClosestGap
335}
336if {![llength [info globals tkPriv]]} {
337    tk::unsupported::ExposePrivateVariable tkPriv
338}
339
340# parse arguments coming in to a proc and return in a parsed manner
341proc getopt {returnvar valid raw} {
342    upvar $returnvar opts
343
344    foreach i $valid {
345        if { [string range $i end end ]  == ":" } {
346            set flags(-[string trimright $i :]) 1
347            set opts([string trimright $i :]) -1
348        } else {
349            set flags(-$i) 0
350            set opts($i) -1
351        }
352    }
353    for { set j 0 } { $j < [ llength $raw ] } { incr j } {
354        set possflag [ lindex $raw $j ]
355        if { [info exists flags($possflag)] } {
356            if {$flags($possflag) == 1} {
357                set opts([string trimleft $possflag -]) [lindex $raw [expr $j + 1 ] ]
358                incr j
359            } else {
360                set opts([string trimleft $possflag -]) 1
361            }
362        } else {
363            set opts(EXTRA) [lrange $raw $j end]
364            break
365        }
366    }
367}
368
369# there are equivalents to the next 2 procs in extended tcl/tk, but we're not
370# going to assume we're running under that
371
372# return minimum of 2 vals
373proc calc_min {arg1 arg2} {
374    if { $arg1 < $arg2} {
375        return $arg1
376    } else {
377        return $arg2
378    }
379}
380# return maximum of 2 vals
381proc calc_max {arg1 arg2} {
382    if { $arg1 > $arg2} {
383        return $arg1
384    } else {
385        return $arg2
386    }
387}
388
389# also similar to some extended tcl procs
390
391# add a new element to the beginning of a list, but limit its length
392proc listshift {arrayname index limit new_item} {
393    upvar $arrayname arr
394
395    set arr($index) [ linsert [lrange $arr($index) 0 [expr $limit - 2 ] ] 0 "$new_item" ]
396}
397# return the first element from a list, and remove it from the list
398proc listpop {arrayname index} {
399    upvar $arrayname arr
400
401    set popped [ lindex $arr($index) 0 ]
402    set arr($index) [ lreplace $arr($index) 0 0 ]
403    return "$popped"
404}
405
406# return the next element in a list
407proc listnext {args} {
408    getopt opts {cycle} $args
409    upvar [lindex $opts(EXTRA) 0] currval
410    set fullist [lindex $opts(EXTRA) 1]
411    set listlen [ expr [ llength $fullist ] - 1 ]
412    set element_pos [lsearch -exact $fullist $currval]
413    if { $element_pos < $listlen } {
414        set currval [ lindex $fullist [incr element_pos] ]
415    } elseif { $opts(cycle) > 0 } {
416        set currval [ lindex $fullist 0 ]
417    }
418}
419
420# return the next element in a list
421proc listprev {args} {
422    getopt opts {cycle} $args
423    upvar [lindex $opts(EXTRA) 0] currval
424    set fullist [lindex $opts(EXTRA) 1]
425    set element_pos [lsearch -exact $fullist $currval]
426    set listlen [ expr [ llength $fullist ] - 1 ]
427    if { $element_pos > 0 } {
428        set currval [ lindex $fullist [incr element_pos -1] ]
429    } elseif { $opts(cycle) > 0 } {
430        set currval [ lindex $fullist $listlen ]
431    }
432}
433
434# create new window
435proc new_tab {args} {
436    global newwin
437    global prefs
438    global messages
439    global settings_file_failures
440
441    getopt opts {strings: file:} $args
442    # new tab defaults to default numstrings in prefs
443    if { $opts(strings) != -1 } {
444        set requested_strings $opts(strings)
445    } else {
446        set requested_strings $prefs(num_strings)
447    }
448
449    # set up a new variable space for the window
450    incr newwin
451    set new_namespace ::WIN::$newwin
452    namespace eval $new_namespace {}
453    set ${new_namespace}::num_strings $requested_strings
454    set ${new_namespace}::name ""
455    if { $opts(file) != -1 } {
456        set ${new_namespace}::name $opts(file)
457    }
458    initialize_vars $new_namespace
459
460    # create the new window
461    build_gui $new_namespace
462
463    # initialize the contents of the tablature
464    redraw_full
465    # let Tk draw the window, so transients of it will appear correctly
466    update idletasks
467    if { $opts(file) != -1 } {
468        open_tab
469    }
470    # need to post settings file load failures after first tab window
471    # is opened (due to it being a transient)
472    foreach filename $settings_file_failures {
473        my_dialog $messages(title:open_fail)  [subst -nocommands -nobackslashes $messages(dialog:open_fail) ] error 0 $messages(button:ok)
474    }
475    set settings_file_failures ""
476}
477
478# perform function for each tab window
479proc each_namespace {cmd} {
480    global curr_namespace
481
482    set orig_namespace $curr_namespace
483    foreach curr_namespace [ namespace children ::WIN ] {
484        eval $cmd
485    }
486    set curr_namespace $orig_namespace
487}
488
489# generic proc to load settings files
490proc read_settings_file {filename} {
491    global settings_file_failures
492
493    catch { set settings_file [open "$filename" r] }
494    # file open failed
495    if { ! ( [ info exists settings_file ] ) } {
496        lappend settings_file_failures $filename
497        return ""
498    }
499
500    set cont_line 0
501    while { [gets $settings_file file_line ] != -1 } {
502        # ignore lines beginning with '#'
503        if { [string first {#} $file_line] == 0 } {
504            set cont_line 0
505            continue
506        # add on to prev. line if last line ended in '\'
507        } elseif { $cont_line == 1 } {
508            if { [string range $file_line end end ] == "\\"} {
509                set file_line [ string range $file_line 0 [ expr [string length $file_line ] - 2 ] ]\n
510            } else {
511                set cont_line 0
512            }
513            append array_value "${file_line}"
514        # look for <word> = <whatever> format
515        } elseif { [regexp {([a-zA-Z0-9\-_\.\,\:]+)\ *=\ *(.+)} $file_line full p1 p2] } {
516            if { [string range $p2 end end ] == "\\"} {
517                set p2 [ string range $p2 0 [ expr [string length $p2 ] - 2 ] ]\n
518                set cont_line 1
519            }
520            set array_key $p1
521            set array_value $p2
522        # ignore lines that don't match above criteria
523        } else {
524            continue
525        }
526        if { $cont_line == 0 } {
527            set return_array($array_key) $array_value
528        }
529    }
530    close $settings_file
531    return [array get return_array]
532}
533
534#look for eTktab user preferences in OS appropriate location
535proc load_prefs {} {
536    global default_prefs
537    global prefs
538    global prefs_filename
539    global tabwin_options
540    global settings_file_failures
541
542    #load defaults
543    array set prefs [ array get default_prefs ]
544
545    if { [string first HKEY_ $prefs_filename ] == 0 } {
546        #ms-windows: look for user-specific registry entries
547        catch { set registry_values [ registry values $prefs_filename ] }
548        if { [ info exists registry_values ] } {
549            foreach curr_registry $registry_values {
550                set curr_value [ registry get $prefs_filename $curr_registry ]
551                set prefs($curr_registry) $curr_value
552            }
553        }
554    } else {
555        # read in prefs file, if it exists
556        array set prefs [ read_settings_file $prefs_filename ]
557        # don't keep info. on failing to read the user's prefs...
558        # they don't have to have a preferences file
559        set settings_file_failures ""
560    }
561    # load in keybindings and natural language support
562    load_language_support
563    load_keybindings
564}
565
566# save user's prefs
567proc save_prefs {} {
568    global prefs
569    global prefs_filename
570    global messages
571
572    set filename $prefs_filename
573    if { [string first HKEY $prefs_filename ] == 0 } {
574        #ms-windows: set user-specific registry entries
575        foreach prefs_key [array names prefs] {
576             registry set $prefs_filename $prefs_key $prefs($prefs_key)
577        }
578    } else {
579        # mac/unix put prefs in user dotfile or mac preferences file
580        # on failed file operation, does user want to retry?
581        set success 0
582        while { ! ($success) } {
583            catch { set prefs_filehandle [open "$prefs_filename" w] }
584            if { [info exists prefs_filehandle] } {
585                set success 1
586            } elseif { [my_dialog  $messages(title:save_fail)  [subst -nocommands -nobackslashes $messages(dialog:save_fail)] error "" $messages(button:retry) $messages(button:cancel) ] == "1" } {
587                    return
588            }
589        }
590
591        # write prefs to file
592        foreach prefs_key [ lsort [array names prefs] ] {
593            puts $prefs_filehandle "$prefs_key = $prefs($prefs_key)"
594        }
595        close $prefs_filehandle
596
597    }
598
599}
600
601#open keybindings file and read its contents into keybind array
602proc load_keybindings {} {
603    global prefs
604    global keybindings
605    global keynames
606    global altkey
607    global commandkey
608    global keynext
609    global keyprior
610    global messages
611    global displayalt
612    global displaycmd
613
614    # Load in defaults
615    array set unparsed_bindings [ default_keybindings ]
616    # Did the user specify a keybindings file in the prefs?
617    if { [array names prefs keybindings] != "" } {
618        # Read in the file
619        array set unparsed_bindings [ read_settings_file $prefs(keybindings)]
620    }
621
622    # Parse raw bindings
623    foreach p1 [array names unparsed_bindings ] {
624        set p2 $unparsed_bindings($p1)
625        set new_keybind ""
626        set new_keyname ""
627        # Substitute for OS-specific keynames
628        regsub -all {PGUP} $p2 $keyprior p2
629        regsub -all {PGDN} $p2 $keynext p2
630        # escape backslashes
631        regsub -all {\\} $p2 {\\\\} p2
632        foreach curr_key $p2 {
633            # parse 'keysym(help_screen)' lines
634            if { ! ( [regexp {([^\(]+)\-\>\((.*)\)} $curr_key full actual display ] ) } {
635                set actual $curr_key
636                set display $curr_key
637            }
638            lappend new_keybind $actual
639            if {$display != ""} {
640                lappend new_keyname $display
641            }
642        }
643        # more os-dependent substitutions
644        regsub -all CMD $new_keybind $commandkey new_keybind
645        regsub -all CMD $new_keyname $displaycmd new_keyname
646        regsub -all {ALT} $new_keyname $displayalt new_keyname
647        regsub -all {ALT} $new_keybind $altkey new_keybind
648        set new_keyname [join $new_keyname " $messages(string:or) "]
649        if { [ string first {note} $p1 ] != 0 } {
650            set new_keyname [format {%-18s} $new_keyname ]
651        }
652        set keybindings($p1) $new_keybind
653        set keynames($p1) $new_keyname
654    }
655}
656
657# default (qwerty keyboard) keybindings
658proc default_keybindings {} {
659    return {
660        back Left
661        forward Right
662        up_string Up
663        down_string Down
664        up_score PGUP->(Page_Up)
665        down_score PGDN->(Page_Down)
666        home Home
667        end End
668        inc_base {plus->(+) equal->()}
669        dec_base {minus->(-) underscore->()}
670        new CMD-n
671        open CMD-o
672        save CMD-s
673        export CMD-e
674        print CMD-p
675        close CMD-w
676        quit_safe {CMD-q Escape->(Esc)}
677        exit CMD-backslash->(CMD-\\)
678        redraw CMD-l
679        help {question->(?) CMD-h}
680        mode Key-Tab->(Tab)
681        lyrics_mode CMD-Key-Tab->(CMD-Tab)
682        mark CMD-m
683        select_all CMD-a
684        copy CMD-c
685        cut CMD-x
686        paste CMD-v
687        undo CMD-u
688        redo CMD-r
689        del_note Delete
690        del_pos Shift-Delete
691        backspace BackSpace
692        tuning {semicolon->(;) colon->()}
693        blanktab_before Insert
694        blanktab_after space
695        whitespace_after Shift-space
696        whitespace_to_endline Return
697        bar {bar->(|) backslash->()}
698        repeat {ALT-semicolon->(ALT-;) ALT-colon->()}
699        mod:0 ALT-minus->(ALT--)
700        mod:1 ALT-h
701        mod:2 ALT-p
702        mod:3 ALT-Key-6->(ALT-6)
703        mod:4 ALT-quoteleft->(ALT-`)
704        mod:5 ALT-slash->(ALT-/)
705        mod:6 ALT-backslash->(ALT-\\)
706        mod:7 ALT-s
707        mod:8 ALT-b
708        mod:9 ALT-r
709        mod:10 ALT-t
710        mod:20 ALT-x
711        note:E.o exclam->(!)
712        note:A.o at->(@)
713        note:D.o numbersign->(#)
714        note:G.o dollar->($)
715        note:B.o percent->(%)
716        note:e.o asciicircum->(^)
717        note:a.o ampersand->(&)
718        note:E.0 Key-1->(1)
719        note:A.0 Key-2->(2)
720        note:D.0 Key-3->(3)
721        note:G.0 Key-4->(4)
722        note:B.0 Key-5->(5)
723        note:e.0 Key-6->(6)
724        note:a.0 Key-7->(7)
725        note:E.1 q
726        note:A.1 w
727        note:D.1 e
728        note:G.1 r
729        note:B.1 t
730        note:e.1 y
731        note:a.1 u
732        note:E.2 a
733        note:A.2 s
734        note:D.2 d
735        note:G.2 f
736        note:B.2 g
737        note:e.2 h
738        note:a.2 j
739        note:E.3 z
740        note:A.3 x
741        note:D.3 c
742        note:G.3 v
743        note:B.3 b
744        note:e.3 n
745        note:a.3 m
746        lyr_left Left
747        lyr_right Right
748        lyr_up Up
749        lyr_down Down
750        lyr_upsection PGUP->(Page_Up)
751        lyr_dnsection PGDN->(Page_Down)
752        lyr_home Home
753        lyr_end End
754        lyr_delete Delete
755        lyr_backspace BackSpace
756        lyr_enter Return
757    }
758}
759
760# set up a global bindtag for each possible type of tablature (4,5,6 string)
761proc keybind_global {} {
762    global keybindings
763    global keybind_funcs
764    global common_funcs
765    global lyrics_funcs
766    global keynames
767    global my_platform
768    global embellish
769    global valid_numstrings
770    global mousebind
771
772    set string_set "E A D G B e a"
773    foreach ns $valid_numstrings {
774        # bulk of the keybindings
775        foreach func_name [ array names keybind_funcs ] {
776            foreach keypress $keybindings($func_name) {
777                bind Tabwindow$ns "<${keypress}>" $keybind_funcs($func_name)
778            }
779        }
780        # keybindings active in both tab and lyrics modes
781        foreach func_name [ array names common_funcs ] {
782            foreach keypress $keybindings($func_name) {
783                bind Tabwindow$ns "<${keypress}>" $common_funcs($func_name)
784            }
785        }
786        # modifiers
787        foreach modnum [ array names embellish ] {
788            foreach keypress $keybindings(mod:$modnum) {
789                bind Tabwindow$ns "<${keypress}>" "modifier $modnum"
790            }
791        }
792
793        # note insertions
794        set string_num $ns
795        foreach bind_string $string_set {
796           incr string_num -1
797           foreach bind_fret "o 0 1 2 3" {
798               foreach keypress $keybindings(note:${bind_string}.${bind_fret}) {
799                   # blank out some keybindings in 4/5-string mode
800                   if { $string_num < 0} {
801                       bind Tabwindow$ns "<${keypress}>" {}
802                   } else {
803                       bind Tabwindow$ns "<${keypress}>" "ins_note $string_num $bind_fret"
804                   }
805               }
806           }
807        }
808    }
809
810    # Mousebindings
811    bind Tablature <ButtonPress-1> "clear_mark; absolute_pos %x %y"
812    bind Tablature <Button1-Motion> "set_mark ; absolute_pos %x %y"
813    bind Tablature <ButtonRelease-1> "tkCancelRepeat"
814    bind Tablature <B1-Leave> {set tkPriv(x) %x ; set tkPriv(y) %y ; dragtab %W absolute_pos}
815    bind Tablature <B1-Enter> {tkCancelRepeat}
816    bind Tablature <$mousebind(paste)> "clear_mark ; absolute_pos %x %y; edit_menu paste"
817    bind Tablature <$mousebind(extend)> "absolute_pos %x %y"
818    foreach disable $mousebind(disable) {
819        bind Tablature <$disable> {}
820    }
821
822    # text/lyrics mode
823    bind Lyrics <ButtonPress-1> "absolute_textpos %x %y"
824    bind Lyrics <Button1-Motion> "text_select %x %y"
825    bind Lyrics <ButtonRelease-1> "tkCancelRepeat"
826    bind Lyrics <$mousebind(paste)> "absolute_textpos %x %y; edit_menu paste"
827    bind Lyrics <$mousebind(extend)> "text_select %x %y"
828    bind Lyrics <KeyPress> "text_insert %A"
829    bind Lyrics <B1-Leave> {set tkPriv(x) %x ; set tkPriv(y) %y ; dragtab %W text_select}
830    bind Lyrics <B1-Enter> {tkCancelRepeat}
831    foreach func_name [ array names lyrics_funcs ] {
832        foreach keypress $keybindings($func_name) {
833            bind Lyrics "<${keypress}>" $lyrics_funcs($func_name)
834        }
835    }
836    foreach func_name [ array names common_funcs ] {
837        foreach keypress $keybindings($func_name) {
838            bind Lyrics "<${keypress}>" $common_funcs($func_name)
839        }
840    }
841
842    # change keyboard acellerator shown in menu items of each open window
843    if { [info exists ::curr_namespace] } {
844        each_namespace label_menu_accel
845    }
846}
847
848#open natural-language support file and read its contents into messages array
849proc load_language_support {} {
850    global prefs
851    global messages
852    global valid_numstrings
853    global save_types
854    global open_types
855    global export_types
856    global language_types
857    global keybind_types
858    global ext
859    global macext
860
861    # load in defaults
862    array set messages [ default_language_support ]
863    # did user specify message file in prefs?
864    if { [array names prefs language] != "" } {
865        # read in the file
866        array set messages [ read_settings_file $prefs(language) ]
867    }
868
869    # fill in constants that need messages array
870    set export_types "
871        {{$messages(string:file_tab)}	{.tab}	}
872        {{$messages(string:file_tab)}	{}  TEXT}
873    "
874    set keybind_types "
875        {{$messages(string:keybind)}	{.etk}	}
876    "
877    set language_types "
878        {{$messages(string:language)}	{.etl}	}
879    "
880
881    foreach ns $valid_numstrings {
882        set filetype($ns) [ subst -nocommands -nobackslashes $messages(string:file_etx) ]
883        set messages(menu:${ns}string) [ subst -nocommands -nobackslashes $messages(menu:xstring) ]
884    }
885    foreach ns $valid_numstrings {
886        set save_types($ns) "
887            {{$filetype($ns)}       {$ext($ns)}       }
888            {{$filetype($ns)}       {}    $macext($ns)}
889        "
890        # put current type at top, followed by the other valid ones
891        set open_types($ns) "
892            {{$filetype($ns)}       {$ext($ns)}       }
893            {{$filetype($ns)}       {}    $macext($ns)}"
894        foreach non_ns $valid_numstrings {
895            if {$non_ns != $ns} {
896                append open_types($ns) "
897                    {{$filetype($non_ns)}       {$ext($non_ns)}       }
898                    {{$filetype($non_ns)}       {}    $macext($non_ns)}"
899            }
900        }
901    }
902}
903
904# default (American English) language support
905proc default_language_support {} {
906    return {
907        string:open Open
908        string:save Save
909        string:export Export
910        string:print Print
911        string:close Close
912        string:untitled Untitled
913        string:mode Mode
914        string:lead Lead
915        string:chord Chord
916        string:lyrics Lyrics
917        string:basefret {Base Fret}
918        string:or or
919        string:color_menu_fg_left {Left Side Menu Foreground}
920        string:color_menu_fg_right {Right Side Menu Foreground}
921        string:color_menu_bg {Menu/Button Background}
922        string:color_tab_fg_default {Tablature Default Foreground}
923        string:color_tab_fg_currpos {Tablature Current Position Foreground}
924        string:color_tab_fg_currstring {Tablature Current String Foreground}
925        string:color_tab_bg_default {Default Tablature Background}
926        string:color_tab_bg_sel {Selected Tablature Background}
927        string:color_help_fg {Help Text Foreground}
928        string:color_help_bg {Help Text Background}
929        string:font_help {Help Font}
930        string:font_tab {Tablature Font}
931        string:font_statusbar {Statusbar Font}
932        string:separation {Tab Spacing}
933        string:width {Tab Width}
934        string:window_width {Window Width}
935        string:window_height {Window Height}
936        string:regular Regular
937        string:bold Bold
938        string:italic Italic
939        string:bold_italic Bold+Italic
940        string:string_name {String $cs}
941        string:file_tab {ASCII Tab}
942        string:keybind Keybindings
943        string:language Language
944        string:file_etx {eTktab $ns String}
945        string:tuning_presets {Tuning Presets}
946        string:name Name
947        string:usage {Usage: $argv0 [tablature file]
948}
949        title:help {Help: eTktab$version}
950        title:tuning {Set Instrument Tuning}
951        title:about {About eTktab}
952        title:prefs_verify {Overwrite Preferences}
953        title:save_fail {Save Failed}
954        title:open_fail {Open Failed}
955        title:file_bad {File Format Bad}
956        title:close_verify {File not Saved!}
957        title:color {Choose Colors}
958        title:print_return {Printing Results}
959        dialog:about {eTktab $version by $author
960$webpage}
961        dialog:save_fail {Save operation failed for file:  $filename}
962        dialog:open_fail {Open operation failed for file:  $filename}
963        dialog:file_bad {eTktab$version cannot read the file format of $filename}
964        dialog:close_verify {$filename has been modified.  Do you want to save before closing?}
965        dialog:prefs_verify {This will overwrite all saved preferences.  Are you sure?}
966        dialog:print_command {Print Command:}
967        dialog:print_select {Select Printer:}
968        dialog:page_length {Page Length:}
969        dialog:print_unsupported {Sorry, printing not supported in Mac OS older than 10.2}
970        button:tuning Tuning
971        button:help Help
972        button:ok OK
973        button:cancel Cancel
974        button:yes Yes
975        button:no No
976        button:retry Retry
977        button:add Add
978        button:edit Edit
979        button:delete Delete
980        menu:file File
981        menu:new New
982        menu:save_as {Save As}
983        menu:close Close
984        menu:quit Quit
985        menu:edit Edit
986        menu:windows Windows
987        menu:undo {Undo $undo_menu}
988        menu:redo {Redo $redo_menu}
989        menu:cut Cut
990        menu:copy Copy
991        menu:clear Clear
992        menu:paste Paste
993        menu:select_all {Select All}
994        menu:options Preferences
995        menu:default_numstrings {New Document Default}
996        menu:default_tuning {Default Tuning}
997        menu:format {Document Formatting}
998        menu:default_format {Default Formatting}
999        menu:font Fonts
1000        menu:color Colors
1001        menu:revert {Revert to Defaults}
1002        menu:xstring {$ns string}
1003        history:note {Insert Note}
1004        history:tuning {Change Tuning}
1005        history:delete {Delete Tablature}
1006        history:del_note {Delete Note}
1007        history:blanktab {Insert Blank Tab}
1008        history:whitespace {Insert Space}
1009        history:cut {Cut Tablature}
1010        history:clear {Clear Tablature}
1011        history:paste {Paste Tablature}
1012        history:expression {Expression Mark}
1013        history:repeat {Toggle Repeat Symbol}
1014        history:bar {Insert Bar}
1015        history:newline {New Line}
1016        history:text_cut {Cut Lyrics}
1017        history:text_del {Delete Character}
1018        history:text_clear {Clear Lyrics}
1019        history:text_insert {Insert Lyrics}
1020        history:text_paste {Paste Lyrics}
1021        help:start {This help document describes the eTktab keybindings.  For a more general
1022explanation of how the program works, please see the 'README.html' file that
1023comes with the program.
1024
1025Inserting notes:
1026
1027Chord mode does not advance the cursor after each inserted note, lead mode
1028does.  This mode may be changed via pulldown menu or keys in the Misc. section
1029
1030
1031          STRING (guitar)             STRING (banjo)            STRING (bass)
1032
1033            E A D G B E                  G B G B D                  E A D G
1034          +-------------+              +-----------+              +---------+
1035F  base+0 | $keynames(note:E.0) $keynames(note:A.0) $keynames(note:D.0) $keynames(note:G.0) $keynames(note:B.0) $keynames(note:e.0) |    F  base+0 | $keynames(note:E.0) $keynames(note:A.0) $keynames(note:D.0) $keynames(note:G.0) $keynames(note:B.0) |    F  base+0 | $keynames(note:E.0) $keynames(note:A.0) $keynames(note:D.0) $keynames(note:G.0) |
1036R  base+1 | $keynames(note:E.1) $keynames(note:A.1) $keynames(note:D.1) $keynames(note:G.1) $keynames(note:B.1) $keynames(note:e.1) |    R  base+1 | $keynames(note:E.1) $keynames(note:A.1) $keynames(note:D.1) $keynames(note:G.1) $keynames(note:B.1) |    R  base+1 | $keynames(note:E.1) $keynames(note:A.1) $keynames(note:D.1) $keynames(note:G.1) |
1037E  base+2 | $keynames(note:E.2) $keynames(note:A.2) $keynames(note:D.2) $keynames(note:G.2) $keynames(note:B.2) $keynames(note:e.2) |    E  base+2 | $keynames(note:E.2) $keynames(note:A.2) $keynames(note:D.2) $keynames(note:G.2) $keynames(note:B.2) |    E  base+2 | $keynames(note:E.2) $keynames(note:A.2) $keynames(note:D.2) $keynames(note:G.2) |
1038T  base+3 | $keynames(note:E.3) $keynames(note:A.3) $keynames(note:D.3) $keynames(note:G.3) $keynames(note:B.3) $keynames(note:e.3) |    T  base+3 | $keynames(note:E.3) $keynames(note:A.3) $keynames(note:D.3) $keynames(note:G.3) $keynames(note:B.3) |    T  base+3 | $keynames(note:E.3) $keynames(note:A.3) $keynames(note:D.3) $keynames(note:G.3) |
1039
1040   open   | $keynames(note:E.o) $keynames(note:A.o) $keynames(note:D.o) $keynames(note:G.o) $keynames(note:B.o) $keynames(note:e.o) |       open   | $keynames(note:E.o) $keynames(note:A.o) $keynames(note:D.o) $keynames(note:G.o) $keynames(note:B.o) |       open   | $keynames(note:E.o) $keynames(note:A.o) $keynames(note:D.o) $keynames(note:G.o) |
1041
1042* base is shown in the status line and is changed via pulldown menu or the
1043  keys listed in the 'Miscellaneous' section, below
1044* bindings in the 'open' row are always at fret 0 (ignoring base fret)
1045________________________________________________________________________________
1046Cursor Movement:
1047
1048$keynames(up_string)  up a string         $keynames(down_string)  down a string
1049$keynames(back)  left a position     $keynames(forward)  right a position
1050$keynames(up_score)  up a score          $keynames(down_score)  down a score
1051
1052left mouse button click    unset mark (if any) and move to mouse position
1053________________________________________________________________________________
1054Insert/Delete:
1055
1056$keynames(backspace)  delete previous position OR clear (*)
1057$keynames(del_note)  delete note under cursor OR clear (*)
1058$keynames(del_pos)  delete current position  OR clear (*)
1059$keynames(blanktab_before)  insert a new position at the cursor
1060$keynames(blanktab_after)  insert a new position after the cursor
1061$keynames(whitespace_after)  insert whitespace at the cursor
1062$keynames(whitespace_to_endline)  fill in whitespace to the end of the current line
1063
1064    (*) if there is currently a highlighted area (if a mark is set) this key
1065        will clear that area instead of its usual function
1066________________________________________________________________________________
1067Note Alterations:
1068
1069$keynames(mod:5)  slide up to note    $keynames(mod:6)  slide down to note
1070$keynames(mod:8)  bend                $keynames(mod:9)  release bend
1071$keynames(mod:1)  hammer-on           $keynames(mod:2)  pull-off
1072$keynames(mod:4)  vibrato (~)         $keynames(mod:3)  harmonic (^)
1073$keynames(mod:7)  slap/pop            $keynames(mod:10)  right-hand tapping
1074$keynames(mod:20)  muted               $keynames(mod:0)  remove alteration
1075________________________________________________________________________________
1076Cut/Paste:
1077
1078$keynames(mark)  (un)set mark        $keynames(select_all)  select all
1079$keynames(copy)  copy highlighted tab
1080$keynames(cut)  cut highlighted tab $keynames(paste)  paste(*)
1081$keynames(undo)  undo                $keynames(redo)  redo
1082
1083$keynames(del_note)/   $keynames(backspace)  SEE Insert/Delete section above
1084
1085left mouse button click    unset mark (if any) and move to mouse position
1086left mouse button drag     highlight dragged over area}
1087        help:unix_mouse {
1088middle mouse button        paste(*)
1089right mouse button         move to mouse position; extend highlighted area}
1090        help:windows_mouse {
1091shift-left button click    move to mouse position; extend highlighted area
1092right mouse button         paste(*)}
1093        help:macintosh_mouse {
1094shift-left button click    move to mouse position; extend highlighted area
1095right mouse button         paste(*)
1096    NOTE:  'left button' bindings only, on a 1-button mouse}
1097        help:end {
1098
1099    (*) if there is currently a highlighted area (if a mark is set) the paste
1100        function replaces the highlighted tab
1101________________________________________________________________________________
1102Miscellaneous:
1103
1104$keynames(inc_base)  increase basefret   $keynames(dec_base)  decrease basefret
1105$keynames(bar)  add a bar           $keynames(repeat)  toggle repeat (*)
1106$keynames(mode)  toggle chord/lead   $keynames(lyrics_mode)  toggle lyrics/tab
1107$keynames(tuning)  change guitar tuning
1108
1109    (*) repeat symbols on bar lines... looking like this   |:   :|
1110________________________________________________________________________________
1111File I/O:
1112
1113$keynames(help)  HELP                $keynames(redraw)  redraw screen
1114$keynames(quit_safe)  quit with save      $keynames(exit)  quit without save
1115$keynames(open)  open eTktab file    $keynames(save)  save eTktab file
1116$keynames(export)  export ascii tab    $keynames(new)  new tab
1117$keynames(close)  close document      $keynames(print)  print tab
1118
1119________________________________________________________________________________}
1120    }
1121}
1122
1123# revert all preferences to defaults
1124proc pref_revert {} {
1125    global prefs
1126    global default_prefs
1127    global curr_namespace
1128    global messages
1129    global prefs_button
1130    variable ${curr_namespace}::tabwin
1131
1132    set w .prefs_verify
1133    if { [ winfo exists $w ] } {
1134        raise $w
1135        focus $w
1136        return
1137    }
1138    if { [ basic_transient $w $messages(title:prefs_verify) ] == -1 } {
1139        return
1140    }
1141
1142    label $w.text -text $messages(dialog:prefs_verify)
1143    pack $w.text -side top -fill x
1144    $w.buttons.cancel configure -command "
1145        set prefs_button -1
1146    "
1147    $w.buttons.ok configure -default active -command "
1148        set prefs_button 1
1149    "
1150    wm transient $w $tabwin
1151    grab $w
1152
1153    tkwait variable prefs_button
1154    grab release $w
1155    destroy $w
1156    if {$prefs_button == -1 } {
1157        unset prefs_button
1158        return
1159    }
1160    unset prefs_button
1161
1162    set old_keybindings [ array names prefs keybindings ]
1163    set old_language [ array names prefs language ]
1164
1165    # reset all preferences
1166    unset prefs
1167    array set prefs [ array get default_prefs ]
1168    # save changes
1169    save_prefs
1170
1171    # reload default keybindings and language support, if necessary
1172    if {$old_language != ""} {
1173        load_language_support
1174        each_namespace label_gui
1175    }
1176    if {$old_keybindings != ""} {
1177        load_keybindings
1178        keybind_global
1179    }
1180    each_namespace color_gui
1181}
1182
1183#set pref for default new tablature type
1184proc pref_numstrings {strings} {
1185    global prefs
1186    global curr_namespace
1187
1188    save_prefs
1189
1190    # change behavior of 'new tab' keybinding in each open tab window
1191    keybind_global
1192}
1193
1194# show user reqested color combinations in color prefs window
1195proc trycolor {} {
1196    global temp_colors
1197
1198    foreach color_pref [ array names temp_colors] {
1199        switch -glob -- $color_pref {
1200            {*bg*}
1201                {.color.test tag configure $color_pref -background $temp_colors($color_pref)}
1202            {*fg*}
1203                {.color.test tag configure $color_pref -foreground $temp_colors($color_pref)}
1204        }
1205    }
1206}
1207
1208# place transient window centered over its parent
1209proc place_transient {window} {
1210    global my_platform
1211    global curr_namespace
1212    variable ${curr_namespace}::tabwin
1213
1214    wm withdraw $window
1215    set x [expr {[winfo screenwidth $window]/2 - \
1216        [winfo reqwidth $window]/2 - [winfo vrootx $tabwin]}]
1217    set y [expr {[winfo screenheight $window]/2 - \
1218        [winfo reqheight $window]/2 - [winfo vrooty $tabwin]}]
1219    wm geom $window +$x+$y
1220    wm resizable $window no no
1221    wm transient $window $tabwin
1222    wm deiconify $window
1223
1224    #ms-windows doesn't seem to want to focus on our new toplevel windows
1225    if {$my_platform(platform)=="windows"} {
1226        update idletasks
1227        focus -force $window
1228    }
1229}
1230
1231# lower and uppercase bindings of the first letter of a button's text
1232proc button_bind {args} {
1233    global altkey
1234
1235    getopt opts {alt} $args
1236    if {$opts(alt) > 0 } {
1237        set prefix ${altkey}-
1238    } else {
1239        set prefix ""
1240    }
1241    set widget [lindex $opts(EXTRA) 0]
1242    set window [winfo toplevel $widget]
1243    set buttontext [$widget cget -text]
1244
1245    foreach i "tolower toupper" {
1246        bind $window "<${prefix}Key-[string $i [string index $buttontext 0 ] ]>" "$widget invoke"
1247    }
1248}
1249
1250# 'spinboxes' are only in tcl/tk 8.4, don't want to require that to run eTktab
1251# This code based on a Richard Suchenwirth post to wiki.tcl.tk
1252proc arrowbuttons {w placement upcommand dncommand} {
1253    global prefs
1254    global images
1255
1256    #create arrow images to be used in homemade 'spinboxes'
1257    if {![info exists images($placement.up)]} {
1258        set images($placement.up) [image create bitmap -data "#define i_width 5\n#define i_height 3\nstatic char i_bits = {\n4,14,31}"]
1259        set images($placement.dn) [image create bitmap -data "#define i_width 5\n#define i_height 3\nstatic char i_bits = {\n31,14,4}"]
1260    }
1261
1262    frame $w
1263    foreach i {up dn} {
1264        set arr $w.$i
1265        # add repeating fuctionality to arrow button... more code based on wiki
1266        proc repeat$arr {arr pause} {
1267            if {![set ::ok_$arr]} {
1268                return
1269            }
1270            $arr config -relief sunken
1271            uplevel eval [$arr cget -command]
1272            after $pause "repeat$arr $arr 100"
1273        }
1274        button $arr -image $images($placement.$i) -width 10 -height 4 -command [set ${i}command ]
1275        bind $arr <ButtonPress-1> {set ::ok_%W 1; repeat%W %W 1000}
1276        bind $arr <ButtonRelease-1> "set ::ok_%W 0; $arr config -relief raised"
1277        bind $arr <Leave> [ bind Button <Leave> ]
1278        bind $arr <Enter> [ bind Button <Enter> ]
1279        bindtags $arr [lreplace [bindtags $arr] 1 1 ]
1280    }
1281    pack $w.up -anchor n
1282    pack $w.dn -anchor s
1283}
1284
1285# process 'shorthand' notation for creating a menubutton
1286proc my_menubutton {mb_name args} {
1287    set menu_items [lrange $args end end]
1288    set args [lreplace $args end end]
1289    eval "menubutton $mb_name -menu $mb_name.menu $args"
1290    eval "my_menu $mb_name.menu $menu_items"
1291    set mb_width 0
1292}
1293
1294# process 'shorthand' notation for creting a menu
1295proc my_menu {menu_name menu_items} {
1296    menu $menu_name
1297    foreach item $menu_items {
1298        switch -exact -- [lindex $item 0] {
1299            {command}
1300                {set item [linsert $item [ expr [ llength $item ] - 1] -command]}
1301            {cascade} {
1302                my_menu $menu_name.[lindex $item 1] [lindex $item 2]
1303                set item [lreplace $item 1 2 -menu $menu_name.[lindex $item 1]]
1304            }
1305        }
1306        eval "$menu_name add $item"
1307    }
1308}
1309
1310# call standard tk color dialog, and change OK, Cancel button text
1311proc my_chooseColor {args} {
1312    global messages
1313
1314    set frame .__tk__color.bot
1315    after idle "catch {$frame.ok configure -text $messages(button:ok)}"
1316    after idle "catch {button_bind -alt $frame.ok}"
1317    after idle "catch {$frame.cancel configure -text $messages(button:cancel)}"
1318    after idle "catch {button_bind -alt $frame.cancel}"
1319    return [ eval [ linsert $args 0 tk_chooseColor ] ]
1320}
1321
1322# call standard tk file dialog, and change Open, Save, Cancel button text
1323proc my_filedialog {args} {
1324    global messages
1325
1326    set w .__tk_filedialog
1327    set parent [ lsearch -exact $args -parent ]
1328    if {$parent > 0} {
1329        set w [ lindex $args [expr $parent + 1] ]$w
1330    }
1331    if { [ lindex $args 0 ] == "tk_getOpenFile" } {
1332        set buttontext(f2.ok) $messages(string:open)
1333    } else {
1334        set buttontext(f2.ok) $messages(string:save)
1335    }
1336    set buttontext(f3.cancel) $messages(button:cancel)
1337
1338    foreach widget [ array names text ] {
1339        after idle "catch {$w.$widget configure -text $buttontext($widget)}"
1340        after idle "catch {button_bind -alt $w.$widget}"
1341    }
1342    return [ eval $args ]
1343}
1344
1345# call standard tk dialog creation proc, and add keyboard bindings
1346proc my_dialog {args} {
1347    global curr_namespace
1348    variable ${curr_namespace}::tabwin
1349
1350    set w "${tabwin}.dialog"
1351    for { set i 0 } { $i < [ expr [llength $args] - 4] } { incr i } {
1352        after idle button_bind ${w}.button$i
1353    }
1354    return [ eval [ linsert $args 0 tk_dialog $w ] ]
1355}
1356
1357# proc to handle windows/mac documents dragged to eTktab
1358proc tkOpenDocument {args} {
1359    global used_dragdrop
1360
1361    set used_dragdrop 1
1362    foreach file $args {
1363        new_tab -file $file
1364    }
1365}
1366
1367# tkOpenDocument moved to ::tk::mac namespace in tk 8.4
1368if { ($my_platform(platform) == "macintosh") && ( $tcl_version > 8.3 ) } {
1369    rename tkOpenDocument ::tk::mac::OpenDocument
1370}
1371
1372# close all windows, checking if each document was saved
1373proc quit_safe {args} {
1374    global curr_namespace
1375
1376    each_namespace {
1377        set currwin [set [ string range $curr_namespace 2 end ]::tabwin]
1378        if { [ focus ] != $currwin} {
1379            switchfocus $currwin
1380        }
1381        close_tab
1382    }
1383}
1384
1385# redraw menu of available windows
1386proc refresh_winmenu {} {
1387    catch {.docmenu delete 0 end}
1388    each_namespace {
1389        set currwin [set [ string range $curr_namespace 2 end ]::tabwin]
1390        .docmenu add radiobutton -label [lrange [wm title $currwin] 2 end] -command "switchfocus $currwin" -value $curr_namespace -variable ::curr_namespace
1391    }
1392}
1393
1394# change which window has focus
1395proc switchfocus {currwin} {
1396    catch {wm deiconify $currwin}
1397    raise $currwin
1398    focus $currwin
1399}
1400
1401# about window
1402proc about {} {
1403    global author
1404    global version
1405    global webpage
1406    global messages
1407
1408    if { [ basic_transient -nocancel .about $messages(title:about) ] == -1 } {
1409        return
1410    }
1411
1412    label .about.text -text [subst -nobackslashes -nocommands $messages(dialog:about)]
1413    pack .about.text -side top -fill x
1414}
1415
1416# help window
1417proc help {} {
1418    global prefs
1419    global my_platform
1420    global version
1421    global keynames
1422    global messages
1423    global keyprior
1424    global keynext
1425    global clover
1426
1427    if { [ winfo exists .helpwin ] } {
1428        raise .helpwin
1429        focus .helpwin
1430        return
1431    }
1432    toplevel .helpwin -class Textwin
1433    wm title .helpwin [subst -nocommands -nobackslashes $messages(title:help) ]
1434    frame .helpwin.msg_frame -background $prefs(color_menu_bg)
1435    frame .helpwin.buttons -background $prefs(color_menu_bg)
1436    button .helpwin.buttons.can -background $prefs(color_menu_bg) -font $prefs(font_statusbar) -highlightbackground $prefs(color_menu_bg) -foreground $prefs(color_menu_fg_left) -text $messages(string:close) -default active -command {destroy .helpwin}
1437
1438    text .helpwin.txt -font $prefs(font_help) -foreground $prefs(color_help_fg) -background $prefs(color_help_bg) -width 80 -height 40 -yscrollcommand ".helpwin.scrolly set" -xscrollcommand ".helpwin.scrollx set"
1439    scrollbar .helpwin.scrollx -background $prefs(color_menu_bg) -highlightbackground $prefs(color_menu_bg) -activebackground $prefs(color_menu_bg) -orient horizontal -command ".helpwin.txt xview"
1440    scrollbar .helpwin.scrolly -background $prefs(color_menu_bg) -highlightbackground $prefs(color_menu_bg) -activebackground $prefs(color_menu_bg) -command ".helpwin.txt yview"
1441
1442    #put actual help contents in window
1443    .helpwin.txt insert end [subst -nocommands -nobackslashes $messages(help:start)]
1444    .helpwin.txt insert end [subst -nocommands -nobackslashes $messages(help:$my_platform(platform)_mouse)]
1445    .helpwin.txt insert end [subst -nocommands -nobackslashes $messages(help:end)]
1446
1447    .helpwin.txt configure -state disabled
1448    # some versions of macos won't allow us to change button bg color,font
1449    if {$my_platform(platform)!="macintosh"} {
1450        .helpwin.buttons.can configure -font $prefs(font_statusbar)
1451    } else {
1452       # change font of each cloverleaf char to 'Chicago'
1453       .helpwin.txt tag configure chicago -font "Chicago [lrange $prefs(font_help) 1 end]"
1454       set nextclover [.helpwin.txt search -forwards -exact -- "\x11" {1.0} end]
1455       while { $nextclover != ""} {
1456           .helpwin.txt tag add chicago $nextclover
1457           set nextclover "$nextclover + 1 chars"
1458           set nextclover [.helpwin.txt search -forwards -exact -- "\x11" $nextclover end]
1459       }
1460    }
1461    # keybindings
1462    bind .helpwin <Key-Return> ".helpwin.buttons.can invoke"
1463    bind .helpwin <Key-Left> ".helpwin.txt xview scroll -1 units"
1464    bind .helpwin <Key-Right> ".helpwin.txt xview scroll 1 units"
1465    bind .helpwin <Key-Up> ".helpwin.txt yview scroll -1 units"
1466    bind .helpwin <Key-Down> ".helpwin.txt yview scroll 1 units"
1467    bind .helpwin <Key-$keyprior> ".helpwin.txt yview scroll -1 pages"
1468    bind .helpwin <Key-$keynext> ".helpwin.txt yview scroll 1 pages"
1469    bind .helpwin <Key-Home> ".helpwin.txt yview moveto 0"
1470    bind .helpwin <Key-End> ".helpwin.txt yview moveto 1"
1471
1472    pack .helpwin.buttons.can -pady 4 -side left
1473
1474    grid rowconfig .helpwin.msg_frame 0 -weight 1 -minsize 0
1475    grid columnconfig .helpwin.msg_frame 0 -weight 1 -minsize 0
1476    grid .helpwin.txt -in .helpwin.msg_frame -row 0 -column 0 -rowspan 1 -columnspan 1 -sticky news
1477    grid .helpwin.scrolly -in .helpwin.msg_frame -row 0 -column 1 -rowspan 1 -columnspan 1 -sticky news
1478    grid .helpwin.scrollx -in .helpwin.msg_frame -row 1 -column 0 -rowspan 1 -columnspan 1 -sticky news
1479
1480    pack .helpwin.buttons -side top -fill both
1481    pack .helpwin.msg_frame -side top -fill both -expand true
1482    #ms-windows doesn't seem to want to focus on our new toplevel windows
1483    if {$my_platform(platform)=="windows"} {
1484        update idletasks
1485        focus -force .helpwin
1486    }
1487}
1488
1489
1490#######################################
1491### FUNCTIONS THAT ACT ON CURRENTLY FOCUSED TAB WINDOW
1492###
1493
1494#
1495# back end stuff, user doesn't call directly
1496#
1497
1498# initialize all globals that do get reset at new document
1499proc initialize_vars {new_namespace} {
1500    global messages
1501    global prefs
1502    variable ${new_namespace}::basefret
1503    variable ${new_namespace}::data_end
1504    variable ${new_namespace}::fret
1505    variable ${new_namespace}::insert_mode
1506    variable ${new_namespace}::mode_old
1507    variable ${new_namespace}::mark
1508    variable ${new_namespace}::num_strings
1509    variable ${new_namespace}::pos
1510    variable ${new_namespace}::saved
1511    variable ${new_namespace}::string
1512    variable ${new_namespace}::tabwin
1513    variable ${new_namespace}::winnum
1514    variable ${new_namespace}::score_width
1515    variable ${new_namespace}::row_sep_lines
1516    variable ${new_namespace}::text
1517
1518    # which window are we in?
1519    set winnum [ namespace tail $new_namespace ]
1520    set tabwin .tabwin$winnum
1521
1522    # chord or note insertion type
1523    set insert_mode $messages(string:lead)
1524    set mode_old $insert_mode
1525
1526    # where do we start on the fretboard?
1527    set fret 0
1528    set string 0
1529    set basefret 0
1530
1531    # erase any "mark"
1532    set mark -1
1533
1534    # is the file saved ?
1535    set saved 1
1536
1537    # current position
1538    set pos 0
1539
1540    set data_end 0
1541
1542    set score_width $prefs(score_width)
1543
1544    # blank lines between scores
1545    set row_sep_lines $prefs(row_sep_lines)
1546
1547    initialize_numstrings $new_namespace
1548}
1549
1550proc initialize_numstrings {namespace} {
1551    global blank_tab
1552    global blank_asciitab
1553    global prefs
1554    variable ${namespace}::num_strings
1555    variable ${namespace}::tab_data
1556    variable ${namespace}::tab_ascii
1557    variable ${namespace}::tuning
1558
1559    array set tuning $prefs(tuning_$num_strings)
1560
1561    # start with blank tablature
1562    set tab_data $blank_tab($num_strings)
1563    array set tab_ascii $blank_asciitab($num_strings)
1564
1565    process_formatting $namespace
1566}
1567
1568# empty the undo/redo buffers
1569proc history_clear {} {
1570    global curr_namespace
1571    variable ${curr_namespace}::redo
1572    variable ${curr_namespace}::undo
1573
1574    foreach i {tab_data pos tuning mark last_action text text_pos text_mark} {
1575            set undo($i) ""
1576            set redo($i) ""
1577    }
1578}
1579
1580# add to the undo buffer
1581proc history_add {last_action} {
1582    global curr_namespace
1583    global histsteps
1584    global messages
1585    variable ${curr_namespace}::redo
1586    variable ${curr_namespace}::undo
1587    variable ${curr_namespace}::tabwin
1588
1589    set text_pos [$tabwin.tablature index insert]
1590    set text_mark ""
1591    catch { set text_mark [$tabwin.tablature index lyr_selection] }
1592    foreach i {tuning text} {
1593        variable ${curr_namespace}::$i
1594        set redo($i) ""
1595        listshift undo $i $histsteps [ array get $i ]
1596    }
1597    foreach i {tab_data pos mark} {
1598        variable ${curr_namespace}::$i
1599        set redo($i) ""
1600        listshift undo $i $histsteps [set $i]
1601    }
1602    foreach i {last_action text_pos text_mark} {
1603        set redo($i) ""
1604        listshift undo $i $histsteps [set $i]
1605    }
1606    set_saved 0
1607    ghost_menu normal menu:undo undo_menu $last_action
1608    ghost_menu disabled menu:redo redo_menu {}
1609}
1610
1611# replace current tab with most recent in undo buffer
1612proc history_undo {} {
1613    global curr_namespace
1614    global histsteps
1615    global messages
1616    variable ${curr_namespace}::redo
1617    variable ${curr_namespace}::undo
1618    variable ${curr_namespace}::tabwin
1619    variable ${curr_namespace}::insert_mode
1620
1621    if { $undo(pos) == "" } {
1622        return
1623    }
1624
1625    listshift redo last_action $histsteps [ listpop undo last_action ]
1626    listshift redo text_pos $histsteps [ $tabwin.tablature index insert ]
1627    set text_mark ""
1628    catch { set text_mark [$tabwin.tablature index lyr_selection] }
1629    listshift redo text_mark $histsteps $text_mark
1630    foreach i {tuning text} {
1631        variable ${curr_namespace}::$i
1632        listshift redo $i $histsteps [ array get $i ]
1633        array set $i [ listpop undo $i ]
1634    }
1635    foreach i {tab_data pos mark} {
1636        variable ${curr_namespace}::$i
1637
1638        listshift redo $i $histsteps [set $i]
1639        set $i [ listpop undo $i ]
1640    }
1641    set_saved 0
1642    redraw_full
1643    ghost_menu normal menu:redo redo_menu [lindex $redo(last_action) 0]
1644    set undo_length [ llength $undo(pos) ]
1645    if { $undo_length == 0 } {
1646        ghost_menu disabled menu:undo undo_menu {}
1647    } else {
1648        ghost_menu normal menu:undo undo_menu [lindex $undo(last_action) 0]
1649    }
1650    if { $insert_mode == $messages(string:lyrics) } {
1651        $tabwin.tablature mark set insert [ listpop undo text_pos ]
1652        $tabwin.tablature see insert
1653        set text_mark [ listpop undo text_mark ]
1654        if { $text_mark == "" } {
1655            catch {$tabwin.tablature mark unset lyr_selection}
1656            ghost_cutcopy disabled
1657        } else {
1658            $tabwin.tablature mark set lyr_selection $text_mark
1659            ghost_cutcopy normal
1660        }
1661        recolor_tab_full -notwhitespace
1662    } elseif { $mark == -1 } {
1663        ghost_cutcopy disabled
1664    } else {
1665        ghost_cutcopy normal
1666    }
1667}
1668
1669# replace current tab with most recent in redo buffer
1670proc history_redo {} {
1671    global curr_namespace
1672    global histsteps
1673    global messages
1674    variable ${curr_namespace}::redo
1675    variable ${curr_namespace}::tuning
1676    variable ${curr_namespace}::undo
1677    variable ${curr_namespace}::tabwin
1678    variable ${curr_namespace}::insert_mode
1679
1680    if { $redo(pos) == "" } {
1681        return
1682    }
1683
1684    listshift undo last_action $histsteps [ listpop redo last_action ]
1685    listshift undo text_pos $histsteps [ $tabwin.tablature index insert ]
1686    set text_mark ""
1687    catch { set text_mark [$tabwin.tablature index lyr_selection] }
1688    listshift undo text_mark $histsteps $text_mark
1689    foreach i {tuning text} {
1690        variable ${curr_namespace}::$i
1691        listshift undo $i $histsteps [ array get $i ]
1692        array set $i [ listpop redo $i ]
1693    }
1694    foreach i {tab_data pos mark} {
1695        variable ${curr_namespace}::$i
1696
1697        listshift undo $i $histsteps [set $i ]
1698        set $i [ listpop redo $i ]
1699    }
1700    set_saved 0
1701    redraw_full
1702    ghost_menu normal menu:undo undo_menu [lindex $undo(last_action) 0]
1703    set redo_length [ llength $redo(pos) ]
1704    if { $redo_length == 0 } {
1705        ghost_menu disabled menu:redo redo_menu {}
1706    } else {
1707        ghost_menu normal menu:redo redo_menu [lindex $redo(last_action) 0]
1708    }
1709    if { $insert_mode == $messages(string:lyrics) } {
1710        $tabwin.tablature mark set insert [ listpop redo text_pos ]
1711        $tabwin.tablature see insert
1712        set text_mark [ listpop redo text_mark ]
1713        if { $text_mark == "" } {
1714            catch {$tabwin.tablature mark unset lyr_selection}
1715            ghost_cutcopy disabled
1716        } else {
1717            $tabwin.tablature mark set lyr_selection $text_mark
1718            ghost_cutcopy normal
1719        }
1720        recolor_tab_full -notwhitespace
1721    } elseif { $mark == -1 } {
1722        ghost_cutcopy disabled
1723    } else {
1724        ghost_cutcopy normal
1725    }
1726}
1727
1728# put human readable copy of marked tablature in system's clipboard
1729proc update_clipboard {} {
1730    global curr_namespace
1731    global clip
1732    variable ${curr_namespace}::mark
1733    variable ${curr_namespace}::pos
1734
1735    selection own -selection "CLIPBOARD" .
1736    selection own -selection "PRIMARY" .
1737    selection own -selection "ETKTAB" .
1738    clipboard clear
1739    clipboard append $clip
1740}
1741
1742# push out clipboard contents
1743proc clipboard_dump {offset maxbytes} {
1744    global clip
1745
1746    return [string range $clip $offset [expr $offset + $maxbytes ] ]
1747}
1748
1749# push out paste buffer contents
1750proc pastebuf_dump {offset maxbytes} {
1751    global pastebuf
1752
1753    return [string range $pastebuf $offset [expr $offset + $maxbytes ] ]
1754}
1755
1756# change enable/disable state of cut,copy,clear menu items
1757proc ghost_cutcopy {state} {
1758    global curr_namespace
1759    variable ${curr_namespace}::mark
1760
1761    foreach item {cut copy clear} {
1762            ghost_menu $state menu:$item
1763    }
1764}
1765
1766# change enable/disable (and/or text) of menu items
1767proc ghost_menu {state textkey args} {
1768    global curr_namespace
1769    global messages
1770    global gui_label
1771    variable ${curr_namespace}::tabwin
1772
1773    # read in any variables necessary for variable substitution below
1774    array set data $args
1775    foreach varname [array names data] {
1776        set $varname $data($varname)
1777    }
1778    foreach widget $gui_label($textkey) {
1779        $tabwin.[lindex $widget 0] entryconfigure [lindex $widget 1] -state $state -label [subst -nocommands -nobackslashes $messages($textkey)]
1780    }
1781}
1782
1783# change color of 'save' menu item
1784proc set_saved {status} {
1785    global curr_namespace
1786    global prefs
1787    global messages
1788    variable ${curr_namespace}::tabwin
1789    variable ${curr_namespace}::saved
1790
1791    set saved $status
1792    if {$status == 1 } {
1793        set state disabled
1794    } else {
1795        set state normal
1796    }
1797
1798    $tabwin.msg_frame.left_frame.file.menu entryconfigure $messages(string:save) -state $state
1799}
1800
1801# set values that depend on the text formatting values
1802proc process_formatting {namespace} {
1803    global initial_col
1804    global col_width
1805    variable ${namespace}::num_strings
1806    variable ${namespace}::score_width
1807    variable ${namespace}::col_max
1808    variable ${namespace}::row_sep
1809    variable ${namespace}::row_sep_lines
1810
1811    # set last position possible on a line
1812    set col_max [ expr int (($score_width - $initial_col) / $col_width) ]
1813
1814    # blank lines between scores
1815    set row_sep ""
1816    for { set i 0 } { $i < $row_sep_lines } { incr i } {
1817        append row_sep "\n"
1818    }
1819}
1820
1821# finds the right col and row in function of pos
1822proc calc_rowcol {position} {
1823    global curr_namespace
1824    variable ${curr_namespace}::col_max
1825
1826    set column [ expr $position % $col_max ]
1827    set score [ expr ($position - $column) / $col_max ]
1828    return "row $score col $column"
1829}
1830
1831# replaces notes on all strings with note sent as arg
1832proc replace_pos {fill} {
1833    global curr_namespace
1834    variable ${curr_namespace}::num_strings
1835    variable ${curr_namespace}::pos
1836    variable ${curr_namespace}::tab_data
1837
1838    for { set i 0 } { $i < $num_strings } { incr i } {
1839        set tab_data [ lreplace $tab_data $pos $pos [ lreplace [ lindex $tab_data $pos ] $i $i $fill ] ]
1840    }
1841    asciitab_replace $pos 1 1
1842}
1843
1844# due to moving of $mark or $pos, need to recolor a range of tab
1845proc recolor_tab_full {args} {
1846    global col_width
1847    global curr_namespace
1848    global initial_col
1849    global col_width
1850    global messages
1851    variable ${curr_namespace}::col_max
1852    variable ${curr_namespace}::row_sep_lines
1853    variable ${curr_namespace}::mark
1854    variable ${curr_namespace}::num_strings
1855    variable ${curr_namespace}::pos
1856    variable ${curr_namespace}::string
1857    variable ${curr_namespace}::tabwin
1858    variable ${curr_namespace}::data_end
1859    variable ${curr_namespace}::insert_mode
1860    variable ${curr_namespace}::score_width
1861    variable ${curr_namespace}::tab_data
1862
1863    # this loop removes old color coding en masse
1864    foreach i "marked currpos currstring" {
1865        catch { $tabwin.tablature tag remove $i 0.0 end }
1866    }
1867
1868    # draw whitespace appropriately
1869    if { [ string trim $args ] != "-notwhitespace" } {
1870        catch { $tabwin.tablature tag remove whitespace 0.0 end }
1871        for { set i 0 } { $i <= $data_end } { incr i } {
1872            if { [ lindex [ lindex $tab_data $i ] 0 ] == "-16" } {
1873                recolor_tab_pos $i
1874            }
1875        }
1876    }
1877
1878    # set color for marked area
1879    if { $insert_mode != $messages(string:lyrics) } {
1880        # selected tab
1881        if {$mark!=-1} {
1882            array set marklow [ calc_rowcol [ calc_min $pos $mark ] ]
1883            array set markhi [ calc_rowcol [ calc_max $pos $mark ] ]
1884
1885            for { set i $marklow(row) } { $i <= $markhi(row) } { incr i } {
1886                if { $i == $marklow(row) } {
1887                    set leftedge [ expr $marklow(col) * $col_width + $initial_col ]
1888                } else {
1889                    set leftedge $initial_col
1890                }
1891                if { $i == $markhi(row) } {
1892                    set rightedge [ expr ($markhi(col)+1) * $col_width + $initial_col ]
1893                } else {
1894                    set rightedge $score_width
1895                }
1896
1897                for { set j 0 } { $j < $num_strings } { incr j } {
1898                    $tabwin.tablature tag add marked "line$i + $j lines + $leftedge chars" "line$i + $j lines + $rightedge chars"
1899                }
1900            }
1901        }
1902
1903        #set color for current position
1904        array set current [ calc_rowcol $pos ]
1905        $tabwin.tablature mark set start "line$current(row) + $string lines + [expr $current(col) * $col_width + $initial_col ] chars"
1906        $tabwin.tablature tag add currstring start "start + $col_width chars"
1907        for { set i 0 } { $i < $num_strings } { incr i } {
1908            $tabwin.tablature mark set start "line$current(row) + $i lines + [expr $current(col) * $col_width + $initial_col ] chars"
1909            $tabwin.tablature tag add currpos start "start + $col_width chars"
1910        }
1911        $tabwin.tablature mark unset start
1912    } else {
1913        #add currpos color to current textbox
1914        array set charinfo [ find_textpos insert ]
1915        $tabwin.tablature tag add currpos $charinfo(textstart) "$charinfo(textend) + 1 chars"
1916        # color selected area
1917        if { [ catch {$tabwin.tablature index lyr_selection} ] == 0 } {
1918            if { [ $tabwin.tablature compare insert < lyr_selection ] } {
1919                $tabwin.tablature tag add marked insert lyr_selection
1920            } else {
1921                $tabwin.tablature tag add marked lyr_selection insert
1922            }
1923        }
1924    }
1925}
1926
1927# recolor a single position of tab
1928proc recolor_tab_pos {pos_todraw args} {
1929    global curr_namespace
1930    global initial_col
1931    global col_width
1932    variable ${curr_namespace}::pos
1933    variable ${curr_namespace}::tabwin
1934    variable ${curr_namespace}::tab_data
1935    variable ${curr_namespace}::mark
1936    variable ${curr_namespace}::num_strings
1937    variable ${curr_namespace}::string
1938
1939    array set rowcol [ calc_rowcol $pos_todraw ]
1940
1941    # pick the color for the text based on whether we're in a cut/paste
1942    # selection zone or not, and whether or not we're under the cursor
1943    array set tag {marked remove currpos remove whitespace remove}
1944    # make whitespace visible with stipple
1945    if { [ string trim [ lindex [ lindex $tab_data $pos_todraw ] 0 ] ] == "-16" } {
1946        set tag(whitespace) add
1947        #puts "add whitespace to $pos_todraw"
1948    }
1949    if { ($mark != -1) && ($pos_todraw >= [ calc_min $mark $pos ]) && ($pos_todraw <= [ calc_max $mark  $pos ]) } {
1950        set tag(marked) add
1951    }
1952    if { $pos == $pos_todraw } {
1953        set tag(currpos) add
1954    }
1955    for { set i 0 } { $i < $num_strings } { incr i } {
1956        set tag(currstring) remove
1957        # pick a color based on whether we're at the exact string and
1958        #  position of the cursor
1959        if { ($i == $string)&&($pos == $pos_todraw) } {
1960            set tag(currstring) add
1961        }
1962        $tabwin.tablature mark set start "line$rowcol(row) + $i lines + [ expr $rowcol(col) * $col_width + $initial_col ] chars"
1963        foreach j "marked currpos currstring whitespace" {
1964            catch { $tabwin.tablature tag $tag($j) $j start "start + $col_width chars"}
1965        }
1966    }
1967    $tabwin.tablature mark unset start
1968}
1969
1970# redraw single position of tablature
1971proc redraw_pos {pos_todraw} {
1972    global curr_namespace
1973    global initial_col
1974    global col_width
1975    variable ${curr_namespace}::tabwin
1976    variable ${curr_namespace}::num_strings
1977    variable ${curr_namespace}::tab_ascii
1978
1979    # allow writes to the window
1980    $tabwin.tablature configure -state normal
1981    array set rowcol [ calc_rowcol $pos_todraw ]
1982
1983    # change contents of 'predrawn tab' array
1984    asciitab_replace $pos_todraw 1 1
1985    for { set i 0 } { $i < $num_strings } { incr i } {
1986        # change contents of tab window
1987        $tabwin.tablature mark set start "line$rowcol(row) + $i lines + [ expr $rowcol(col) * $col_width + $initial_col ] chars"
1988        $tabwin.tablature delete start "start + $col_width chars"
1989        $tabwin.tablature mark unset start
1990
1991        $tabwin.tablature insert "line$rowcol(row) + $i lines + [ expr $rowcol(col) * $col_width + $initial_col ] chars" [ string range $tab_ascii($i) [expr $pos_todraw * $col_width ] [expr ($pos_todraw + 1) * $col_width - 1] ]
1992    }
1993
1994    recolor_tab_pos $pos_todraw
1995    # re-disable writes to window, so user can't type arbitrary text
1996    $tabwin.tablature configure -state disabled
1997    see_currpos
1998}
1999
2000# make sure a position is visible in the tablaure
2001proc see_currpos {} {
2002    global curr_namespace
2003    global initial_col
2004    global col_width
2005    variable ${curr_namespace}::col_max
2006    variable ${curr_namespace}::row_sep_lines
2007    variable ${curr_namespace}::num_strings
2008    variable ${curr_namespace}::pos
2009    variable ${curr_namespace}::string
2010    variable ${curr_namespace}::tabwin
2011
2012    array set current [ calc_rowcol $pos ]
2013
2014    $tabwin.tablature see "line$current(row) - $row_sep_lines lines"
2015    $tabwin.tablature see "line$current(row) + $num_strings lines + $row_sep_lines lines"
2016    # added the following because xview stuff doesn't work in 'see?'
2017    set xvisible [$tabwin.tablature xview]
2018    if {[lindex $xvisible 1] < 1} {
2019        # * 1.0 means give me a floating point, not an integer
2020        set xview [ calc_max 0 [ expr (1.0*$current(col) / $col_max) - (([lindex $xvisible 1] - [lindex $xvisible 0]) / 2) ] ]
2021        $tabwin.tablature xview moveto $xview
2022    }
2023}
2024
2025
2026# delete and then redraw the whole tablature.
2027proc redraw_full {} {
2028    global curr_namespace
2029    global messages
2030    variable ${curr_namespace}::num_strings
2031    variable ${curr_namespace}::tab_data
2032    variable ${curr_namespace}::tab_ascii
2033    variable ${curr_namespace}::tabwin
2034    variable ${curr_namespace}::insert_mode
2035
2036    set text_mark ""
2037    catch { set text_mark [$tabwin.tablature index lyr_selection] }
2038    asciitab_replace all 0 0
2039    redisplay_toend start
2040    if { $insert_mode == $messages(string:lyrics) } {
2041        if { $text_mark != "" } {
2042            catch {$tabwin.tablature mark set lyr_selection $text_mark}
2043            recolor_tab_full
2044        }
2045    }
2046}
2047
2048# clear out, then redisplay some of the tab window's contents
2049proc redisplay_toend {args} {
2050    global curr_namespace
2051    variable ${curr_namespace}::col_max
2052    variable ${curr_namespace}::row_sep_lines
2053    variable ${curr_namespace}::row_sep
2054    variable ${curr_namespace}::tabwin
2055    variable ${curr_namespace}::data_end
2056
2057    set insert [ $tabwin.tablature index insert ]
2058    if { [ lindex $args 0 ] == "-nosymbols" } {
2059        set startpos [ lindex $args 1 ]
2060    } else {
2061        set startpos [ lindex $args 0 ]
2062    }
2063    # allow writes to the window
2064    set oldstate [ $tabwin.tablature cget -state ]
2065    $tabwin.tablature configure -state normal
2066
2067    # even redraw header, if asked to redraw from pos "start"
2068    if {$startpos == "start"} {
2069        set deletefrom 1.0
2070        if { [ lindex $args 0 ] == "-nosymbols" } {
2071            append redraw [ text_draw_newlines -nosymbols header ]
2072        } else {
2073            append redraw [ text_draw_newlines header ]
2074        }
2075        set rowcol(row) 0
2076        set startpos 0
2077    } else {
2078        array set rowcol [ calc_rowcol $startpos ]
2079        # back up to start of line of tab and delete from there to end
2080        # (easier to delete from the beginning of a line of tab)
2081        set startpos [ expr $startpos - $rowcol(col) ]
2082        set deletefrom "line$rowcol(row) - $row_sep_lines lines"
2083        set redraw ""
2084    }
2085    # doesn't delete correctly unless deletion leaves newline as last char
2086    $tabwin.tablature delete $deletefrom delend
2087
2088    # draw a row at a time, and keep track of relative positions
2089    set row_curr [ expr $rowcol(row) - 1]
2090    for { set i $startpos } { $i <= $data_end } { incr i $col_max } {
2091        incr row_curr
2092        set newline [tabdata_to_asciitab $i [ expr $i + $col_max - 1] ]
2093        if { [ lindex $args 0 ] == "-nosymbols" } {
2094            append newline [ text_draw_newlines -nosymbols line$row_curr ]
2095        } else {
2096            append newline [ text_draw_newlines line$row_curr ]
2097        }
2098        set linechars($row_curr) [ string length $newline ]
2099        incr linechars($row_curr) -$row_sep_lines
2100        append redraw $newline
2101    }
2102    if { [ lindex $args 0 ] == "-nosymbols" } {
2103        set footer [ text_draw_newlines -nosymbols footer ]
2104    } else {
2105        set footer [ text_draw_newlines footer ]
2106    }
2107    append redraw $row_sep $footer
2108
2109    # insert the new text
2110    $tabwin.tablature insert delend $redraw
2111    # put textwin marks in text for locating various points, later
2112    $tabwin.tablature mark set header 1.0
2113    $tabwin.tablature mark set footer "delend - [ string length $footer] chars"
2114    set lastmark "footer"
2115    for { set i $row_curr } { $i >= $rowcol(row) } { incr i -1 } {
2116        $tabwin.tablature mark set "line$i" "$lastmark - $linechars($i) chars - $row_sep_lines chars"
2117        set lastmark "line$i"
2118    }
2119    recolor_tab_full
2120
2121    catch {$tabwin.tablature mark set insert $insert}
2122    $tabwin.tablature see insert
2123    see_currpos
2124    # re-disable writes to window, so user can't type arbitrary text
2125    $tabwin.tablature configure -state $oldstate
2126}
2127
2128# output (en masse) ascii tab from the tab data
2129proc tabdata_to_asciitab {startpos endpos} {
2130    global curr_namespace
2131    global col_width
2132    variable ${curr_namespace}::num_strings
2133    variable ${curr_namespace}::tab_ascii
2134    variable ${curr_namespace}::row_sep
2135    variable ${curr_namespace}::tuning
2136    variable ${curr_namespace}::data_end
2137    variable ${curr_namespace}::col_max
2138
2139    set redraw ""
2140    if {($endpos == "end")||($endpos>$data_end)} {
2141        set ascii_end [expr [string length $tab_ascii(0) ] - 1]
2142    } else {
2143        set ascii_end [ expr ( $endpos + 1) * $col_width - 1 ]
2144    }
2145
2146    # draw a line at a time of tab
2147    set linelength [ expr ($col_max + 1) * $col_width ]
2148    for { set startline [ expr $startpos * $col_width ] } { $startline <= $ascii_end } {incr startline $linelength } {
2149        append redraw $row_sep
2150        set endline [calc_min [ expr $startline + $linelength - 1 ] $ascii_end]
2151        #  do a guitar string at a time
2152        for { set t 0 } { $t < $num_strings } { incr t } {
2153                append redraw "$tuning($t)|[string range $tab_ascii($t) $startline $endline]\n"
2154        }
2155    }
2156    return $redraw
2157}
2158
2159# update predrawn ascii tab array
2160proc asciitab_replace {at_pos cols_removeold cols_addnew} {
2161    global curr_namespace
2162    global col_width
2163    variable ${curr_namespace}::num_strings
2164    variable ${curr_namespace}::tab_data
2165    variable ${curr_namespace}::tab_ascii
2166    variable ${curr_namespace}::data_end
2167
2168    for { set i 0 } { $i < $num_strings } { incr i } {
2169        # grab tablature before and after position we're changing/deleting
2170        if { $at_pos == "all" } {
2171            set before_ascii($i) ""
2172            set after_ascii($i) ""
2173            set at_pos 0
2174            set cols_addnew [llength $tab_data]
2175        } elseif { $at_pos == 0 } {
2176            set before_ascii($i) ""
2177            set after_ascii($i) "[string range $tab_ascii($i) [ expr ($at_pos + $cols_removeold) * $col_width ] end]"
2178        } elseif { $at_pos == "end" } {
2179            set before_ascii($i) $tab_ascii($i)
2180            set after_ascii($i) ""
2181        } else {
2182            set before_ascii($i) "[string range $tab_ascii($i) 0 [expr $at_pos * $col_width - 1]]"
2183            set after_ascii($i) "[string range $tab_ascii($i) [ expr ($at_pos + $cols_removeold) * $col_width ] end]"
2184        }
2185        set insert_ascii($i) ""
2186        # drop in any tab we've been asked to insert
2187        for {set j 0} { $j < $cols_addnew } { incr j } {
2188            set pos_todraw [ expr $at_pos + $j ]
2189	    append insert_ascii($i) [fretnum_to_asciitab [string trim [ lindex [ lindex $tab_data $pos_todraw ] $i ] ] ]
2190        }
2191        set tab_ascii($i) "$before_ascii($i)$insert_ascii($i)$after_ascii($i)"
2192    }
2193    set data_end [ expr [ llength $tab_data ] - 1 ]
2194}
2195
2196# redisplay contents of one text section
2197proc text_redisplay_section {section} {
2198    global curr_namespace
2199    variable ${curr_namespace}::tabwin
2200
2201    array set secinfo [find_textpos $section]
2202    set startindex [ $tabwin.tablature index $section ]
2203    set redraw_text [ text_draw_newlines $section ]
2204
2205    $tabwin.tablature delete $secinfo(textstart) "$secinfo(textend) + 2 chars"
2206    $tabwin.tablature insert $secinfo(textstart) $redraw_text
2207    $tabwin.tablature mark set $section $startindex
2208    recolor_tab_full
2209}
2210
2211# add in carriage returns and end-of-textbox symbols, do line wrap
2212proc text_draw_newlines {args} {
2213    global curr_namespace
2214    variable ${curr_namespace}::text
2215    variable ${curr_namespace}::score_width
2216
2217    # drop the section symbol from the end when printing to the printer
2218    if { [ lindex $args 0 ] == "-nosymbols" } {
2219        set section [ lindex $args 1 ]
2220        set endsymbol ""
2221        # in "printer" mode... don't print empty sections
2222        if {$text($section)=="\x07"} {
2223            return ""
2224        }
2225    } else {
2226        set section [ lindex $args 0 ]
2227        set endsymbol "\xA7"
2228    }
2229    if {![info exists text($section)]} {
2230        set text($section) "\x07"
2231    }
2232    set end "\n"
2233    set returnval ""
2234
2235    # doublecheck that we haven't somehow lost the trailing return char
2236    if { [ string range $text($section) end end ] != "\x07"} {
2237        set string($section) "$string($section)\x07"
2238    }
2239    set temp $text($section)
2240    # data uses \x07 as carriage return... easier to deal with at load/save
2241    while {[ set newline [ string first "\x07" $temp ] ] != -1} {
2242        # chop up lines by line length, unless we see a hard return
2243        while {[ set newline [string first "\x07" $temp ] ] >= $score_width} {
2244            # split line at the start of a word, if possible
2245            set endline [ string wordstart $temp [ expr $score_width - 1 ] ]
2246            if { $endline > 0 } {
2247                append returnval [ string range $temp 0 [ expr $endline - 2 ] ] "\n"
2248                set temp [ string range $temp $endline end ]
2249            } else {
2250                # otherwise, split by line length
2251                append returnval [ string range $temp 0 [ expr $score_width - 1 ] ] "\n"
2252                set temp [ string range $temp $score_width end ]
2253            }
2254        }
2255        # put a section symbol after the last character inserted by the user
2256        if { $newline == [ expr [string length $temp ] - 1 ] } {
2257            set end "$endsymbol\n"
2258        }
2259        append returnval [ string range $temp 0 [ expr $newline - 1 ] ] "$end"
2260        set temp [ string range $temp [ expr $newline + 1 ] end ]
2261    }
2262    return $returnval
2263}
2264
2265# return various info. about the text position queried when in lyrics mode
2266proc find_textpos {textindex} {
2267    global curr_namespace
2268    variable ${curr_namespace}::tabwin
2269    variable ${curr_namespace}::num_strings
2270    variable ${curr_namespace}::row_sep_lines
2271
2272    set section [ findmark previous "$textindex + 1 chars" ]
2273    set nextsection [ findmark next "$textindex + 1 chars" ]
2274    switch  -exact -- $section {
2275        {header} {
2276            set textstart header
2277            set textend "$nextsection - $row_sep_lines lines - 2 chars"
2278        }
2279        {footer}
2280            -
2281        {delend}
2282            -
2283        {} {
2284            # clicking below the footer may yield "" or delend as prev. mark
2285            set textstart footer
2286            set textend "delend - 2 chars"
2287        }
2288        default {
2289            # lyrics lines
2290            set textstart "$section + $num_strings lines"
2291            set textend "$nextsection - $row_sep_lines lines - 2 chars"
2292        }
2293    }
2294    # what is the corresponding location in the asciitab string?
2295    set lyrics_pos [ string length [ $tabwin.tablature get $textstart $textindex ] ]
2296    return "section $section lyrics_pos $lyrics_pos textstart {$textstart} textend {$textend}"
2297}
2298
2299# generalized proc to move cursor up/down/left/right in lyrics mode
2300proc text_cursor {adjust} {
2301    global curr_namespace
2302    variable ${curr_namespace}::tabwin
2303
2304    array set charinfo [ find_textpos insert ]
2305    if { [ lindex $adjust 0 ] == "+" } {
2306        set comparison "<="
2307        set limit $charinfo(textend)
2308    } else {
2309        set comparison ">="
2310        set limit $charinfo(textstart)
2311    }
2312    # don't allow user to roll past edge of this textbox
2313    if { [ $tabwin.tablature compare "insert $adjust" $comparison $limit ] } {
2314       $tabwin.tablature mark set insert "insert $adjust"
2315       $tabwin.tablature see insert
2316    }
2317    if { [ catch {$tabwin.tablature index lyr_selection} ] == 0 } {
2318        recolor_tab_full -notwhitespace
2319    }
2320}
2321
2322# copy highlighted text
2323proc text_copy {} {
2324    global curr_namespace
2325    global messages
2326    global clip
2327    variable ${curr_namespace}::tabwin
2328    variable ${curr_namespace}::text
2329
2330    if { [ catch {$tabwin.tablature index lyr_selection} ] != 0 } {
2331        return
2332    }
2333    if { [ $tabwin.tablature compare insert < lyr_selection ] } {
2334        array set mark_low [ find_textpos insert ]
2335        array set mark_hi [ find_textpos lyr_selection ]
2336    } else {
2337        array set mark_low [ find_textpos lyr_selection ]
2338        array set mark_hi [ find_textpos insert ]
2339    }
2340    regsub -all "\x07" [ string range $text($mark_low(section)) $mark_low(lyrics_pos) [ expr $mark_hi(lyrics_pos) - 1 ] ] "\n" clip
2341    update_clipboard
2342    $tabwin.tablature mark unset lyr_selection
2343    recolor_tab_full -notwhitespace
2344    ghost_cutcopy disabled
2345}
2346
2347# cut highlighted text
2348proc text_cut {args} {
2349    global curr_namespace
2350    global messages
2351    global clip
2352    variable ${curr_namespace}::tabwin
2353    variable ${curr_namespace}::text
2354
2355    if { [ catch {$tabwin.tablature index lyr_selection} ] != 0 } {
2356        return
2357    }
2358    getopt opts {history} $args
2359    if { [ $tabwin.tablature compare insert < lyr_selection ] } {
2360        array set mark_low [ find_textpos insert ]
2361        array set mark_hi [ find_textpos lyr_selection ]
2362        set insert [ $tabwin.tablature index insert ]
2363    } else {
2364        array set mark_low [ find_textpos lyr_selection ]
2365        array set mark_hi [ find_textpos insert ]
2366        set insert [ $tabwin.tablature index lyr_selection ]
2367    }
2368    if { $opts(history) > 0 } {
2369        history_add $messages(history:text_cut)
2370        regsub -all "\x07" [ string range $text($mark_low(section)) $mark_low(lyrics_pos) [ expr $mark_hi(lyrics_pos) - 1 ] ] "\n" clip
2371        update_clipboard
2372    }
2373    set before [ string range $text($mark_low(section)) 0 [ expr $mark_low(lyrics_pos) - 1 ] ]
2374    set after [ string range $text($mark_low(section)) $mark_hi(lyrics_pos) end ]
2375    set text($mark_low(section)) "${before}$after"
2376    text_redisplay_section $mark_low(section)
2377    $tabwin.tablature mark unset lyr_selection
2378    $tabwin.tablature mark set insert $insert
2379    $tabwin.tablature see insert
2380    ghost_cutcopy disabled
2381}
2382
2383# cut highlighted text without adding it to the paste buffer
2384proc text_clear {} {
2385    global messages
2386
2387    history_add $messages(history:text_clear)
2388    text_cut
2389}
2390
2391#paste text in lyrics mode
2392proc text_paste {} {
2393    global curr_namespace
2394    global messages
2395    global my_platform
2396    variable ${curr_namespace}::tabwin
2397    variable ${curr_namespace}::text
2398
2399    # grab paste text from the system clipboard... should catch anything
2400    # we placed in it, or any other program did
2401    set paste_raw ""
2402    if { $my_platform(platform) == "unix" } {
2403        set paste_raw [ selection get -selection PRIMARY ]
2404    } else {
2405        set paste_raw [ selection get -selection CLIPBOARD]
2406    }
2407    set paste_processed ""
2408    # look through paste buffer and eliminate non-printables, convert endlines
2409    foreach character [split $paste_raw {}] {
2410        scan $character %c asciival
2411        if { $character == "\n" } {
2412            append paste_processed "\x07"
2413        } elseif { $asciival > 31 } {
2414            append paste_processed $character
2415        }
2416    }
2417    if { $paste_processed == "" } {
2418        return
2419    }
2420
2421    history_add $messages(history:text_paste)
2422    if { [ catch {$tabwin.tablature index lyr_selection} ] == 0 } {
2423        text_cut
2424    }
2425    array set charinfo [ find_textpos insert ]
2426    set insert [ $tabwin.tablature index insert ]
2427
2428    set before [ string range $text($charinfo(section)) 0 [ expr $charinfo(lyrics_pos) - 1 ] ]
2429    set after [ string range $text($charinfo(section)) $charinfo(lyrics_pos) end ]
2430    set text($charinfo(section)) "${before}${paste_processed}$after"
2431    text_redisplay_section $charinfo(section)
2432    $tabwin.tablature mark set insert "$insert + [string length $paste_processed] chars"
2433    $tabwin.tablature see insert
2434}
2435
2436# delete a character to the right of the cursor
2437proc text_delete {} {
2438    global curr_namespace
2439    global messages
2440    variable ${curr_namespace}::tabwin
2441    variable ${curr_namespace}::text
2442
2443    if { [ catch {$tabwin.tablature index lyr_selection} ] == 0 } {
2444        text_clear
2445    } elseif { [ $tabwin.tablature get insert ] == "\xA7" } {
2446        # don't go past boundary of textbox
2447        return
2448    }
2449    history_add $messages(history:text_del)
2450    set insert [ $tabwin.tablature index insert ]
2451    array set charinfo [ find_textpos insert ]
2452    set before [ string range $text($charinfo(section)) 0 [ expr $charinfo(lyrics_pos) - 1 ] ]
2453    set after [ string range $text($charinfo(section)) [ expr $charinfo(lyrics_pos) + 1 ] end ]
2454    set text($charinfo(section)) "${before}$after"
2455    text_redisplay_section $charinfo(section)
2456    $tabwin.tablature mark set insert $insert
2457    $tabwin.tablature see insert
2458}
2459
2460# delete a character to the left of the cursor
2461proc text_backspace {} {
2462    global curr_namespace
2463    global messages
2464    variable ${curr_namespace}::tabwin
2465    variable ${curr_namespace}::text
2466
2467    array set charinfo [ find_textpos insert ]
2468    if { [ catch {$tabwin.tablature index lyr_selection} ] == 0 } {
2469        text_clear
2470        return
2471    } elseif { $charinfo(lyrics_pos) <= 0 } {
2472        # don't go past boundary of textbox
2473        return
2474    }
2475    history_add $messages(history:text_del)
2476    set newcursor [ $tabwin.tablature index "insert - 1 chars" ]
2477    set before [ string range $text($charinfo(section)) 0 [ expr $charinfo(lyrics_pos) - 2 ] ]
2478    set after [ string range $text($charinfo(section)) $charinfo(lyrics_pos) end ]
2479    set text($charinfo(section)) "${before}$after"
2480    text_redisplay_section $charinfo(section)
2481    $tabwin.tablature mark set insert $newcursor
2482    $tabwin.tablature see insert
2483}
2484
2485# move up one section of lyrics
2486proc text_upsection {} {
2487    global curr_namespace
2488    variable ${curr_namespace}::tabwin
2489
2490    if { [ catch {$tabwin.tablature index lyr_selection} ] == 0 } {
2491        array set charinfo [ find_textpos insert ]
2492        $tabwin.tablature mark set insert $charinfo(textstart)
2493        recolor_tab_full -notwhitespace
2494    } else {
2495        set new_section [ findmark previous [ findmark previous "insert + 1 chars" ] ]
2496        if { $new_section != "" } {
2497            array set charinfo [ find_textpos $new_section ]
2498            $tabwin.tablature mark set insert $charinfo(textend)
2499            recolor_tab_full -notwhitespace
2500        }
2501    }
2502    $tabwin.tablature see insert
2503}
2504
2505# move down one section of lyrics
2506proc text_dnsection {} {
2507    global curr_namespace
2508    variable ${curr_namespace}::tabwin
2509
2510    if { [ catch {$tabwin.tablature index lyr_selection} ] == 0 } {
2511        array set charinfo [ find_textpos insert ]
2512        $tabwin.tablature mark set insert $charinfo(textend)
2513        recolor_tab_full -notwhitespace
2514    } else {
2515        set new_section [ findmark next "insert + 1 chars" ]
2516        if { $new_section != "delend" } {
2517            array set charinfo [ find_textpos $new_section ]
2518            $tabwin.tablature mark set insert $charinfo(textstart)
2519            recolor_tab_full -notwhitespace
2520        }
2521    }
2522    $tabwin.tablature see insert
2523}
2524
2525# move to beginning of lyrics
2526proc text_home {} {
2527    global curr_namespace
2528    variable ${curr_namespace}::tabwin
2529
2530    if { [ catch {$tabwin.tablature index lyr_selection} ] == 0 } {
2531        array set charinfo [ find_textpos insert ]
2532        $tabwin.tablature mark set insert $charinfo(textstart)
2533        recolor_tab_full -notwhitespace
2534    } else {
2535        $tabwin.tablature mark set insert 1.0
2536        recolor_tab_full -notwhitespace
2537    }
2538    $tabwin.tablature see insert
2539}
2540
2541# move to end of lyrics
2542proc text_end {} {
2543    global curr_namespace
2544    variable ${curr_namespace}::tabwin
2545
2546    if { [ catch {$tabwin.tablature index lyr_selection} ] == 0 } {
2547        array set charinfo [ find_textpos insert ]
2548        $tabwin.tablature mark set insert $charinfo(textend)
2549        recolor_tab_full -notwhitespace
2550    } else {
2551        $tabwin.tablature mark set insert "delend - 2 chars"
2552        recolor_tab_full -notwhitespace
2553    }
2554    $tabwin.tablature see insert
2555}
2556
2557# set lyrics mode insertion cursor to location of mouse
2558proc absolute_textpos {x y} {
2559    global curr_namespace
2560    global messages
2561    variable ${curr_namespace}::insert_mode
2562    variable ${curr_namespace}::mode_old
2563    variable ${curr_namespace}::tabwin
2564    variable ${curr_namespace}::col_max
2565    variable ${curr_namespace}::data_end
2566    variable ${curr_namespace}::num_strings
2567
2568    # unhighlight selected text
2569    if { [ catch { $tabwin.tablature index lyr_selection } ] == 0 } {
2570        $tabwin.tablature mark unset lyr_selection
2571        ghost_cutcopy disabled
2572        recolor_tab_full -notwhitespace
2573    }
2574
2575    set gapindex [ tkTextClosestGap $tabwin.tablature $x $y ]
2576    array set charinfo [ find_textpos $gapindex ]
2577    if { ( [ $tabwin.tablature compare $gapindex >= $charinfo(textstart) ] ) && ( [ $tabwin.tablature compare $gapindex <= $charinfo(textend) ] ) } {
2578        # in a textbox
2579        $tabwin.tablature mark set insert $gapindex
2580        $tabwin.tablature see insert
2581        recolor_tab_full -notwhitespace
2582    } elseif { [ $tabwin.tablature get @$x,$y ] == "\xA7" } {
2583        # clicked on the end-of-textbox symbol
2584        $tabwin.tablature mark set insert "$gapindex - 1 chars"
2585        $tabwin.tablature see insert
2586        recolor_tab_full -notwhitespace
2587    } else {
2588        # check for click in a tab score
2589        array set new [ tabpos_from_xy $x $y ]
2590        if { ($new(col)<$col_max)&&($new(col)>=0)&&($new(string)>=0)&&($new(pos)>=0)&&($new(pos)<=$data_end)&&($new(string)<$num_strings) } {
2591            #set insert_mode $messages(string:lead)
2592            set insert_mode $mode_old
2593            lyrics_done $x $y
2594        }
2595    }
2596}
2597
2598# update selected area according to mouse drag
2599proc text_select {x y} {
2600    global curr_namespace
2601    variable ${curr_namespace}::tabwin
2602
2603    if { [ catch { $tabwin.tablature index lyr_selection } ] != 0 } {
2604        $tabwin.tablature mark set lyr_selection insert
2605        ghost_cutcopy normal
2606    }
2607    array set insertinfo [ find_textpos lyr_selection ]
2608    set index [ tkTextClosestGap $tabwin.tablature $x $y ]
2609    # don't allow cursor to go beyond bounds of a textbox
2610    if { [ $tabwin.tablature compare $index > $insertinfo(textend) ] } {
2611        $tabwin.tablature mark set insert $insertinfo(textend)
2612        tkCancelRepeat
2613    } elseif { [ $tabwin.tablature compare $index < $insertinfo(textstart) ] } {
2614        $tabwin.tablature mark set insert $insertinfo(textstart)
2615        tkCancelRepeat
2616    } else {
2617        $tabwin.tablature mark set insert $index
2618    }
2619    $tabwin.tablature see insert
2620    recolor_tab_full -notwhitespace
2621}
2622
2623#insert text in lyrics mode
2624proc text_insert {character} {
2625    global curr_namespace
2626    global messages
2627    variable ${curr_namespace}::tabwin
2628    variable ${curr_namespace}::text
2629
2630    # ignore non-printables... like ^C
2631    if { $character == "\n" } {
2632        set character "\x07"
2633    } elseif {$character == ""} {
2634        return
2635    } else {
2636        scan $character %c asciival
2637        if { $asciival < 32 } {
2638            return
2639        }
2640    }
2641
2642    history_add $messages(history:text_insert)
2643    if { [ catch {$tabwin.tablature index lyr_selection} ] == 0 } {
2644        text_cut
2645    }
2646    array set charinfo [ find_textpos insert ]
2647
2648    set before [ string range $text($charinfo(section)) 0 [ expr $charinfo(lyrics_pos) - 1 ] ]
2649    set after [ string range $text($charinfo(section)) $charinfo(lyrics_pos) end ]
2650    set text($charinfo(section)) "${before}${character}$after"
2651    set insert [ $tabwin.tablature index insert ]
2652    #redraw_full
2653    text_redisplay_section $charinfo(section)
2654    $tabwin.tablature mark set insert "$insert + 1 chars"
2655    $tabwin.tablature see insert
2656}
2657
2658# return ascii tab notation that corresponds to fret number given on input
2659proc fretnum_to_asciitab {fret_todraw} {
2660    global tab_symbols
2661    global embellish
2662
2663    if { [ info exists tab_symbols($fret_todraw) ] } {
2664        return $tab_symbols($fret_todraw)
2665    } elseif { $fret_todraw < 0 } {
2666        return "---"
2667    } elseif { $fret_todraw < 2000} {
2668        # modifier is 100's digit
2669        set modnum [ expr int ( $fret_todraw / 100 ) ]
2670        # fret is 1's and 10's
2671        set fretnum [ expr $fret_todraw % 100 ]
2672        # if fret < 10, add in a '-' to fill the 'empty' spot
2673        set filler [ lindex { - {} } [ expr $fretnum > 9 ] ]
2674        return "$embellish($modnum)${fretnum}$filler"
2675    } elseif { $fret_todraw < 2100} {
2676        return "-x-"
2677    } else {
2678        return "---"
2679    }
2680}
2681
2682
2683#export tablature
2684proc export_tab {} {
2685    global curr_namespace
2686    global version
2687    global export_types
2688    global my_platform
2689    global cwd
2690    global messages
2691    variable ${curr_namespace}::name
2692    variable ${curr_namespace}::tabwin
2693    variable ${curr_namespace}::winnum
2694
2695    # what do we do if we don't yet have a filename?
2696    if { $name == "" } {
2697        set basename $messages(string:untitled)$winnum
2698    } else {
2699        set basename [ file rootname [ lindex [ file split $name ] end ] ]
2700    }
2701
2702    # pull up the file dialog window
2703    if {$my_platform(os)=="MacOS"} {
2704        set filename [my_filedialog tk_getSaveFile \
2705            -title $messages(string:export) -parent $tabwin \
2706            -initialfile $basename -initialdir $cwd -defaultextension .tab ]
2707    } else {
2708        set filename [my_filedialog tk_getSaveFile -filetypes $export_types \
2709            -title $messages(string:export) -parent $tabwin \
2710            -initialfile $basename -initialdir $cwd -defaultextension .tab ]
2711    }
2712
2713    # did user close file dialog without choosing a file?
2714    if { $filename == "" } {
2715        return
2716    }
2717
2718    # hack around exten. not auto-appended in OSX tcl/tk 8.4a4-2
2719    if { ($my_platform(os)=="Darwin") && ([file extension $filename] != ".tab" ) } {
2720        append filename .tab
2721    }
2722    set cwd [ file dirname $filename ]
2723    # on failed file operation, does user want to retry?
2724    set success 0
2725    while { $success == 0 } {
2726        catch { set myfile [open "$filename" w] }
2727        if { [info exists myfile] } {
2728            set success 1
2729        } elseif { [my_dialog  $messages(title:save_fail)  [subst -nocommands -nobackslashes $messages(dialog:save_fail)] error "" $messages(button:retry) $messages(button:cancel) ] == "1" } {
2730                return
2731        }
2732    }
2733
2734    # dump data into the file, dropping section symbols
2735    # according to fconfigure manpage, end-of-line chars will be translated
2736    # appropriately for each OS
2737    set insert [ $tabwin.tablature index insert ]
2738    redisplay_toend -nosymbols start
2739    puts -nonewline $myfile [$tabwin.tablature get 1.0 end]
2740    redisplay_toend start
2741    $tabwin.tablature mark set insert $insert
2742    recolor_tab_full -notwhitespace
2743    close $myfile
2744    if { $my_platform(os) == "MacOS" } {
2745            file attributes $filename -creator ttxt -type TEXT
2746    }
2747}
2748
2749#save tablature
2750proc save_tab {args} {
2751    global curr_namespace
2752    global version
2753    global save_types
2754    global ext
2755    global macext
2756    global my_platform
2757    global cwd
2758    global messages
2759    variable ${curr_namespace}::name
2760    variable ${curr_namespace}::num_strings
2761    variable ${curr_namespace}::saved
2762    variable ${curr_namespace}::tab_data
2763    variable ${curr_namespace}::tabwin
2764    variable ${curr_namespace}::winnum
2765    variable ${curr_namespace}::tuning
2766    variable ${curr_namespace}::row_sep_lines
2767    variable ${curr_namespace}::score_width
2768    variable ${curr_namespace}::text
2769
2770    getopt opts {as} $args
2771    # nothing to do if file is already saved, and user isn't doing save_as
2772    if { ($saved == 1)&&($opts(as) < 1) } {
2773        return
2774    }
2775    # what do we do if we don't yet have a filename?
2776    if { $name == "" } {
2777        set basename $messages(string:untitled)$winnum
2778        set opts(as) 1
2779    } else {
2780        set basename [ file rootname [ lindex [ file split $name ] end ] ]
2781    }
2782
2783    # pull up the file dialog window
2784    if {$opts(as) > 0} {
2785        if {$my_platform(os)=="MacOS"} {
2786            set filename [my_filedialog tk_getSaveFile -parent $tabwin \
2787                -title $messages(string:save) -initialfile $basename \
2788                -defaultextension $ext($num_strings) -initialdir $cwd ]
2789        } else {
2790            set filename [my_filedialog tk_getSaveFile -parent $tabwin \
2791                -title $messages(string:save) -initialfile $basename \
2792                -defaultextension $ext($num_strings) -initialdir $cwd \
2793                -filetypes $save_types($num_strings) ]
2794        }
2795
2796        # did user close file dialog without choosing a file?
2797        if { $filename == "" } {
2798            return
2799        }
2800        # hack around exten. not auto-appended in OSX tcl/tk 8.4a4-2
2801        if { ($my_platform(os)=="Darwin") && ([file extension $filename] != $ext($num_strings) ) } {
2802            append filename $ext($num_strings)
2803        }
2804        set cwd [ file dirname $filename ]
2805        set name $filename
2806    }
2807
2808    # on failed file operation, does user want to retry?
2809    set success 0
2810    while { $success == 0 } {
2811        catch { set myfile [open "$name" w] }
2812        if { [info exists myfile] } {
2813            set success 1
2814        } elseif { [my_dialog  $messages(title:save_fail)  [subst -nobackslashes -nocommands $messages(dialog:save_fail)] error "" $messages(button:retry) $messages(button:cancel) ] == "1" } {
2815                return
2816        }
2817    }
2818
2819    # dump data into the file
2820    puts $myfile "#eTktab$version tablature file"
2821    puts $myfile "#*formatting: score_width $score_width row_sep_lines $row_sep_lines"
2822    puts $myfile "#*lyrics: [array get text]"
2823    for { set i 0 } { $i < $num_strings } { incr i } {
2824        puts $myfile $tuning($i)
2825        # windows wants us to flush when we write in multiple statements
2826        flush $myfile
2827    }
2828    puts -nonewline $myfile $tab_data
2829    close $myfile
2830    if { $my_platform(os) == "MacOS" } {
2831            file attributes $name -creator eTkt -type $macext($num_strings)
2832    }
2833
2834    # update window
2835    wm title $tabwin "eTktab$version - $name"
2836    refresh_winmenu
2837    set_saved 1
2838}
2839
2840#load tablature
2841proc open_tab {} {
2842    global curr_namespace
2843    global my_platform
2844    global version
2845    global chromatic
2846    global messages
2847    global default_prefs
2848    variable ${curr_namespace}::data_end
2849    variable ${curr_namespace}::mark
2850    variable ${curr_namespace}::name
2851    variable ${curr_namespace}::num_strings
2852    variable ${curr_namespace}::pos
2853    variable ${curr_namespace}::saved
2854    variable ${curr_namespace}::tab_data
2855    variable ${curr_namespace}::tabwin
2856    variable ${curr_namespace}::tuning
2857    variable ${curr_namespace}::row_sep_lines
2858    variable ${curr_namespace}::score_width
2859    variable ${curr_namespace}::text
2860
2861    array set new_tuning [ array get tuning ]
2862    set filename $name
2863
2864    # on failed file operation, does user want to retry?
2865    set success 0
2866    while { $success == 0 } {
2867        catch { set myfile [open "$name" r] }
2868        if { [info exists myfile] } {
2869            set success 1
2870        } elseif { [my_dialog  $messages(title:open_fail)  [subst -nocommands -nobackslashes $messages(dialog:open_fail) ] error "" $messages(button:retry) $messages(button:cancel) ] == "1" } {
2871                return
2872        }
2873    }
2874
2875    # as of version 2.0, there's a line at the top to identify it's a
2876    # eTktab file
2877    # according to fconfigure tcl manpage, we don't have to worry about
2878    # which OS the file was made on (what end-of-line char is used)
2879    # as tcl will translate automatically for us!
2880    set i 0
2881    while { [ info exists tab_data_new ] == 0 } {
2882        gets $myfile next_line
2883        if { [ string range "$next_line" 0 12 ] == "#*formatting:" } {
2884            #formatting
2885            regexp {^#\*formatting: *score_width *([0-9]+) *row_sep_lines *([0-9]+)} $next_line full score_width_new row_sep_lines_new
2886        } elseif { [ string range "$next_line" 0 8 ] == "#*lyrics:"} {
2887            # lyrics
2888            array set text_new [string range $next_line 10 end]
2889        } elseif { [lsearch -exact $chromatic $next_line] > -1 } {
2890            # tuning
2891            set new_tuning($i) $next_line
2892            incr i
2893        } elseif { [ string index "$next_line" 0 ] != "#" } {
2894            # tab, not 'comments'
2895            set num_strings_new $i
2896            set tab_data_new $next_line
2897        }
2898    }
2899    close $myfile
2900
2901    # tab looks valid?
2902    if { ( [ llength [ lindex $tab_data_new 0 ] ] != $num_strings_new ) || (($num_strings_new < 4)||($num_strings_new > 7)) } {
2903        my_dialog  $messages(title:file_bad) [subst -nocommands -nobackslashes $messages(dialog:file_bad) ] error 0 $messages(button:ok)
2904        return
2905    }
2906
2907    set num_strings $num_strings_new
2908    if { [info exists row_sep_lines_new] } {
2909        set row_sep_lines $row_sep_lines_new
2910    } else {
2911        set row_sep_lines $default_prefs(row_sep_lines)
2912    }
2913    if { [info exists score_width_new] } {
2914        set score_width $score_width_new
2915    } else {
2916        set score_width $default_prefs(score_width)
2917    }
2918    if { [info exists text_new ] } {
2919        array set text [ array get text_new ]
2920    } else {
2921        array set text ""
2922    }
2923    initialize_numstrings $curr_namespace
2924
2925    array set tuning [ array get new_tuning ]
2926    set tab_data $tab_data_new
2927    set data_end [ expr [llength $tab_data] -1 ]
2928    set pos $data_end
2929    set mark -1
2930    redraw_full
2931    wm title $tabwin "eTktab$version - $name"
2932    refresh_winmenu
2933
2934    set_saved 1
2935    history_clear
2936
2937    lyrics_done
2938    # change keyboard and mouse bindings
2939    bindtags $tabwin [ lreplace [bindtags $tabwin ] 1 1 Tabwindow$num_strings ]
2940    bindtags $tabwin.tablature [ lreplace [bindtags $tabwin.tablature ] 1 2 Tablature Tabwindow$num_strings ]
2941}
2942
2943# close window... if unsaved, ask user what to do
2944proc close_tab {} {
2945    global curr_namespace
2946    global messages
2947    variable ${curr_namespace}::name
2948    variable ${curr_namespace}::saved
2949    variable ${curr_namespace}::tabwin
2950    variable ${curr_namespace}::winnum
2951
2952    if { $saved == 0 } {
2953        if { $name == "" } {
2954            set filename $messages(string:untitled)$winnum
2955        } else {
2956            set filename $name
2957        }
2958
2959        set response [my_dialog  $messages(title:close_verify) [subst -nocommands -nobackslashes $messages(dialog:close_verify)] warning "" $messages(button:yes) $messages(button:no) $messages(button:cancel) ]
2960        if {$response == 0} {
2961            save_tab
2962        } elseif {($response != 1)} {
2963            return
2964        }
2965    }
2966    # closing the last window means quitting the program
2967    if { [ llength [ namespace children ::WIN ] ] == 1 } {
2968        __exit_now
2969    } else {
2970        destroy $tabwin
2971        namespace delete $curr_namespace
2972        refresh_winmenu
2973    }
2974}
2975
2976#print tablature
2977proc print_tab {} {
2978    global curr_namespace
2979    global my_platform
2980    global cwd
2981    global program_dir
2982    global tempdir
2983    global messages
2984    global print_counter
2985    global prefs
2986    variable ${curr_namespace}::tabwin
2987    variable ${curr_namespace}::row_sep_lines
2988
2989    incr print_counter
2990    set name [lrange [wm title $tabwin] 2 end]
2991    if { $my_platform(platform) == "unix" } {
2992        if { [ print_dialog $print_counter ] != 1 } {
2993            return
2994        }
2995        set filename "| $prefs(print_command)"
2996    } elseif { $my_platform(platform) == "macintosh" } {
2997        if { [ file executable /usr/bin/lpstat ] != 1 } {
2998            set w .printerr_$print_counter
2999            if { [ basic_transient -nocancel $w $messages(title:print_return) ] != -1 } {
3000                label ${w}.text -text $messages(dialog:print_unsupported)
3001                pack ${w}.text -side top -fill x
3002                wm transient $w $tabwin
3003            }
3004            return
3005        }
3006        if { [ print_dialog $print_counter ] != 1 } {
3007            return
3008        }
3009        set filename "| /usr/bin/lpr -P $prefs(print_command)"
3010    } else {
3011        set filename [ file join $tempdir eTktab_[pid]_${print_counter}.txt ]
3012    }
3013
3014    # on failed file operation, does user want to retry?
3015    set success 0
3016    while { $success == 0 } {
3017        catch { set myfile [open "$filename" w] }
3018        if { [info exists myfile] } {
3019            set success 1
3020        } elseif { [my_dialog  $messages(title:save_fail)  [subst -nocommands -nobackslashes $messages(dialog:save_fail)] error "" $messages(button:retry) $messages(button:cancel) ] == "1" } {
3021                return
3022        }
3023    }
3024
3025    # change cursor to let user know we're processing
3026    set cursor [ $tabwin.tablature cget -cursor ]
3027    $tabwin.tablature configure -cursor watch
3028    update idletasks
3029
3030    #redraw the screen contents w/o section symbols
3031    set insert [ $tabwin.tablature index insert ]
3032    redisplay_toend -nosymbols start
3033
3034    #break each page at the start of a score, making sure that it's less than
3035    #the page length
3036    set pagenum 1
3037    set pagestart header
3038    set blank_lines $row_sep_lines
3039    set pagebreak ""
3040    set pageend ""
3041    while { $pagestart != "delend" } {
3042        set tryend $pagestart
3043        # start-end... don't print blank lines at page bottom, add 2 line header
3044        while { ([ expr int([$tabwin.tablature index $tryend] - [$tabwin.tablature index $pagestart]) - $blank_lines + 2 ] <= $prefs(page_length)) } {
3045            set pageend $tryend
3046            if { $pageend == "delend" } {
3047                break
3048            }
3049            set tryend [ findmark next $tryend ]
3050            if { $tryend == "delend" } {
3051                set blank_lines 0
3052            }
3053        }
3054        #add a header (title + page number) followed by a blank line
3055        puts $myfile "${pagebreak}$pagenum  $name\n"
3056        # cut row_sep off from end of pages in middle of tab
3057        if { $pageend == $pagestart } {
3058            set pageend "$pagestart + $prefs(page_length) lines"
3059            puts -nonewline $myfile [ $tabwin.tablature get $pagestart $pageend ]
3060        } elseif { $pageend != "delend"} {
3061            puts -nonewline $myfile [ $tabwin.tablature get $pagestart "$pageend - $row_sep_lines lines" ]
3062        } else {
3063            puts -nonewline $myfile [ $tabwin.tablature get $pagestart $pageend ]
3064        }
3065        incr pagenum
3066        set pagestart $pageend
3067        set pagebreak "\x0c"
3068    }
3069    # according to fconfigure manpage, end-of-line chars will be translated
3070    # appropriately for each OS
3071
3072    catch {close $myfile} return_val
3073
3074    #  Run windows print commands against tempfile
3075    switch -- $my_platform(platform) {
3076        {windows} {
3077            exec [file join $program_dir prfile32.exe] /q /i:[file join $program_dir prfile.ini ] /delete $filename
3078            # change cursor back to normal
3079            $tabwin.tablature configure -cursor $cursor
3080        }
3081        {default} {
3082            # change cursor back to normal
3083            $tabwin.tablature configure -cursor $cursor
3084            # present any errors from print helper
3085            if { $return_val != "" } {
3086                set w .printerr_$print_counter
3087                if { [ basic_transient -nocancel $w $messages(title:print_return) ] != -1 } {
3088                    label ${w}.text -text $return_val
3089                    pack ${w}.text -side top -fill x
3090                    wm transient $w $tabwin
3091                }
3092            }
3093        }
3094    }
3095    # restore window contents
3096    redisplay_toend start
3097    $tabwin.tablature mark set insert $insert
3098    recolor_tab_full -notwhitespace
3099}
3100
3101#
3102# Pull up transient windows for user input
3103#
3104
3105#set which file to look to for natural language support strings
3106proc pref_language {} {
3107    global curr_namespace
3108    global prefs
3109    global messages
3110    global program_dir
3111    global curr_namespace
3112    global language_types
3113    global settings_file_failures
3114    variable ${curr_namespace}::tabwin
3115
3116    # call up file dialog to find natural language file
3117    set filename [my_filedialog tk_getOpenFile -parent $tabwin \
3118        -title $messages(string:language)  -filetypes $language_types \
3119        -initialdir $program_dir -defaultextension .etl ]
3120    # did the user give a filename?
3121    if { $filename == "" } {
3122        return
3123    }
3124
3125    # alter prefs and load in file
3126    set prefs(language) $filename
3127    load_language_support
3128
3129    # did load fail?
3130    if { $settings_file_failures != "" } {
3131        my_dialog $messages(title:open_fail)  [subst -nocommands -nobackslashes $messages(dialog:open_fail) ] error 0 $messages(button:ok)
3132        set settings_file_failures ""
3133        return
3134    }
3135
3136    #save all user prefs
3137    save_prefs
3138
3139    # load lang. support strings into each open tab window
3140    each_namespace label_gui
3141    # kill and reopen help window
3142    if { [ winfo exists .helpwin ] } {
3143        destroy .helpwin
3144        help
3145    }
3146}
3147
3148#set which file to look to for keybindings
3149proc pref_keybindings {} {
3150    global curr_namespace
3151    global prefs
3152    global messages
3153    global program_dir
3154    global curr_namespace
3155    global keybind_types
3156    global settings_file_failures
3157    variable ${curr_namespace}::tabwin
3158
3159    # call up file dialog to find keybindings file
3160    set filename [my_filedialog tk_getOpenFile -filetypes $keybind_types \
3161        -title $messages(string:keybind) -parent $tabwin \
3162        -initialdir $program_dir -defaultextension .etk ]
3163    # did the user give a filename?
3164    if { $filename == "" } {
3165        return
3166    }
3167
3168    # alter prefs and load in file
3169    set prefs(keybindings) $filename
3170    load_keybindings
3171
3172    # did load fail?
3173    if { $settings_file_failures != "" } {
3174        my_dialog $messages(title:open_fail)  [subst -nocommands -nobackslashes $messages(dialog:open_fail) ] error 0 $messages(button:ok)
3175        set settings_file_failures ""
3176        return
3177    }
3178
3179    #save all user prefs
3180    save_prefs
3181
3182    # load bindings into each open tab window
3183    keybind_global
3184    # kill and reopen help window
3185    if { [ winfo exists .helpwin ] } {
3186        destroy .helpwin
3187        help
3188    }
3189}
3190
3191#call up a window with the preferred command for printing
3192proc print_dialog {print_counter} {
3193    global curr_namespace
3194    global prefs
3195    global print_command
3196    global print_button
3197    global pagelen
3198    global messages
3199    global my_platform
3200    variable ${curr_namespace}::tabwin
3201
3202    set w .printprefs_$print_counter
3203    set pagelen $prefs(page_length)
3204    set print_command $prefs(print_command)
3205    if {$my_platform(platform) == "unix"} {
3206        if { [ basic_transient -alt $w $messages(string:print) ] == -1 } {
3207            return 0
3208        }
3209        label $w.command_label -text $messages(dialog:print_command)
3210        entry $w.command_entry -textvariable print_command
3211        pack $w.command_label
3212        pack $w.command_entry -fill x
3213        bind $w <FocusIn> "focus $w.command_entry"
3214    } else {
3215       # macintosh
3216       if { [ basic_transient $w $messages(string:print) ] == -1 } {
3217           return 0
3218       }
3219       set printer_list ""
3220       foreach lpstat_line [split [exec /usr/bin/lpstat -a] "\n" ] {
3221           lappend printer_list "radiobutton -label [ lindex $lpstat_line 0 ] -variable ::print_command"
3222           lappend mac_printers [ lindex $lpstat_line 0 ]
3223       }
3224       if { $printer_list == ""} {
3225           destroy $w
3226           return 0
3227       }
3228       if { ($print_command=="") || ([lsearch -exact $mac_printers $print_command]== -1) } {
3229           set print_command [ lrange [ exec /usr/bin/lpstat -d] end end ]
3230       }
3231       label $w.printer_label -text $messages(dialog:print_select)
3232       my_menubutton $w.printer_list -textvariable ::print_command $printer_list
3233       pack $w.printer_label
3234       pack $w.printer_list
3235    }
3236    label $w.pagelength_label -text "\n$messages(dialog:page_length)"
3237    scale $w.pagelength_scale -showvalue true -from 40 -to 120 -resolution 1 -orient horizontal -variable ::pagelen
3238    pack $w.pagelength_label
3239    pack $w.pagelength_scale -fill x
3240    $w.buttons.cancel configure -command "
3241        set print_button -1
3242    "
3243    $w.buttons.ok configure -default active -command "
3244        set print_button 1
3245    "
3246    wm transient $w $tabwin
3247    grab $w
3248    bind $w <Return> "$w.buttons.ok invoke"
3249
3250    tkwait variable print_button
3251    grab release $w
3252    destroy $w
3253    if {$print_button == -1 } {
3254        unset print_button
3255        return 0
3256    }
3257    if {($print_command != $prefs(print_command)) || ( $pagelen != $prefs(page_length))} {
3258        set prefs(print_command) $print_command
3259        set prefs(page_length) $pagelen
3260        save_prefs
3261    }
3262    unset print_button
3263    return 1
3264}
3265
3266#build a generic transient window to fill in with whatever
3267proc basic_transient {args} {
3268    global messages
3269
3270    getopt opts {alt nocancel} $args
3271    if {$opts(nocancel) > 0} {
3272        set close ok
3273    } else {
3274        set close cancel
3275    }
3276    set w [ lindex $opts(EXTRA) 0 ]
3277    set title [ lindex $opts(EXTRA) 1 ]
3278
3279    if { [ winfo exists $w ] } {
3280        raise $w
3281        focus $w
3282        return -1
3283    }
3284
3285    toplevel $w
3286    wm title $w $title
3287    frame $w.buttons
3288    pack $w.buttons -side bottom -pady 2m
3289    button $w.buttons.ok -under 0 -text $messages(button:ok)
3290    pack $w.buttons.ok -side left -expand true -padx 2.5m
3291    if { $opts(alt) > 0 } {
3292        button_bind -alt $w.buttons.ok
3293    } else {
3294        button_bind $w.buttons.ok
3295    }
3296
3297    # do we have a both ok and cancel, or just ok?
3298    if { $close == "cancel" } {
3299        button $w.buttons.cancel -under 0 -text $messages(button:cancel)
3300        pack $w.buttons.cancel -side left -expand true -padx 2.5m
3301        if { $opts(alt) > 0 } {
3302           button_bind -alt $w.buttons.cancel
3303        } else {
3304           button_bind $w.buttons.cancel
3305        }
3306    } else {
3307        $w.buttons.ok configure -default active
3308        bind $w <Key-Return> "$w.buttons.ok invoke"
3309    }
3310    $w.buttons.$close configure -command "
3311        grab release $w
3312        destroy $w
3313    "
3314    wm protocol $w WM_DELETE_WINDOW "$w.buttons.$close invoke"
3315}
3316
3317#set color preferences
3318proc pref_colors {} {
3319    global curr_namespace
3320    global prefs
3321    global messages
3322    global temp_colors
3323    global my_platform
3324
3325    if { [ basic_transient .color $messages(title:color) ] == -1 } {
3326        return
3327    }
3328
3329    text .color.test -font {Courier 18} -height 7 -width 14
3330    pack .color.test -side right -fill y
3331    frame .color.settings
3332    pack .color.settings -side top -fill both -expand true
3333
3334    .color.buttons.ok configure -command {
3335        array set prefs [ array get temp_colors ]
3336        #save all user prefs
3337        save_prefs
3338
3339        # load colors into each open tab window
3340        # we'll skip the help window on this one pref. proc.
3341        each_namespace color_gui
3342        destroy .color
3343    }
3344
3345    set attribute_old ""
3346    array set attrib_row {bg -1 fg -1}
3347    array set attrib_col {bg 1 fg 0}
3348    foreach setting [ lsort [ array names prefs {color*} ] ] {
3349        #some macos versions don't like font redef. in menus
3350        if {($my_platform(platform)=="macintosh")&&([string match {*menu*} $setting])} {
3351            continue
3352        }
3353        set temp_colors($setting) $prefs($setting)
3354        button .color.settings.$setting -font $prefs(font_statusbar) -text $messages(string:$setting) -command "
3355            set tc \[my_chooseColor -parent .color -title {$messages(string:$setting)} -initialcolor \$temp_colors($setting)\]
3356            if {\$tc != \"\"} {
3357                set temp_colors($setting) \$tc
3358                trycolor
3359            }
3360         "
3361        regexp {color_[a-z]+_([bf]g)} $setting full attribute
3362        if {($attribute != $attribute_old)&&($attribute == {bg})} {
3363                set lastrow [calc_max $attrib_row(bg) $attrib_row(fg)]
3364                array set attrib_row "fg $lastrow bg $lastrow"
3365        }
3366        incr attrib_row($attribute)
3367        grid .color.settings.$setting -row $attrib_row($attribute) -column $attrib_col($attribute) -pady 2m -sticky we
3368        set attribute_old $attribute
3369    }
3370
3371    trycolor
3372    .color.test insert end "\n 0123ABCDabcd\n\n 0123ABCDabcd"
3373    .color.test tag add color_help_bg 2.0 3.0
3374    .color.test tag add color_help_fg 2.0 3.0
3375    # don't show menu color opts on mac
3376    if {$my_platform(platform)!="macintosh"} {
3377        .color.test insert end "\n\n 0123ABCDabcd"
3378        .color.test tag add color_menu_bg 4.0 5.0
3379        .color.test tag add color_menu_fg_left 4.0 4.7
3380        .color.test tag add color_menu_fg_right 4.7 5.0
3381        set lastrow 6
3382    } else {
3383        set lastrow 4
3384    }
3385    .color.test tag add color_tab_bg_default ${lastrow}.0 ${lastrow}.7
3386    .color.test tag add color_tab_bg_sel ${lastrow}.7 end
3387    .color.test tag add color_tab_fg_currpos ${lastrow}.0 ${lastrow}.3 ${lastrow}.7 ${lastrow}.9
3388    .color.test tag add color_tab_fg_currstring ${lastrow}.3 ${lastrow}.5 ${lastrow}.9 ${lastrow}.11
3389    .color.test tag add color_tab_fg_default ${lastrow}.5 ${lastrow}.7 ${lastrow}.11 end
3390
3391    place_transient .color
3392}
3393
3394#set font size/weight preferences... not family, because we want to force
3395#the user to a non-proportional tablature font, and it also makes this easier
3396proc pref_fonts {} {
3397    global curr_namespace
3398    global prefs
3399    global messages
3400    global font_sizes
3401    global font_weights
3402    global temp_font
3403    global my_platform
3404
3405    if { [ basic_transient .font $messages(menu:font) ] == -1 } {
3406        return
3407    }
3408
3409    .font.buttons.ok configure -command {
3410        array set prefs [ array get temp_font ]
3411        #save all user prefs
3412        save_prefs
3413
3414        # load fonts into each open tab window
3415        each_namespace color_gui
3416        destroy .font
3417        # load fonts into any open help windows
3418        if { [ winfo exists .helpwin ] } {
3419            .helpwin.txt configure -font $prefs(font_help)
3420            .helpwin.buttons.can configure -font $prefs(font_statusbar)
3421        }
3422    }
3423
3424    frame .font.pref
3425    pack .font.pref -side top -fill x -pady 2m
3426    set i -1
3427    foreach setting [ lsort [ array names prefs {font*} ] ] {
3428        #some macos versions don't like font redef. in menus
3429        if {($my_platform(platform)=="macintosh")&&([string match {*status*} $setting])} {
3430            continue
3431        }
3432        set prefix .font.pref.${setting}
3433        incr i
3434        set temp_font($setting) $prefs($setting)
3435        # get size and weight of fonts currently in use
3436        regexp {([0-9]+)} $prefs($setting) full size
3437        switch -glob -- $prefs($setting) {
3438            {*bold?italic*}
3439                {set weight bold_italic}
3440            {*bold*}
3441                {set weight bold}
3442            {*italic*}
3443                {set weight italic}
3444            default
3445                {set weight regular}
3446        }
3447
3448        # Font name written in chosen font
3449        label ${prefix}_name -justify left -text $messages(string:$setting) -font $prefs($setting)
3450
3451        # size choice menubutton
3452        menubutton ${prefix}_size -text $size -menu ${prefix}_size.menu -width 2
3453        menu ${prefix}_size.menu
3454        foreach size_choice $font_sizes {
3455            ${prefix}_size.menu add radiobutton -indicatoron false -label $size_choice -command "
3456                regsub {(\[0-9\]+)} \$temp_font($setting) $size_choice temp_font($setting)
3457                ${prefix}_name configure -font \$temp_font($setting)
3458                ${prefix}_size configure -text $size_choice
3459            "
3460        }
3461
3462        # weight choice menubutton
3463        menubutton ${prefix}_weight -text $messages(string:$weight) -menu ${prefix}_weight.menu
3464        menu ${prefix}_weight.menu
3465        set mb_width 0
3466        foreach weight_choice [ lsort [ array names font_weights ] ] {
3467            ${prefix}_weight.menu add radiobutton -indicatoron false -label $messages(string:$weight_choice) -command "
3468                set temp_font($setting) \"\[lrange \$temp_font($setting) 0 1 \] \$font_weights($weight_choice)\"
3469                ${prefix}_name configure -font \$temp_font($setting)
3470                ${prefix}_weight configure -text $messages(string:$weight_choice)
3471            "
3472            if { [ string length $messages(string:$weight_choice) ] > $mb_width } {
3473                set mb_width [ string length $messages(string:$weight_choice) ]
3474            }
3475        }
3476        ${prefix}_weight configure -width $mb_width
3477        grid ${prefix}_name ${prefix}_size ${prefix}_weight -row $i -sticky we -pady 2m
3478    }
3479
3480    place_transient .font
3481}
3482
3483# set formatting of tablature
3484proc pref_format {variable} {
3485    global curr_namespace
3486    global messages
3487    global my_platform
3488    global col_width
3489
3490    if {$variable == "current"} {
3491        set space $curr_namespace
3492        variable ${space}::temp_format
3493        variable ${space}::score_width
3494        variable ${space}::row_sep_lines
3495        variable ${space}::tabwin
3496        array set temp_format [list row_sep_lines $row_sep_lines score_width $score_width]
3497        set window $tabwin.format
3498        set title $messages(menu:format)
3499    } else {
3500        set space "::defaults"
3501        global prefs
3502        variable ${space}::temp_format
3503        array set temp_format [list row_sep_lines $prefs(row_sep_lines) score_width $prefs(score_width) window_width $prefs(window_width) window_height $prefs(window_height)]
3504        set window .format_defaults
3505        set title $messages(menu:default_format)
3506    }
3507
3508    if { [ basic_transient $window $title ] == -1 } {
3509        return
3510    }
3511
3512    if {$variable == "current"} {
3513        $window.buttons.ok configure -command "
3514            set ${space}::score_width \$${space}::temp_format(score_width)
3515            set ${space}::row_sep_lines \$${space}::temp_format(row_sep_lines)
3516
3517            # load formatting into current tab window
3518            process_formatting $space
3519            redisplay_toend start
3520
3521            destroy $window
3522        "
3523    } else {
3524        $window.buttons.ok configure -command "
3525            array set prefs \[array get ${space}::temp_format \]
3526            save_prefs
3527            destroy $window
3528        "
3529    }
3530
3531    frame $window.pref
3532    pack $window.pref -side top -fill x -pady 2m
3533
3534    label $window.pref.rowsep_label -text $messages(string:separation)
3535    scale $window.pref.rowsep_scale -showvalue true -from 1 -to 10 -resolution 1 -orient vertical -variable ${space}::temp_format(row_sep_lines)
3536    grid $window.pref.rowsep_label -row 0 -column 0 -columnspan 2 -sticky e
3537    grid $window.pref.rowsep_scale -row 0 -column 2 -rowspan 2 -sticky w
3538    scale $window.pref.width_scale -showvalue true -from 45 -to 135 -resolution $col_width -label $messages(string:width) -orient horizontal -variable ${space}::temp_format(score_width)
3539    grid $window.pref.width_scale -row 1 -column 0 -columnspan 2 -sticky we -pady 2m
3540    if {$variable != "current"} {
3541        label $window.pref.spacer -text "   "
3542        label $window.pref.winheight_label -text $messages(string:window_height)
3543        scale $window.pref.winheight_scale -showvalue true -from 20 -to 80 -resolution 1 -orient vertical -variable ${space}::temp_format(window_height)
3544        grid $window.pref.spacer -row 1 -column 3
3545        grid $window.pref.winheight_label -row 0 -column 4 -columnspan 2 -sticky e
3546        grid $window.pref.winheight_scale -row 0 -column 6 -rowspan 2 -sticky w
3547        scale $window.pref.winwidth_scale -showvalue true -from 50 -to 140 -label $messages(string:window_width) -orient horizontal -variable ${space}::temp_format(window_width)
3548        grid $window.pref.winwidth_scale -row 1 -column 4 -columnspan 2 -sticky we -pady 2m
3549    }
3550
3551    place_transient $window
3552}
3553
3554# allow user to add/del/edit from a list of known 'preset' tunings
3555proc tuning_presets {ns} {
3556    global prefs
3557    global messages
3558    variable ::defaults::tunings_$ns
3559    variable ::defaults::tun_names_$ns
3560
3561    # access current prefs.
3562    array set tunings_$ns $prefs(tun_presets_$ns)
3563    set tun_names_$ns [ lsort [ array names tunings_$ns ] ]
3564
3565    # draw the window
3566    set window .preflist_$ns
3567    if { [ basic_transient $window "$messages(string:tuning_presets) $ns" ] == -1 } {
3568        return
3569    }
3570    $window.buttons.ok configure -command "
3571        set prefs(tun_presets_$ns) \[ array get ::defaults::tunings_$ns \]
3572        save_prefs
3573        destroy $window
3574    "
3575    frame $window.body
3576    pack $window.body -expand 1 -fill both -side top
3577
3578    scrollbar $window.body.scroll -command "$window.body.list yview"
3579    listbox $window.body.list -yscroll "$window.body.scroll set" -width 30 -height 16 -setgrid 1 -listvar ::defaults::tun_names_$ns
3580    frame $window.body.actions
3581    pack $window.body.list $window.body.scroll -side left -fill y -expand 1
3582    pack $window.body.actions -side bottom
3583
3584    button $window.body.actions.edit -text $messages(button:edit) -command "tuning_win presets $ns \[selection get\]"
3585    button $window.body.actions.add -text $messages(button:add) -command "tuning_win presets $ns {}"
3586    button $window.body.actions.del -text $messages(button:delete) -command "
3587        array unset ::defaults::tunings_$ns \"\[selection get\]\"
3588        set ::defaults::tun_names_$ns \[ array names ::defaults::tunings_$ns \]
3589    "
3590
3591    pack $window.body.actions.add $window.body.actions.edit $window.body.actions.del -fill x -expand 1
3592
3593    # double-clicking an entry is the same as pushing the 'edit' button
3594    bind $window.body.list <Double-1> "$window.body.actions.edit invoke"
3595}
3596
3597# pulldown menus to change tuning of individual strings
3598proc tuning_win {args} {
3599    global chromatic
3600    global curr_namespace
3601    global messages
3602    global prefs
3603    variable ${curr_namespace}::pos
3604    variable ${curr_namespace}::tabwin
3605    variable ${curr_namespace}::text
3606
3607    # alter behavior, based on whether we're editing the tuning of a
3608    # tab window, the default for some # of strings, or a named preset
3609    switch  -glob -- $args {
3610        {current} {
3611            set space $curr_namespace
3612            variable ${space}::num_strings
3613            variable ${space}::tuning
3614            variable ${space}::temp_tuning
3615            set ns $num_strings
3616            array set temp_tuning [ array get tuning ]
3617            set window $tabwin.tuning
3618            set title $messages(title:tuning)
3619            if { [ basic_transient $window $title ] == -1 } {
3620                return
3621            }
3622        }
3623        {newtab*} {
3624            set ns [ lindex $args 1 ]
3625            set space ::defaults
3626            variable ${space}::temp_tuning
3627            array set temp_tuning $prefs(tuning_$ns)
3628            set window .tuning_defaults
3629            set title $messages(menu:default_tuning)
3630            if { [ basic_transient $window $title ] == -1 } {
3631                return
3632            }
3633        }
3634        {presets*} {
3635            set space ::defaults
3636            variable ${space}::temp_tuning
3637            variable ${space}::tun_name
3638            set ns [ lindex $args 1 ]
3639            set tun_name [ lindex $args 2 ]
3640            # if the preset has a name, we're editing an existing preset,
3641            # if the name is empty, we're adding a new one
3642            if {$tun_name == ""} {
3643                array set temp_tuning $prefs(tuning_$ns)
3644                set title $messages(string:tuning_presets)
3645            } else {
3646                set ::defaults::oldname "$tun_name"
3647                set title "$tun_name"
3648                array set temp_tuning [ lindex [ array get ::defaults::tunings_$ns "$tun_name" ] 1 ]
3649            }
3650            set window .tuning_edit_presets
3651            if { [ basic_transient -alt "$window" "$title" ] == -1 } {
3652                return
3653            }
3654        }
3655    }
3656    # build a list of items to put in a menu of named tunings
3657    array set presets $prefs(tun_presets_$ns)
3658    foreach p [ lsort [ array names presets ] ] {
3659        lappend preset_menu "command -label {$p} {array set ${space}::temp_tuning {$presets($p)}}"
3660    }
3661
3662    frame $window.body
3663    pack $window.body -expand 1 -fill both -side top
3664
3665    # make a menubutton for each instrument string
3666    for { set i 0 } { $i < $ns } { incr i } {
3667        set cs [ expr $i + 1 ]
3668        menubutton $window.body.${i}_button -textvariable ${space}::temp_tuning($i) -menu $window.body.${i}_button.menu -direction right -indicatoron 0 -width 2
3669        menu $window.body.${i}_button.menu
3670        foreach j $chromatic {
3671            $window.body.${i}_button.menu add radiobutton -label $j -variable ${space}::temp_tuning($i)
3672        }
3673        arrowbuttons $window.body.${i}_arrowframe standard "listprev -cycle ${space}::temp_tuning($i) {\$::chromatic}" "listnext -cycle ${space}::temp_tuning($i) {\$::chromatic}"
3674        $window.body.${i}_button.menu entryconfigure 9 -columnbreak 1
3675        label $window.body.${i}_label -justify left -text [ subst -nobackslashes -nocommands $messages(string:string_name) ]
3676        grid $window.body.${i}_label -row $i -column 0 -sticky we -pady 1m -padx 2m
3677        grid $window.body.${i}_button -row $i -column 1 -sticky we -pady 1m
3678        grid $window.body.${i}_arrowframe -row $i -column 2 -sticky we -pady 1m
3679    }
3680    frame $window.body.presets
3681    grid $window.body.presets -row $ns -column 0 -columnspan 3 -sticky we -pady 5m
3682
3683    switch  -glob -- $args {
3684        {current} {
3685            my_menubutton $window.body.presets.list -text $messages(string:tuning_presets) $preset_menu
3686            pack $window.body.presets.list
3687            $window.buttons.ok configure -command "
3688                history_add {$messages(history:tuning)}
3689                array set ${curr_namespace}::tuning \[ array get ${space}::temp_tuning \]
3690                redisplay_toend 0
3691                grab release $window
3692                destroy $window
3693            "
3694        }
3695        {newtab*} {
3696            my_menubutton $window.body.presets.list -text $messages(string:tuning_presets) $preset_menu
3697            pack $window.body.presets.list
3698            $window.buttons.ok configure -command "
3699                set prefs(tuning_$ns) \[array get ${space}::temp_tuning \]
3700                save_prefs
3701                grab release $window
3702                destroy $window
3703            "
3704        }
3705        {presets*} {
3706            label $window.body.presets.label -text $messages(string:name)
3707            entry $window.body.presets.entry -textvariable ::defaults::tun_name
3708            pack $window.body.presets.label -side left
3709            pack $window.body.presets.entry -side right -fill x -expand true
3710
3711            # Insist that the user fill in a name for the tuning...
3712            # If they didn't, change the gui to highlight the name entry box
3713            $window.buttons.ok configure -command "
3714                if { \"\$::defaults::tun_name\" == {} } {
3715                    $window.body.presets.entry configure -highlightcolor red -highlightbackground indianred -insertbackground red -insertwidth 6
3716                    focus $window.body.presets.entry
3717                } else {
3718                    if { \[ info exists ::defaults::oldname \] } {
3719                        array unset ::defaults::tunings_$ns \"\$::defaults::oldname\"
3720                    }
3721                    array set ::defaults::tunings_$ns \"{\$::defaults::tun_name} {\[array get ::defaults::temp_tuning \]}\"
3722                    set ::defaults::tun_names_$ns \[ lsort \[ array names ::defaults::tunings_$ns \] \]
3723                    grab release $window
3724                    destroy $window
3725                }
3726            "
3727        }
3728    }
3729
3730    place_transient $window
3731    update idletasks
3732    grab $window
3733}
3734
3735proc toggle_lyrics_mode {} {
3736    global curr_namespace
3737    global messages
3738    variable ${curr_namespace}::insert_mode
3739    variable ${curr_namespace}::mode_old
3740
3741    if { $insert_mode == $messages(string:lyrics) } {
3742        set insert_mode $mode_old
3743        lyrics_done
3744    } else {
3745        set insert_mode $messages(string:lyrics)
3746        lyrics_edit
3747    }
3748}
3749
3750# text edit window
3751proc lyrics_edit {} {
3752    global curr_namespace
3753    global images
3754    variable ${curr_namespace}::tabwin
3755    variable ${curr_namespace}::pos
3756    variable ${curr_namespace}::num_strings
3757
3758    # change keyboard and mouse bindings
3759    bindtags $tabwin [ lreplace [bindtags $tabwin ] 1 1 Lyricswindow ]
3760    bindtags $tabwin.tablature [ lreplace [bindtags $tabwin.tablature ] 1 2 Lyrics Lyricswindow ]
3761
3762    # disable buttons not in use during lyrics editing
3763    foreach disable_widget {tuning basefret basefret_legend} {
3764        $tabwin.msg_frame.right_frame.$disable_widget configure -state disabled
3765    }
3766    $tabwin.msg_frame.right_frame.bfarrow_frame.up configure -image $images(disabled.up)
3767    $tabwin.msg_frame.right_frame.bfarrow_frame.dn configure -image $images(disabled.dn)
3768
3769    # position cursor and set appearance of mouse pointer
3770    array set current [ calc_rowcol $pos ]
3771    $tabwin.tablature mark set insert "line$current(row) + $num_strings lines"
3772    $tabwin.tablature see insert
3773    $tabwin.tablature configure -cursor xterm -state normal
3774
3775    ghost_menu disable menu:select_all
3776    # works around an apparent bug where tk forgets to make cursor blink
3777    focus $tabwin ; update ;focus $tabwin.tablature
3778
3779    clear_mark
3780    ghost_cutcopy disabled
3781    recolor_tab_full -notwhitespace
3782}
3783
3784# return to tablature editing mode from lyrics editing mode
3785proc lyrics_done {args} {
3786    global curr_namespace
3787    global prefs
3788    global initial_col
3789    global images
3790    variable ${curr_namespace}::tabwin
3791    variable ${curr_namespace}::num_strings
3792    variable ${curr_namespace}::pos
3793    variable ${curr_namespace}::insert_mode
3794    variable ${curr_namespace}::mode_old
3795
3796    set mode_old $insert_mode
3797    # Return, doing nothing if just swtiching between chord/lead modes
3798    if { [ lsearch -exact [ bindtags $tabwin.tablature ] Tablature ] > -1 } {
3799        return
3800    }
3801
3802    # change keyboard and mouse bindings
3803    bindtags $tabwin [ lreplace [bindtags $tabwin ] 1 1 Tabwindow$num_strings ]
3804    bindtags $tabwin.tablature [ lreplace [bindtags $tabwin.tablature ] 1 2 Tablature Tabwindow$num_strings ]
3805
3806    # enable buttons not in use during tablature editing
3807    foreach enable_widget {tuning basefret basefret_legend} {
3808        $tabwin.msg_frame.right_frame.$enable_widget configure -state normal
3809    }
3810    $tabwin.msg_frame.right_frame.bfarrow_frame.up configure -image $images(msg_frame_right.up)
3811    $tabwin.msg_frame.right_frame.bfarrow_frame.dn configure -image $images(msg_frame_right.dn)
3812
3813    # position cursor and set appearance of mouse pointer
3814    if { [ lindex $args 1 ] != "" } {
3815        set xy $args
3816    } else {
3817        array set charinfo [ find_textpos insert ]
3818        if { $charinfo(section) == "header" } {
3819            set charinfo(section) line0
3820        } elseif { $charinfo(section) == "footer" } {
3821            array set charinfo [ find_textpos [ findmark previous footer ] ]
3822        }
3823        set xy [ $tabwin.tablature bbox "$charinfo(section) + $initial_col chars" ]
3824    }
3825    absolute_pos [ lindex $xy 0 ] [ lindex $xy 1 ]
3826    $tabwin.tablature configure -cursor left_ptr -state disabled
3827
3828    ghost_menu normal menu:select_all
3829    focus $tabwin.tablature
3830    catch {$tabwin.tablature mark unset lyr_selection}
3831    ghost_cutcopy disabled
3832    recolor_tab_full -notwhitespace
3833}
3834
3835# file open/save/export window
3836proc open_dialog {} {
3837    global curr_namespace
3838    global ext
3839    global open_types
3840    global blank_tab
3841    global cwd
3842    global messages
3843    global prefs
3844    variable ${curr_namespace}::name
3845    variable ${curr_namespace}::tabwin
3846    variable ${curr_namespace}::tab_data
3847
3848    set filename [my_filedialog tk_getOpenFile -title $messages(string:open) \
3849        -parent $tabwin -defaultextension $ext($prefs(num_strings)) \
3850        -initialdir $cwd -filetypes $open_types($prefs(num_strings)) ]
3851
3852    if { $filename == "" } {
3853        return
3854    }
3855
3856    set cwd [ file dirname $filename ]
3857    # get new window for tab, unless current tab window is empty
3858    if { $tab_data == $blank_tab($prefs(num_strings)) } {
3859        set name $filename
3860        open_tab
3861    } else {
3862        new_tab -file $filename
3863    }
3864}
3865
3866
3867#
3868# functions mapped to keypresses by end user
3869#
3870
3871# **functions that affect overall mode
3872
3873# toggle chord/note mode
3874proc toggle_insert_mode {} {
3875    global curr_namespace
3876    global messages
3877    variable ${curr_namespace}::insert_mode
3878    variable ${curr_namespace}::mode_old
3879
3880    if { $insert_mode == $messages(string:chord) } {
3881	set insert_mode $messages(string:lead)
3882    } else {
3883	set insert_mode $messages(string:chord)
3884    }
3885    set mode_old $insert_mode
3886}
3887
3888# move the base fret up 1
3889proc inc_basefret {} {
3890    global curr_namespace
3891    global maxbasefret
3892    global messages
3893    variable ${curr_namespace}::basefret
3894    variable ${curr_namespace}::insert_mode
3895
3896    if { $insert_mode == $messages(string:lyrics) } {
3897        return
3898    }
3899    if { $basefret < $maxbasefret } {
3900      incr basefret
3901    }
3902    ghost_arrows 0 $maxbasefret $basefret
3903}
3904
3905# move the base fret down 1
3906proc dec_basefret {} {
3907    global curr_namespace
3908    global maxbasefret
3909    global messages
3910    variable ${curr_namespace}::basefret
3911    variable ${curr_namespace}::insert_mode
3912
3913    if { $insert_mode == $messages(string:lyrics) } {
3914        return
3915    }
3916    if { $basefret > 0 } {
3917      incr basefret -1
3918    }
3919    ghost_arrows 0 $maxbasefret $basefret
3920}
3921
3922# if basefret is at max or min, disable the corresponding spinbox arrow
3923proc ghost_arrows {min max value} {
3924    global curr_namespace
3925    variable ${curr_namespace}::tabwin
3926
3927    if {$value == $min} {
3928        $tabwin.msg_frame.right_frame.bfarrow_frame.dn configure -state disabled
3929    } else {
3930        $tabwin.msg_frame.right_frame.bfarrow_frame.dn configure -state normal
3931    }
3932    if {$value == $max} {
3933        $tabwin.msg_frame.right_frame.bfarrow_frame.up configure -state disabled
3934    } else {
3935        $tabwin.msg_frame.right_frame.bfarrow_frame.up configure -state normal
3936    }
3937}
3938
3939
3940# **cursor movement
3941
3942# move back a position in the tab
3943proc back {} {
3944    global curr_namespace
3945    variable ${curr_namespace}::pos
3946    variable ${curr_namespace}::col_max
3947
3948    if { $pos > 0 } {
3949        set old_pos $pos
3950	incr pos -1
3951	recolor_tab_pos $old_pos
3952	recolor_tab_pos $pos
3953        see_currpos
3954    }
3955}
3956
3957# move forward a position in the tab
3958proc forward {} {
3959    global curr_namespace
3960    variable ${curr_namespace}::data_end
3961    variable ${curr_namespace}::pos
3962    variable ${curr_namespace}::col_max
3963
3964    if { $pos < $data_end } {
3965	set old_pos $pos
3966	incr pos
3967	recolor_tab_pos $old_pos
3968	recolor_tab_pos $pos
3969        see_currpos
3970    }
3971}
3972
3973# move up a string
3974proc up_string {} {
3975    global curr_namespace
3976    variable ${curr_namespace}::pos
3977    variable ${curr_namespace}::string
3978
3979    if { $string > 0 } {
3980        incr string -1
3981        recolor_tab_pos $pos
3982    }
3983}
3984
3985# move down a string
3986proc down_string {} {
3987    global curr_namespace
3988    variable ${curr_namespace}::num_strings
3989    variable ${curr_namespace}::pos
3990    variable ${curr_namespace}::string
3991
3992    if { $string < [expr $num_strings - 1] } {
3993        incr string
3994        recolor_tab_pos $pos
3995    }
3996}
3997
3998
3999# move up a score
4000proc up_score {} {
4001    global curr_namespace
4002    variable ${curr_namespace}::mark
4003    variable ${curr_namespace}::pos
4004    variable ${curr_namespace}::col_max
4005
4006    set pos_new [ expr $pos - $col_max ]
4007    if { $pos_new >= 0 } {
4008        set pos_old $pos
4009        set pos $pos_new
4010        if { $mark == -1 } {
4011            recolor_tab_pos $pos_old
4012            recolor_tab_pos $pos
4013        } else {
4014            recolor_tab_full -notwhitespace
4015        }
4016        see_currpos
4017    }
4018}
4019
4020# move down a score
4021proc down_score {} {
4022    global curr_namespace
4023    variable ${curr_namespace}::data_end
4024    variable ${curr_namespace}::mark
4025    variable ${curr_namespace}::pos
4026    variable ${curr_namespace}::row
4027    variable ${curr_namespace}::col_max
4028
4029    set pos_old $pos
4030    set pos_new [ expr $pos + $col_max ]
4031    set row [ lindex [ calc_rowcol $pos ] 1 ]
4032    if { $pos_new <= $data_end } {
4033        set pos $pos_new
4034    } else {
4035        set pos_new [ expr ( $row + 1 ) * $col_max ]
4036        if { $pos_new <= $data_end } {
4037            set pos $data_end
4038        }
4039    }
4040    if { $pos != $pos_old } {
4041        if { $mark == -1 } {
4042            recolor_tab_pos $pos_old
4043            recolor_tab_pos $pos
4044        } else {
4045            recolor_tab_full -notwhitespace
4046        }
4047        see_currpos
4048    }
4049}
4050
4051# move to start of score
4052proc home {} {
4053    global curr_namespace
4054    variable ${curr_namespace}::mark
4055    variable ${curr_namespace}::pos
4056
4057    set pos_old $pos
4058    set pos 0
4059    if { $mark == -1 } {
4060        recolor_tab_pos $pos_old
4061        recolor_tab_pos $pos
4062    } else {
4063        recolor_tab_full -notwhitespace
4064    }
4065    see_currpos
4066}
4067
4068# move to end of score
4069proc end {} {
4070    global curr_namespace
4071    variable ${curr_namespace}::data_end
4072    variable ${curr_namespace}::mark
4073    variable ${curr_namespace}::pos
4074
4075    set pos_old $pos
4076    set pos $data_end
4077    if { $mark == -1 } {
4078        recolor_tab_pos $pos_old
4079        recolor_tab_pos $pos
4080    } else {
4081        recolor_tab_full -notwhitespace
4082    }
4083    see_currpos
4084}
4085
4086
4087# look for text 'marks', ignoring tk presets current and insert
4088proc findmark {direction currindex} {
4089    global curr_namespace
4090    variable ${curr_namespace}::tabwin
4091
4092    set section [ $tabwin.tablature mark $direction $currindex ]
4093    while { ($section == "current") || ($section == "insert") || ( $section == "lyr_selection") } {
4094        set section [ $tabwin.tablature mark $direction $section ]
4095    }
4096    return $section
4097}
4098
4099# absolute position set via mouse click in tab mode
4100proc absolute_pos {x y} {
4101    global curr_namespace
4102    global messages
4103    variable ${curr_namespace}::insert_mode
4104    variable ${curr_namespace}::col_max
4105    variable ${curr_namespace}::row_sep_lines
4106    variable ${curr_namespace}::score_width
4107    variable ${curr_namespace}::data_end
4108    variable ${curr_namespace}::mark
4109    variable ${curr_namespace}::num_strings
4110    variable ${curr_namespace}::pos
4111    variable ${curr_namespace}::row
4112    variable ${curr_namespace}::row_height
4113    variable ${curr_namespace}::string
4114    variable ${curr_namespace}::tabwin
4115
4116    focus $tabwin.tablature
4117    array set new [ tabpos_from_xy $x $y ]
4118
4119    # if the mouse is within a score, move the current postion, there
4120    if { ($new(col)<$col_max)&&($new(col)>=0)&&($new(string)>=0)&&($new(pos)>=0)&&($new(pos)<=$data_end)&&($new(string)<$num_strings) } {
4121        set pos_old $pos
4122        set pos $new(pos)
4123        set string $new(string)
4124        if { $mark == -1 } {
4125            recolor_tab_pos $pos_old
4126            recolor_tab_pos $pos
4127        } else {
4128            recolor_tab_full -notwhitespace
4129        }
4130    } elseif { $mark != -1 } {
4131    # if we're dragging the mouse to select an area, approximate how a
4132    # word processor would highlight, when "out of bounds"
4133        if { $new(rowindex)=="header" } {
4134            set pos 0
4135        } elseif { $new(rowindex)=="footer" } {
4136            return
4137        } elseif { $new(row) < $new(row_mark) } {
4138            set pos [ expr ( $new(row) + 1 ) * $col_max  ]
4139        } elseif { $new(string) >= $num_strings } {
4140            set pos [ calc_min [ expr ( $new(row) + 1 ) * $col_max - 1 ] $data_end ]
4141        } else {
4142            return
4143        }
4144        recolor_tab_full -notwhitespace
4145    } else {
4146        # check if clicked in textbox
4147        array set charinfo [ find_textpos @$x,$y ]
4148        if { ( [ $tabwin.tablature compare @$x,$y >= $charinfo(textstart) ] ) && ( [ $tabwin.tablature compare @$x,$y <= $charinfo(textend) ] ) } {
4149            set insert_mode $messages(string:lyrics)
4150            lyrics_edit
4151            absolute_textpos $x $y
4152        }
4153    }
4154    see_currpos
4155}
4156
4157proc tabpos_from_xy {x y} {
4158    global curr_namespace
4159    global initial_col
4160    global col_width
4161    variable ${curr_namespace}::col_max
4162    variable ${curr_namespace}::mark
4163    variable ${curr_namespace}::tabwin
4164
4165    # what text position corresponds to mouse position
4166    set char_x [ lindex [ split [ $tabwin.tablature index @$x,$y ] . ]  1 ]
4167    set char_y [ lindex [ split [ $tabwin.tablature index @$x,$y ] . ]  0 ]
4168
4169    # look for previous marker of the start of a row in the text
4170    set rowindex [ findmark previous $char_y.$char_x ]
4171    if { $rowindex == "" } {
4172        return [ list pos -1 row -1 col -1 string -1 rowindex -1 row_mark -1 ]
4173    }
4174    if { ($rowindex == "header")||($rowindex == "footer") } {
4175        set row_new -1
4176    } else {
4177        set row_new [ string range $rowindex 4 end ]
4178    }
4179    # compare exact location to start of row
4180    set string_new [ expr $char_y - int( [$tabwin.tablature index $rowindex] ) ]
4181    set col_new [ expr int ( ( $char_x - $initial_col ) / $col_width ) ]
4182    set pos_new [ expr $row_new * $col_max + $col_new ]
4183    set row_mark [ lindex [ calc_rowcol $mark ] 1 ]
4184    return [ list pos $pos_new row $row_new col $col_new string $string_new rowindex $rowindex row_mark $row_mark ]
4185}
4186
4187# scroll selection in tab window... altered version of tkTextAutoScan
4188proc dragtab {w place_cursor} {
4189    global tkPriv
4190
4191    if {![winfo exists $w]} {
4192        return
4193    }
4194    array set scroll {x 1 y 1}
4195    if {$tkPriv(y) >= [winfo height $w]} {
4196        $w yview scroll 2 units
4197    } elseif { $tkPriv(y) < 0 } {
4198        $w yview scroll -2 units
4199    } else {
4200        unset scroll(y)
4201    }
4202    if {$tkPriv(x) > [winfo width $w]} {
4203        $w xview scroll 2 units
4204    } elseif {$tkPriv(x) < 0} {
4205        $w xview scroll -2 units
4206    } else {
4207        unset scroll(x)
4208    }
4209    if {[info exists scroll]} {
4210        set tkPriv(afterId) [after 50 dragtab $w $place_cursor]
4211        $place_cursor $tkPriv(x) $tkPriv(y)
4212        update idletasks
4213    }
4214}
4215
4216# **insert/delete related functions
4217
4218# delete note cursor is over, but leave the rest of this position intact
4219proc del_note {} {
4220    global curr_namespace
4221    global messages
4222    variable ${curr_namespace}::mark
4223    variable ${curr_namespace}::pos
4224    variable ${curr_namespace}::string
4225    variable ${curr_namespace}::tab_data
4226
4227    if { $mark != -1 } {
4228        history_add $messages(history:delete)
4229        cut_tab -redraw
4230    } elseif { [ lindex [ lindex $tab_data $pos ] $string ] > -1 } {
4231        history_add $messages(history:del_note)
4232        set tab_data [ lreplace $tab_data $pos $pos [ lreplace [ lindex $tab_data $pos ] $string $string -1 ] ]
4233        redraw_pos $pos
4234    }
4235}
4236
4237# delete position behind cursor
4238proc backspace {} {
4239    global curr_namespace
4240    global messages
4241    variable ${curr_namespace}::mark
4242    variable ${curr_namespace}::pos
4243
4244    history_add $messages(history:delete)
4245    if { $mark != -1 } {
4246        cut_tab -redraw
4247    } else {
4248        # don't do backspace functionality if already at beginning of tab
4249        if { $pos > 0 } {
4250            back
4251            del_pos
4252        }
4253    }
4254}
4255
4256
4257# delete whole position
4258proc del_pos {args} {
4259    global blank_tab
4260    global curr_namespace
4261    global messages
4262    variable ${curr_namespace}::data_end
4263    variable ${curr_namespace}::mark
4264    variable ${curr_namespace}::num_strings
4265    variable ${curr_namespace}::pos
4266    variable ${curr_namespace}::tab_data
4267
4268    getopt opts history $args
4269    if { $opts(history) > 0 } {
4270        history_add $messages(history:delete)
4271    }
4272    if { $mark == -1 } {
4273        set mark $pos
4274    }
4275    cut_tab -redraw
4276}
4277
4278# add blank spaces to the end of the current line
4279proc force_newline {} {
4280    global curr_namespace
4281    global messages
4282    variable ${curr_namespace}::pos
4283    variable ${curr_namespace}::col_max
4284
4285    set pos_old $pos
4286    history_add $messages(history:newline)
4287
4288    for { set i [ expr [ lindex [ calc_rowcol $pos ] 3 ] + 1 ]} { $i <= $col_max } { incr i } {
4289        whitespace
4290    }
4291
4292    redisplay_toend $pos_old
4293}
4294
4295# insert new position
4296proc add_blank {args} {
4297    global blank_tab
4298    global curr_namespace
4299    global messages
4300    global col_width
4301    variable ${curr_namespace}::data_end
4302    variable ${curr_namespace}::insert_mode
4303    variable ${curr_namespace}::mark
4304    variable ${curr_namespace}::num_strings
4305    variable ${curr_namespace}::pos
4306    variable ${curr_namespace}::tab_data
4307    variable ${curr_namespace}::col_max
4308
4309    getopt opts {advance history redraw} $args
4310    if { $opts(history) > 0 } {
4311        history_add $messages(history:blanktab)
4312    }
4313
4314    # where to we insert the new blank?
4315    if { $mark != -1 } {
4316        # if we delete whole tablature, cut_tab proc already inserts a blank
4317        if { [ expr abs($mark - $pos) ] == $data_end } {
4318            cut_tab
4319            if { $opts(redraw) > 0 } {
4320                redisplay_toend [ calc_max [ expr $pos - 1] 0 ]
4321                see_currpos
4322            }
4323            return
4324        }
4325        set splitafter [ expr [ calc_min $pos $mark ] - 1]
4326        cut_tab
4327        # undoing the advance at the end if we had to cut tab, first
4328        if { ( $opts(advance) > 0 ) } {
4329            incr pos -1
4330        }
4331    } elseif { $opts(advance) > 0 } {
4332        set splitafter $pos
4333    } else {
4334        set splitafter [ expr $pos - 1 ]
4335    }
4336
4337    # adjust insertion for first, last, middle of tab
4338    if { $splitafter == $data_end } {
4339        set tab_data [ concat $tab_data $blank_tab($num_strings) ]
4340    } elseif { $splitafter < 0 } {
4341        set tab_data [ concat $blank_tab($num_strings) $tab_data ]
4342    } else {
4343        set tab_data [ concat [ lrange $tab_data 0 $splitafter ] $blank_tab($num_strings) [ lrange $tab_data [ expr $splitafter + 1 ] $data_end ] ]
4344    }
4345
4346    # update ascii version
4347    asciitab_replace [ expr $splitafter + 1 ] 0 1
4348
4349    if { $opts(advance) > 0 } {
4350        incr pos
4351    }
4352    if { $opts(redraw) > 0 } {
4353        redisplay_toend [ calc_max [ expr $pos - 1] 0 ]
4354        see_currpos
4355    }
4356}
4357
4358# replace contents of current position with a bar
4359proc whitespace {args} {
4360    global curr_namespace
4361    global messages
4362    variable ${curr_namespace}::data_end
4363    variable ${curr_namespace}::fret
4364    variable ${curr_namespace}::insert_mode
4365    variable ${curr_namespace}::mark
4366    variable ${curr_namespace}::pos
4367    variable ${curr_namespace}::tab_data
4368
4369    getopt opts {history redraw} $args
4370    if { $opts(history) > 0 } {
4371        history_add $messages(history:whitespace)
4372    }
4373
4374    set redisplay $pos
4375    add_blank
4376    replace_pos {-16}
4377
4378    if { $pos >= $data_end } {
4379        set pos $data_end
4380        add_blank -advance
4381    } else {
4382        incr pos
4383    }
4384    if { $opts(redraw) > 0 } {
4385        redisplay_toend $redisplay
4386        see_currpos
4387    }
4388}
4389
4390# remove mark
4391proc clear_mark {} {
4392    global curr_namespace
4393    variable ${curr_namespace}::mark
4394    variable ${curr_namespace}::pos
4395
4396    if { $mark != -1 } {
4397        set mark -1
4398        recolor_tab_full -notwhitespace
4399        ghost_cutcopy disabled
4400    }
4401}
4402
4403# place mark
4404proc set_mark {} {
4405    global curr_namespace
4406    variable ${curr_namespace}::mark
4407    variable ${curr_namespace}::pos
4408
4409    if { $mark == -1 } {
4410        set mark $pos
4411        recolor_tab_pos $pos
4412        ghost_cutcopy normal
4413    }
4414}
4415
4416# toggle mark on/off
4417proc toggle_mark {} {
4418    global curr_namespace
4419    variable ${curr_namespace}::mark
4420
4421    if { $mark == -1 } {
4422        set_mark
4423    } else {
4424        clear_mark
4425    }
4426}
4427
4428# select all of tablature
4429proc select_all {} {
4430    global curr_namespace
4431    variable ${curr_namespace}::mark
4432    variable ${curr_namespace}::pos
4433    variable ${curr_namespace}::data_end
4434
4435    set mark 0
4436    set pos_old $pos
4437    set pos $data_end
4438    ghost_cutcopy normal
4439    recolor_tab_full -notwhitespace
4440    see_currpos
4441}
4442
4443# decide what to do with menu requests for cut/paste based on tab/lyrics mode
4444proc edit_menu {function} {
4445    global curr_namespace
4446    global messages
4447    variable ${curr_namespace}::insert_mode
4448
4449    if { $insert_mode != $messages(string:lyrics) } {
4450        switch $function {
4451            {cut} {
4452                cut_tab -history -redraw
4453            }
4454            {copy} {
4455                copy_tab
4456            }
4457            {clear} {
4458                clear_tab
4459            }
4460            {paste} {
4461                paste_tab
4462            }
4463        }
4464    } else {
4465        switch $function {
4466            {cut} {
4467                text_cut -history
4468            }
4469            {copy} {
4470                text_copy
4471            }
4472            {clear} {
4473                text_clear
4474            }
4475            {paste} {
4476                text_paste
4477            }
4478        }
4479    }
4480}
4481
4482# copy tab into paste buffer
4483proc copy_tab {} {
4484    global curr_namespace
4485    global pastebuf
4486    global clip
4487    variable ${curr_namespace}::mark
4488    variable ${curr_namespace}::pos
4489    variable ${curr_namespace}::tab_data
4490
4491    if { $mark != -1 } {
4492        set clip [ tabdata_to_asciitab [ calc_min $pos $mark ] [ calc_max $pos $mark ]]
4493        update_clipboard
4494        set pastebuf [ lrange $tab_data [ calc_min $pos $mark ] [calc_max $pos $mark ] ]
4495        clear_mark
4496    }
4497}
4498
4499# cut tab from screen into paste buffer
4500proc cut_tab {args} {
4501    global blank_tab
4502    global curr_namespace
4503    global pastebuf
4504    global messages
4505    global clip
4506    variable ${curr_namespace}::data_end
4507    variable ${curr_namespace}::mark
4508    variable ${curr_namespace}::num_strings
4509    variable ${curr_namespace}::pos
4510    variable ${curr_namespace}::tab_data
4511
4512    getopt opts {history redraw} $args
4513    if { $mark != -1 } {
4514        if { $opts(history) > 0 } {
4515            history_add $messages(history:cut)
4516            set clip [ tabdata_to_asciitab [ calc_min $pos $mark ] [ calc_max $pos $mark ]]
4517            update_clipboard
4518            set pastebuf [ lrange $tab_data [ calc_min $pos $mark ] [calc_max $pos $mark ] ]
4519        }
4520        set tab_data [ lreplace $tab_data [ calc_min $pos $mark ] [ calc_max $pos $mark ] ]
4521        asciitab_replace [calc_min $pos $mark] [ expr abs($pos - $mark) + 1 ] 0
4522        set pos [ calc_min $pos $mark ]
4523        if { $data_end < 0 } {
4524            set tab_data [ concat $tab_data $blank_tab($num_strings) ]
4525            set data_end 0
4526            asciitab_replace all 0 0
4527        }
4528        set pos [ calc_min $pos $data_end ]
4529        set mark -1
4530        ghost_cutcopy disabled
4531        if { $opts(redraw) > 0 } {
4532            redisplay_toend $pos
4533        }
4534    }
4535}
4536
4537# cut with addition to history buffer, but not to paste buffer
4538proc clear_tab {} {
4539    global curr_namespace
4540    global messages
4541    variable ${curr_namespace}::mark
4542
4543    if { $mark != -1 } {
4544        history_add $messages(history:clear)
4545        cut_tab -redraw
4546    }
4547}
4548
4549# paste from paste buffer
4550proc paste_tab {} {
4551    global curr_namespace
4552    global pastebuf
4553    global messages
4554    global my_platform
4555    variable ${curr_namespace}::mark
4556    variable ${curr_namespace}::num_strings
4557    variable ${curr_namespace}::pos
4558    variable ${curr_namespace}::tab_data
4559
4560    # on Unix, grab the paste data from primary eTktab window
4561    # even if it's in another eTktab process
4562    catch {set x_selection [selection get -selection ETKTAB]}
4563    if { ($my_platform(platform) == "unix") && ([info exists x_selection]) } {
4564        set pastebuf $x_selection
4565    }
4566    # do nothing if paste buffer is empty, or paste tab is mismatch 6/5/4 string
4567    if { $pastebuf == "" } {
4568        return
4569    }
4570    if { [ llength [ lindex $pastebuf 0 ] ] != $num_strings } {
4571        return
4572    }
4573
4574    history_add $messages(history:paste)
4575    if { $mark != -1 } {
4576        cut_tab
4577    }
4578    set before [ lrange $tab_data 0 [ expr $pos - 1 ]]
4579    set after [ lrange $tab_data $pos end ]
4580    set tab_data [ concat $before $pastebuf $after ]
4581    asciitab_replace $pos 0 [llength $pastebuf]
4582
4583    redisplay_toend $pos
4584}
4585
4586#insert note requested from keyboard bindings
4587proc ins_note {askstring askfret} {
4588    global curr_namespace
4589    global messages
4590    variable ${curr_namespace}::basefret
4591    variable ${curr_namespace}::data_end
4592    variable ${curr_namespace}::fret
4593    variable ${curr_namespace}::insert_mode
4594    variable ${curr_namespace}::mark
4595    variable ${curr_namespace}::pos
4596    variable ${curr_namespace}::string
4597    variable ${curr_namespace}::tab_data
4598    variable ${curr_namespace}::col_max
4599
4600
4601    history_add $messages(history:note)
4602    if { ( $mark != -1 ) || ( $insert_mode == $messages(string:lead) ) } {
4603        set redisplay $pos
4604        add_blank
4605    }
4606
4607    # user asked for 'open' string, or number above basefret?
4608    if { $askfret == "o" } {
4609        set fret 0
4610    } else {
4611        set fret [expr $basefret + $askfret ]
4612    }
4613
4614    set string $askstring
4615    set fret_old [ lindex [ lindex $tab_data $pos ] $string ]
4616    if { $fret_old < -1 } {
4617        replace_pos {-1}
4618    }
4619
4620    set fret [ expr ( 100 * int ( abs ( $fret_old ) / 100 ) ) + $fret ]
4621    set tab_data [ lreplace $tab_data $pos $pos [ lreplace [ lindex $tab_data $pos ] $string $string $fret ] ]
4622    asciitab_replace $pos 1 1
4623
4624    if { $insert_mode == $messages(string:lead) } {
4625        if { $pos >= $data_end } {
4626            set pos $data_end
4627            add_blank -advance
4628        } else {
4629            incr pos
4630        }
4631    }
4632    if { [ info exists redisplay ] } {
4633        redisplay_toend $redisplay
4634    } else {
4635        redraw_pos $pos
4636    }
4637}
4638
4639# add or remove embellishments (hammer-on, pull-off, etc.)
4640proc modifier {modnum} {
4641    global curr_namespace
4642    global embellish
4643    global messages
4644    variable ${curr_namespace}::mark
4645    variable ${curr_namespace}::pos
4646    variable ${curr_namespace}::string
4647    variable ${curr_namespace}::tab_data
4648
4649    set fret_old [ lindex [ lindex $tab_data $pos ] $string ]
4650    if { $fret_old > -1 } {
4651        history_add $messages(history:expression)
4652        set newfret  [ expr ( $fret_old % 100 ) + ( $modnum * 100 ) ]
4653        set tab_data [ lreplace $tab_data $pos $pos [ lreplace [ lindex $tab_data $pos ] $string $string $newfret ] ]
4654
4655         if { $mark != -1 } {
4656             clear_mark
4657         }
4658         redraw_pos $pos
4659    }
4660}
4661
4662# add or remove repeat marks from measure bar
4663proc toggle_repeat {} {
4664    global curr_namespace
4665    global messages
4666    variable ${curr_namespace}::mark
4667    variable ${curr_namespace}::num_strings
4668    variable ${curr_namespace}::pos
4669    variable ${curr_namespace}::tab_data
4670
4671    set fret_old [ lindex [ lindex $tab_data $pos ] 1 ]
4672    if { ( $fret_old > -2 ) || ( $fret_old < -14 ) } {
4673        return
4674    }
4675
4676    history_add $messages(history:repeat)
4677    set bar_values {-2 -10 -6 -14}
4678    set newfret [ lindex $bar_values [ expr ([ lsearch -exact $bar_values [string trim $fret_old] ] + 1) % 4 ] ]
4679
4680    set second [ expr $num_strings - 2 ]
4681    set tab_data [ lreplace $tab_data $pos $pos [ lreplace [ lreplace [ lindex $tab_data $pos ] 1 1 $newfret ] $second $second $newfret ] ]
4682
4683     if { $mark != -1 } {
4684         clear_mark
4685     }
4686     redraw_pos $pos
4687}
4688
4689# replace contents of current position with a bar
4690proc bar {} {
4691    global curr_namespace
4692    global messages
4693    variable ${curr_namespace}::data_end
4694    variable ${curr_namespace}::fret
4695    variable ${curr_namespace}::insert_mode
4696    variable ${curr_namespace}::mark
4697    variable ${curr_namespace}::pos
4698    variable ${curr_namespace}::tab_data
4699
4700    set fret_old [ lindex [ lindex $tab_data $pos ] 0 ]
4701    # don't need <= other neg numbers for repeat symbols only on two strings
4702    # (not on string 0)
4703    if { $fret_old == -2 } {
4704        return
4705    }
4706
4707    history_add $messages(history:bar)
4708    if { ( $mark != -1 ) || ( $insert_mode == $messages(string:lead) ) } {
4709        set redisplay $pos
4710        add_blank
4711    }
4712
4713    # if the value is -2 it means there's the bar
4714    replace_pos {-2}
4715
4716    if { $insert_mode == $messages(string:lead) } {
4717        if { $pos >= $data_end } {
4718            set pos $data_end
4719            add_blank -advance
4720        } else {
4721            incr pos
4722        }
4723    }
4724    if { [ info exists redisplay ] } {
4725        redisplay_toend $redisplay
4726    } else {
4727        redraw_pos $pos
4728    }
4729}
4730
4731
4732
4733
4734#######################################
4735### BUILD THE GUI
4736###
4737
4738proc build_gui {new_namespace} {
4739    global curr_namespace
4740    global ext
4741    global maxbasefret
4742    global prefs
4743    global my_platform
4744    global version
4745    global embellish
4746    global messages
4747    global valid_numstrings
4748    global lyrics_max
4749    variable ${new_namespace}::tabwin
4750    variable ${new_namespace}::winnum
4751    variable ${new_namespace}::score_width
4752    variable ${new_namespace}::num_strings
4753
4754    toplevel $tabwin -class Textwin
4755    # set up keybindings common to all tabwindows with this number of strings
4756    bindtags $tabwin [ linsert [bindtags $tabwin ] 1 Tabwindow$num_strings ]
4757    bind $tabwin <FocusIn> "set ::curr_namespace $new_namespace"
4758        frame $tabwin.tab_frame
4759            scrollbar $tabwin.scrollx -orient horizontal -command "$tabwin.tablature xview"
4760            scrollbar $tabwin.scrolly -command "$tabwin.tablature yview"
4761            text $tabwin.tablature -xscrollcommand "$tabwin.scrollx set" -yscrollcommand "$tabwin.scrolly set" -width $prefs(window_width) -height $prefs(window_height) -state disabled -exportselection false -highlightcolor white
4762            $tabwin.tablature insert end "\n\n"
4763            $tabwin.tablature mark set delend "end - 1 chars"
4764            # load bindings, drop some standard Text bindings
4765            bindtags $tabwin.tablature [ lreplace [bindtags $tabwin.tablature ] 1 1 Tablature Tabwindow$num_strings ]
4766
4767        frame $tabwin.msg_frame
4768          frame $tabwin.msg_frame.right_frame
4769            label $tabwin.msg_frame.right_frame.chord_lead_legend
4770            my_menubutton $tabwin.msg_frame.right_frame.chord_lead -textvariable ${new_namespace}::insert_mode "
4771                {radiobutton -variable ${new_namespace}::insert_mode -label $messages(string:chord) -command lyrics_done}
4772                {radiobutton -variable ${new_namespace}::insert_mode -label $messages(string:lead) -command lyrics_done}
4773                {radiobutton -variable ${new_namespace}::insert_mode -label $messages(string:lyrics) -command lyrics_edit}
4774            "
4775
4776            label $tabwin.msg_frame.right_frame.basefret_legend
4777            for { set i 0 } { $i <= $maxbasefret } { incr i } {
4778                lappend basefret_entries "radiobutton -label $i -variable ${new_namespace}::basefret -command {ghost_arrows 0 $maxbasefret \$${new_namespace}::basefret}"
4779            }
4780            my_menubutton $tabwin.msg_frame.right_frame.basefret -indicatoron 0 -textvariable ${new_namespace}::basefret -width 2 $basefret_entries
4781            $tabwin.msg_frame.right_frame.basefret.menu entryconfigure 12 -columnbreak 1
4782            arrowbuttons $tabwin.msg_frame.right_frame.bfarrow_frame msg_frame_right inc_basefret dec_basefret
4783            $tabwin.msg_frame.right_frame.bfarrow_frame.dn configure -state disabled
4784
4785            button $tabwin.msg_frame.right_frame.tuning -command "tuning_win current"
4786
4787          frame $tabwin.msg_frame.left_frame
4788            foreach ns $valid_numstrings {
4789                lappend newtab_entries "command {new_tab -strings $ns}"
4790                lappend stringpref_entries "radiobutton -variable prefs(num_strings) -value $ns -command {pref_numstrings $ns}"
4791                lappend tunpref_entries "command {tuning_win newtab $ns}"
4792                lappend tunpreset_entries "command {tuning_presets $ns}"
4793            }
4794            my_menubutton $tabwin.msg_frame.left_frame.file "
4795                {cascade new {$newtab_entries}}
4796                {command open_dialog}
4797                {command -state disabled save_tab}
4798                {command {save_tab -as}}
4799                {command export_tab}
4800                {command print_tab}
4801                {command close_tab}
4802                {command quit_safe}
4803            "
4804
4805        my_menubutton $tabwin.msg_frame.left_frame.edit "
4806            {command -state disabled history_undo}
4807            {command -state disabled history_redo}
4808            separator
4809            {command -state disabled {edit_menu cut}}
4810            {command -state disabled {edit_menu copy}}
4811            {command -state disabled {edit_menu clear}}
4812            {command {edit_menu paste}}
4813            {command select_all}
4814            separator
4815            {command {pref_format current}}
4816            {cascade option {
4817                {command pref_keybindings}
4818                {command pref_language}
4819                {command pref_fonts}
4820                {command pref_colors}
4821                separator
4822                {cascade numstrings {$stringpref_entries}}
4823                {cascade tun_default {$tunpref_entries}}
4824                {cascade tun_presets {$tunpreset_entries}}
4825                {command {pref_format default}}
4826                separator
4827                {command pref_revert}
4828            }}
4829        "
4830
4831        menubutton $tabwin.msg_frame.left_frame.windows -menu $tabwin.msg_frame.left_frame.windows.menu
4832        .docmenu clone $tabwin.msg_frame.left_frame.windows.menu
4833        button $tabwin.msg_frame.left_frame.help -command help
4834
4835    grid rowconfig $tabwin.tab_frame 0 -weight 1 -minsize 0
4836    grid columnconfig $tabwin.tab_frame 0 -weight 1 -minsize 0
4837    grid $tabwin.tablature -in $tabwin.tab_frame -row 0 -column 0 -sticky news
4838    grid $tabwin.scrolly -in $tabwin.tab_frame -row 0 -column 1 -sticky news
4839    grid $tabwin.scrollx -in $tabwin.tab_frame -row 1 -column 0 -sticky news
4840
4841    pack $tabwin.msg_frame.right_frame.tuning $tabwin.msg_frame.right_frame.chord_lead $tabwin.msg_frame.right_frame.chord_lead_legend $tabwin.msg_frame.right_frame.bfarrow_frame $tabwin.msg_frame.right_frame.basefret $tabwin.msg_frame.right_frame.basefret_legend -side right -anchor e -ipady 2
4842    pack $tabwin.msg_frame.left_frame.file $tabwin.msg_frame.left_frame.edit $tabwin.msg_frame.left_frame.windows $tabwin.msg_frame.left_frame.help -side left -anchor w -ipady 2
4843
4844    pack $tabwin.msg_frame.left_frame -side left -fill y
4845    pack $tabwin.msg_frame.right_frame -side right -fill y
4846    pack $tabwin.msg_frame -side top -fill both
4847    pack $tabwin.tab_frame -side bottom -fill both -expand true
4848
4849    wm protocol $tabwin WM_DELETE_WINDOW "set ::curr_namespace $new_namespace ; close_tab"
4850    wm title $tabwin "eTktab$version - $messages(string:untitled)$winnum"
4851    #ms-windows doesn't seem to want to focus on our new toplevel windows
4852    if {$my_platform(platform)=="windows"} {
4853        update idletasks
4854        focus -force $tabwin
4855    }
4856    if {$my_platform(platform)=="macintosh"} {
4857            pack forget $tabwin.msg_frame.left_frame
4858            $tabwin configure -menu $tabwin.menubar
4859            menu $tabwin.menubar
4860            $tabwin.menubar add cascade -menu $tabwin.menubar.file -label $messages(menu:file)
4861            $tabwin.msg_frame.left_frame.file.menu clone $tabwin.menubar.file
4862            $tabwin.menubar add cascade -menu $tabwin.menubar.edit -label $messages(menu:edit)
4863            $tabwin.msg_frame.left_frame.edit.menu clone $tabwin.menubar.edit
4864            $tabwin.menubar add cascade -menu .docmenu -label $messages(menu:windows)
4865            $tabwin.menubar add cascade -menu $tabwin.menubar.apple
4866            .mac_menus.apple clone $tabwin.menubar.apple
4867            $tabwin.menubar add cascade -menu $tabwin.menubar.help
4868            .mac_menus.help clone $tabwin.menubar.help
4869    }
4870
4871    set curr_namespace $new_namespace
4872
4873    history_clear
4874    label_gui
4875    label_menu_accel
4876    color_gui
4877    refresh_winmenu
4878}
4879
4880# put strings in each widget (buttons, menus, etc.)
4881proc label_gui {} {
4882    global curr_namespace
4883    global gui_text
4884    global gui_label
4885    global messages
4886    variable ${curr_namespace}::tabwin
4887    variable ${curr_namespace}::undo
4888    variable ${curr_namespace}::redo
4889
4890    # labels and buttons
4891    foreach text_key [ array names gui_text ] {
4892        foreach widget $gui_text($text_key) {
4893            ${tabwin}.$widget configure -text $messages($text_key)
4894        }
4895    }
4896
4897    # prepare for undo and redo menu entries
4898    set undo_menu $undo(last_action)
4899    set redo_menu $redo(last_action)
4900
4901    # most menu entries
4902    foreach text_key [ array names gui_label ] {
4903        foreach widget $gui_label($text_key) {
4904            ${tabwin}.[lindex $widget 0] entryconfigure [lindex $widget 1] -label [ subst -nocommands -nobackslashes $messages($text_key) ]
4905        }
4906    }
4907
4908    set mb_width 0
4909    foreach i "chord lead lyrics" {
4910        if { [ string length $messages(string:$i) ] > $mb_width } {
4911            set mb_width [ string length $messages(string:$i) ]
4912        }
4913    }
4914    $tabwin.msg_frame.right_frame.chord_lead configure -width $mb_width
4915}
4916
4917# assign fonts and colors to tab window
4918proc color_gui {} {
4919    global curr_namespace
4920    global prefs
4921    global my_platform
4922    global images
4923    variable ${curr_namespace}::tabwin
4924
4925    #all other widgets...
4926    foreach widget [info commands $tabwin.* ] {
4927        switch -glob -- $widget {
4928            {*.tab_frame}
4929                -
4930            {*.msg*frame} {
4931                $widget configure -background $prefs(color_menu_bg)
4932            }
4933            {*.tablature} {
4934                $tabwin.tablature configure -background $prefs(color_tab_bg_default) -foreground $prefs(color_tab_fg_default) -font $prefs(font_tab) -insertbackground $prefs(color_tab_fg_currstring)
4935                $tabwin.tablature tag configure whitespace -overstrike on -fgstipple gray25
4936                $tabwin.tablature tag configure marked -background $prefs(color_tab_bg_sel) -borderwidth 1 -relief raised
4937                $tabwin.tablature tag configure currpos -foreground $prefs(color_tab_fg_currpos)
4938                $tabwin.tablature tag configure currstring -foreground $prefs(color_tab_fg_currstring)
4939            }
4940            {*.msg_frame.*} {
4941                regexp {\.msg_frame\.([a-z]+)} $widget figa side
4942                $widget configure -background $prefs(color_menu_bg) -foreground $prefs(color_menu_fg_$side)
4943                catch { $widget configure -highlightbackground $prefs(color_menu_bg) }
4944                #certain widgets can't have diff fonts macos
4945                if {$my_platform(platform)!="macintosh"} {
4946                    $widget configure -font $prefs(font_statusbar)
4947                }
4948            }
4949            {*.scrollx}
4950                -
4951            {*.scrolly} {
4952                $widget configure -background $prefs(color_menu_bg) -highlightbackground $prefs(color_menu_bg) -activebackground $prefs(color_menu_bg)
4953            }
4954        }
4955    }
4956    #to change color of 'spinbox' arrows, have to change image, not widget
4957    foreach i {up dn} {
4958        $images(msg_frame_right.$i) configure -foreground $prefs(color_menu_fg_right)
4959    }
4960}
4961
4962# write in menu "key accellerator" text
4963proc label_menu_accel {} {
4964    global curr_namespace
4965    global keynames
4966    global gui_accel
4967    global valid_numstrings
4968    global prefs
4969    variable ${curr_namespace}::num_strings
4970    variable ${curr_namespace}::tabwin
4971
4972    # put text version of keystrokes into menu text
4973    foreach widget [ array names gui_accel ] {
4974        ${tabwin}.[lindex $gui_accel($widget) 0] entryconfigure [lindex $gui_accel($widget) 1] -accelerator [lindex $keynames($widget) 0]
4975    }
4976    # add accel for 'new' to our preferred numstrings for new tab
4977    foreach ns $valid_numstrings {
4978        if { $ns == $prefs(num_strings) } {
4979            $tabwin.msg_frame.left_frame.file.menu.new entryconfigure "${ns}*" -accelerator [lindex $keynames(new) 0]
4980        } else {
4981            $tabwin.msg_frame.left_frame.file.menu.new entryconfigure "${ns}*" -accelerator ""
4982        }
4983    }
4984}
4985
4986
4987#######################################
4988### MAIN:
4989### READ COMMAND LINE AND PREFS; INITIALIZE CONTENTS OF MAIN WINDOW
4990###
4991
4992# set up tk defaults for widgets
4993foreach i [ array names tabwin_options ] {
4994    option add $i $tabwin_options($i) 50
4995}
4996# designate handlers for clipboard access from X-Windows
4997selection handle -selection "CLIPBOARD" . clipboard_dump
4998selection handle -selection "PRIMARY" . clipboard_dump
4999selection handle -selection "ETKTAB" . pastebuf_dump
5000# undo standard Tk bindings that conflict with program bindings
5001bind all <Alt-KeyPress> {}
5002bind all <Key-Tab> {}
5003
5004# set up a menu of the windows that are in use
5005menu .docmenu
5006# color the disabled spinbuttons
5007$images(disabled.up) configure -foreground [ .docmenu cget -disabledforeground ]
5008$images(disabled.dn) configure -foreground [ .docmenu cget -disabledforeground ]
5009# load in preferences
5010load_prefs
5011# load global keybindings
5012keybind_global
5013
5014# OS Specific stuff
5015switch $my_platform(platform) {
5016    {macintosh} {
5017        # tkOpenDocument doesn't work correctly on mac no windows are mapped
5018        # so we make the window appear offscreen, instead
5019        wm geometry . 1x1-25000-25000
5020        . configure -menu .mac_menus
5021        menu .mac_menus
5022            .mac_menus add cascade -menu .mac_menus.apple
5023                menu .mac_menus.apple
5024                .mac_menus.apple add command -label $messages(title:about) -command about
5025            .mac_menus add cascade -menu .mac_menus.help
5026                menu .mac_menus.help
5027                .mac_menus.help add command -label [subst -nocommands -nobackslashes $messages(title:help)] -command help
5028        # hide the tcl/tk console window, but add shortcut so programmer
5029        # can use it for debugging ;-)
5030        console hide
5031        bind all <Control-Option-ButtonPress> {console show}
5032    }
5033    {windows} {
5034        # figure out if there's already a running eTktab
5035        if { [dde services TclEval eTktab] == "" } {
5036            # register as a dde server
5037            dde servername eTktab
5038        } else {
5039            # already a copy running... tell it to open a new window and quit
5040            dde execute TclEval eTktab {new_tab}
5041            __exit_now
5042        }
5043        wm withdraw .
5044        . configure -menu .win_menus
5045        menu .win_menus
5046            .win_menus add cascade -menu .win_menus.system
5047                menu .win_menus.system
5048                .win_menus.system add command -label $messages(title:about) -command about
5049        # add shortcut to pull up console window so programmer
5050        # can use it for debugging ;-)
5051        bind all <Control-Alt-ButtonPress-1> {console show}
5052    }
5053    default {
5054        #Unix
5055        wm withdraw .
5056        # give usage statement.  -b no longer allowed; replaced by preferences
5057        if { [ string index [lindex $argv 0] 0 ] == "-" } {
5058            puts [subst -nocommands -nobackslashes $messages(string:usage)]
5059            __exit_now
5060        }
5061    }
5062}
5063
5064set req_file ""
5065set used_dragdrop 0
5066# In windows installation program, we're setting the registry to send us
5067# __dde__ on the command line when the program isn't running, but the user
5068# double-clicked a document
5069if { [ lindex $argv 0 ] == "__dde__" } {
5070    set used_dragdrop 1
5071} elseif { $argv != "" } {
5072    # initial filename on command line?
5073    foreach i  [list "${cwd}/" "" ] {
5074        if { $used_dragdrop } {
5075            break
5076        }
5077        foreach j [concat {{}} $open_types($prefs(num_strings))] {
5078            if {$j != ""} {
5079                set j [ lindex $j 1]
5080                if { ! ([string match {.et*} $j]) } {
5081                    continue
5082                }
5083            }
5084            # if filename is valid, open it
5085            if { [ file exists ${i}[lindex $argv 0]${j} ] } {
5086                set cwd [ file dirname $req_file ]
5087                set used_dragdrop 1
5088                new_tab -file ${i}[lindex $argv 0]${j}
5089                break
5090            }
5091        }
5092    }
5093}
5094
5095# look for incoming mac drag/drop events
5096update
5097
5098# on mac/win the following will check if we started via drag & drop
5099# If we did, we don't need to create an initial window, because it will
5100# be created for us via the tkOpenDocument proc
5101if { $used_dragdrop == 0 } {
5102    # Initialize empty window
5103    new_tab
5104}
5105
5106