From 22a829cb1907c79bfe68ad91314a1dddbf1beeb3 Mon Sep 17 00:00:00 2001 From: Miller Puckette Date: Tue, 1 Sep 2009 18:22:23 +0000 Subject: merge in HC's new tcl code and start taking patches svn path=/trunk/; revision=12166 --- pd/tcl/pd_menucommands.tcl | 126 ++++++++++++++++++++++++++++++++------------- 1 file changed, 89 insertions(+), 37 deletions(-) (limited to 'pd/tcl/pd_menucommands.tcl') diff --git a/pd/tcl/pd_menucommands.tcl b/pd/tcl/pd_menucommands.tcl index 6530c52a..e1373b84 100644 --- a/pd/tcl/pd_menucommands.tcl +++ b/pd/tcl/pd_menucommands.tcl @@ -16,7 +16,8 @@ proc ::pd_menucommands::menu_new {} { variable untitled_number variable menu_new_dir if { ! [file isdirectory $menu_new_dir]} {set menu_new_dir $::env(HOME)} - pdsend "pd filename Untitled-$untitled_number [enquote_path $menu_new_dir]" + set untitled_name [_ "Untitled"] + pdsend "pd filename $untitled_name-$untitled_number [enquote_path $menu_new_dir]" pdsend "#N canvas" pdsend "#X pop 1" incr untitled_number @@ -31,7 +32,6 @@ proc ::pd_menucommands::menu_open {} { -initialdir $menu_open_dir] if {$files ne ""} { foreach filename $files { - puts "open_file $filename" open_file $filename } set menu_open_dir [file dirname $filename] @@ -40,14 +40,14 @@ proc ::pd_menucommands::menu_open {} { proc ::pd_menucommands::menu_print {mytoplevel} { set filename [tk_getSaveFile -initialfile pd.ps \ - -defaultextension .ps \ - -filetypes { {{postscript} {.ps}} }] - if {$filename != ""} { - $mytoplevel.c postscript -file $filename + -defaultextension .ps \ + -filetypes { {{postscript} {.ps}} }] + if {$filename ne ""} { + $mytoplevel.c postscript -file $filename } } -# panel types: +# dialog 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) @@ -57,61 +57,56 @@ proc ::pd_menucommands::menu_print {mytoplevel} { # functions called from Edit menu proc menu_undo {mytoplevel} { - puts stderr "menu_undo $mytoplevel not implemented yet" + # puts stderr "menu_undo $mytoplevel not implemented yet" } proc menu_redo {mytoplevel} { - puts stderr "menu_redo $mytoplevel not implemented yet" + # puts stderr "menu_redo $mytoplevel not implemented yet" } # ------------------------------------------------------------------------------ -# open the panels +# open the dialog panels -proc ::pd_menucommands::menu_message_panel {} { +proc ::pd_menucommands::menu_message_dialog {} { if {[winfo exists .send_message]} { wm deiconify .send_message raise .message } else { # TODO insert real message panel here toplevel .send_message + wm group .send_message . wm title .send_message [_ "Send Message..."] wm resizable .send_message 0 0 - ::pd_bindings::panel_bindings .send_message "send_message" + ::pd_bindings::dialog_bindings .send_message "send_message" frame .send_message.frame - label .send_message.label -text "message" -width 30 -height 15 + label .send_message.label -text [_ "Message"] -width 30 -height 15 pack .send_message.label .send_message.frame -side top -expand yes -fill both } } - -proc ::pd_menucommands::menu_dialog_font {mytoplevel} { +proc ::pd_menucommands::menu_font_dialog {mytoplevel} { if {[winfo exists .font]} { - wm deiconify .font raise .font + } elseif {$mytoplevel eq ".pdwindow"} { + pdtk_canvas_dofont .pdwindow [lindex [.pdwindow.text cget -font] 1] } else { - # TODO insert real preference panel here - toplevel .font - wm title .font [_ "Font"] - ::pd_bindings::panel_bindings .font "font" - frame .font.frame - label .font.label -text "font" -width 30 -height 15 - pack .font.label .font.frame -side top -expand yes -fill both + pdsend "$mytoplevel menufont" } } -proc ::pd_menucommands::menu_path_panel {} { +proc ::pd_menucommands::menu_path_dialog {} { if {[winfo exists .path]} { - raise .path + raise .path } else { - pdsend "pd start-path-dialog" + pdsend "pd start-path-dialog" } } -proc ::pd_menucommands::menu_startup_panel {} { +proc ::pd_menucommands::menu_startup_dialog {} { if {[winfo exists .startup]} { - raise .startup + raise .startup } else { - pdsend "pd start-startup-dialog" + pdsend "pd start-startup-dialog" } } @@ -127,13 +122,12 @@ proc ::pd_menucommands::menu_maximize {mytoplevel} { } proc menu_raise_pdwindow {} { - set pd_window . - set top_window [lindex [wm stackorder $pd_window] end] - if {$pd_window eq $top_window} { - lower $pd_window + set top_window [lindex [wm stackorder .pdwindow] end] + if {.pdwindow eq $top_window} { + lower .pdwindow } else { - wm deiconify $pd_window - raise $pd_window + wm deiconify .pdwindow + raise .pdwindow } } @@ -143,14 +137,72 @@ proc menu_raise_pdwindow {} { # this gets the dir from the path of a window's title proc ::pd_menucommands::set_menu_new_dir {mytoplevel} { variable menu_new_dir + variable menu_open_dir # TODO add Aqua specifics once g_canvas.c has [wm attributes -titlepath] - if {$mytoplevel eq "."} { - set menu_new_dir [pwd] + if {$mytoplevel eq ".pdwindow"} { + # puts "set_menu_new_dir $mytoplevel" + set menu_new_dir $menu_open_dir } else { regexp -- ".+ - (.+)" [wm title $mytoplevel] ignored menu_new_dir } } +# ------------------------------------------------------------------------------ +# opening docs as menu items (like the Test Audio and MIDI patch and the manual) +proc ::pd_menucommands::menu_doc_open {subdir basename} { + set dirname "$::sys_libdir/$subdir" + + switch -- [string tolower [file extension $basename]] { + ".txt" {::pd_menucommands::menu_opentext "$dirname/$basename" + } ".c" {::pd_menucommands::menu_opentext "$dirname/$basename" + } ".htm" {::pd_menucommands::menu_openhtml "$dirname/$basename" + } ".html" {::pd_menucommands::menu_openhtml "$dirname/$basename" + } default { + pdsend "pd open [enquote_path $basename] [enquote_path $dirname]" + } + } +} + +# open text docs in a Pd window +proc ::pd_menucommands::menu_opentext {filename} { + global pd_myversion + set mytoplevel [format ".help%d" [clock seconds]] + toplevel $mytoplevel -class TextWindow + text $mytoplevel.text -relief flat -borderwidth 0 \ + -yscrollcommand "$mytoplevel.scroll set" -background white + scrollbar $mytoplevel.scroll -command "$mytoplevel.text yview" + pack $mytoplevel.scroll -side right -fill y + pack $mytoplevel.text -side left -fill both -expand 1 + ::pd_bindings::window_bindings $mytoplevel + + set textfile [open $filename] + while {![eof $textfile]} { + set bigstring [read $textfile 1000] + regsub -all PD_BASEDIR $bigstring $::sys_guidir bigstring2 + regsub -all PD_VERSION $bigstring2 $pd_myversion bigstring3 + $mytoplevel.text insert end $bigstring3 + } + close $textfile +} + +# open HTML docs from the menu using the OS-default HTML viewer +proc ::pd_menucommands::menu_openhtml {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 + } + } + } +} + # ------------------------------------------------------------------------------ # Mac OS X specific functions -- cgit v1.2.1