Commit 2c0d129d authored by Ivica Bukvic's avatar Ivica Bukvic
Browse files

*added adapted backport of recent files feature

*code clean-up
*brought the rest of disabled tcl files up-to-date with the 0.45 branch for possible future merge
parent fb2c97bd
......@@ -207,8 +207,7 @@ install: all tkpath tkdnd
install $(BIN_DIR)/$(GUINAME) $(DESTDIR)$(libpdbindir)/$(GUINAME)
install $(BIN_DIR)/pd-watchdog $(DESTDIR)$(libpdbindir)/pd-watchdog
install -m644 pd.tk $(DESTDIR)$(libpdbindir)/pd.tk
install -m644 pkgIndex.tcl $(DESTDIR)$(libpdbindir)/pkgIndex.tcl
install -m644 helpbrowser.tcl $(DESTDIR)$(libpdbindir)/helpbrowser.tcl
install -m644 *.tcl $(DESTDIR)$(libpdbindir)/
install -m644 ../tkpath/library/tkpath.tcl $(DESTDIR)$(libpdbindir)/tkpath.tcl
install -m644 ../tkpath/libtkpath*so $(DESTDIR)$(libpdbindir)/
install -m644 ../tkdnd/library/tkdnd.tcl $(DESTDIR)$(libpdbindir)/tkdnd.tcl
......
......@@ -619,6 +619,12 @@ set help_top_directory $pd_guidir/doc
#==============================================================================#
# pd-gui-rewrite-0.43 help browser backport
switch -- $pd_nt {
0 { set ::windowingsystem "x11" }
1 { set ::windowingsystem "win32" }
2 { set ::windowingsystem "aqua" }
}
# 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
......@@ -626,6 +632,15 @@ package require helpbrowser
package require msgcat
package require tkpng
package require tkdnd
package require pd_guiprefs
package require pd_menus
namespace import ::pd_guiprefs::init
namespace import ::pd_guiprefs::update_recentfiles
namespace import ::pd_guiprefs::write_recentfiles
set total_recentfiles 5
::pd_guiprefs::init
# official GNU gettext msgcat shortcut
proc _ {s} {return [::msgcat::mc $s]}
......@@ -659,7 +674,7 @@ 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]
match_linux_wm [list menu .mbar.file -tearoff $pd_tearoff -postcommand [concat pdtk_fixfilemenu .mbar.file]]
.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
......@@ -1041,6 +1056,10 @@ proc pdtk_canvas_menuclose {window reply} {
}
}
proc pdtk_fixfilemenu {name} {
::pd_menus::update_recentfiles_menu $name false
}
set menu_windowlist {}
proc pdtk_fixwindowmenu {} {
......@@ -1183,6 +1202,7 @@ proc open_file {filename} {
if {[regexp -nocase -- "\.(pd|pat|mxt)$" $basename]} {
pd "pd open [pdtk_enquote $basename] [pdtk_enquote $directory] ;"
set pd_opendir $directory
::pd_guiprefs::update_recentfiles $filename 1
}
}
......@@ -1543,13 +1563,11 @@ proc menu_addstd {mbar} {
.mbar.file add command -label Open -command {menu_open} \
-accelerator [accel_munge "Ctrl+o"]
match_linux_wm [list .mbar.file add separator]
.mbar.file add command -label Close -accelerator [accel_munge "Ctrl+w"] \
-state disabled
.mbar.file add command -label Save -accelerator [accel_munge "Ctrl+s"] \
-state disabled
.mbar.file add command -label "Save as..." -accelerator [accel_munge "Ctrl+S"] \
-state disabled
match_linux_wm [list .mbar.file add separator]
match_linux_wm [list .mbar.file add separator]
if {$pd_nt != 2} {
.mbar.file add command -label "Message..." -command {menu_send} \
-accelerator [accel_munge "Ctrl+m"]
......@@ -1570,11 +1588,21 @@ if {$pd_nt != 2} {
match_linux_wm [list .mbar.file add separator]
.mbar.file add command -label "Print..." -accelerator [accel_munge "Ctrl+p"] \
-state disabled
if {$pd_nt != 2} {
# Mac OS X doesn't put Quit on the File menu
# update recent files
match_linux_wm [list .mbar.file add separator]
#if {[llength $::recentfiles_list] > 0} {
# ::pd_menus::update_recentfiles_menu .mbar.file false
#}
match_linux_wm [list .mbar.file add separator]
.mbar.file add command -label Quit -command {menu_quit} \
-accelerator [accel_munge "Ctrl+q"]
.mbar.file add command -label Close -accelerator [accel_munge "Ctrl+w"] \
-state disabled
if {$pd_nt != 2} {
# Mac OS X doesn't put Quit on the File menu
.mbar.file add command -label Quit -command {menu_quit} \
-accelerator [accel_munge "Ctrl+q"]
}
#################### the "Edit" menu for the Pd window ##############
......@@ -2765,7 +2793,7 @@ proc pdtk_canvas_new {name width height geometry editable} {
# For the main window, they are created on load, at the
# top of this file.
match_linux_wm [list menu $name.m -relief flat]
match_linux_wm [list menu $name.m.file -tearoff $pd_tearoff]
match_linux_wm [list menu $name.m.file -postcommand [concat pdtk_fixfilemenu $name.m.file] -tearoff $pd_tearoff]
$name.m add cascade -label File -menu $name.m.file
$name.m.file add command -label New -command {menu_new} \
......@@ -2779,9 +2807,6 @@ proc pdtk_canvas_new {name width height geometry editable} {
}
match_linux_wm [list $name.m.file add separator]
$name.m.file add command -label Close \
-command [concat menu_close $name] \
-accelerator [accel_munge "Ctrl+w"]
$name.m.file add command -label Save -command [concat menu_save $name] \
-accelerator [accel_munge "Ctrl+s"]
......@@ -2814,9 +2839,20 @@ proc pdtk_canvas_new {name width height geometry editable} {
$name.m.file add command -label "Print..." -command [concat menu_print $name] \
-accelerator [accel_munge "Ctrl+p"]
}
# update recent files
match_linux_wm [list $name.m.file add separator]
#match_linux_wm [list $name.m.file add separator]
#if {[llength $::recentfiles_list] > 0} {
# ::pd_menus::update_recentfiles_menu $name.m.file false
#}
match_linux_wm [list $name.m.file add separator]
$name.m.file add command -label Close \
-command [concat menu_close $name] \
-accelerator [accel_munge "Ctrl+w"]
if {$pd_nt != 2} {
# Mac OS X doesn't put Quit on the File menu
match_linux_wm [list $name.m.file add separator]
$name.m.file add command -label Quit -command {menu_quit} \
-accelerator [accel_munge "Ctrl+q"]
}
......@@ -4722,6 +4758,8 @@ proc pdtk_canvas_saveas {name initfile initdir} {
[pdtk_enquote $directory] \;]
# pd [concat $name savetofile $basename $directory \;]
set untitled_directory $directory
# add to recentfiles
::pd_guiprefs::update_recentfiles $filename 1
}
# zooming (a subset of dofont)
......
#
# 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 ::pd_guiprefs::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 ::pd_guiprefs::init_win {} {
# windows uses registry
set ::recentfiles_domain "HKEY_CURRENT_USER\\Software\\Pd-L2Ork"
set ::recentfiles_key "RecentDocs"
}
proc ::pd_guiprefs::init_x11 {} {
# linux uses ~/.config/pure-data dir
set ::recentfiles_domain "~/.config/pd-l2ork"
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 save} {
# 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 .mbar.file $save
::pd_guiprefs::write_recentfiles
}
#################################################################
# main read/write procedures
#################################################################
# ------------------------------------------------------------------------------
# get configs from a file or the registry
#
proc ::pd_guiprefs::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 ::pd_guiprefs::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 ::pd_guiprefs::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]
}
} else {
# initialize NSRecentDocuments with an empty array
exec defaults write $adomain $akey -array
set conf {}
}
return $conf
}
# ------------------------------------------------------------------------------
# win: read in the registry
#
proc ::pd_guiprefs::get_config_win {adomain {akey} {arr false}} {
package require registry
if {![catch {registry get $adomain $akey} conf]} {
return [expr {$conf}]
} else {
return {}
}
}
# ------------------------------------------------------------------------------
# linux: read a config file and return its lines splitted.
#
proc ::pd_guiprefs::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 ::pd_guiprefs::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]} {
::pdwindow::error "write_config_aqua $akey: $errorMsg"
}
if {$arr} {
foreach filepath $data {
set escaped [escape_for_plist $filepath]
exec defaults write $adomain $akey -array-add "$escaped"
}
} else {
set escaped [escape_for_plist $data]
exec defaults write $adomain $akey '$escaped'
}
}
# ------------------------------------------------------------------------------
# win: write configs to registry
# if $arr is true, we write an array
#
proc ::pd_guiprefs::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]} {
::pdwindow::error "write_config_win $data $akey: $errorMsg"
}
} else {
if {[catch {registry set $adomain $akey $data sz} errorMsg]} {
::pdwindow::error "write_config_win $data $akey: $errorMsg"
}
}
}
# ------------------------------------------------------------------------------
# linux: write configs to USER_APP_CONFIG_DIR
#
proc ::pd_guiprefs::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]} {
::pdwindow::error "write_config_x11 $data $akey: $errorMsg"
} else {
puts -nonewline $fl $data
close $fl
}
}
#################################################################
# utils
#################################################################
# ------------------------------------------------------------------------------
# linux only! : look for pd config directory and create it if needed
#
proc ::pd_guiprefs::prepare_configdir {} {
if {[file isdirectory $::recentfiles_domain] != 1} {
file mkdir $::recentfiles_domain
::pdwindow::debug "$::recentfiles_domain was created.\n"
}
}
# ------------------------------------------------------------------------------
# osx: handles arrays in plist files (thanks hc)
#
proc ::pd_guiprefs::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
regsub -line -- {^'(.*)'$} $filelist {\1} filelist
foreach file $filelist {
set filename [regsub -- {,$} $file {}]
lappend result $filename
}
return $result
}
# the Mac OS X 'defaults' command uses single quotes to quote things,
# so they need to be escaped
proc ::pd_guiprefs::escape_for_plist {str} {
return [regsub -all -- {'} $str {\\'}]
}
This diff is collapsed.
# Copyright (c) 1997-2009 Miller Puckette.
#(c) 2008 WordTech Communications LLC. License: standard Tcl license, http://www.tcl.tk/software/tcltk/license.html
package provide pd_menus 0.1
#package require pd_menucommands
# TODO figure out Undo/Redo/Cut/Copy/Paste state changes for menus
# since there is one menubar that is used for all windows, the menu -commands
# use {} quotes so that $::focused_window is interpreted when the menu item
# is called, not when the command is mapped to the menu item. This is the
# opposite of the 'bind' commands in pd_bindings.tcl
namespace eval ::pd_menus:: {
variable accelerator
#variable menubar ".mbar"
namespace export create_menubar
namespace export configure_for_pdwindow
namespace export configure_for_canvas
namespace export configure_for_dialog
# turn off tearoff menus globally
option add *tearOff 0
}
# ------------------------------------------------------------------------------
# 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 {menu {write true}} {
#variable menubar
switch -- $::windowingsystem {
"aqua" {::pd_menus::update_openrecent_menu_aqua $menu $write}
"win32" {::pd_menus::update_recentfiles_on_menu $menu $write}
"x11" {::pd_menus::update_recentfiles_on_menu $menu $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 {write}} {
if {! [winfo exists $mymenu]} {menu $mymenu}
$mymenu delete 0 end
# now the list is last first so we just add
foreach filename $::recentfiles_list {
$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 {write}} {
set lastitem [$mymenu index end]
set i 0
while {[$mymenu entrycget [expr $lastitem-$i] -label] ne ""} {incr i}
set bottom_separator [expr $lastitem-$i]
incr i
while {[$mymenu entrycget [expr $lastitem-$i] -label] ne ""} {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]
}
# 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 }
}
\ No newline at end of file
......@@ -2,6 +2,8 @@
#
package ifneeded helpbrowser 0.1 [list source [file join $dir helpbrowser.tcl]]
package ifneeded pd_guiprefs 0.1 [list source [file join $dir pd_guiprefs.tcl]]
package ifneeded pd_menus 0.1 [list source [file join $dir pd_menus_SHORT.tcl]]
namespace eval ::tkpath {
proc load_package {dir} {
......
......@@ -3,17 +3,8 @@
# other configuration, like when 'pd' launches Wish.app or when 'pd' is using
# an X11 wish on Mac OS X. GNU/Linux and Windows will never use this file.
puts --------------------------AppMain.tcl-----------------------------------
catch {console show}
package require apple_events
puts "AppMain.tcl"
puts "argv0: $argv0"
puts "executable: [info nameofexecutable]"
puts "argc: $argc argv: $argv"
# TODO is there anything useful to do with the psn (Process Serial Number)?
if {[string first "-psn" [lindex $argv 0]] == 0} {
set argv [lrange $argv 1 end]
......
AUTOMAKE_OPTIONS = foreign
SUFFIXES = .tcl
# we want these in the dist tarball
#EXTRA_DIST = CHANGELOG.txt notes.txt makefile.mingw
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 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 pdtk_textwindow.tcl scrollbox.tcl pd_guiprefs.tcl pd.ico
etags: TAGS
etags --append --language=none --regex="/proc[ \t]+\([^ \t]+\)/\1/" *.tcl
package provide apple_events 0.1
package require pdwindow
package require wheredoesthisgo
# from http://wiki.tcl.tk/12987
set ::tk::mac::CGAntialiasLimit 0 ;# min line thickness to anti-alias (default: 3)
set ::tk::mac::antialiasedtext 1 ;# enable/disable anti-aliased text
set ::tk::mac::antialiasedtext 1 ;# enable anti-aliased text
# kAEOpenDocuments
proc ::tk::mac::OpenDocument {args} {
foreach filename $args {
puts "open_file $filename"
open_file $filename
foreach filename $args {
if {$::done_init} {
open_file $filename
} else {
lappend ::filestoopen_list $filename
}
}
set ::pd_menucommands::menu_open_dir [file dirname $filename]
}
# kEventAppHidden
proc ::tk::mac::OnHide {} {
# TODO
proc ::tk::mac::OnHide {args} {
::pdwindow::verbose 1 "::tk::mac::OnHide $args +++++++++++++++++++++"
}
# kEventAppShown
proc ::tk::mac::OnShow {} {
# TODO
proc ::tk::mac::OnShow {args} {
::pdwindow::verbose 1 "::tk::mac::OnShow $args +++++++++++++++++++++"
}
# open About Pd... in Tk/Cocoa
proc tkAboutDialog {} {
menu_aboutpd
}
# kAEShowPreferences
proc ::tk::mac::ShowPreferences {} {
menu_preferences_dialog
proc ::tk::mac::ShowPreferences {args} {
::pdwindow::verbose 1 "::tk::mac::ShowPreferences $args ++++++++++++"
pdsend "pd start-path-dialog"
}
# kAEQuitApplication
#proc ::tk::mac::Quit {} {
# # TODO sort this out... how to quit pd-gui after sending the message
# puts stderr "Custom exit proc"
# pdsend "pd verifyquit"
proc ::tk::mac::Quit {args} {
pdsend "pd verifyquit"
}
# on Tk/Cocoa, override the Apple Help menu
#proc tk::mac::ShowHelp {args} {
#}
# these I gleaned by reading the source (tkMacOSXHLEvents.c)
proc ::tk::mac::PrintDocument {args} {
# TODO what's $mytoplevel here?. I am guessing args would be the same as
# ::tk::mac::OpenDocument
#menu_print $mytoplevel
menu_print $::focused_window
}
proc ::tk::mac::OpenApplication {} {
proc ::tk::mac::OpenApplication {args} {
::pdwindow::verbose 1 "::tk::mac::OpenApplication $args ++++++++++++"
}
proc ::tk::mac::ReopenApplication {} {
proc ::tk::mac::ReopenApplication {args} {
::pdwindow::verbose 1 "::tk::mac::ReopenApplication $args ++++++++++"
}
......@@ -239,7 +239,6 @@ proc ::dialog_array::ok {mytoplevel} {
}
proc ::dialog_array::pdtk_array_dialog {mytoplevel name size flags newone} {
puts "::dialog_array::pdtk_array_dialog {$mytoplevel $name $size $flags $newone}"
if {[winfo exists $mytoplevel]} {
wm deiconify $mytoplevel
raise $mytoplevel
......@@ -262,7 +261,11 @@ puts "::dialog_array::pdtk_array_dialog {$mytoplevel $name $size $flags $newone}
proc ::dialog_array::create_dialog {mytoplevel newone} {
toplevel $mytoplevel -class DialogWindow
wm title $mytoplevel [_ "Array Properties"]
if {$::windowingsystem eq "aqua"} {$mytoplevel configure -menu .menubar}
wm group $mytoplevel .
wm resizable $mytoplevel 0 0
wm transient $mytoplevel $::focused_window