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