From e1fc51c3a1d944193032d8bb1d95741d090b6d3b Mon Sep 17 00:00:00 2001 From: Hans-Christoph Steiner Date: Sun, 9 Oct 2011 16:41:04 +0000 Subject: checked in pd-0.43-1test4.src.tar.gz svn path=/trunk/; revision=15558 --- pd/tcl/Makefile.am | 2 +- pd/tcl/pd-gui.tcl | 10 +- pd/tcl/pd_guiprefs.tcl | 240 +++++++++++++++++++++++++++++++++++++++++++++ pd/tcl/pd_menus.tcl | 57 +++++++---- pd/tcl/pdtk_canvas.tcl | 19 ++-- pd/tcl/pdtk_text.tcl | 13 ++- pd/tcl/pkgIndex.tcl | 1 + pd/tcl/wheredoesthisgo.tcl | 13 ++- 8 files changed, 314 insertions(+), 41 deletions(-) create mode 100644 pd/tcl/pd_guiprefs.tcl (limited to 'pd/tcl') diff --git a/pd/tcl/Makefile.am b/pd/tcl/Makefile.am index 65780ebf..cf952d22 100644 --- a/pd/tcl/Makefile.am +++ b/pd/tcl/Makefile.am @@ -10,7 +10,7 @@ bin_SCRIPTS = pd-gui.tcl libpdtcldir = $(pkglibdir)/tcl dist_libpdtcl_SCRIPTS = pd-gui.tcl -dist_libpdtcl_DATA = apple_events.tcl dialog_canvas.tcl dialog_gatom.tcl dialog_path.tcl pd_bindings.tcl pd_menus.tcl pdwindow.tcl scrollboxwindow.tcl AppMain.tcl dialog_data.tcl dialog_iemgui.tcl dialog_startup.tcl pd_connect.tcl pdtk_array.tcl pkgIndex.tcl wheredoesthisgo.tcl dialog_array.tcl dialog_find.tcl dialog_message.tcl helpbrowser.tcl pdtk_canvas.tcl pkg_mkIndex.tcl dialog_audio.tcl dialog_font.tcl dialog_midi.tcl opt_parser.tcl pd_menucommands.tcl pdtk_text.tcl scrollbox.tcl pd.ico +dist_libpdtcl_DATA = apple_events.tcl dialog_canvas.tcl dialog_gatom.tcl dialog_path.tcl pd_bindings.tcl pd_menus.tcl pdwindow.tcl scrollboxwindow.tcl AppMain.tcl dialog_data.tcl dialog_iemgui.tcl dialog_startup.tcl pd_connect.tcl pdtk_array.tcl pkgIndex.tcl wheredoesthisgo.tcl dialog_array.tcl dialog_find.tcl dialog_message.tcl helpbrowser.tcl pdtk_canvas.tcl pkg_mkIndex.tcl dialog_audio.tcl dialog_font.tcl dialog_midi.tcl opt_parser.tcl pd_menucommands.tcl pdtk_text.tcl scrollbox.tcl pd_guiprefs.tcl pd.ico etags: TAGS etags --append --language=none --regex="/proc[ \t]+\([^ \t]+\)/\1/" *.tcl diff --git a/pd/tcl/pd-gui.tcl b/pd/tcl/pd-gui.tcl index 39b260f5..d2fbdba8 100644 --- a/pd/tcl/pd-gui.tcl +++ b/pd/tcl/pd-gui.tcl @@ -46,10 +46,15 @@ package require pdtk_canvas package require pdtk_text # 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::* @@ -167,9 +172,9 @@ set dsp 0 set meters 0 # the toplevel window that currently is on top and has focus set focused_window . -# store that last 10 files that were opened +# store that last 5 files that were opened set recentfiles_list {} -set total_recentfiles 10 +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 @@ -492,6 +497,7 @@ proc pdtk_pd_startup {major minor bugfix test 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_measured_metrics" ::pd_bindings::class_bindings ::pd_bindings::global_bindings diff --git a/pd/tcl/pd_guiprefs.tcl b/pd/tcl/pd_guiprefs.tcl new file mode 100644 index 00000000..29d45677 --- /dev/null +++ b/pd/tcl/pd_guiprefs.tcl @@ -0,0 +1,240 @@ +# +# Copyright (c) 1997-2009 Miller Puckette. +# Copyright (c) 2011 Yvan Volochine. +#(c) 2008 WordTech Communications LLC. License: standard Tcl license, http://www.tcl.tk/software/tcltk/license.html + +package provide pd_guiprefs 0.1 + + +namespace eval ::pd_guiprefs:: { + namespace export init + namespace export write_recentfiles + namespace export update_recentfiles +} + +# FIXME should these be globals ? +set ::recentfiles_key "" +set ::recentfiles_domain "" + + +################################################################# +# global procedures +################################################################# +# ------------------------------------------------------------------------------ +# init preferences +# +proc ::pd_guiprefs::init {} { + switch -- $::windowingsystem { + "aqua" { init_aqua } + "win32" { init_win } + "x11" { init_x11 } + } + # assign gui preferences + # osx special case for arrays + set arr [expr { $::windowingsystem eq "aqua" }] + set ::recentfiles_list "" + catch {set ::recentfiles_list [get_config $::recentfiles_domain \ + $::recentfiles_key $arr]} +} + +proc init_aqua {} { + # osx has a "Open Recent" menu with 10 recent files (others have 5 inlined) + set ::recentfiles_domain org.puredata + set ::recentfiles_key "NSRecentDocuments" + set ::total_recentfiles 10 +} + +proc init_win {} { + # windows uses registry + set ::recentfiles_domain "HKEY_CURRENT_USER\\Software\\Pure-Data" + set ::recentfiles_key "RecentDocs" +} + +proc init_x11 {} { + # linux uses ~/.config/pure-data dir + set ::recentfiles_domain "~/.config/pure-data" + set ::recentfiles_key "recentfiles.conf" + prepare_configdir +} + +# ------------------------------------------------------------------------------ +# write recent files +# +proc ::pd_guiprefs::write_recentfiles {} { + write_config $::recentfiles_list $::recentfiles_domain $::recentfiles_key true +} + +# ------------------------------------------------------------------------------ +# this is called when opening a document (wheredoesthisshouldgo.tcl) +# +proc ::pd_guiprefs::update_recentfiles {afile} { + # remove duplicates first + set index [lsearch -exact $::recentfiles_list $afile] + set ::recentfiles_list [lreplace $::recentfiles_list $index $index] + # insert new one in the beginning and crop the list + set ::recentfiles_list [linsert $::recentfiles_list 0 $afile] + set ::recentfiles_list [lrange $::recentfiles_list 0 $::total_recentfiles] + ::pd_menus::update_recentfiles_menu +} + +################################################################# +# main read/write procedures +################################################################# + +# ------------------------------------------------------------------------------ +# get configs from a file or the registry +# +proc get_config {adomain {akey} {arr}} { + switch -- $::windowingsystem { + "aqua" { set conf [get_config_aqua $adomain $akey $arr] } + "win32" { set conf [get_config_win $adomain $akey $arr] } + "x11" { set conf [get_config_x11 $adomain $akey $arr] } + } + return $conf +} + +# ------------------------------------------------------------------------------ +# write configs to a file or to the registry +# $arr is true if the data needs to be written in an array +# +proc write_config {data {adomain} {akey} {arr false}} { + switch -- $::windowingsystem { + "aqua" { write_config_aqua $data $adomain $akey $arr } + "win32" { write_config_win $data $adomain $akey $arr } + "x11" { write_config_x11 $data $adomain $akey } + } +} + +################################################################# +# os specific procedures +################################################################# + +# ------------------------------------------------------------------------------ +# osx: read a plist file +# +proc get_config_aqua {adomain {akey} {arr false}} { + if {![catch {exec defaults read $adomain $akey} conf]} { + if {$arr} { + set conf [plist_array_to_tcl_list $conf] + } + } { + # initialize NSRecentDocuments with an empty array + exec defaults write $adomain $akey -array + set conf {} + } + return $conf +} + +# ------------------------------------------------------------------------------ +# win: read in the registry +# +proc get_config_win {adomain {akey} {arr false}} { + package require registry + if {![catch {registry get $adomain $akey} conf]} { + return [expr {$conf}] + } { + return {} + } +} + +# ------------------------------------------------------------------------------ +# linux: read a config file and return its lines splitted. +# +proc get_config_x11 {adomain {akey} {arr false}} { + set filename [file join $adomain $akey] + set conf {} + if { + [file exists $filename] == 1 + && [file readable $filename] + } { + set fl [open $filename r] + while {[gets $fl line] >= 0} { + lappend conf $line + } + close $fl + } + return $conf +} + +# ------------------------------------------------------------------------------ +# osx: write configs to plist file +# if $arr is true, we write an array +# +proc write_config_aqua {data {adomain} {akey} {arr false}} { + # FIXME empty and write again so we don't loose the order + if {[catch {exec defaults write $adomain $akey -array} errorMsg]} { + puts stderr "ERROR: write_config_aqua $akey: $errorMsg" + } + if {$arr} { + foreach filepath $data { + exec defaults write $adomain $akey -array-add $filepath + } + } { + exec defaults write $adomain $akey $data + } +} + +# ------------------------------------------------------------------------------ +# win: write configs to registry +# if $arr is true, we write an array +# +proc write_config_win {data {adomain} {akey} {arr false}} { + package require registry + # FIXME: ugly + if {$arr} { + if {[catch {registry set $adomain $akey $data multi_sz} errorMsg]} { + puts stderr "ERROR: write_config_win $data $akey: $errorMsg" + } + } { + if {[catch {registry set $adomain $akey $data sz} errorMsg]} { + puts stderr "ERROR: write_config_win $data $akey: $errorMsg" + } + } +} + +# ------------------------------------------------------------------------------ +# linux: write configs to USER_APP_CONFIG_DIR +# +proc write_config_x11 {data {adomain} {akey}} { + # right now I (yvan) assume that data are just \n separated, i.e. no keys + set data [join $data "\n"] + set filename [file join $adomain $akey] + if {[catch {set fl [open $filename w]} errorMsg]} { + puts stderr "ERROR: write_config_x11 $data $akey: $errorMsg" + } { + puts -nonewline $fl $data + close $fl + } +} + +################################################################# +# utils +################################################################# + +# ------------------------------------------------------------------------------ +# linux only! : look for pd config directory and create it if needed +# +proc prepare_configdir {} { + if {[file isdirectory $::recentfiles_domain] != 1} { + file mkdir $::recentfiles_domain + puts "$::recentfiles_domain was created.\n" + } +} + +# ------------------------------------------------------------------------------ +# osx: handles arrays in plist files (thanks hc) +# +proc plist_array_to_tcl_list {arr} { + set result {} + set filelist $arr + regsub -all -- {("?),\s+("?)} $filelist {\1 \2} filelist + regsub -all -- {\n} $filelist {} filelist + regsub -all -- {^\(} $filelist {} filelist + regsub -all -- {\)$} $filelist {} filelist + + foreach file $filelist { + set filename [regsub -- {,$} $file {}] + lappend result $filename + } + return $result +} diff --git a/pd/tcl/pd_menus.tcl b/pd/tcl/pd_menus.tcl index fc617dfa..9219f30a 100644 --- a/pd/tcl/pd_menus.tcl +++ b/pd/tcl/pd_menus.tcl @@ -123,7 +123,7 @@ proc ::pd_menus::configure_for_dialog {mytoplevel} { # ------------------------------------------------------------------------------ # menu building functions proc ::pd_menus::build_file_menu {mymenu} { - # run the platform-specific build_file_menu_* procs first, the config them + # run the platform-specific build_file_menu_* procs first, and config them [format build_file_menu_%s $::windowingsystem] $mymenu $mymenu entryconfigure [_ "New"] -command {menu_new} $mymenu entryconfigure [_ "Open"] -command {menu_open} @@ -133,6 +133,10 @@ proc ::pd_menus::build_file_menu {mymenu} { $mymenu entryconfigure [_ "Close"] -command {menu_send_float $::focused_window menuclose 0} $mymenu entryconfigure [_ "Message..."] -command {menu_message_dialog} $mymenu entryconfigure [_ "Print..."] -command {menu_print $::focused_window} + # update recent files + if {[llength $::recentfiles_list] > 0} { + ::pd_menus::update_recentfiles_menu false + } } proc ::pd_menus::build_edit_menu {mymenu} { @@ -171,7 +175,7 @@ proc ::pd_menus::build_edit_menu {mymenu} { $mymenu add separator #TODO madness! how to set the state of the check box without invoking the menu! $mymenu add check -label [_ "Edit Mode"] -accelerator "$accelerator+E" \ - -selectcolor grey85 -variable ::editmode_button \ + -variable ::editmode_button \ -command {menu_editmode $::editmode_button} } @@ -326,52 +330,69 @@ proc ::pd_menus::update_undo_on_menu {mytoplevel} { } # ------------------------------------------------------------------------------ -# update the menu entries for opening recent files -proc ::pd_menus::update_recentfiles_menu {} { +# update the menu entries for opening recent files (write arg should always be true except the first time when pd is opened) +proc ::pd_menus::update_recentfiles_menu {{write true}} { variable menubar switch -- $::windowingsystem { - "aqua" {::pd_menus::update_openrecent_menu_aqua .openrecent} - "win32" {update_recentfiles_on_menu $menubar.file} - "x11" {update_recentfiles_on_menu $menubar.file} + "aqua" {::pd_menus::update_openrecent_menu_aqua .openrecent $write} + "win32" {::pd_menus::update_recentfiles_on_menu $menubar.file $write} + "x11" {::pd_menus::update_recentfiles_on_menu $menubar.file $write} } } proc ::pd_menus::clear_recentfiles_menu {} { set ::recentfiles_list {} ::pd_menus::update_recentfiles_menu + # empty recentfiles in preferences (write empty array) + ::pd_guiprefs::write_recentfiles } -proc ::pd_menus::update_openrecent_menu_aqua {mymenu} { +proc ::pd_menus::update_openrecent_menu_aqua {mymenu {write}} { if {! [winfo exists $mymenu]} {menu $mymenu} $mymenu delete 0 end - $mymenu add separator - $mymenu add command -label [_ "Clear Menu"] \ - -command "::pd_menus::clear_recentfiles_menu" - # newest need to be on top, but the list in oldest first, so insert + + # now the list is last first so we just add foreach filename $::recentfiles_list { - $mymenu insert 0 command -label [file tail $filename] \ + $mymenu add command -label [file tail $filename] \ -command "open_file {$filename}" } + # clear button + $mymenu add separator + $mymenu add command -label [_ "Clear Menu"] \ + -command "::pd_menus::clear_recentfiles_menu" + # write to config file + if {$write == true} { ::pd_guiprefs::write_recentfiles } } +# ------------------------------------------------------------------------------ # this expects to be run on the File menu, and to insert above the last separator -proc ::pd_menus::update_recentfiles_on_menu {mymenu} { +proc ::pd_menus::update_recentfiles_on_menu {mymenu {write}} { set lastitem [$mymenu index end] set i 1 while {[$mymenu type [expr $lastitem-$i]] ne "separator"} {incr i} set bottom_separator [expr $lastitem-$i] incr i + while {[$mymenu type [expr $lastitem-$i]] ne "separator"} {incr i} set top_separator [expr $lastitem-$i] if {$top_separator < [expr $bottom_separator-1]} { $mymenu delete [expr $top_separator+1] [expr $bottom_separator-1] } - foreach filename $::recentfiles_list { + # insert the list from the end because we insert each element on the top + set i [llength $::recentfiles_list] + while {[incr i -1] > 0} { + + set filename [lindex $::recentfiles_list $i] $mymenu insert [expr $top_separator+1] command \ -label [file tail $filename] -command "open_file {$filename}" } -} + set filename [lindex $::recentfiles_list 0] + $mymenu insert [expr $top_separator+1] command \ + -label [file tail $filename] -command "open_file {$filename}" + # write to config file + if {$write == true} { ::pd_guiprefs::write_recentfiles } +} # ------------------------------------------------------------------------------ # lots of crazy recursion to update the Window menu @@ -481,7 +502,8 @@ proc ::pd_menus::build_file_menu_aqua {mymenu} { variable accelerator $mymenu add command -label [_ "New"] -accelerator "$accelerator+N" $mymenu add command -label [_ "Open"] -accelerator "$accelerator+O" - ::pd_menus::update_openrecent_menu_aqua .openrecent + # this is now done in main ::pd_menus::build_file_menu + #::pd_menus::update_openrecent_menu_aqua .openrecent $mymenu add cascade -label [_ "Open Recent"] -menu .openrecent $mymenu add separator $mymenu add command -label [_ "Close"] -accelerator "$accelerator+W" @@ -583,4 +605,3 @@ proc ::pd_menus::build_window_menu_win32 {mymenu} { } # the "Help" does not have cross-platform differences - diff --git a/pd/tcl/pdtk_canvas.tcl b/pd/tcl/pdtk_canvas.tcl index c1a85420..3ed8e0b6 100644 --- a/pd/tcl/pdtk_canvas.tcl +++ b/pd/tcl/pdtk_canvas.tcl @@ -127,6 +127,8 @@ proc pdtk_canvas_saveas {name initialfile initialdir} { set basename [file tail $filename] pdsend "$name savetofile [enquote_path $basename] [enquote_path $dirname]" set ::filenewdir $dirname + # add to recentfiles + ::pd_guiprefs::update_recentfiles $filename } ##### ask user Save? Discard? Cancel?, and if so, send a message on to Pd ###### @@ -180,7 +182,15 @@ proc pdtk_canvas_rightclick {tkcanvas x y b} { proc pdtk_canvas_clickpaste {tkcanvas x y b} { pdtk_canvas_mouse $tkcanvas $x $y $b 0 pdtk_canvas_mouseup $tkcanvas $x $y $b - pdtk_pastetext + if { [catch {set pdtk_pastebuffer [selection get]}] } { + # no selection... do nothing + } else { + for {set i 0} {$i < [string length $pdtk_pastebuffer]} {incr i 1} { + set cha [string index $pdtk_pastebuffer $i] + scan $cha %c keynum + pdsend "pd key 1 $keynum 0" + } + } } #------------------------------------------------------------------------------# @@ -264,13 +274,6 @@ proc ::pdtk_canvas::pdtk_canvas_editmode {mytoplevel state} { set ::editmode_button $state set ::editmode($mytoplevel) $state event generate $mytoplevel <> - # can't change the menu background color on Aqua - if {$::windowingsystem eq "aqua"} {return} - if {$state == 0} { - $::pd_menus::menubar.edit entryconfigure [_ "Edit Mode"] -background {} - } else { - $::pd_menus::menubar.edit entryconfigure [_ "Edit Mode"] -background green - } } # message from Pd to update the currently available undo/redo action diff --git a/pd/tcl/pdtk_text.tcl b/pd/tcl/pdtk_text.tcl index 5818926c..b23ae0b2 100644 --- a/pd/tcl/pdtk_text.tcl +++ b/pd/tcl/pdtk_text.tcl @@ -28,11 +28,14 @@ proc pdtk_text_set {tkcanvas tag text} { # paste into an existing text box by literally "typing" the contents of the # clipboard, i.e. send the contents one character at a time via 'pd key' proc pdtk_pastetext {args} { - catch {set pdtk_pastebuffer [clipboard get]} - for {set i 0} {$i < [string length $pdtk_pastebuffer]} {incr i 1} { - set cha [string index $pdtk_pastebuffer $i] - scan $cha %c keynum - pdsend "pd key 1 $keynum 0" + if { [catch {set pdtk_pastebuffer [clipboard get]}] } { + # no selection... do nothing + } else { + for {set i 0} {$i < [string length $pdtk_pastebuffer]} {incr i 1} { + set cha [string index $pdtk_pastebuffer $i] + scan $cha %c keynum + pdsend "pd key 1 $keynum 0" + } } } diff --git a/pd/tcl/pkgIndex.tcl b/pd/tcl/pkgIndex.tcl index 5f4921b8..0dc25e1c 100644 --- a/pd/tcl/pkgIndex.tcl +++ b/pd/tcl/pkgIndex.tcl @@ -25,6 +25,7 @@ package ifneeded dialog_path 0.1 [list source [file join $dir dialog_path.tcl]] package ifneeded dialog_startup 0.1 [list source [file join $dir dialog_startup.tcl]] package ifneeded helpbrowser 0.1 [list source [file join $dir helpbrowser.tcl]] package ifneeded opt_parser 0.1 [list source [file join $dir opt_parser.tcl]] +package ifneeded pd_guiprefs 0.1 [list source [file join $dir pd_guiprefs.tcl]] package ifneeded pdwindow 0.1 [list source [file join $dir pdwindow.tcl]] package ifneeded pd_menucommands 0.1 [list source [file join $dir pd_menucommands.tcl]] package ifneeded pd_menus 0.1 [list source [file join $dir pd_menus.tcl]] diff --git a/pd/tcl/wheredoesthisgo.tcl b/pd/tcl/wheredoesthisgo.tcl index 1e9e0344..acee40c0 100644 --- a/pd/tcl/wheredoesthisgo.tcl +++ b/pd/tcl/wheredoesthisgo.tcl @@ -6,15 +6,14 @@ package provide wheredoesthisgo 0.1 proc open_file {filename} { set directory [file normalize [file dirname $filename]] set basename [file tail $filename] - if {[regexp -nocase -- "\.(pd|pat|mxt)$" $filename]} { + if { + [file exists $filename] + && [regexp -nocase -- "\.(pd|pat|mxt)$" $filename] + } then { ::pdtk_canvas::started_loading_file [format "%s/%s" $basename $filename] pdsend "pd open [enquote_path $basename] [enquote_path $directory]" - # remove duplicates first, then the duplicate added after to the top - set index [lsearch -exact $::recentfiles_list $filename] - set ::recentfiles_list [lreplace $::recentfiles_list $index $index] - lappend ::recentfiles_list $filename - set ::recentfiles_list [lrange $::recentfiles_list 0 $::total_recentfiles] - ::pd_menus::update_recentfiles_menu + # now this is done in pd_guiprefs + ::pd_guiprefs::update_recentfiles $filename } { ::pdwindow::post [format [_ "Ignoring '%s': doesn't look like a Pd-file"] $filename] } -- cgit v1.2.1