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