[4b0dc9]: tcl / pd-gui.tcl  Maximize  Restore  History

Download this file

746 lines (680 with data), 28.4 kB

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
#!/bin/sh
# This line continues for Tcl, but is a single line for 'sh' \
exec wish "$0" -- ${1+"$@"}
# For information on usage and redistribution, and for a DISCLAIMER OF ALL
# WARRANTIES, see the file, "LICENSE.txt," in this distribution.
# Copyright (c) 1997-2009 Miller Puckette.
# "." automatically gets a window, we don't want it. Withdraw it before doing
# anything else, so that we don't get the automatic window flashing for a
# second while pd loads.
if { [catch {wm withdraw .} fid] } { exit 2 }
package require Tcl 8.3
package require Tk
#package require tile
## replace Tk widgets with Ttk widgets on 8.5
#namespace import -force ttk::*
package require msgcat
# TODO create a constructor in each package to create things at startup, that
# way they can be easily be modified by startup scripts
# TODO create alt-Enter/Cmd-I binding to bring up Properties panels
# Pd's packages are stored in the same directory as the main script (pd-gui.tcl)
set auto_path [linsert $auto_path 0 [file dirname [info script]]]
package require pd_connect
package require pd_menus
package require pd_bindings
package require pdwindow
package require dialog_array
package require dialog_audio
package require dialog_canvas
package require dialog_data
package require dialog_font
package require dialog_gatom
package require dialog_iemgui
package require dialog_message
package require dialog_midi
package require dialog_path
package require dialog_startup
package require helpbrowser
package require makeapp
package require pd_menucommands
package require opt_parser
package require pdtk_canvas
package require pdtk_text
package require pdtk_textwindow
# TODO eliminate this kludge:
package require wheredoesthisgo
package require pd_guiprefs
#------------------------------------------------------------------------------#
# import functions into the global namespace
# gui preferences
namespace import ::pd_guiprefs::init
namespace import ::pd_guiprefs::update_recentfiles
namespace import ::pd_guiprefs::write_recentfiles
# make global since they are used throughout
namespace import ::pd_menucommands::*
# import into the global namespace for backwards compatibility
namespace import ::pd_connect::pdsend
namespace import ::pdwindow::pdtk_post
namespace import ::pdwindow::pdtk_pd_dio
namespace import ::pdwindow::pdtk_pd_dsp
namespace import ::pdwindow::pdtk_pd_meters
namespace import ::pdtk_canvas::pdtk_canvas_popup
namespace import ::pdtk_canvas::pdtk_canvas_editmode
namespace import ::pdtk_canvas::pdtk_canvas_autopatch
namespace import ::pdtk_canvas::pdtk_canvas_magicglass
namespace import ::pdtk_canvas::pdtk_canvas_getscroll
namespace import ::pdtk_canvas::pdtk_canvas_setparents
namespace import ::pdtk_canvas::pdtk_canvas_reflecttitle
namespace import ::pdtk_canvas::pdtk_canvas_menuclose
namespace import ::dialog_array::pdtk_array_dialog
namespace import ::dialog_audio::pdtk_audio_dialog
namespace import ::dialog_canvas::pdtk_canvas_dialog
namespace import ::dialog_data::pdtk_data_dialog
namespace import ::dialog_find::pdtk_couldnotfind
namespace import ::dialog_font::pdtk_canvas_dofont
namespace import ::dialog_gatom::pdtk_gatom_dialog
namespace import ::dialog_iemgui::pdtk_iemgui_dialog
namespace import ::dialog_midi::pdtk_midi_dialog
namespace import ::dialog_midi::pdtk_alsa_midi_dialog
namespace import ::dialog_path::pdtk_path_dialog
namespace import ::dialog_startup::pdtk_startup_dialog
# hack - these should be better handled in the C code
namespace import ::dialog_array::pdtk_array_listview_new
namespace import ::dialog_array::pdtk_array_listview_fillpage
namespace import ::dialog_array::pdtk_array_listview_setpage
namespace import ::dialog_array::pdtk_array_listview_closeWindow
#------------------------------------------------------------------------------#
# global variables
# this is a wide array of global variables that are used throughout the GUI.
# they can be used in plugins to check the status of various things since they
# should all have been properly initialized by the time startup plugins are
# loaded.
set PD_MAJOR_VERSION 0
set PD_MINOR_VERSION 0
set PD_BUGFIX_VERSION 0
set PD_TEST_VERSION ""
set done_init 0
set TCL_MAJOR_VERSION 0
set TCL_MINOR_VERSION 0
set TCL_BUGFIX_VERSION 0
# for testing which platform we are running on ("aqua", "win32", or "x11")
set windowingsystem ""
# args about how much and where to log
set loglevel 2
set stderr 0
# connection between 'pd' and 'pd-gui'
set host ""
set port 0
# canvas font, received from pd in pdtk_pd_startup, set in s_main.c
set font_family "courier"
set font_weight "normal"
# sizes of chars for each of the Pd fixed font sizes:
# fontsize width(pixels) height(pixels)
set font_fixed_metrics {
8 5 11
9 6 12
10 6 13
12 7 16
14 8 17
16 10 19
18 11 22
24 14 29
30 18 37
36 22 44
}
# root path to lib of Pd's files, see s_main.c for more info
set sys_libdir {}
# root path where the pd-gui.tcl GUI script is located
set sys_guidir {}
# user-specified search path for objects, help, fonts, etc.
set sys_searchpath {}
# hard-coded search patch for objects, help, plugins, etc.
set sys_staticpath {}
# the path to the folder where the current plugin is being loaded from
set current_plugin_loadpath {}
# a list of plugins that were loaded
set loaded_plugins {}
# list of command line flags set at startup
set startup_flags {}
# list of libraries loaded on startup
set startup_libraries {}
# start dirs for new files and open panels
set filenewdir [pwd]
set fileopendir [pwd]
# lists of audio/midi devices and APIs for prefs dialogs
set audio_apilist {}
set audio_indevlist {}
set audio_outdevlist {}
set midi_apilist {}
set midi_indevlist {}
set midi_outdevlist {}
set pd_whichapi 0
set pd_whichmidiapi 0
# current state of the DSP
set dsp 0
# state of the peak meters in the Pd window
set meters 0
# the toplevel window that currently is on top and has focus
set focused_window .
# store that last 5 files that were opened
set recentfiles_list {}
set total_recentfiles 5
# keep track of the location of popup menu for PatchWindows, in canvas coords
set popup_xcanvas 0
set popup_ycanvas 0
# modifier for key commands (Ctrl/Control on most platforms, Cmd/Mod1 on MacOSX)
set modifier ""
# Alt key for key commands (Alt on most platforms, Option on Mac OS X)
set altkey ""
# current state of each 'editor meta' menu item
set autopatch_button 0
set editmode_button 0
set magicglass_button 0
set perfmode_button 0
## per toplevel/patch data
# window location modifiers
set menubarsize 0 ;# Mac OS X and other platforms have a menubar on top
set windowframex 0 ;# different platforms have different window frames
set windowframey 0 ;# different platforms have different window frames
# patch properties
array set editmode {} ;# store editmode state for each open PatchWindow
array set autopatch {} ;# store autopatch state for each open PatchWindow
array set magicglass {} ;# store magicglass state for each open PatchWindow
array set editingtext {};# if an obj, msg, or comment is being edited, per patch
array set loaded {} ;# store whether a patch has completed loading
array set xscrollable {};# keep track of whether the scrollbars are present
array set yscrollable {}
# patch window tree, these might contain patch IDs without a mapped toplevel
array set windowname {} ;# window names based on mytoplevel IDs
array set childwindows {} ;# all child windows based on mytoplevel IDs
array set parentwindows {} ;# topmost parent window ID based on mytoplevel IDs
# minimum size of the canvas window of a patch
set canvas_minwidth 50
set canvas_minheight 20
# undo states
set ::undo_action "no"
set ::redo_action "no"
set ::undo_toplevel "."
# color scheme
set ::canvas_fill "white"
set ::text_color "#000"
set ::select_color "#00f"
set ::dash_outline "#f00"
set ::dash_fill "#fff"
set ::box_outline "#ccc"
set ::graph_outline "#777"
set ::atom_box_fill "#eee"
set ::msg_box_fill "#f8f8f6"
set ::obj_box_fill "#f6f8f8"
set ::signal_cord_highlight "#58a"
set ::signal_cord "#558"
set ::signal_nlet $signal_cord
set ::msg_cord_highlight "#474"
set ::msg_cord "#121"
set ::msg_nlet "#fff"
set :mixed_nlet "#88aaff"
#------------------------------------------------------------------------------#
# coding style
#
# these are preliminary ideas, we'll change them as we work things out:
# - when possible use "" doublequotes to delimit messages
# - use '$::myvar' instead of 'global myvar'
# - for the sake of clarity, there should not be any inline code, everything
# should be in a proc that is ultimately triggered from main()
# - if a menu_* proc opens a dialog panel, that proc is called menu_*_dialog
# - use "eq/ne" for string comparison, NOT "==/!=" (http://wiki.tcl.tk/15323)
#
#
## Names for Common Variables
#----------------------------
# variables named after the Tk widgets they represent
# $window = any kind of Tk widget that can be a Tk 'window'
# $mytoplevel = a window id made by a 'toplevel' command
# $gfxstub = a 'toplevel' window id for dialogs made in gfxstub/x_gui.c
# $menubar = the 'menu' attached to each 'toplevel'
# $mymenu = 'menu' attached to the menubar, like the File menu
# $tkcanvas = a Tk 'canvas', which is the root of each patch
#
#
## Dialog Panel Types
#----------------------------
# global (only one): find, sendmessage, prefs, helpbrowser
# per-canvas: font, canvas properties (created with a message from pd)
# per object: gatom, iemgui, array, data structures (created with a message from pd)
#
#
## Prefix Names for procs
#----------------------------
# pdtk_ pd -> pd-gui API (i.e. called from 'pd')
# pdsend pd-gui -> pd API (sends a message to 'pd' using pdsend)
# ------------------------------------------------------------------------------
# init functions
# root paths to find Pd's files where they are installed
proc set_pd_paths {} {
set ::sys_guidir [file normalize [file dirname [info script]]]
set ::sys_libdir [file normalize [file join $::sys_guidir ".."]]
}
proc init_for_platform {} {
# we are not using Tk scaling, so fix it to 1 on all platforms. This
# guarantees that patches will be pixel-exact on every platform
tk scaling 1
switch -- $::windowingsystem {
"x11" {
set ::modifier "Control"
set ::altkey "Alt"
option add *PatchWindow*Canvas.background "white" startupFile
# add control to show/hide hidden files in the open panel (load
# the tk_getOpenFile dialog once, otherwise it will not work)
catch {tk_getOpenFile -with-invalid-argument}
set ::tk::dialog::file::showHiddenBtn 1
set ::tk::dialog::file::showHiddenVar 0
# set file types that open/save recognize
set ::filetypes \
[list \
[list [_ "Associated Files"] {.pd .pat .mxt .mxb .help} ] \
[list [_ "Pd Files"] {.pd} ] \
[list [_ "Max Patch Files"] {.pat} ] \
[list [_ "Max Text Files"] {.mxt} ] \
[list [_ "Max Binary Files"] {.mxb} ] \
[list [_ "Max Help Files"] {.help} ] \
]
# some platforms have a menubar on the top, so place below them
set ::menubarsize 0
# Tk handles the window placement differently on each
# platform. With X11, the x,y placement refers to the window
# frame's upper left corner. http://wiki.tcl.tk/11502
set ::windowframex 3
set ::windowframey 53
# mouse cursors for all the different modes
set ::cursor_runmode_nothing "left_ptr"
set ::cursor_runmode_clickme "arrow"
set ::cursor_runmode_thicken "sb_v_double_arrow"
set ::cursor_runmode_addpoint "plus"
set ::cursor_editmode_nothing "hand2"
set ::cursor_editmode_connect "circle"
set ::cursor_editmode_disconnect "X_cursor"
}
"aqua" {
set ::modifier "Mod1"
set ::altkey "Option"
option add *DialogWindow*background "#E8E8E8" startupFile
option add *DialogWindow*Entry.highlightBackground "#E8E8E8" startupFile
option add *DialogWindow*Button.highlightBackground "#E8E8E8" startupFile
option add *DialogWindow*Entry.background "white" startupFile
# set file types that open/save recognize
set ::filetypes \
[list \
[list [_ "Associated Files"] {.pd .pat .mxt .mxb .help} ] \
[list [_ "Pd Files"] {.pd} ] \
[list [concat [_ "Max Patch Files"] " (.pat)"] {.pat} ] \
[list [concat [_ "Max Text Files"] " (.mxt)"] {.mxt} ] \
[list [concat [_ "Max Binary Files"] " (.mxb)"] {.mxb} ] \
[list [concat [_ "Max Help Files"] "(.help)"] {.help} ] \
]
# some platforms have a menubar on the top, so place below them
set ::menubarsize 22
# Tk handles the window placement differently on each platform, on
# Mac OS X, the x,y placement refers to the content window's upper
# left corner (not of the window frame) http://wiki.tcl.tk/11502
set ::windowframex 0
set ::windowframey 0
# mouse cursors for all the different modes
set ::cursor_runmode_nothing "arrow"
set ::cursor_runmode_clickme "center_ptr"
set ::cursor_runmode_thicken "sb_v_double_arrow"
set ::cursor_runmode_addpoint "plus"
set ::cursor_editmode_nothing "hand2"
set ::cursor_editmode_connect "circle"
set ::cursor_editmode_disconnect "X_cursor"
}
"win32" {
set ::modifier "Control"
set ::altkey "Alt"
option add *PatchWindow*Canvas.background "white" startupFile
# fix menu font size on Windows with tk scaling = 1
font create menufont -family Tahoma -size -11
option add *Menu.font menufont startupFile
option add *HelpBrowser*font menufont startupFile
option add *DialogWindow*font menufont startupFile
option add *PdWindow*font menufont startupFile
option add *ErrorDialog*font menufont startupFile
# set file types that open/save recognize
set ::filetypes \
[list \
[list [_ "Associated Files"] {.pd .pat .mxt .mxb .help} ] \
[list [_ "Pd Files"] {.pd} ] \
[list [_ "Max Patch Files"] {.pat} ] \
[list [_ "Max Text Files"] {.mxt} ] \
[list [_ "Max Binary Files"] {.mxb} ] \
[list [_ "Max Help Files"] {.help} ] \
]
# some platforms have a menubar on the top, so place below them
set ::menubarsize 0
# Tk handles the window placement differently on each platform, on
# Mac OS X, the x,y placement refers to the content window's upper
# left corner. http://wiki.tcl.tk/11502
# TODO this probably needs a script layer: http://wiki.tcl.tk/11291
set ::windowframex 0
set ::windowframey 0
# mouse cursors for all the different modes
set ::cursor_runmode_nothing "right_ptr"
set ::cursor_runmode_clickme "arrow"
set ::cursor_runmode_thicken "sb_v_double_arrow"
set ::cursor_runmode_addpoint "plus"
set ::cursor_editmode_nothing "hand2"
set ::cursor_editmode_connect "circle"
set ::cursor_editmode_disconnect "X_cursor"
}
}
}
proc add_app_icon {} {
# add an icon for all windows, mostly viewable in Alt-Tab. As of writing
# this code, "wm iconphoto" is ignored by Mac OS X, and the icon is
# instead handled in the standard Mac OS X app wrapper in Info.plist
if {$::windowingsystem eq "aqua"} return
set im [image create photo -file [file join $::sys_guidir ".." tcl pd.gif]]
wm iconphoto . -default $im
}
# ------------------------------------------------------------------------------
# locale handling
# official GNU gettext msgcat shortcut
proc _ {s} {return [::msgcat::mc $s]}
proc load_locale {} {
# On any UNIX-like environment, Tcl should automatically use LANG,
# LC_ALL, etc. On Windows, ::msgcat::Init automatically fetches
# the locale info from the registry and sets it for us. This is
# supposed to happen on Mac OS X also, but it only seems to work
# for the $LANG env var.
if {$::tcl_platform(os) eq "Darwin" && ! [info exists ::env(LANG)]} {
# http://thread.gmane.org/gmane.comp.lang.tcl.mac/5215
# http://thread.gmane.org/gmane.comp.lang.tcl.mac/6433
if {![catch "exec defaults read com.apple.dock loc" lang]} {
::msgcat::mclocale $lang
} elseif {![catch "exec defaults read NSGlobalDomain AppleLocale" lang]} {
::msgcat::mclocale $lang
}
}
::msgcat::mcload [file join [file dirname [info script]] .. po]
##--moo: force default system and stdio encoding to UTF-8
encoding system utf-8 ;# TODO this is probably unnecessary
fconfigure stderr -encoding utf-8
fconfigure stdout -encoding utf-8
##--/moo
}
# ------------------------------------------------------------------------------
# font handling
# this proc gets the internal font name associated with each size
proc get_font_for_size {size} {
return "::pd_font_${size}"
}
# searches for a font to use as the default. Tk automatically assigns a
# monospace font to the name "Courier" (see Tk 'font' docs), but it doesn't
# always do a good job of choosing in respect to Pd's needs. So this chooses
# from a list of fonts that are known to work well with Pd.
proc find_default_font {} {
set testfonts {"DejaVu Sans Mono" "Bitstream Vera Sans Mono" \
"Inconsolata" "Courier 10 Pitch" "Andale Mono" "Droid Sans Mono"}
foreach family $testfonts {
if {[lsearch -exact -nocase [font families] $family] > -1} {
set ::font_family $family
break
}
}
::pdwindow::verbose 0 [format [_ "Default font: %s"]\n $::font_family]
}
proc set_base_font {family weight} {
if {[lsearch -exact [font families] $family] > -1} {
set ::font_family $family
} else {
::pdwindow::post [format \
[_ "WARNING: Font family '%s' not found, using default (%s)"]\n \
$family $::font_family]
}
if {[lsearch -exact {bold normal} $weight] > -1} {
set ::font_weight $weight
set using_defaults 0
} else {
::pdwindow::post [format \
[_ "WARNING: Font weight '%s' not found, using default (%s)"]\n \
$weight $::font_weight]
}
}
# creates all the base fonts (i.e. pd_font_8 thru pd_font_36) so that they fit
# into the metrics given by $::font_fixed_metrics for any given font/weight
proc fit_font_into_metrics {} {
foreach {size width height} $::font_fixed_metrics {
set pixelheight [expr -1 * $height]
font create tmpfont -family $::font_family -weight $::font_weight \
-size $pixelheight
while {[font measure tmpfont M] > $width || \
[font metrics tmpfont -linespace] > $height} {
# this actually makes it smaller since pixel heights are negative
incr pixelheight 1
font configure tmpfont -size $pixelheight
}
::pdwindow::logpost "" 8 "Creating $size font at {$pixelheight $width $height}\n"
font create [get_font_for_size $size] \
-family $::font_family -weight $::font_weight -size $pixelheight
font delete tmpfont
}
}
# ------------------------------------------------------------------------------
# procs called directly by pd
proc pdtk_pd_startup {major minor bugfix test
audio_apis midi_apis sys_font sys_fontweight} {
set ::PD_MAJOR_VERSION $major
set ::PD_MINOR_VERSION $minor
set ::PD_BUGFIX_VERSION $bugfix
set ::PD_TEST_VERSION $test
set oldtclversion 0
set ::audio_apilist $audio_apis
set ::midi_apilist $midi_apis
if {$::tcl_version >= 8.5} {find_default_font}
set_base_font $sys_font $sys_fontweight
fit_font_into_metrics
::pd_guiprefs::init
pdsend "pd init [enquote_path [pwd]] $oldtclversion $::font_fixed_metrics"
::pd_bindings::class_bindings
::pd_bindings::global_bindings
::pd_menus::create_menubar
::pdtk_canvas::create_popup
::pdwindow::create_window
::pd_menus::configure_for_pdwindow
load_startup_plugins
open_filestoopen
set ::done_init 1
}
##### routine to ask user if OK and, if so, send a message on to Pd ######
proc pdtk_check {mytoplevel message reply_to_pd default} {
wm deiconify $mytoplevel
raise $mytoplevel
if {$::windowingsystem eq "win32"} {
set answer [tk_messageBox -message [_ $message] -type yesno -default $default \
-icon question -title [wm title $mytoplevel]]
} else {
set answer [tk_messageBox -message [_ $message] -type yesno \
-default $default -parent $mytoplevel -icon question]
}
if {$answer eq "yes"} {
pdsend $reply_to_pd
}
}
# ------------------------------------------------------------------------------
# parse command line args when Wish/pd-gui.tcl is started first
proc parse_args {argc argv} {
opt_parser::init {
{-stderr set {::stderr}}
{-open lappend {- ::filestoopen_list}}
}
set unflagged_files [opt_parser::get_options $argv]
# if we have a single arg that is not a file, its a port or host:port combo
if {$argc == 1 && ! [file exists [lindex $argv 0]]} {
if { [string is int $argv] && $argv > 0} {
# 'pd-gui' got the port number from 'pd'
set ::host "localhost"
set ::port $argv
} else {
set hostport [split $argv ":"]
set ::host [lindex $hostport 0]
set ::port [lindex $hostport 1]
}
} elseif {$unflagged_files ne ""} {
foreach filename $unflagged_files {
lappend ::filestoopen_list $filename
}
}
}
proc open_filestoopen {} {
foreach filename $::filestoopen_list {
open_file $filename
}
}
# ------------------------------------------------------------------------------
# X11 procs for handling singleton state and getting args from other instances
# first instance
proc singleton {key} {
if {![catch { selection get -selection $key }]} {
return 0
}
selection handle -selection $key -format UTF8_STRING . "singleton_request"
selection own -command first_lost -selection $key .
return 1
}
proc singleton_request {offset maxbytes} {
wm deiconify .pdwindow
raise .pdwindow
return [tk appname]
}
proc first_lost {} {
receive_args [selection get -selection PUREDATA]
selection own -command first_lost -selection PUREDATA .
}
proc others_lost {} {
set ::singleton_state "exit"
destroy .
exit
}
# all other instances
proc send_args {offset maxChars} {
set sendargs {}
foreach filename $::filestoopen_list {
lappend sendargs [file normalize $filename]
}
return [string range $sendargs $offset [expr {$offset+$maxChars}]]
}
# this command will open files received from a 2nd instance of Pd
proc receive_args {filelist} {
raise .
foreach filename $filelist {
open_file $filename
}
}
proc dde_open_handler {cmd} {
open_file [file normalize $cmd]
}
proc check_for_running_instances {argc argv} {
switch -- $::windowingsystem {
"aqua" {
# handled by ::tk::mac::OpenDocument in apple_events.tcl
} "x11" {
# http://wiki.tcl.tk/1558
# TODO replace PUREDATA name with path so this code is a singleton
# based on install location rather than this hard-coded name
if {![singleton PUREDATA_MANAGER]} {
# other instances called by wish/pd-gui (exempt 'pd' by 5400 arg)
if {$argc == 1 && [string is int $argv] && $argv >= 5400} {return}
selection handle -selection PUREDATA -format UTF8_STRING . "send_args"
selection own -command others_lost -selection PUREDATA .
after 5000 set ::singleton_state "timeout"
vwait ::singleton_state
exit
} else {
# first instance
selection own -command first_lost -selection PUREDATA .
}
} "win32" {
## http://wiki.tcl.tk/8940
package require dde ;# 1.4 or later needed for full unicode support
set topic "Pd-extended_DDE_Open"
# if no DDE service is running, start one and claim the name
if { [dde services TclEval $topic] == {} } {
dde servername -handler dde_open_handler $topic
}
}
}
}
# ------------------------------------------------------------------------------
# load plugins on startup
proc load_plugin_script {filename} {
global errorInfo
set basename [file tail $filename]
if {[lsearch $::loaded_plugins $basename] > -1} {
::pdwindow::post \
[format [_ "'%s' already loaded, ignoring %s"]\n \
$basename $filename]
return
}
::pdwindow::debug [format [_ "Loading plugin: %s"]\n $filename]
set tclfile [open $filename]
set tclcode [read $tclfile]
close $tclfile
# if the plugin folder includes translations, load them
set podir "[file dirname $filename]/po"
if {[file exists $podir] && [file isdir $podir]} {
::pdwindow::debug [format [_ "Loading translations for %s"]\n $basename]
::msgcat::mcload $podir
}
if {[catch {uplevel #0 $tclcode} errorname]} {
::pdwindow::error "-----------\n"
::pdwindow::error [concat [_ "(Tcl) UNHANDLED ERROR: "] $errorInfo "\n"]
::pdwindow::error [format [_ "FAILED TO LOAD %s"]\n $filename]
::pdwindow::error "-----------\n"
} else {
lappend ::loaded_plugins $basename
}
}
proc load_startup_plugins {} {
foreach pathdir [concat $::sys_searchpath $::sys_staticpath] {
set dir [file normalize $pathdir]
if { ! [file readable $dir] || ! [file isdirectory $dir]} {
::pdwindow::debug \
[format [_ "Cannot read plugins folder: '%s'"]\n $dir]
continue
}
foreach filename [glob -directory $dir -nocomplain -types {f} -- \
*-plugin/*-plugin.tcl *-plugin.tcl] {
set ::current_plugin_loadpath [file dirname $filename]
load_plugin_script $filename
}
}
}
# ------------------------------------------------------------------------------
# main
proc main {argc argv} {
# TODO Tcl/Tk 8.3 doesn't have [tk windowingsystem]
set ::windowingsystem [tk windowingsystem]
tk appname pd-gui
load_locale
parse_args $argc $argv
check_for_running_instances $argc $argv
set_pd_paths
init_for_platform
add_app_icon
# ::host and ::port are parsed from argv by parse_args
if { $::port > 0 && $::host ne "" } {
# 'pd' started first and launched us, so get the port to connect to
::pd_connect::to_pd $::port $::host
} else {
# the GUI is starting first, so create socket and exec 'pd'
set ::port [::pd_connect::create_socket]
set pd_exec [file join [file dirname [info script]] ../bin/pd]
exec -- $pd_exec -guiport $::port &
if {$::windowingsystem eq "aqua"} {
# on Aqua, if 'pd-gui' first, then initial dir is home
set ::filenewdir $::env(HOME)
set ::fileopendir $::env(HOME)
}
}
::pdwindow::verbose 0 "------------------ done with main ----------------------\n"
}
main $::argc $::argv