pd.tk

#!/usr/bin/wish
# Copyright (c) 1997-1999 Miller Puckette.
# For information on usage and redistribution, and for a DISCLAIMER OF ALL
# WARRANTIES, see the file, "LICENSE.txt," in this distribution.

# changed by Thomas Musil 09.2001
# between "pdtk_graph_dialog -- dialog window for graphs"
# and "pdtk_array_dialog -- dialog window for arrays"
# a new dialogbox was inserted, named:
# "pdtk_iemgui_dialog -- dialog window for iem guis"
#
# all these changes are labeled with #######iemlib########

# set pd_nt (bad name) 0 for unix, 1 for microsoft, and 2 for Mac OSX.

#May 22 2009
#GUI improvements and dynamic runtime 8.5 widget upgrade for Linux by Ivica Ico Bukvic
#http://ico.bukvic.net <ico@vt.edu>

#puts stderr [info tclversion]
##--moo: force default system and stdio encoding to UTF-8
encoding system utf-8
fconfigure stderr -encoding utf-8
fconfigure stdout -encoding utf-8
##--/moo

if { [info tclversion] >= 8.5 } {

	# EDIT THIS PART TO CUSTOMIZE LINUX THEME
	# match gnome colors
	# Ubuntu Human
	# set linux_wm_bgcolor "#3e3d39"
	set linux_wm_bgcolor "#e5e5e5"
	# set linux_wm_hlcolor "#fdbf69"
	# set linux_wm_hlcolor "#f9ba81"
	# set linux_wm_hlcolor "#ffaa16"
	set linux_wm_hlcolor "#eb5f28"

	# ttk colors
	# -frame, -lighter, and -selectbg are automatically
	#	replaced by theme colors specified above
	variable colors
	array set colors {
		-frame 		"#e5e5e5"
		-window		"#ffffff"
		-darkest 	"#999999"
		-darker 	"#709970"
		#-dark		"#a8e6a8"
		-dark		"#bcbcbc"
		-light		"#d2ffd2"
		-lighter 	"#e5e5e5"
		-disabledfg	"#a3a3a3"
		-selectbg	"#fdbf69"
		-selectfg	"#000000"
	}
	# STOP EDITING BEYOND THIS POINT

	#sync ttk with theme choice above it
	set colors(-frame) $linux_wm_bgcolor
	set colors(-lighter) $linux_wm_bgcolor
	set colors(-selectbg) $linux_wm_hlcolor

	ttk::style theme create purty_linux -parent clam -settings {

		ttk::style configure "." \
			-background 	$colors(-frame) \
			-foreground 	black \
			-bordercolor	$colors(-darkest) \
			-selectbackground 	$colors(-selectbg) \
			-selectforeground 	$colors(-selectfg) \
			-troughcolor	$colors(-dark) \
			-arrowcolor 	$colors(-darkest) \
			-font 		TkDefaultFont \
			;

		ttk::style map "." -background \
			[list disabled $colors(-frame)  active $colors(-lighter)] ;
		ttk::style map "." -foreground [list disabled $colors(-disabledfg)] ;
		    ttk::style map "." -embossed [list disabled 0] ;

		ttk::style configure TButton \
			-anchor center -width -11 -padding "1 1" \
			-relief raised -shiftrelief 1 \
			-highlightthickness 1 -highlightcolor $colors(-selectbg)

		ttk::style map TButton -relief {
			{pressed !disabled} 	sunken
			{active !disabled} 	raised
		} -highlightcolor {alternate black}

		ttk::style configure TCheckbutton \
			-indicatorcolor $colors(-window) -padding 2
		ttk::style configure TRadiobutton \
			-indicatorcolor $colors(-window) -padding 2
		ttk::style map TCheckbutton -indicatorcolor \
			[list  disabled $colors(-frame)  pressed $colors(-frame)]
		ttk::style map TRadiobutton -indicatorcolor \
			[list  disabled $colors(-frame)  pressed $colors(-frame)]

		ttk::style configure TMenubutton \
			-width -11 -padding "3 3" -relief raised

		ttk::style configure TEntry \
			-padding 1 -fieldbackground $colors(-window) ;
		ttk::style map TEntry -fieldbackground \
			[list readonly $colors(-frame) disabled $colors(-frame)]
		ttk::style configure TCombobox \
			-padding 1 -fieldbackground $colors(-window) ;
		ttk::style map TCombobox -fieldbackground \
			[list readonly $colors(-frame) disabled $colors(-frame)]

		ttk::style configure Toolbutton -relief flat -padding 2
		ttk::style map Toolbutton -relief \
			{disabled flat selected sunken pressed sunken active raised}
		ttk::style map Toolbutton -background \
			[list pressed $colors(-dark)  active $colors(-light)]

		ttk::style configure TScrollbar -relief raised
		ttk::style configure TScale \
			-groovewidth 4 -troughrelief sunken \
			-sliderwidth raised -borderwidth 2
		ttk::style configure TProgressbar \
			-background $colors(-selectbg) -borderwidth 0

		ttk::style configure TLabelframe -relief groove -borderwidth 2

		ttk::style configure TNotebook -tabmargins {2 2 1 0}
		ttk::style configure TNotebook.Tab \
			-padding {4 2} -background $colors(-dark)
		ttk::style map TNotebook.Tab \
			-background [list selected $colors(-frame)] \
			-expand [list selected {2 2 1 0}] \
			;

		ttk::style configure Treeview -fieldbackground $colors(-window)
		ttk::style configure Heading -font TkHeadingFont -relief raised
		ttk::style configure Row -background $colors(-window)
		ttk::style map Row \
			-background [list selected $colors(-selectbg)]
		ttk::style map Item \
			-foreground [list selected $colors(-selectfg)]
		ttk::style map Cell \
			-foreground [list selected $colors(-selectfg)]
	}
}

# Automate matching of the linux wm and use ttk where possible
# As of right now it is only enabled if system is Linux/Unix using tcl >= 8.5
proc match_linux_wm {list} {
	global pd_nt linux_wm_bgcolor linux_wm_hlcolor
	if { [info tclversion] >= 8.5 && $pd_nt == 0 } {
		if {[lsearch -regexp $list ::] == -1} {
			#puts stderr [lindex $list 0]
			if {[lindex $list 0] != "button" \
				&& [lindex $list 0] != "checkbutton" \
				&& [lindex $list 0] != "radiobutton" \
				&& [lindex $list 0] != "entry" \
				&& [lindex $list 0] != "scrollbar" \
				&& [lindex $list 1] != "add"} { 
					lappend list -bg $linux_wm_bgcolor
			}
			if {[lindex $list 0] == "listbox" \
				|| [lindex $list 0] == "text"} {

				lappend list -bg white -highlightcolor $linux_wm_hlcolor
			}
			if {[lindex $list 1] == "add"} {
	
				#lappend list -background "#000000"
				set newlist [list [lindex $list 0] add command -label {} -state disabled]
			}
			if {[lindex $list 0] == "menu"} {
	
				lappend list -activebackground $linux_wm_hlcolor -bg "#3c3b37" -fg "#dddddd" -bd 0 -activeborderwidth 0 -relief flat -disabledforeground "#777777"
			}
			#convert non-ttk objects to ttk objects
			if {[lindex $list 0] == "button" \
				|| [lindex $list 0] == "checkbutton" \
				|| [lindex $list 0] == "radiobutton" \
				|| [lindex $list 0] == "entry" \
				|| [lindex $list 0] == "scrollbar"} { 
				set newlist [lreplace $list 0 0 ttk::[lindex $list 0]]
			}
		}
	}
	if {[info exists newlist]} {
		eval $newlist
	} else {
		eval $list
	}
}

if { $tcl_platform(platform) == "windows" }  {
    set pd_nt 1
    set ctrl_key "Control"
    # fontsc
    set defaultFontFamily {DejaVu Sans Mono}
    font create menuFont -family Tahoma -size 10
    # mouse cursors
    set cursor_runmode_nothing "arrow"
    set cursor_runmode_clickme "right_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"
	set cursor_editmode_resize "sb_h_double_arrow"
	set cursor_editmode_resize_bottom_right "bottom_right_corner"
	set cursor_scroll "fleur"
	# set file types that open/save recognize
	set filetypes {
		{{Pd Files}         {.pd}  }
		{{Max Patch Files}  {.pat} }
		{{Max Text Files}   {.mxt} }
		{{Max Binary Files} {.mxb} }
		{{Max Help Files}   {.help} }
	}
	# use CommonProgramFiles by default instead because its a lot easier to
	# find. Microsoft seems to have carefully hidden the AppData folder from
	# all but the most determined users.
	#set externalsdir "$::env(AppData)/Pd"
	set externalsdir "$::env(CommonProgramFiles)/Pd"
} elseif { $tcl_platform(os) == "Darwin" } {  
    set pd_nt 2
	set ctrl_key "Mod1"
    # fonts
    set defaultFontFamily Monaco
    # mouse cursors
    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"
	set cursor_editmode_resize "sb_h_double_arrow"
	set cursor_editmode_resize_bottom_right "bottom_right_corner"
	set cursor_scroll "fleur"
	# set file types that open/save recognize
	set filetypes {
		{{Pd Files}                {.pd}  }
		{{Max Patch Files (.pat)}  {.pat} }
		{{Max Text Files (.mxt)}   {.mxt} }
		{{Max Binary Files (.mxb)} {.mxb} }
		{{Max Help Files (.help)}  {.help} }
	}
	set externalsdir "$::env(HOME)/Library/Pd"
} else { 
	# set nicer theme
	ttk::style theme use purty_linux
	clipboard clear
	set window_prefs {}
    set pd_nt 0
    set ctrl_key "Control"
	# Shift modifier
	set shift_l_down 0
	set shift_r_down 0
	# Ctrl modifier
	set ctrl_l_down 0
	set ctrl_r_down 0
    # fonts
    set defaultFontFamily {DejaVu Sans Mono}
    # mouse cursors
    set cursor_runmode_nothing "left_ptr"
    set cursor_runmode_clickme "right_ptr"
    set cursor_runmode_thicken "sb_v_double_arrow"
    set cursor_runmode_addpoint "plus"
    set cursor_editmode_nothing "hand2"
    set cursor_editmode_connect "target"
    set cursor_editmode_disconnect "X_cursor"
	set cursor_editmode_resize "sb_h_double_arrow"
	set cursor_editmode_resize_bottom_right "bottom_right_corner"
	set cursor_scroll "fleur"
	# set file types that open/save recognize
	set filetypes {
		{{pd files}         {.pd}  }
		{{max patch files}  {.pat} }
		{{max text files}   {.mxt} }
		{{max binary files} {.mxb} }
		{{max help files}   {.help} }
	}
	set externalsdir "$::env(HOME)/pd-l2ork-externals"
}   

#proc bgerror {message} {
#	pdtk_post "\ntcl error: $message"
#}     

# make sure the user folder for installing externals exists
catch {
	if { ! [file exists $externalsdir] && [file exists [file dirname $externalsdir]] } {
		puts stderr "Creating folder for user-installed externals: \n\t$externalsdir"
		file mkdir $externalsdir
	}
}


# namespace for general-purpose functions
proc pdtk_encode { listdata } {
    set outlist {}
    foreach this_path $listdata {
        if {0==[string match "" $this_path]} {
            lappend outlist [pdtk_encodedialog $this_path]
        }
    }
    return $outlist
}


# args is a list of length 1 or 2,
# specifying optional additional x, y offsets for the window
proc center_window { w args } {
    set offx 0
    set offy 0

    if { [llength $args] >= 2 } {
        set offx [lindex $args 0]
        set offy [lindex $args 1]
    }

    set x [expr [winfo screenwidth $w]/2 - [winfo reqwidth $w]/2 \
        - [winfo vrootx [winfo parent $w]] + $offx]
    set y [expr [winfo screenheight $w]/2 - [winfo reqheight $w]/2 \
        - [winfo vrooty [winfo parent $w]] + $offy]
    wm geom $w +$x+$y
}


# start Pd-extended font hacks -----------------------------

# Pd-0.39.2-extended hacks to make font/box sizes the same across platform
#puts stderr "tk scaling is [tk scaling]"
tk scaling 1

# this font is for the Pd Window console text
font create console_font -family $defaultFontFamily -size 9 -weight normal
# this font is for text in Pd windows
font create text_font -family $defaultFontFamily -size 9 -weight normal
# for text in Properties Panels and other panes
font create highlight_font -family $defaultFontFamily -size 9 -weight bold

# end Pd-extended font hacks -----------------------------

# K-12 version global variable (enabled through -k12, disabled by default)
set k12_mode 0
set k12_saveas_on_new 0

# Only can be enabled at startup (cannot be toggled afterwards)
proc pdtk_enable_k12_mode {extra_dir} {
	global k12_mode
	global signal_cord_width
	global autotips
	global signal_cord_highlight
	global signal_cord
	global highlight_width

	set k12_mode 1
	set signal_cord_width 5
	set autotips 1
	set signal_cord_highlight "#474"
	set signal_cord "#2ca7d4"
	set highlight_width 7

	image create photo i.wii_connect -file $extra_dir/K12/icons/wii_connect_on.png
	image create photo i.wii_buttons -file $extra_dir/K12/icons/wii_buttons.png
	image create photo i.wii_speed -file $extra_dir/K12/icons/wii_speed.png
	image create photo i.wii_hit -file $extra_dir/K12/icons/wii_hit.png

	image create photo i.sarcduino -file $extra_dir/K12/icons/sarcduino_on.png
	image create photo i.sarcduino_digital -file $extra_dir/K12/icons/sarcduino_digital.png
	image create photo i.sarcduino_analog -file $extra_dir/K12/icons/sarcduino_analog.png
	image create photo i.sarcduino_hit -file $extra_dir/K12/icons/sarcduino_hit.png
	image create photo i.sarcduino_piezo -file $extra_dir/K12/icons/sarcduino_piezo.png
	#image create photo i.sarcduino_net -file $extra_dir/K12/icons/sarcduino_net.png

	image create photo i.math_number -file $extra_dir/K12/icons/math_number.png
	image create photo i.math_netsend -file $extra_dir/K12/icons/math_netsend.png
	image create photo i.math_netreceive -file $extra_dir/K12/icons/math_netreceive.png
	image create photo i.math_tag -file $extra_dir/K12/icons/math_tag.png
	image create photo i.math_routebytag -file $extra_dir/K12/icons/math_routebytag.png

	image create photo i.math_average -file $extra_dir/K12/icons/math_average.png
	image create photo i.math_random -file $extra_dir/K12/icons/math_random.png
	image create photo i.math_add -file $extra_dir/K12/icons/math_add.png
	image create photo i.math_subtract -file $extra_dir/K12/icons/math_subtract.png
	image create photo i.math_multiply -file $extra_dir/K12/icons/math_multiply.png

	image create photo i.math_divide -file $extra_dir/K12/icons/math_divide.png
	image create photo i.math_scale -file $extra_dir/K12/icons/math_scale.png

	image create photo i.logic_compare -file $extra_dir/K12/icons/logic_compare.png
	image create photo i.logic_mapper -file $extra_dir/K12/icons/logic_mapper.png
	image create photo i.logic_metronome -file $extra_dir/K12/icons/logic_metronome.png
	image create photo i.logic_counter -file $extra_dir/K12/icons/logic_counter.png
	image create photo i.logic_sequencer -file $extra_dir/K12/icons/logic_sequencer.png

	image create photo i.preset -file $extra_dir/K12/icons/preset.png
	image create photo i.comment -file $extra_dir/K12/icons/comment.png

	image create photo i.signal_microphone -file $extra_dir/K12/icons/signal_microphone.png
	image create photo i.signal_netsend -file $extra_dir/K12/icons/signal_netsend.png
	image create photo i.signal_netreceive -file $extra_dir/K12/icons/signal_netreceive.png	
	image create photo i.signal_sampler -file $extra_dir/K12/icons/signal_sampler.png
	image create photo i.signal_player -file $extra_dir/K12/icons/signal_player.png

	image create photo i.signal_sine -file $extra_dir/K12/icons/signal_sine.png
	image create photo i.signal_saw -file $extra_dir/K12/icons/signal_saw.png
	image create photo i.signal_square -file $extra_dir/K12/icons/signal_square.png
	image create photo i.signal_triangle -file $extra_dir/K12/icons/signal_triangle.png
	image create photo i.signal_envelope -file $extra_dir/K12/icons/signal_envelope.png

	image create photo i.signal_noise -file $extra_dir/K12/icons/signal_noise.png
	image create photo i.signal_pink -file $extra_dir/K12/icons/signal_pink.png
	image create photo i.signal_add -file $extra_dir/K12/icons/signal_add.png
	image create photo i.signal_multiply -file $extra_dir/K12/icons/signal_multiply.png

	image create photo i.instr_short1 -file $extra_dir/K12/icons/instr_short1.png
	image create photo i.instr_short2 -file $extra_dir/K12/icons/instr_short2.png
	image create photo i.instr_sustained1 -file $extra_dir/K12/icons/instr_sustained1.png
	image create photo i.instr_sustained2 -file $extra_dir/K12/icons/instr_sustained2.png

	image create photo i.fx_filter -file $extra_dir/K12/icons/fx_filter.png
	image create photo i.fx_multitap -file $extra_dir/K12/icons/fx_multitap.png
	image create photo i.fx_reverb -file $extra_dir/K12/icons/fx_reverb.png

	image create photo i.output -file $extra_dir/K12/icons/audio_on.png

	image create photo i.edit -file $extra_dir/K12/icons/edit.png
	image create photo i.perform -file $extra_dir/K12/icons/perform.png

	image create photo i.data -file $extra_dir/K12/icons/data.png
	image create photo i.sound -file $extra_dir/K12/icons/sound.png
	image create photo i.data_on -file $extra_dir/K12/icons/data_on.png
	image create photo i.sound_on -file $extra_dir/K12/icons/sound_on.png

	#pack forget .controls.switches.audiobutton
	#pack forget .controls.inout
	#.mbar.audio delete 0 2
}

# calculate offset on a movable canvas
set tmp_xpix 0
set tmp_ypix 0

set popup_xpix 0
set popup_ypix 0

# monitor pointer position
set pointer_x_local 0
set pointer_y_local 0

set pointer_x_virtual 0
set pointer_y_virtual 0

set pointer_x_global 0
set pointer_y_global 0

# text pasting global
set copytexttocanvas 0

set global_clipboard 0
# used for comparison to avoid redundant copyfromexternalbuffer
set last_clipboard 0
set global_selection 0

#TOOLTIPS PATCH
#TODO: make a separate tcl file for tooltips and put
#afterid in its scope    
variable afterid 0
variable duplicate_tags -1
variable current_window 0
variable nlet_color 0
variable autotips 0
#variable magicglass 0
variable tooltip_visible 0

# x:y location tooltip during dragging
set tooltip [toplevel .tooltip -bd 1 -bg black]
wm attributes $tooltip -topmost 1
wm overrideredirect $tooltip 1
pack [label $tooltip.label -bg lightyellow -fg black -text aaa -justify left]
wm withdraw $tooltip

# timeout for the tooltip
proc pdtk_toggle_xy_tooltip {name num} {
	global tooltip
	if {$num == 0} {
		wm withdraw $tooltip
	} else {
		wm deiconify $tooltip
	}
}

proc pdtk_update_xy_tooltip {name x y} {
	global tooltip
	global pointer_x_virtual pointer_y_virtual pointer_x_global pointer_y_global
	wm geometry $tooltip +[expr $pointer_x_global+15]+[expr $pointer_y_global-2]
	$tooltip.label configure -text [concat x: $x\ny: $y]
	set pointer_x_virtual $x
	set pointer_y_virtual $y
}

# begin hack to hide hidden files/folder in tk browser on unix ----------
if {$pd_nt == 0} {
    # load the dialog once, otherwise setting the vars will not work
    catch {tk_getOpenFile -with-invalid-argument} 

    # change the environment variables
    namespace eval ::tk::dialog::file {
    variable showHiddenBtn 1
    variable showHiddenVar 0
    }
}
# end hidden files/folder hack ------------------

# Tearoff is set to false by default:
set pd_tearoff 0
# Put menu tearoff is set to true by default:
set put_tearoff 1
# turn off tearoff menus globally
#option add *tearOff 0

# jsarlo
set pd_array_listview_pagesize 1000
set pd_array_listview_id(0) 0
set pd_array_listview_entry(0) 0
set pd_array_listview_page(0) 0
# end jsarlo

# color scheme
set canvas_fill "white"
set text_color "#000"
set select_color "#e87216"
set dash_outline "#f00"
set dash_fill "#f7f7f7"
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 "#808095"
set signal_nlet $signal_cord
set signal_cord_width 3
set msg_cord_highlight "#474"
set msg_cord "#565"
set msg_nlet "white"
set mixed_nlet "#88aaff"
set msg_cord_width 1

#nlet highlighting stuff
set select_nlet_color $select_color
set highlight_width 5

if {$pd_nt == 1} {
    global pd_guidir
    set pd_gui2 [string range $argv0 0 [expr [string last \\ $argv0 ] - 1]]
    regsub -all \\\\ $pd_gui2 / pd_gui3
    set pd_guidir [file normalize $pd_gui3/..]
    load $pd_guidir/bin/pdtcl.dll
}

if {$pd_nt == 2} {
    # turn on James Tittle II's fast drawing
    set tk::mac::useCGDrawing 1
    # anti-alias all lines that need it
    set tk::mac::CGAntialiasLimit 0
    global pd_guidir
    set pd_gui2 [string range $argv0 0 [expr [string last / $argv0 ] - 1]]
    set pd_guidir [file normalize $pd_gui2/..]
    load $pd_guidir/bin/libPdTcl.dylib
    global pd_macready
    set pd_macready 0
    global pd_macdropped
    set pd_macdropped ""
    # tk::mac::OpenDocument is called with the filenames put into the 
    # var args whenever docs are either dropped on the Pd.app icon or 
    # opened from the Finder.
    # It uses menu_doc_open so it can handles numerous file types.
    proc tk::mac::OpenDocument {args} {
        global pd_macready pd_macdropped
        foreach file $args {
            if {$pd_macready != 0} {
                pd [concat pd open [pdtk_enquote [file tail $file]] \
                        [pdtk_enquote  [file dirname $file]] \;]
                menu_doc_open [file dirname $file] [file tail $file]
            } else {
                set pd_macdropped $args
            }
        }
    }
	# intercept kAEQuitApplication from Cmd-Q
	proc ::tk::mac::Quit {} {
		puts stderr "::tk::mac::Quit"
		menu_quit
	}
}

# hack so you can easily test-run this script in linux... define pd_guidir
# (which is normally defined at startup in pd under linux...)

if {$pd_nt == 0} {
    if {! [info exists pd_guidir]} {
        global pd_guidir
        puts stderr {setting pd_guidir to '.'}
        set pd_guidir .
    }
}

#set pd_deffont {courier 10}
set pd_deffont console_font

set help_top_directory $pd_guidir/doc

#==============================================================================#
# pd-gui-rewrite-0.43 help browser backport

# 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]]]
# the pd-gui-rewrite-0.43 help browser is backported to Pd-extended 0.42
package require helpbrowser
package require msgcat
package require tkpng

# official GNU gettext msgcat shortcut
proc _ {s} {return [::msgcat::mc $s]}

namespace eval ::pdwindow:: {
    proc verbose {level postme} {puts stderr "$level: $postme"}
    proc error {postme} {puts stderr $postme; pdtk_post $postme}
    proc warn {postme} {::pdwindow::error $postme}
}

set ::dialog_menubar .mbar
set ::modifier $ctrl_key
set ::sys_libdir $pd_guidir
switch $pd_nt {
    0 {set ::pd_path [list ~/pd-l2ork-externals /usr/local/lib/pd-l2ork-externals]}
    1 {set ::pd_path [list [file normalize $::env(AppData)/Pd] \
                          [file normalize $::env(CommonProgramFiles)/Pd]]}
    2 {set ::pd_path [list ~/Library/Pd /Library/Pd]}
}
#==============================================================================#

################## set up main window #########################
# the menus are instantiated here for the main window
# for the patch windows, they are created by pdtk_canvas_new

#ttk error button customizations
ttk::style configure IOErrorOn.TButton -background "#dd2222"
ttk::style map IOErrorOn.TButton -background [list active "#ff2222"] \
	-foreground [list disabled black]
ttk::style configure IOErrorOff.TButton -background lightgrey
ttk::style map IOErrorOff.TButton -background [list active $colors(-frame)]

match_linux_wm [list menu .mbar -relief flat]
match_linux_wm [list menu .mbar.file -tearoff $pd_tearoff]
.mbar add cascade -label File -menu .mbar.file
match_linux_wm [list menu .mbar.edit -tearoff $pd_tearoff]
.mbar add cascade -label Edit -menu .mbar.edit
match_linux_wm [list menu .mbar.put -tearoff $pd_tearoff]
.mbar add cascade -label Put -menu .mbar.put
#match_linux_wm [list menu .mbar.find -tearoff $put_tearoff]
#.mbar add cascade -label Find -menu .mbar.find
match_linux_wm [list menu .mbar.windows -postcommand [concat pdtk_fixwindowmenu] \
	-tearoff $pd_tearoff]
match_linux_wm [list menu .mbar.audio -tearoff $pd_tearoff]
if {$pd_nt != 2} {
    .mbar add cascade -label "Windows" -menu .mbar.windows
    .mbar add cascade -label "Media" -menu .mbar.audio
    match_linux_wm [list menu .mbar.help -tearoff $pd_tearoff]
    .mbar add cascade -label "Help" -menu .mbar.help
} else {
    menu .mbar.apple -tearoff 0
    .mbar add cascade -label "Apple" -menu .mbar.apple 
    # arrange menus according to Apple HIG
    .mbar add cascade -label "Media" -menu .mbar.audio
    .mbar add cascade -label "Window" -menu .mbar.windows
    match_linux_wm [list menu .mbar.help -tearoff $pd_tearoff]
    .mbar add cascade -label "Help" -menu .mbar.help
}

# fix menu font size on Windows with tk scaling = 1
if {$pd_nt == 1} {
    .mbar.file configure -font menuFont
    .mbar.edit configure -font menuFont
    .mbar.find configure -font menuFont
    .mbar.windows configure -font menuFont
    .mbar.audio configure -font menuFont
    .mbar.help configure -font menuFont
}

proc showhide_printouttext {state} {
    if {$state} {
        #pack .printout -side bottom -fill both -expand 1
		#pack .controls.clr_console -pady 30
		wm deiconify .printout
		#wm resizable . 1 1
		#wm minsize . 460 194
    } else {
        #pack forget .printout
		wm withdraw .printout
		#pack forget .controls.clr_console
		#wm minsize . 0 0
		#wm geometry . 355x75
		#wm resizable . 0 0
    }
}

set ctrls_audio_on 0
set ctrls_meter_on 0
set ctrls_inlevel 0
set ctrls_outlevel 0
set show_text_window 0

match_linux_wm [list frame .controls]
#if { [info tclversion] >= 8.5 && $pd_nt == 0 } {
#	ttk::separator .eyecandy
#	pack .eyecandy .controls -fill x -expand 0
#} else {
pack .controls -fill x -expand 1
#}
match_linux_wm [list frame .controls.switches]
match_linux_wm [list checkbutton .controls.switches.audiobutton -text {compute audio  } \
    -variable ctrls_audio_on \
    -command {pd [concat pd dsp $ctrls_audio_on \;]}]

match_linux_wm [list checkbutton .controls.switches.meterbutton -text {peak meters  } \
    -variable ctrls_meter_on \
    -command {pd [concat pd meters $ctrls_meter_on \;]}]

match_linux_wm [list checkbutton .controls.switches.console -text "console" \
    -variable show_console \
    -command {showhide_printouttext $show_console}]

pack .controls.switches.audiobutton .controls.switches.meterbutton \
    .controls.switches.console -side top -anchor w

match_linux_wm [list frame .controls.inout]
match_linux_wm [list frame .controls.inout.in]
match_linux_wm [list label .controls.inout.in.label -text IN]
entry .controls.inout.in.level -textvariable ctrls_inlevel -width 3 \
	-highlightthickness 0 -takefocus 0 -state readonly -readonlybackground white
if { [info tclversion] >= 8.5 && $pd_nt == 0 } {
	match_linux_wm [list button .controls.inout.in.clip \
		-text {CLIP} -state disabled -style IOErrorOff.TButton -width 4]
} else {
	button .controls.inout.in.clip -text {CLIP} -state disabled
}

match_linux_wm [list frame .controls.inout.in.spacer]

pack .controls.inout.in.label .controls.inout.in.level \
    .controls.inout.in.clip .controls.inout.in.spacer -side top -pady 1

match_linux_wm [list frame .controls.inout.out]
match_linux_wm [list label .controls.inout.out.label -text OUT]
entry .controls.inout.out.level -textvariable ctrls_outlevel -width 3 \
	 -highlightthickness 0 -takefocus 0 -state readonly -readonlybackground white
if { [info tclversion] >= 8.5 && $pd_nt == 0 } {
	match_linux_wm [list button .controls.inout.out.clip \
		-text {CLIP} -state disabled -style IOErrorOff.TButton -width 4]
} else {
	button .controls.inout.out.clip -text {CLIP} -state disabled
}

match_linux_wm [list frame .controls.inout.out.spacer]

pack .controls.inout.out.label .controls.inout.out.level \
    .controls.inout.out.clip .controls.inout.out.spacer -side top -pady 1

if { [info tclversion] >= 8.5 && $pd_nt == 0 } {
	match_linux_wm [list ttk::button .controls.dio -text "\nIO Errors\n" \
		-command { if {![info exists show_console] || $show_console == 0} \
		{ menu_toggle_console; }; \
		pd [concat pd audiostatus \;]} \
		-width 8 -style IOErrorOff.TButton]
} else {
	button .controls.dio -text "DIO\nerrors" \
		-command { if {![info exists show_console] || $show_console == 0} \ 
		{ .controls.switches.console invoke; }; \
		pd [concat pd audiostatus \;]}
}

#match_linux_wm [list button .controls.clr_console -text "Clear Console" \
#	-command [concat menu_clear_console]]

pack .controls.inout.in .controls.inout.out -side left -padx 6
pack .controls.inout -side left -padx 14
pack .controls.switches -side right
pack .controls.dio -side right -padx 20

#if {[info exists show_console] && $show_console == 1} {
#	pack .controls.clr_console -pady 30
#}

toplevel .printout -class [winfo class .]
wm title .printout "Console"
# initial location of the console window (+x+y)
wm geometry .printout +10+170
# wm minsize .printout 460 194
wm protocol .printout WM_DELETE_WINDOW { .controls.switches.console invoke }
match_linux_wm [list frame .printout.frame]
text .printout.frame.text -relief sunken -bd 1 -font console_font \
    -yscrollcommand ".printout.frame.scroll set"  -width 70 -height 24 \
	-highlightthickness 0 -takefocus 0 -fg gray20 -state disabled
#.printout.frame.text tag configure sel -background $linux_wm_hlcolor

# .printout.frame.text insert end "\n\n\n\n\n\n\n\n\n\n"
match_linux_wm [list scrollbar .printout.frame.scroll -command ".printout.frame.text yview"]
match_linux_wm [list frame .printout.bar]
match_linux_wm [list button .printout.bar.clear -text "CLEAR" \
	-width 7 -command [concat menu_clear_console]]
match_linux_wm [list entry .printout.bar.entry \
	-textvariable send_textvariable]
bind .printout.bar.entry <KeyPress-Return> {
	pdtk_post "\nmessage-to-pd: $send_textvariable"
    pd [concat $send_textvariable \;]
}
#match_linux_wm [list button .printout.bar.x -text "x" \
#	-width 2 -command [concat .printout.bar.entry delete 0 end]]
match_linux_wm [list label .printout.bar.label -text "Send Message to Pd:"]

pack .printout.frame.scroll -side right -fill y
pack .printout.frame.text -side left -fill both -expand 1
pack .printout.bar -side bottom -fill x -expand 0
pack .printout.frame -fill both -expand 1
pack .printout.bar.clear -side left -padx 3 -pady 3
#pack .printout.bar.x -side right -padx 3 -pady 3
pack .printout.bar.entry -side right -fill both -expand 1 -padx 3 -pady 3
pack .printout.bar.label -side right -padx 3 -pady 3

# the console is open by default
#.controls.switches.console select
# in the case console should be turned off by default
wm withdraw .printout
#wm geometry .printout 1x1+0+0
#wm overrideredirect .printout 1
#wm transient .printout

bind .printout.frame.text <Button> {pdtk_update_root_edit_menu 0}
bind .printout.frame.text <<Selection>> {pdtk_update_root_edit_menu 1}
bind .printout <Control-Next> {menu_raisenextwindow}	
bind .printout <Control-w> { .controls.switches.console invoke }

proc pdtk_update_root_edit_menu {value} {
	#pdtk_post "update_root_edit_menu $value\n"
	if {$value} {
		set range [.printout.frame.text tag ranges sel]
		#pdtk_post "[lindex $range 0] -- [lindex $range 1]\n"
		if {[lindex $range 0] != [lindex $range 1]} {
			#.mbar.edit entryconfigure "Cut" -state normal
			.mbar.edit entryconfigure "Copy" -state normal
		}
	} else {
		#pdtk_post off
		#.mbar.edit entryconfigure "Cut" -state disabled
		.mbar.edit entryconfigure "Copy" -state disabled
	}
}

proc pdtk_post {stuff} {
	.printout.frame.text configure -state normal
    .printout.frame.text insert end $stuff
    .printout.frame.text yview end-2char
	.printout.frame.text configure -state disabled
}

proc pdtk_standardkeybindings {id} {
    global pd_nt ctrl_key
    bind $id <$ctrl_key-Key> {pdtk_canvas_ctrlkey %W %K 0}
    bind $id <$ctrl_key-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}
}

proc pdtk_panelkeybindings {id panelname} {
    global pd_nt ctrl_key
    pdtk_standardkeybindings $id
    bind $id <KeyPress-Escape> [format "%s_cancel %s" $panelname $id]
    bind $id <KeyPress-Return> [format "%s_ok %s" $panelname $id]
    bind $id <$ctrl_key-Key-w> [format "%s_cancel %s" $panelname $id]
}

pdtk_standardkeybindings .
# hacks to add standard key bindings to the Pd window
bind . <$ctrl_key-Key-a> {.printout.frame.text tag add sel 1.0 end}
#bind . <$ctrl_key-Key-x> {tk_textCut .printout.frame.text; \
#	.mbar.edit entryconfigure "Paste" -state normal}
bind . <$ctrl_key-Key-c> {tk_textCopy .printout.frame.text}
bind .printout <$ctrl_key-Key-c> {tk_textCopy .printout.frame.text}
bind .printout <$ctrl_key-Key-a> {.printout.frame.text tag add sel 1.0 end}
#	.mbar.edit entryconfigure "Paste" -state normal}
#bind . <$ctrl_key-Key-v> {tk_textPaste .printout.frame.text}
bind . <$ctrl_key-Key-w> {menu_quit}
# kludge to add window control bindings to the Pd Window
if {$pd_nt == 2} {
	bind . <Mod1-quoteleft>  {menu_raisenextwindow}
} else {
	bind . <Control-Next>    {menu_raisenextwindow}
	bind . <Control-Prior>   {menu_raisepreviouswindow} ;# needs Tcl/Tk 8.5
}

# pass key presses inside main window to patch windows
proc pdtk_capture_root_window_keys {state key iso shift} {
	global menu_windowlist

	set first_patch_window_name [lindex $menu_windowlist 0 1]
	# pdtk_post "$first_patch_window_name\n"

	if { [string length $first_patch_window_name] > 0 } {
		pdtk_canvas_sendkey $first_patch_window_name.c $state $key $iso $shift 0
	}
}

bind . <Key> {pdtk_capture_root_window_keys 1 %K %A 0}
bind . <Shift-Key> {pdtk_capture_root_window_keys 1 %K %A 1}
bind . <KeyRelease> {pdtk_capture_root_window_keys 0 %K %A 0}
bind . <Control-Key> {pdtk_canvas_ctrlkey %W %K 0}
bind . <Control-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}

bind .printout <Key> {pdtk_capture_root_window_keys 1 %K %A 0}
bind .printout <Shift-Key> {pdtk_capture_root_window_keys 1 %K %A 1}
bind .printout <KeyRelease> {pdtk_capture_root_window_keys 0 %K %A 0}
bind .printout <Control-Key> {pdtk_canvas_ctrlkey %W %K 0}
bind .printout <Control-Shift-Key> {pdtk_canvas_ctrlkey %W %K 1}

wm title . "Pure-Data L2Ork"
# initial location of Pd window (+x+y)
wm geometry . +10+35
catch {
	set appicon [image create photo -format gif -file "$pd_guidir/pd-l2ork.gif"]
	wm iconphoto . -default $appicon
}
. configure -menu .mbar -width 200 -height 150
if { [info tclversion] >= 8.5 && $pd_nt == 0 } { wm resizable . 0 0 }
# Intercept closing the main pd window: MP 20060413:
wm protocol . WM_DELETE_WINDOW menu_quit
focus .


############### set up global variables ################################

set untitled_number 1
if {$pd_nt == 2} {
    set untitled_directory $::env(HOME)
} else {
    set untitled_directory [pwd]
}
set pd_opendir $untitled_directory
set pd_savedir $untitled_directory
#set pd_undoaction no
#set pd_redoaction no
#set pd_undocanvas no

################ utility functions #########################

# enquote a string to send it to a tcl function
proc pdtk_enquote {x} {
    set foo [string map {"," "" ";" "" \" ""} $x]
    set foo2 [string map {" " "\\ "} $foo]
    concat $foo2
}

#enquote a string to send it to Pd.  Blow off semi and comma; alias spaces
#we also blow off "{", "}", "\" because they'll just cause bad trouble later.
proc pdtk_unspace {x} {
    set y [string map {" " "_" ";" "" "," "" "{" "" "}" "" "\\" ""} $x]
    if {$y == ""} {set y "empty"}
    concat $y
}

#enquote a string for preferences (command strings etc.)
proc pdtk_encodedialog {x} {
    concat +[string map {" " "+_" "$" "+d" ";" "+s" "," "+c" "+" "++"} $x]
}

proc pdtk_debug {x} {
    tk_messageBox -message $x -type ok
}

proc pdtk_watchdog {} {
    pd [concat pd watchdog \;]
    after 2000 {pdtk_watchdog}
}

proc pdtk_ping {} {
    pd [concat pd ping \;]
}

##### routine to ask user if OK and, if so, send a message on to Pd ######
proc pdtk_check {canvas x message default} {
    global pd_nt
	raise $canvas
    if {$pd_nt == 1} {
        set answer [tk_messageBox -message $x -type yesno -default $default \
            -icon question]
    } else {
        set answer [tk_messageBox -message $x -type yesno -default $default \
            -parent $canvas -icon question]
    }
    if {! [string compare $answer yes]}  {
		pd $message
		if {$canvas eq "."} {
			focus $canvas
		} else {
			menu_close $canvas
		}
	}
}

##### ask user Save? Discard? Cancel?, and if so, send a message on to Pd ######
proc pdtk_canvas_menuclose {window reply} {
	global pd_nt
	raise $window
	set filename [wm title $window]
	set message [format {Do you wish to save the changes you made in "%s"?} $filename]
	set answer [tk_messageBox -message $message -type yesnocancel -default "yes" \
					-parent $window -icon question]
	switch -- $answer {
		yes {
			pd [concat $window menusave \;]
			#when quitting the application sometimes the save menu fails to show up
			#after 250 pd $reply
			#pd $reply
		}
		no {
			pd [concat $window dirty 0 \;]
			pd $reply
		}
		cancel {}
	}
}

set menu_windowlist {} 

proc pdtk_fixwindowmenu {} {
    global menu_windowlist pd_nt k12_mode
	if { $k12_mode == 0 } {
		.mbar.windows delete 0 end
		if {$pd_nt == 2} {
			.mbar.windows add command -label {Minimize} -command {menu_minimize .} \
				-accelerator [accel_munge "Ctrl+m"]
			.mbar.windows add command -label {Zoom} -command {menu_zoom .}
		} else {
			.mbar.windows add command -label "Next Window" -command {menu_raisenextwindow} \
				-accelerator "Ctrl+PageDown"
			.mbar.windows add command -label "Previous Window" -command {menu_raisepreviouswindow} \
				-accelerator "Ctrl+PageUp"
		}
		match_linux_wm [list .mbar.windows add separator]
		.mbar.windows add command -label {parent window} -state disabled
		.mbar.windows add command -label {Pd & Console} -command menu_raise_console \
			-accelerator [accel_munge "Ctrl+;"] -state disabled
		match_linux_wm [list .mbar.windows add separator]
		foreach i $menu_windowlist {
		    .mbar.windows add command -label [lindex $i 0] \
		        -command [concat menu_domenuwindow [lindex $i 1]]
		    menu_fixwindowmenu [lindex $i 1]
		}
	}
}

####### Odd little function to make better Mac accelerators #####

proc accel_munge {acc} {
    global pd_nt

    if {$pd_nt == 2} {
        if [string is upper [string index $acc end]] {
            return [format "%s%s" "Shift+" \
                        [string toupper [string map {Ctrl Meta} $acc] end]]
        } else {
            return [string toupper [string map {Ctrl Meta} $acc] end]
        }
    } else {
        return $acc
    }
}



###############  the "New" menu command  ########################
proc menu_new {} {
    global untitled_number
    global untitled_directory
	global k12_mode
	global k12_saveas_on_new
    if { ! [file isdirectory $untitled_directory]} {set untitled_directory $::env(HOME)}
    pd [concat pd filename Untitled-$untitled_number \
			[pdtk_enquote $untitled_directory] \;]
	if { $k12_mode == 1 } {
		set k12_saveas_on_new 1
		pd {
		    #N canvas;
			#X obj -30 -30 preset_hub k12 1 %hidden%;
		    #X pop 1;
		}
	} else {
		pd {
		    #N canvas;
		    #X pop 1;
		}
	}
    set untitled_number [expr $untitled_number + 1]
}

################## the "Open" menu command #########################

proc menu_open {} {
    global pd_opendir filetypes
    if { ! [file isdirectory $pd_opendir]} {set pd_opendir $::env(HOME)}
    set files [tk_getOpenFile -defaultextension .pd \
					  -multiple true \
                      -filetypes $filetypes -initialdir $pd_opendir]
    if {$files != ""} {
		foreach filename $files {
			open_file $filename
		}
	}
}

proc menu_k12_open_demos {} {
	global pd_guidir filetypes
	if { ! [file isdirectory $pd_guidir/extra/K12/demos]} {
		set files [tk_getOpenFile -defaultextension .pd \
						  -multiple true \
		                  -filetypes $filetypes -initialdir $pd_guidir/extra/]
	} else {
		set files [tk_getOpenFile -defaultextension .pd \
						  -multiple true \
		                  -filetypes $filetypes -initialdir $pd_guidir/extra/K12/demos]
	}
    if {$files != ""} {
		foreach filename $files {
			open_file $filename
		}
	}	
}

proc pdtk_set_current_dir {path_and_filename} {
	global pd_opendir untitled_directory
	set directory [file dirname $path_and_filename]
	set pd_opendir $directory
	set untitled_directory $directory
}

proc open_file {filename} {
    global pd_opendir pd_guidir pd_nt
	#puts stderr open_file
	set directory [file dirname $filename]
	set basename [file tail $filename]
    if {[regexp -nocase -- "\.(pat|mxb|help)$" $basename]} {
		puts stderr "converting $filename"
		if {$pd_nt == 0} { 
			# on GNU/Linux, cyclist is installed into /usr/bin usually
			set cyclist "/usr/bin/cyclist" 
		} else {
			set cyclist "$pd_guidir/bin/cyclist"
		}
		puts stderr "$cyclist '$filename'"
		# convert Max binary to text .pat
		set binport [open "| \"$cyclist\" \"$filename\""]
		set convertedtext [read $binport]
		if { ! [catch {close $binport} err]} {
			if {! [file writable $directory]} {	set directory "/tmp" }
			set basename "$basename.pat"
			set textpatfile [open "$directory/$basename" w]
			puts $textpatfile $convertedtext
			close $textpatfile
			puts stderr "converted Max binary to text format: $directory/$basename"
		}
	}
    if {[regexp -nocase -- "\.(pd|pat|mxt)$" $basename]} {
        pd "pd open [pdtk_enquote $basename] [pdtk_enquote $directory] ;"
        set pd_opendir $directory
    }
}

catch {
    package require tkdnd
    dnd bindtarget . text/uri-list <Drop> {
        foreach file %D {open_file $file}
    }
}

################## the "Message" menu command #########################
proc menu_send {} {
    global pd_nt ctrl_key
    if { [winfo exists .sendpanel.entry] } {
        raise .sendpanel
    } else {
		toplevel .sendpanel -class [winfo class .]
		wm title .sendpanel {Send Message to Pd}
		wm resizable .sendpanel 0 0
		match_linux_wm [list .sendpanel configure]
		pdtk_standardkeybindings .sendpanel
		match_linux_wm [list entry .sendpanel.entry \
			-textvariable send_textvariable]
		pack .sendpanel.entry -side bottom -fill both -ipadx 100 -padx 3 -pady 5
		if { [info tclversion] < 8.5 } {
			.sendpanel.entry select from 0
			.sendpanel.entry select adjust end
		}
		bind .sendpanel <$ctrl_key-Key-w> {destroy .sendpanel}
		bind .sendpanel <KeyPress-Escape> {destroy .sendpanel}
		bind .sendpanel.entry <KeyPress-Return> {
			pdtk_post "\nmessage-to-pd: $send_textvariable"
		    pd [concat $send_textvariable \;]
		}
		focus .sendpanel.entry
	}
}


################## menu commands for Mac OS X #########################

proc menu_minimize {window} {
	if {$window eq ""} { #Pd Window
		wm iconify [winfo toplevel .printout]
	} else {
		wm iconify [winfo toplevel $window]
	}
}

proc menu_zoom {window} {
	wm state $window zoomed
}

proc menu_raisenextwindow {} {
	set target [lindex [wm stackorder .] 0]
	raise $target
	if { [winfo exists $target.c] } {
		focus $target.c
	} else {
		focus $target
	}
}

# lreverse came along in Tcl 8.5
proc menu_raisepreviouswindow {} {
	set last [lindex [wm stackorder .] end]
	set all [wm stackorder .]
	foreach i $all {
		if { $i != $last } { 
			raise [lindex $i]
			set target $i
		} else {
			if { [winfo exists $target.c] } {
				focus $target.c
			} else {
				focus $target
			}
		}
	}
}

################## menu commands for console #########################

proc menu_raise_console {} {
	set pd_window .
	set top_window [lindex [wm stackorder $pd_window] end]
	focus .
	if {$pd_window eq $top_window} {
		lower $pd_window
		.controls.switches.console instate {selected} {
			lower .printout
		}
		#catch {lower .printout}
	} else {
		wm deiconify $pd_window
		raise $pd_window
		.controls.switches.console instate {selected} {
			wm deiconify .printout
			wm manage .printout
			raise .printout
			#focus .printout
		}
		#catch {wm deiconify .printout}
		#catch {wm manage .prinout}
		#raise .printout
	}
}

proc menu_toggle_console {} { .controls.switches.console invoke }

proc menu_clear_console {} {.printout.frame.text configure -state normal; .printout.frame.text delete 0.0 end; .printout.frame.text configure -state disabled}

################## the "Quit" menu command #########################
proc menu_really_quit {} {pd {pd quit;}}

proc menu_quit {} {pd {pd verifyquit;}}

######### the "audio" menu command  ###############
proc menu_audio {flag} {pd [concat pd dsp $flag \;]}

######### the "reselect" menu command ################
proc menu_reselect {name} {pd [concat $name reselect \;]}

######### the "documentation" menu command  ###############

set doc_number 1

# open text docs in a Pd window
proc menu_opentext {filename} {
    global doc_number
    global pd_guidir
    global pd_myversion
	global ctrl_key
    if { [winfo exists .about.text] } {
        raise .about
    } else {
		destroy .about
		toplevel .about -class [winfo class .]
		wm title .about "Text Viewer"
		wm geometry .about 550x480
		match_linux_wm [list text .about.text -relief sunken -bd 1 -font text_font \
		    -yscrollcommand ".about.scroll set" -highlightthickness 0 -takefocus 0]
		match_linux_wm [list scrollbar .about.scroll -command ".about.text yview"]
		pack .about.scroll -side right -fill y
		pack .about.text -side left -fill both -expand 1
		bind .about <$ctrl_key-Key-w> [concat destroy .about set doc_number [expr $doc_number - 1]]
		
		set f [open $filename]
		while {![eof $f]} {
		    set bigstring [read $f 1000]
		    regsub -all PD_BASEDIR $bigstring $pd_guidir bigstring2
		    regsub -all PD_VERSION $bigstring2 $pd_myversion bigstring3
		    .about.text insert end $bigstring3
		}
		close $f
	}
}

# open HTML docs from the menu using the OS-default HTML viewer
proc menu_openhtml {filename} {
    global pd_nt         

    if {$pd_nt == 0} {
        foreach candidate \
            { gnome-open xdg-open sensible-browser iceweasel firefox mozilla \
                  galeon konqueror netscape lynx } {
                      set browser [lindex [auto_execok $candidate] 0]
                      if {[string length $browser]} {
                          puts stderr [format "%s '%s'" $browser $filename]
                          exec -- sh -c [format "%s '%s'" $browser $filename] &
                          break
                      }
                  }
    } elseif {$pd_nt == 2} {
        puts stderr [format "open '%s'" $filename]
        exec sh -c [format "open '%s'" $filename]
    } else {
        exec rundll32 url.dll,FileProtocolHandler \
            [format "%s" $filename] &
    }
}

proc menu_openpdpedia {} {
	set top_window [lindex [wm stackorder .] end]
	set window_title [wm title $top_window]
	set helpfile [regsub -- {(.*)-help.*} $window_title {\1}]
	if {$helpfile eq $window_title} {
		menu_openhtml "http://wiki.puredata.info/"
	} else {
		menu_openhtml "http://wiki.puredata.info/en/$helpfile"
	}
}

proc menu_doc_open {dir basename} {
    global pd_guidir
    
    if {[file pathtype $dir] eq "relative"} {
        set dirname "$pd_guidir/$dir"
    } else {
        set dirname $dir
    }

    if {[file isdirectory [file join $dirname $basename]]} {
        menu_openhtml $dirname/$basename
    } elseif {[regexp -nocase -- ".*\.(txt|c)$" $basename]} {
        menu_opentext $dirname/$basename
    } elseif {[regexp -nocase -- ".*\.(htm|html|pdf)$" $basename]} {
        menu_openhtml $dirname/$basename
    } else {
        set fullpath [file normalize [file join $dirname $basename]]
        set dirname [file dirname $fullpath]
        set basename [file tail $fullpath]
        pd [concat pd open [pdtk_enquote $basename] \
                [pdtk_enquote $dirname] \;]
    }
}

# backported from pd
# ------------------------------------------------------------------------------
# opening docs as menu items (like the Test Audio and MIDI patch and the manual)
#package provide pd_menucommands 0.1
#
#namespace eval ::pd_menucommands:: {
#    variable untitled_number "1"
#
#    namespace export menu_*
#}

# TODO enquote a filename to send it to pd, " isn't handled properly tho...
#proc enquote_path {message} {
#    string map {"," "\\," ";" "\\;" " " "\\ "} $message
#}

#proc ::menu_doc_open {dir basename} {
#    if {[file pathtype $dir] eq "relative"} {
#        set dirname "$::sys_libdir/$dir"
#    } else {
#        set dirname $dir
#    }
#    set textextension "[string tolower [file extension $basename]]"
#    if {[lsearch -exact [lindex $::filetypes 0 1]  $textextension] > -1} {
#        set fullpath [file normalize [file join $dirname $basename]]
#        set dirname [file dirname $fullpath]
#        set basename [file tail $fullpath]
#        pdsend "pd open [enquote_path $basename] [enquote_path $dirname]"
#    } else {
#        ::menu_openfile "$dirname/$basename"
#    }
#}

# open HTML docs from the menu using the OS-default HTML viewer
proc ::menu_openfile {filename} {
    if {$::tcl_platform(os) eq "Darwin"} {
        exec sh -c [format "open '%s'" $filename]
    } elseif {$::tcl_platform(platform) eq "windows"} {
        exec rundll32 url.dll,FileProtocolHandler [format "%s" $filename] &
    } else {
        foreach candidate { gnome-open xdg-open sensible-browser iceweasel firefox \
                                mozilla galeon konqueror netscape lynx } {
            set browser [lindex [auto_execok $candidate] 0]
            if {[string length $browser] != 0} {
                exec -- sh -c [format "%s '%s'" $browser $filename] &
                break
            }
        }
    }
}

############# routine to add media, help, and apple menu items ###############

proc menu_addstd {mbar} {
    global pd_apilist pd_midiapilist pd_nt pd_tearoff
    #          the "Audio" menu
    $mbar.audio add command -label {Audio ON} -accelerator [accel_munge "Ctrl+/"] \
        -command {menu_audio 1} 
    $mbar.audio add command -label {Audio OFF} -accelerator [accel_munge "Ctrl+."] \
        -command {menu_audio 0} 
	match_linux_wm [list $mbar.audio add separator]
    for {set x 1} {$x<[llength $pd_apilist]} {incr x} {
        $mbar.audio add radiobutton -label [concat [lindex [lindex $pd_apilist $x] 0] Audio Driver] \
            -command {menu_audio 0} -variable pd_whichapi \
            -value [lindex [lindex $pd_apilist $x] 1]\
			-selectcolor "#dddddd" \
            -command {pd [concat pd audio-setapi $pd_whichapi \;]}
    }
	match_linux_wm [list $mbar.audio add separator]
    for {set x 0} {$x<[llength $pd_midiapilist]} {incr x} {
        $mbar.audio add radiobutton -label [concat [lindex [lindex $pd_midiapilist $x] 0] driver]\
            -command {menu_midi 0} -variable pd_whichmidiapi \
            -value [lindex [lindex $pd_midiapilist $x] 1]\
			-selectcolor "#dddddd" \
            -command {pd [concat pd midi-setapi $pd_whichmidiapi \;]}
    }
    #if {$pd_nt != 2} {
	#	$mbar.audio add separator
    #    $mbar.audio add command -label {Audio settings...} \
    #        -command {pd pd audio-properties \;}
    #    $mbar.audio add command -label {MIDI settings...} \
    #        -command {pd pd midi-properties \;}
    #}
	match_linux_wm [list $mbar.audio add separator] 
    $mbar.audio add command -label {Test Audio and MIDI} \
        -command {menu_doc_open doc/7.stuff/tools testtone.pd} 
    $mbar.audio add command -label {Load Meter} \
        -command {menu_doc_open doc/7.stuff/tools load-meter.pd} 

    #       the MacOS X app menu

    # The menu on the main menubar named $whatever.apple while be treated
    # as a special menu on MacOS X.  Tcl/Tk assigns the $whatever.apple menu
    # to the app-specific menu in MacOS X that is named after the app,
    # so in our case, the Pd menu.  <hans@at.or.at>
    # See SPECIAL MENUS IN MENUBARS http://www.tcl.tk/man/tcl8.4/TkCmd/menu.htm
    if {$pd_nt == 2} {
        $mbar.apple add command -label "About Pd..." -command \
            {menu_doc_open doc/1.manual 1.introduction.txt} 
        menu $mbar.apple.preferences -tearoff 0
        $mbar.apple add cascade -label "Preferences" -menu $mbar.apple.preferences
        $mbar.apple.preferences add command -label "Path..." \
            -command {pd pd start-path-dialog \;}
        $mbar.apple.preferences add command -label "Startup..." \
            -command {pd pd start-startup-dialog \;}
        $mbar.apple.preferences add command -label "Audio Settings..." \
            -command {pd pd audio-properties \;}
        $mbar.apple.preferences add command -label "MIDI settings..." \
            -command {pd pd midi-properties \;}
    }


    # the "Help" menu
    if {$pd_nt != 2} {
        $mbar.help add command -label {About Pd-L2Ork} \
            -command {menu_doc_open doc/1.manual 1.introduction.txt} 
    }
    $mbar.help add command -label {Manual} \
        -command {menu_doc_open doc/1.manual index.htm} 
    $mbar.help add command -label {Browser} \
        -accelerator [accel_munge "Ctrl+b"] \
        -command {::helpbrowser::open_helpbrowser}
    match_linux_wm [list $mbar.help add separator]
    #$mbar.help add command -label {puredata.info} \
    #    -command {menu_openhtml http://puredata.info} 
    #$mbar.help add command -label {Pdpedia} \
    #    -command {menu_openpdpedia} 
    #$mbar.help add command -label {FAQ} \
    #    -command {menu_openhtml http://puredata.info/docs/faq} 
    #$mbar.help add separator
    $mbar.help add command -label {Pd-L2Ork mailing list} \
        -command {menu_openhtml http://disis.music.vt.edu/listinfo/l2ork-dev} 
    $mbar.help add command -label {Pure-Data mailing lists} \
        -command {menu_openhtml http://puredata.info/community/lists} 
    $mbar.help add command -label {Forums} \
        -command {menu_openhtml http://puredata.hurleur.com/} 
    $mbar.help add command -label {IRC chat} \
        -command {menu_openhtml irc://irc.freenode.net/dataflow} 
    #$mbar.help add separator
	#$mbar.help add command -label {report bug} -command \
	#	{menu_openhtml {http://sourceforge.net/tracker/?func=add&group_id=55736&atid=478070}} 
}

#################### the "File" menu for the Pd window ##############

.mbar.file add command -label New -command {menu_new} \
    -accelerator [accel_munge "Ctrl+n"]