From 282671282b20fa17ab9dbbaba9d1cf2246b5029d Mon Sep 17 00:00:00 2001 From: Miller Puckette Date: Mon, 17 Aug 2009 23:31:36 +0000 Subject: merge in new tcl implementation by Steiner & Chun svn path=/trunk/; revision=11934 --- pd/doc/1.manual/x1.htm | 2 +- pd/doc/1.manual/x2.htm | 2 +- pd/doc/1.manual/x5.htm | 27 +- pd/doc/4.data.structures/07.sequencer.pd | 18 +- pd/doc/6.externs/makefile | 2 +- pd/doc/7.stuff/tools/testtone.pd | 2 +- pd/extra/expr~/makefile | 2 +- pd/extra/pd~/makefile | 2 +- pd/extra/sigmund~/sigmund~.c | 21 +- pd/src/configure.in | 4 +- pd/src/g_all_guis.c | 2 +- pd/src/g_bang.c | 2 +- pd/src/g_editor.c | 16 +- pd/src/g_graph.c | 2 +- pd/src/g_hdial.c | 2 +- pd/src/g_hslider.c | 2 +- pd/src/g_mycanvas.c | 2 +- pd/src/g_numbox.c | 2 +- pd/src/g_rtext.c | 2 +- pd/src/g_text.c | 2 +- pd/src/g_toggle.c | 2 +- pd/src/g_vdial.c | 2 +- pd/src/g_vslider.c | 2 +- pd/src/g_vumeter.c | 2 +- pd/src/m_binbuf.c | 2 +- pd/src/m_class.c | 2 +- pd/src/m_sched.c | 2 +- pd/src/makefile.in | 24 +- pd/src/makefile.nt | 11 +- pd/src/notes.txt | 4 - pd/src/s_audio.c | 2 +- pd/src/s_audio_jack.c | 2 +- pd/src/s_file.c | 2 +- pd/src/s_inter.c | 126 +- pd/src/s_loader.c | 11 +- pd/src/s_main.c | 38 +- pd/src/s_midi.c | 2 +- pd/src/s_midi_alsa.c | 2 +- pd/src/s_midi_oss.c | 2 +- pd/src/s_midi_pm.c | 2 +- pd/src/s_path.c | 4 +- pd/src/t_main.c | 115 - pd/src/t_tk.h | 10 - pd/src/t_tkcmd.c | 669 ----- pd/src/u_main.tk | 4489 ------------------------------ pd/src/x_gui.c | 2 +- pd/src/x_misc.c | 8 +- pd/src/x_qlist.c | 2 +- pd/tcl/AppMain.tcl | 27 + pd/tcl/apple_events.tcl | 53 + pd/tcl/dialog_find.tcl | 94 + pd/tcl/dialog_font.tcl | 107 + pd/tcl/dialog_gatom.tcl | 211 ++ pd/tcl/dialog_iemgui.tcl | 780 ++++++ pd/tcl/pd.tcl | 315 +++ pd/tcl/pd_bindings.tcl | 201 ++ pd/tcl/pd_connect.tcl | 90 + pd/tcl/pd_menucommands.tcl | 167 ++ pd/tcl/pd_menus.tcl | 355 +++ pd/tcl/pdtk_array.tcl | 346 +++ pd/tcl/pdtk_canvas.tcl | 152 + pd/tcl/pdtk_text.tcl | 20 + pd/tcl/pkgIndex.tcl | 23 + pd/tcl/pkg_mkIndex.tcl | 9 + pd/tcl/wheredoesthisgo.tcl | 1054 +++++++ 65 files changed, 4181 insertions(+), 5480 deletions(-) delete mode 100644 pd/src/t_main.c delete mode 100644 pd/src/t_tk.h delete mode 100644 pd/src/t_tkcmd.c delete mode 100644 pd/src/u_main.tk create mode 100644 pd/tcl/AppMain.tcl create mode 100644 pd/tcl/apple_events.tcl create mode 100644 pd/tcl/dialog_find.tcl create mode 100644 pd/tcl/dialog_font.tcl create mode 100644 pd/tcl/dialog_gatom.tcl create mode 100644 pd/tcl/dialog_iemgui.tcl create mode 100644 pd/tcl/pd.tcl create mode 100644 pd/tcl/pd_bindings.tcl create mode 100644 pd/tcl/pd_connect.tcl create mode 100644 pd/tcl/pd_menucommands.tcl create mode 100644 pd/tcl/pd_menus.tcl create mode 100644 pd/tcl/pdtk_array.tcl create mode 100644 pd/tcl/pdtk_canvas.tcl create mode 100644 pd/tcl/pdtk_text.tcl create mode 100644 pd/tcl/pkgIndex.tcl create mode 100755 pd/tcl/pkg_mkIndex.tcl create mode 100644 pd/tcl/wheredoesthisgo.tcl (limited to 'pd') diff --git a/pd/doc/1.manual/x1.htm b/pd/doc/1.manual/x1.htm index f1f884d1..00fa7da1 100644 --- a/pd/doc/1.manual/x1.htm +++ b/pd/doc/1.manual/x1.htm @@ -73,7 +73,7 @@ To get started writing your own C extensions, refer to chapter 4 of this manual.

There is a new Pd community web site, pure-data.info, which aims to be the central resource for Pd, from documentation and -downloads; to forums, member pages, a patch exchange. +downloads; to forums, member pages, and a patch exchange.

There is a growing number of Pd-related projects hosted at SourceForge. This is open to all Pd diff --git a/pd/doc/1.manual/x2.htm b/pd/doc/1.manual/x2.htm index 9879078e..05b4d84b 100644 --- a/pd/doc/1.manual/x2.htm +++ b/pd/doc/1.manual/x2.htm @@ -110,7 +110,7 @@ In this case the object will be the kind that carries out addition, and the "13" initializes the amount to add.

Atoms are either numbers or -symbols like "+". Anything that is not a valid number os considered a +symbols like "+". Anything that is not a valid number is considered a symbol. Valid numbers may or may not have a decimal point (for instance, 12, 15.6, -.456), or may be written in exponential notation (such as "4.5e6", which means "4.5 multiplied diff --git a/pd/doc/1.manual/x5.htm b/pd/doc/1.manual/x5.htm index 671d967d..c07d48dd 100644 --- a/pd/doc/1.manual/x5.htm +++ b/pd/doc/1.manual/x5.htm @@ -20,7 +20,32 @@

5.1. release notes

-

------------------ 0.42.1 --------------------------- +

------------------ 0.42-5 --------------------------- + +

broken abs~ and log~ fixed + +

pd~ -ninsig 0 hang fixed + +

testtone updated and 16ch version added + +

lrshift~ bug fix + +

32 channel limit removed for portaudio (ASIO/Windows and Mac) + +

------------------ 0.42-4 --------------------------- + +

added -noautopatch startup argument to defeat auto-connecting to +new objects (some folks like it and others hate it) + +

gfxstub bug fix + +

fixed crash on deleting "s" objects with no args + +

re-fixed seteuid(0 problem + +

fixed crash on "find $1" (still not useful though) + +

------------------ 0.42.1-3 ---------------------------

Bug fix on Windows(cancelling window close deactivated window). diff --git a/pd/doc/4.data.structures/07.sequencer.pd b/pd/doc/4.data.structures/07.sequencer.pd index 7bf97b39..eb323520 100644 --- a/pd/doc/4.data.structures/07.sequencer.pd +++ b/pd/doc/4.data.structures/07.sequencer.pd @@ -85,25 +85,25 @@ array pitch template-pitch array amp template-amp; #X floatatom 269 464 0 0 0 0 - - -; #X msg 55 484 start; #X msg 106 484 stop; -#N canvas 137 388 559 411 data 0; -#X scalar template-toplevel 3 86 900 \; 0 0 12 \; 10 0 12 \; \; 0 0 -0 \; 10 0 2.5 \; 11 0 0 \; \;; -#X scalar template-toplevel 14 80 990 \; 0 0 12 \; 10 0 12 \; \; 0 +#N canvas 258 114 425 363 data 1; +#X scalar template-toplevel 22 86 900 \; 0 0 12 \; 10 0 12 \; \; 0 +0 0 \; 10 0 2.5 \; 11 0 0 \; \;; +#X scalar template-toplevel 33 80 990 \; 0 0 12 \; 10 0 12 \; \; 0 0 2.5 \; 10 0 2.5 \; 11 0 0 \; \;; -#X scalar template-toplevel 38 43.25 90 \; 0 65 12 \; 100 10 0 \; 100 +#X scalar template-toplevel 57 43.25 90 \; 0 65 12 \; 100 10 0 \; 100 10 12 \; 230 50 0 \; 230 10 3 \; 240 60 0 \; 240 25 10 \; 250 60 0 \; 250 37 10 \; 260 65 0.5 \; 285 65 0.5 \; \; 1 0 2 \; 103 0 1 \; 195 0 2 \; 220 0 0.75 \; 225 0 1.25 \; 248 0 2.5 \; 251 0 2.25 \; 255 0 0 \; 256 0 1.5 \; 260 0 0 \; 261 0 2 \; 265 0 0 \; 266 0 2.5 \; 270 0 0 \; 271 0 3 \; 275 0 0 \; \;; -#X scalar template-toplevel 64 80 900 \; 0 5 0.25 \; 60 5 0.25 \; \; +#X scalar template-toplevel 83 80 900 \; 0 5 0.25 \; 60 5 0.25 \; \; 0 0 0 \; 28 -0.25 3.5 \; 58 -0.25 0 \; \;; -#X scalar template-toplevel 142 105 900 \; 0 0 12 \; 70 -20 12 \; \; +#X scalar template-toplevel 161 105 900 \; 0 0 12 \; 70 -20 12 \; \; 0 0 0 \; 10 0 2.5 \; 20 0 0 \; 30 0 0 \; 40 0 2.5 \; 50 0 0 \; 60 0 2.5 \; 70 0 0 \; \;; -#X scalar template-toplevel 319 63.5 909 \; 0 0 12 \; 50 0 12 \; \; +#X scalar template-toplevel 338 63.5 909 \; 0 0 12 \; 50 0 12 \; \; 0 0 4 \; 10 0 2.5 \; 50 0 0 \; \;; -#X coords 0 102.75 1 102.5 0 0 0; +#X coords 0 90.75 1 90.5 0 0 0; #X restore 55 364 pd data; #N canvas 82 467 332 145 stuff 0; #X msg 1 101 \; pd-data write xx.txt; diff --git a/pd/doc/6.externs/makefile b/pd/doc/6.externs/makefile index 8a5657fe..5f78fb1d 100644 --- a/pd/doc/6.externs/makefile +++ b/pd/doc/6.externs/makefile @@ -61,7 +61,7 @@ LINUXINCLUDE = -I../../src .c.pd_linux: cc $(LINUXCFLAGS) $(LINUXINCLUDE) -o $*.o -c $*.c - ld -export_dynamic -shared -o $*.pd_linux $*.o -lc -lm + ld -shared -o $*.pd_linux $*.o -lc -lm strip --strip-unneeded $*.pd_linux rm $*.o diff --git a/pd/doc/7.stuff/tools/testtone.pd b/pd/doc/7.stuff/tools/testtone.pd index 072ee6d8..45d60e24 100644 --- a/pd/doc/7.stuff/tools/testtone.pd +++ b/pd/doc/7.stuff/tools/testtone.pd @@ -1,4 +1,4 @@ -#N canvas 283 503 494 364 12; +#N canvas 337 61 494 364 12; #X floatatom 72 273 3 0 0 0 - - -; #X obj 27 221 notein; #X obj 27 247 stripnote; diff --git a/pd/extra/expr~/makefile b/pd/extra/expr~/makefile index 2d74ba36..4c648140 100644 --- a/pd/extra/expr~/makefile +++ b/pd/extra/expr~/makefile @@ -88,7 +88,7 @@ LINUXINCLUDE = -I../../src $(CC) -g $(LINUXCFLAGS) $(LINUXINCLUDE) -o $*.pd_linux_o -c $*.c expr.pd_linux: $(LINUXOBJ) - $(CC) -export_dynamic -shared -o expr.pd_linux $(LINUXOBJ) -lc -lm + $(CC) -shared -o expr.pd_linux $(LINUXOBJ) -lc -lm strip --strip-unneeded expr.pd_linux expr~.pd_linux: expr.pd_linux diff --git a/pd/extra/pd~/makefile b/pd/extra/pd~/makefile index 492c20c2..d069c73d 100644 --- a/pd/extra/pd~/makefile +++ b/pd/extra/pd~/makefile @@ -10,6 +10,6 @@ d_ppc: pdsched.d_ppc pdsched.pd_linux: pdsched.c $(CC) $(LINUXCFLAGS) $(LINUXINCLUDE) -o $*.o -c $*.c - $(CC) -export_dynamic -shared -o $*.pd_linux $*.o -lc -lm + $(CC) -shared -o $*.pd_linux $*.o -lc -lm strip --strip-unneeded $*.pd_linux rm -f $*.o diff --git a/pd/extra/sigmund~/sigmund~.c b/pd/extra/sigmund~/sigmund~.c index 0f8b9283..d5211ac6 100644 --- a/pd/extra/sigmund~/sigmund~.c +++ b/pd/extra/sigmund~/sigmund~.c @@ -235,7 +235,7 @@ static void sigmund_getrawpeaks(int npts, float *insamps, float param1, float param2, float param3, float hifreq) { float oneovern = 1.0/ (float)npts; - float fperbin = 0.5 * srate * oneovern; + float fperbin = 0.5 * srate * oneovern, totalpower = 0; int npts2 = 2*npts, i, bin; int peakcount = 0; float *fp1, *fp2; @@ -272,16 +272,18 @@ static void sigmund_getrawpeaks(int npts, float *insamps, rawimag[-3] = -rawimag[3]; rawimag[-4] = -rawimag[4]; #if 1 - for (i = 0, fp1 = rawreal, fp2 = rawimag; i < npts-1; i++, fp1++, fp2++) + for (i = 0, fp1 = rawreal, fp2 = rawimag; i < maxbin; i++, fp1++, fp2++) { - float x1 = fp1[1] - fp1[-1], x2 = fp2[1] - fp2[-1]; - powbuf[i] = x1*x1+x2*x2; + float x1 = fp1[1] - fp1[-1], x2 = fp2[1] - fp2[-1], p = powbuf[i] = x1*x1+x2*x2; + if (i >= 2) + totalpower += p; } - powbuf[npts-1] = 0; + powbuf[maxbin] = powbuf[maxbin+1] = 0; + *power = 0.5 * totalpower *oneovern * oneovern; #endif for (peakcount = 0; peakcount < npeak; peakcount++) { - float pow1, maxpower = 0, totalpower = 0, windreal, windimag, windpower, + float pow1, maxpower = 0, windreal, windimag, windpower, detune, pidetune, sinpidetune, cospidetune, ampcorrect, ampout, ampoutreal, ampoutimag, freqout, powmask; int bestindex = -1; @@ -296,14 +298,12 @@ static void sigmund_getrawpeaks(int npts, float *insamps, if (pow1 > thresh) maxpower = pow1, bestindex = bin; } - totalpower += pow1; } if (totalpower <= 0 || maxpower < 1e-10*totalpower || bestindex < 0) break; fp1 = rawreal+bestindex; fp2 = rawimag+bestindex; - *power = 0.5 * totalpower *oneovern * oneovern; powmask = maxpower * exp(-param1 * log(10.) / 10.); /* if (loud > 2) post("maxpower %f, powmask %f, param1 %f", @@ -1054,6 +1054,7 @@ static void sigmund_print(t_sigmund *x) post("stabletime %g", x->x_stabletime); post("growth %g", x->x_growth); post("minpower %g", x->x_minpower); + x->x_loud = 1; } static void sigmund_free(t_sigmund *x) @@ -1394,7 +1395,7 @@ void sigmund_tilde_setup(void) gensym("print"), 0); class_addmethod(sigmund_class, (t_method)sigmund_printnext, gensym("printnext"), A_FLOAT, 0); - post("sigmund~ version 0.05"); + post("sigmund~ version 0.06"); } #endif /* PD */ @@ -1641,7 +1642,7 @@ int main() class_register(CLASS_BOX, c); sigmund_class = c; - post("sigmund~ v0.05"); + post("sigmund~ v0.06"); return (0); } diff --git a/pd/src/configure.in b/pd/src/configure.in index bc5d5f7b..dfc1b862 100644 --- a/pd/src/configure.in +++ b/pd/src/configure.in @@ -195,7 +195,7 @@ dnl This should be fixed so Pd can use ALSA shared libraries where appropriate. LDFLAGS="$LDFLAGS -static" fi EXT=pd_linux - CPPFLAGS="-DDL_OPEN -DPA_USE_OSS -DUNIX -DUNISTD\ + CPPFLAGS="-DHAVE_LIBDL -DPA_USE_OSS -DUNIX -DHAVE_UNISTD_H\ -DUSEAPI_OSS \ -fno-strict-aliasing" SYSSRC="s_midi_oss.c s_audio_oss.c" @@ -273,7 +273,7 @@ then -framework AudioUnit -framework AudioToolbox \ -framework Carbon -framework CoreMIDI" EXT=pd_darwin - CPPFLAGS="-DDL_OPEN -DMACOSX -DUNISTD -I/usr/X11R6/include \ + CPPFLAGS="-DHAVE_LIBDL -DMACOSX -DHAVE_UNISTD_H -I/usr/X11R6/include \ -I../portaudio/include -I../portaudio/src/common \ -I../portaudio/src/os/mac_osx/ \ -I../portmidi/pm_common -I../portmidi/pm_mac \ diff --git a/pd/src/g_all_guis.c b/pd/src/g_all_guis.c index 6f196e34..f9314995 100644 --- a/pd/src/g_all_guis.c +++ b/pd/src/g_all_guis.c @@ -12,7 +12,7 @@ #include #include "m_pd.h" #include "g_canvas.h" -#include "t_tk.h" + #include "g_all_guis.h" #include diff --git a/pd/src/g_bang.c b/pd/src/g_bang.c index 1e5d6604..8606b0ac 100644 --- a/pd/src/g_bang.c +++ b/pd/src/g_bang.c @@ -12,7 +12,7 @@ #include #include "m_pd.h" #include "g_canvas.h" -#include "t_tk.h" + #include "g_all_guis.h" #include diff --git a/pd/src/g_editor.c b/pd/src/g_editor.c index 0fbce41a..7ef5266a 100644 --- a/pd/src/g_editor.c +++ b/pd/src/g_editor.c @@ -1421,7 +1421,7 @@ void canvas_doclick(t_canvas *x, int xpos, int ypos, int which, } } -void canvas_mousedown(t_canvas *x, t_floatarg xpos, t_floatarg ypos, +void canvas_mouse(t_canvas *x, t_floatarg xpos, t_floatarg ypos, t_floatarg which, t_floatarg mod) { canvas_doclick(x, xpos, ypos, which, mod, 1); @@ -2454,9 +2454,9 @@ bad: (sink? class_getname(pd_class(&sink->g_pd)) : "???")); } -#define XTOLERANCE 4 -#define YTOLERANCE 3 -#define NHIST 15 +#define XTOLERANCE 18 +#define YTOLERANCE 17 +#define NHIST 35 /* LATER might have to speed this up */ static void canvas_tidy(t_canvas *x) @@ -2514,10 +2514,10 @@ static void canvas_tidy(t_canvas *x) } } } - for (i = 1, besthist = 0, bestdist = 4, ip = histogram + 1; - i < (NHIST-1); i++, ip++) + for (i = 2, besthist = 0, bestdist = 4, ip = histogram + 2; + i < (NHIST-2); i++, ip++) { - int hit = ip[-1] + 2 * ip[0] + ip[1]; + int hit = ip[-2] + 2 * ip[-1] + 3 * ip[0] + 2* ip[1] + ip[2]; if (hit > besthist) { besthist = hit; @@ -2665,7 +2665,7 @@ static void glist_setlastxy(t_glist *gl, int xval, int yval) void g_editor_setup(void) { /* ------------------------ events ---------------------------------- */ - class_addmethod(canvas_class, (t_method)canvas_mousedown, gensym("mouse"), + class_addmethod(canvas_class, (t_method)canvas_mouse, gensym("mouse"), A_FLOAT, A_FLOAT, A_FLOAT, A_FLOAT, A_NULL); class_addmethod(canvas_class, (t_method)canvas_mouseup, gensym("mouseup"), A_FLOAT, A_FLOAT, A_FLOAT, A_NULL); diff --git a/pd/src/g_graph.c b/pd/src/g_graph.c index cfda6c2c..b4112ddd 100644 --- a/pd/src/g_graph.c +++ b/pd/src/g_graph.c @@ -8,7 +8,7 @@ to this file... */ #include #include "m_pd.h" -#include "t_tk.h" + #include "g_canvas.h" #include "s_stuff.h" /* for sys_hostfontsize */ #include diff --git a/pd/src/g_hdial.c b/pd/src/g_hdial.c index ace2ce66..19d21e84 100644 --- a/pd/src/g_hdial.c +++ b/pd/src/g_hdial.c @@ -14,7 +14,7 @@ put out a "float" as in sliders, toggles, etc. */ #include #include "m_pd.h" #include "g_canvas.h" -#include "t_tk.h" + #include "g_all_guis.h" #include diff --git a/pd/src/g_hslider.c b/pd/src/g_hslider.c index 8dc3d0e6..143a8988 100644 --- a/pd/src/g_hslider.c +++ b/pd/src/g_hslider.c @@ -12,7 +12,7 @@ #include #include "m_pd.h" #include "g_canvas.h" -#include "t_tk.h" + #include "g_all_guis.h" #include diff --git a/pd/src/g_mycanvas.c b/pd/src/g_mycanvas.c index 1040c11f..f673f8ed 100644 --- a/pd/src/g_mycanvas.c +++ b/pd/src/g_mycanvas.c @@ -12,7 +12,7 @@ #include #include "m_pd.h" #include "g_canvas.h" -#include "t_tk.h" + #include "g_all_guis.h" #include diff --git a/pd/src/g_numbox.c b/pd/src/g_numbox.c index db25e918..75f6bbbf 100644 --- a/pd/src/g_numbox.c +++ b/pd/src/g_numbox.c @@ -10,7 +10,7 @@ #include #include "m_pd.h" #include "g_canvas.h" -#include "t_tk.h" + #include "g_all_guis.h" #include diff --git a/pd/src/g_rtext.c b/pd/src/g_rtext.c index 63a7485b..976901e9 100644 --- a/pd/src/g_rtext.c +++ b/pd/src/g_rtext.c @@ -13,7 +13,7 @@ #include "m_pd.h" #include "s_stuff.h" #include "g_canvas.h" -#include "t_tk.h" + #define LMARGIN 2 #define RMARGIN 2 diff --git a/pd/src/g_text.c b/pd/src/g_text.c index f927bf38..cff52274 100644 --- a/pd/src/g_text.c +++ b/pd/src/g_text.c @@ -10,7 +10,7 @@ #include "m_pd.h" #include "m_imp.h" #include "s_stuff.h" -#include "t_tk.h" + #include "g_canvas.h" #include #include diff --git a/pd/src/g_toggle.c b/pd/src/g_toggle.c index 830e99cb..344e1522 100644 --- a/pd/src/g_toggle.c +++ b/pd/src/g_toggle.c @@ -12,7 +12,7 @@ #include #include "m_pd.h" #include "g_canvas.h" -#include "t_tk.h" + #include "g_all_guis.h" #include diff --git a/pd/src/g_vdial.c b/pd/src/g_vdial.c index 9f7732f5..f5364750 100644 --- a/pd/src/g_vdial.c +++ b/pd/src/g_vdial.c @@ -13,7 +13,7 @@ put out a "float" as in sliders, toggles, etc. */ #include #include "m_pd.h" #include "g_canvas.h" -#include "t_tk.h" + #include "g_all_guis.h" #include diff --git a/pd/src/g_vslider.c b/pd/src/g_vslider.c index 87309029..6b547f84 100644 --- a/pd/src/g_vslider.c +++ b/pd/src/g_vslider.c @@ -12,7 +12,7 @@ #include #include "m_pd.h" #include "g_canvas.h" -#include "t_tk.h" + #include "g_all_guis.h" #include diff --git a/pd/src/g_vumeter.c b/pd/src/g_vumeter.c index f0ec30aa..75047e8d 100644 --- a/pd/src/g_vumeter.c +++ b/pd/src/g_vumeter.c @@ -12,7 +12,7 @@ #include #include "m_pd.h" #include "g_canvas.h" -#include "t_tk.h" + #include "g_all_guis.h" #include diff --git a/pd/src/m_binbuf.c b/pd/src/m_binbuf.c index 05ef1888..360512d0 100644 --- a/pd/src/m_binbuf.c +++ b/pd/src/m_binbuf.c @@ -7,7 +7,7 @@ #include "m_pd.h" #include "s_stuff.h" #include -#ifdef UNISTD +#ifdef HAVE_UNISTD_H #include #endif #ifdef MSW diff --git a/pd/src/m_class.c b/pd/src/m_class.c index cd4fbb1c..93d9c71b 100644 --- a/pd/src/m_class.c +++ b/pd/src/m_class.c @@ -7,7 +7,7 @@ #include "m_imp.h" #include "s_stuff.h" #include -#ifdef UNISTD +#ifdef HAVE_UNISTD_H #include #endif #ifdef MSW diff --git a/pd/src/m_sched.c b/pd/src/m_sched.c index 411d1963..ae9f3664 100644 --- a/pd/src/m_sched.c +++ b/pd/src/m_sched.c @@ -45,7 +45,7 @@ struct _clock t_clock *clock_setlist; -#ifdef UNISTD +#ifdef HAVE_UNISTD_H #include #endif diff --git a/pd/src/makefile.in b/pd/src/makefile.in index cba0f7a8..7713be99 100644 --- a/pd/src/makefile.in +++ b/pd/src/makefile.in @@ -59,10 +59,6 @@ SRC = g_canvas.c g_graph.c g_text.c g_rtext.c g_array.c g_template.c g_io.c \ OBJ = $(SRC:.c=.o) -GSRC = @GUISRC@ - -GOBJ = $(GSRC:.c=.o) - # get version from m_pd.h to use in doc/1.manual/1.introduction.txt PD_MAJOR_VERSION := $(shell grep PD_MAJOR_VERSION m_pd.h | \ sed 's|^.define *PD_MAJOR_VERSION *\([0-9]*\).*|\1|' ) @@ -84,10 +80,10 @@ endif .PHONY: pd gui externs all all: pd $(BIN_DIR)/pd-watchdog gui $(BIN_DIR)/pdsend \ - $(BIN_DIR)/pdreceive $(BIN_DIR)/pd.tk externs + $(BIN_DIR)/pdreceive externs bin: pd $(BIN_DIR)/pd-watchdog gui $(BIN_DIR)/pdsend \ - $(BIN_DIR)/pdreceive $(BIN_DIR)/pd.tk + $(BIN_DIR)/pdreceive $(OBJ) : %.o : %.c $(CC) $(CFLAGS) $(GFLAGS) $(INCLUDE) -c -o $(OBJ_DIR)/$*.o $*.c @@ -100,12 +96,6 @@ $(ASIOOBJ): %.o : %.cpp pd: $(PDEXEC) -ifneq ($(GSRC),) -gui: $(BIN_DIR)/$(GUINAME) -else -gui: -endif - pd-watchdog: $(BIN_DIR)/pd-watchdog $(BIN_DIR): @@ -123,13 +113,6 @@ $(BIN_DIR)/pdreceive: u_pdreceive.c $(BIN_DIR) $(PDEXEC): $(OBJ) $(BIN_DIR) cd ../obj; $(CC) $(LDFLAGS) $(DBG_CFLAGS) -o $(PDEXEC) $(OBJ) $(LIB) -$(BIN_DIR)/pd-gui: $(GOBJ) $(GSRC) - cd ../obj; $(CC) $(INCLUDE) -o $(BIN_DIR)/$(GUINAME) $(GOBJ) $(GLIB) - -$(BIN_DIR)/pd.tk: u_main.tk $(BIN_DIR) - cp u_main.tk $(BIN_DIR)/pd.tk - touch -r makefile.dependencies $(BIN_DIR) - #this is for Max OSX only... $(BIN_DIR)/libPdTcl.dylib: $(GOBJ) $(GSRC) cd ../obj && $(CC) $(CFLAGS) -dynamiclib -read_only_relocs warning \ @@ -203,7 +186,8 @@ install: all local-clean: -rm -f ../obj/* $(BIN_DIR)/pd $(BIN_DIR)/$(GUINAME) $(BIN_DIR)/pdsend \ - $(BIN_DIR)/pdreceive $(BIN_DIR)/pd-watchdog m_stamp.c + $(BIN_DIR)/pdreceive $(BIN_DIR)/pd-watchdog m_stamp.c \ + $(BIN_DIR)/*.tcl -rm -f `find ../portaudio -name "*.o"` -rm -f *~ -(cd ../doc/6.externs; rm -f *.pd_linux) diff --git a/pd/src/makefile.nt b/pd/src/makefile.nt index cda842f2..7b4e834e 100644 --- a/pd/src/makefile.nt +++ b/pd/src/makefile.nt @@ -1,6 +1,6 @@ # Makefile for PD on MSW -all: pd gui ..\bin\pd.tk ..\bin\pdsend.exe ..\bin\pdreceive.exe +all: pd ..\bin\pdsend.exe ..\bin\pdreceive.exe VCSDK = "C:\Program Files\Microsoft SDKs\Windows\v6.0A" @@ -18,7 +18,6 @@ LIB = /NODEFAULTLIB:libcmt /NODEFAULTLIB:oldnames /NODEFAULTLIB:libc \ $(LDIR)\setupapi.lib ..\bin\pthreadVC.lib \ $(LD2)\libcmt.lib $(LD2)\oldnames.lib -GLIB = $(LIB) ..\bin\tcl84.lib ..\bin\tk84.lib CFLAGS = /nologo /W3 /DMSW /DNT /DPD /DPD_INTERNAL /DWIN32 /DWINDOWS /Ox \ -DPA_LITTLE_ENDIAN -DUSEAPI_MMIO -DUSEAPI_PORTAUDIO -D__i386__ -DPA19 \ -D_CRT_SECURE_NO_WARNINGS @@ -98,8 +97,6 @@ ALLCF = $(CFLAGS) $(INCLUDE) $(INCASIO) $(INCPA) $(INCPM) /D_WINDOWS \ pd: ..\bin\pd.exe ..\bin\pd.com -gui: ..\bin\pdtcl.dll - ..\bin\pd.exe: s_entry.obj ..\bin\pd.lib link $(LFLAGS) /OUT:..\bin\pd.exe /INCREMENTAL:NO s_entry.obj \ ..\bin\pd.lib $(LIB) $(ASIOLIB) @@ -108,12 +105,6 @@ gui: ..\bin\pdtcl.dll link /DLL /OUT:..\bin\pd.dll /EXPORT:sys_main $(LFLAGS) $(OBJC) \ $(OBJASIO) $(LIB) $(ASIOLIB) -..\bin\pdtcl.dll: t_tkcmd.obj - link $(LFLAGS) /dll /export:Pdtcl_Init /out:..\bin\pdtcl.dll \ - t_tkcmd.obj $(GLIB) - -..\bin\pd.tk: u_main.tk; copy u_main.tk ..\bin\pd.tk - ..\bin\pdsend.exe: u_pdsend.obj link $(LFLAGS) /out:..\bin\pdsend.exe /INCREMENTAL:NO u_pdsend.obj \ $(LIB) diff --git a/pd/src/notes.txt b/pd/src/notes.txt index 6c98ca0a..0cf0ee61 100644 --- a/pd/src/notes.txt +++ b/pd/src/notes.txt @@ -1,10 +1,6 @@ ---------------- dolist -------------------- -doc: -exp~, abs~ fixes -pd~ -ninsig 0 bug fixed - compile on various versions of linux windows: modal dialogs confuse watchdog diff --git a/pd/src/s_audio.c b/pd/src/s_audio.c index 81438bbe..2f274fc6 100644 --- a/pd/src/s_audio.c +++ b/pd/src/s_audio.c @@ -9,7 +9,7 @@ #include "m_pd.h" #include "s_stuff.h" #include -#ifdef UNISTD +#ifdef HAVE_UNISTD_H #include #include #include diff --git a/pd/src/s_audio_jack.c b/pd/src/s_audio_jack.c index f00e2f13..990a7a8c 100644 --- a/pd/src/s_audio_jack.c +++ b/pd/src/s_audio_jack.c @@ -13,7 +13,7 @@ #define MAX_CLIENTS 100 -#define NUM_JACK_PORTS 32 +#define NUM_JACK_PORTS 128 /* seems like higher values give bad xrun problems */ #define BUF_JACK 4096 static jack_nframes_t jack_out_max; #define JACK_OUT_MAX 64 diff --git a/pd/src/s_file.c b/pd/src/s_file.c index fe266b37..e5510011 100644 --- a/pd/src/s_file.c +++ b/pd/src/s_file.c @@ -16,7 +16,7 @@ #include #include #include -#ifdef UNISTD +#ifdef HAVE_UNISTD_H #include #include #include diff --git a/pd/src/s_inter.c b/pd/src/s_inter.c index c67076f3..1f17ce70 100644 --- a/pd/src/s_inter.c +++ b/pd/src/s_inter.c @@ -47,6 +47,7 @@ typedef int socklen_t; #include #include #include +#include #else #include #endif @@ -58,6 +59,10 @@ typedef int socklen_t; #define PDBINDIR "bin/" #endif +#ifndef PDTCLDIR +#define PDTCLDIR "tcl/" +#endif + #ifndef WISHAPP #define WISHAPP "wish84.exe" #endif @@ -206,7 +211,7 @@ void sys_microsleep(int microsec) sys_domicrosleep(microsec, 1); } -#ifdef UNISTD +#ifdef HAVE_UNISTD_H typedef void (*sighandler_t)(int); static void sys_signal(int signo, sighandler_t sigfun) @@ -554,7 +559,7 @@ void socketreceiver_read(t_socketreceiver *x, int fd) void sys_closesocket(int fd) { -#ifdef UNISTD +#ifdef HAVE_UNISTD_H close(fd); #endif #ifdef MSW @@ -858,7 +863,7 @@ static int defaultfontshit[MAXFONTS] = { 24, 15, 28}; #define NDEFAULTFONT (sizeof(defaultfontshit)/sizeof(*defaultfontshit)) -int sys_startgui(const char *guidir) +int sys_startgui(const char *libdir) { pid_t childpid; char cmdbuf[4*MAXPDSTRING]; @@ -872,7 +877,7 @@ int sys_startgui(const char *guidir) short version = MAKEWORD(2, 0); WSADATA nobby; #endif -#ifdef UNISTD +#ifdef HAVE_UNISTD_H int stdinpipe[2]; #endif /* create an empty FD poll list */ @@ -880,7 +885,7 @@ int sys_startgui(const char *guidir) sys_nfdpoll = 0; inbinbuf = binbuf_new(); -#ifdef UNISTD +#ifdef HAVE_UNISTD_H signal(SIGHUP, sys_huphandler); signal(SIGINT, sys_exithandler); signal(SIGQUIT, sys_exithandler); @@ -910,7 +915,7 @@ int sys_startgui(const char *guidir) if (GetCurrentDirectory(MAXPDSTRING, cmdbuf) == 0) strcpy(cmdbuf, "."); #endif -#ifdef UNISTD +#ifdef HAVE_UNISTD_H if (!getcwd(cmdbuf, MAXPDSTRING)) strcpy(cmdbuf, "."); @@ -1019,68 +1024,52 @@ int sys_startgui(const char *guidir) if (sys_verbose) fprintf(stderr, "port %d\n", portno); -#ifdef UNISTD +#ifdef HAVE_UNISTD_H if (!sys_guicmd) { #ifdef __APPLE__ - char *homedir = getenv("HOME"), filename[250]; + int i; struct stat statbuf; - /* first look for Wish bundled with and renamed "Pd" */ - sprintf(filename, "%s/../../MacOS/Pd", guidir); - if (stat(filename, &statbuf) >= 0) - goto foundit; - if (!homedir || strlen(homedir) > 150) - goto nohomedir; - /* Look for Wish in user's Applications. Might or might - not be names "Wish Shell", and might or might not be - in "Utilities" subdir. */ - sprintf(filename, - "%s/Applications/Utilities/Wish shell.app/Contents/MacOS/Wish Shell", - homedir); - if (stat(filename, &statbuf) >= 0) - goto foundit; - sprintf(filename, - "%s/Applications/Utilities/Wish.app/Contents/MacOS/Wish", - homedir); - if (stat(filename, &statbuf) >= 0) - goto foundit; - sprintf(filename, - "%s/Applications/Wish shell.app/Contents/MacOS/Wish Shell", - homedir); - if (stat(filename, &statbuf) >= 0) - goto foundit; - sprintf(filename, - "%s/Applications/Wish.app/Contents/MacOS/Wish", - homedir); - if (stat(filename, &statbuf) >= 0) - goto foundit; - nohomedir: - /* Perform the same search among system applications. */ - strcpy(filename, - "/usr/bin/wish"); - if (stat(filename, &statbuf) >= 0) - goto foundit; - strcpy(filename, - "/Applications/Utilities/Wish Shell.app/Contents/MacOS/Wish Shell"); - if (stat(filename, &statbuf) >= 0) - goto foundit; - strcpy(filename, - "/Applications/Utilities/Wish.app/Contents/MacOS/Wish"); - if (stat(filename, &statbuf) >= 0) - goto foundit; - strcpy(filename, - "/Applications/Wish Shell.app/Contents/MacOS/Wish Shell"); - if (stat(filename, &statbuf) >= 0) - goto foundit; - strcpy(filename, - "/Applications/Wish.app/Contents/MacOS/Wish"); - foundit: - sprintf(cmdbuf, "\"%s\" %s/pd.tk %d\n", filename, guidir, portno); + glob_t glob_buffer; + char *homedir = getenv("HOME"); + char embed_glob[FILENAME_MAX]; + char embed_filename[FILENAME_MAX], home_filename[FILENAME_MAX]; + char *wish_paths[10] = { + "(did not find an embedded wish)", + "(did not find a home directory)", + "/Applications/Utilities/Wish.app/Contents/MacOS/Wish", + "/Applications/Utilities/Wish Shell.app/Contents/MacOS/Wish Shell", + "/Applications/Wish.app/Contents/MacOS/Wish", + "/Applications/Wish Shell.app/Contents/MacOS/Wish Shell", + "/usr/bin/wish" + }; + /* this glob is needed so the Wish executable can have the same + * filename as the Pd.app, i.e. 'Pd-0.42-3.app' should have a Wish + * executable called 'Pd-0.42-3.app/Contents/MacOS/Pd-0.42-3' */ + sprintf(embed_glob, "%s/../MacOS/Pd*", libdir); + glob_buffer.gl_matchc = 1; /* we only need one match */ + glob(embed_glob, GLOB_LIMIT, NULL, &glob_buffer); + if (glob_buffer.gl_pathc > 0) { + strcpy(embed_filename, glob_buffer.gl_pathv[0]); + wish_paths[0] = embed_filename; + } + sprintf(home_filename, + "%s/Applications/Wish.app/Contents/MacOS/Wish",homedir); + wish_paths[1] = home_filename; + for(i=0; i<10; i++) + { + if (sys_verbose) + fprintf(stderr, "Trying Wish at \"%s\"\n", wish_paths[i]); + if (stat(wish_paths[i], &statbuf) >= 0) + break; + } + sprintf(cmdbuf,"\"%s\" %s/tcl/pd.tcl %d\n", wish_paths[i], + libdir, portno); #else sprintf(cmdbuf, - "TCL_LIBRARY=\"%s/tcl/library\" TK_LIBRARY=\"%s/tk/library\" \ - \"%s/pd-gui\" %d\n", - sys_libdir->s_name, sys_libdir->s_name, guidir, portno); + "TCL_LIBRARY=\"%s/lib/tcl/library\" TK_LIBRARY=\"%s/lib/tk/library\" \ + wish \"%s/tcl/pd.tcl\" %d\n", + libdir, libdir, libdir, portno); #endif sys_guicmd = cmdbuf; } @@ -1099,6 +1088,7 @@ int sys_startgui(const char *guidir) { setuid(getuid()); /* lose setuid priveliges */ #ifndef __APPLE__ +// TODO this seems unneeded on any platform hans@eds.org /* the wish process in Unix will make a wish shell and read/write standard in and out unless we close the file descriptors. Somehow this doesn't make the MAC OSX @@ -1122,18 +1112,16 @@ int sys_startgui(const char *guidir) #endif /* UNISTD */ #ifdef MSW - /* in MSW land "guipath" is unused; we just do everything from - the libdir. */ - /* fprintf(stderr, "%s\n", sys_libdir->s_name); */ + /* fprintf(stderr, "%s\n", libdir); */ strcpy(scriptbuf, "\""); - strcat(scriptbuf, sys_libdir->s_name); - strcat(scriptbuf, "/" PDBINDIR "pd.tk\""); + strcat(scriptbuf, libdir); + strcat(scriptbuf, "/" PDTCLDIR "pd.tcl\""); sys_bashfilename(scriptbuf, scriptbuf); sprintf(portbuf, "%d", portno); - strcpy(wishbuf, sys_libdir->s_name); + strcpy(wishbuf, libdir); strcat(wishbuf, "/" PDBINDIR WISHAPP); sys_bashfilename(wishbuf, wishbuf); @@ -1197,7 +1185,7 @@ int sys_startgui(const char *guidir) } close(pipe9[1]); - sprintf(cmdbuf, "%s/pd-watchdog\n", guidir); + sprintf(cmdbuf, "%s/bin/pd-watchdog\n", libdir); if (sys_verbose) fprintf(stderr, "%s", cmdbuf); execl("/bin/sh", "sh", "-c", cmdbuf, (char*)0); perror("pd: exec"); diff --git a/pd/src/s_loader.c b/pd/src/s_loader.c index 6cc497c4..b708961c 100644 --- a/pd/src/s_loader.c +++ b/pd/src/s_loader.c @@ -2,10 +2,10 @@ * For information on usage and redistribution, and for a DISCLAIMER OF ALL * WARRANTIES, see the file, "LICENSE.txt," in this distribution. */ -#ifdef DL_OPEN +#ifdef HAVE_LIBDL #include #endif -#ifdef UNISTD +#ifdef HAVE_UNISTD_H #include #include #include @@ -169,7 +169,7 @@ gotone: strncat(filename, nameptr, MAXPDSTRING-strlen(filename)); filename[MAXPDSTRING-1] = 0; -#ifdef DL_OPEN +#ifdef HAVE_LIBDL dlobj = dlopen(filename, RTLD_NOW | RTLD_GLOBAL); if (!dlobj) { @@ -178,6 +178,7 @@ gotone: return (0); } makeout = (t_xxx)dlsym(dlobj, symname); + fprintf(stderr, "symbol %s\n", symname); #endif #ifdef MSW sys_bashfilename(filename, filename); @@ -262,6 +263,7 @@ int sys_run_scheduler(const char *externalschedlibname, (t_externalschedlibmain)GetProcAddress(ntdll, "main"); } #else +#ifdef HAVE_LIBDL { void *dlobj; struct stat statbuf; @@ -282,6 +284,9 @@ int sys_run_scheduler(const char *externalschedlibname, externalmainfunc = (t_externalschedlibmain)dlsym(dlobj, "pd_extern_sched"); } +#else + return (0); +#endif #endif return((*externalmainfunc)(sys_extraflagsstring)); } diff --git a/pd/src/s_main.c b/pd/src/s_main.c index a246e38a..058f0232 100644 --- a/pd/src/s_main.c +++ b/pd/src/s_main.c @@ -13,7 +13,7 @@ #include #include -#ifdef UNISTD +#ifdef HAVE_UNISTD_H #include #endif #ifdef MSW @@ -51,7 +51,6 @@ int sys_nosleep = 0; /* skip all "sleep" calls and spin instead */ char *sys_guicmd; t_symbol *sys_libdir; -t_symbol *sys_guidir; static t_namelist *sys_openlist; static t_namelist *sys_messagelist; static int sys_version; @@ -63,12 +62,12 @@ int sys_midiindevlist[MAXMIDIINDEV] = {1}; int sys_midioutdevlist[MAXMIDIOUTDEV] = {1}; char sys_font[100] = -#ifdef MSW - "Courier"; +#ifdef __APPLE__ + "Monaco"; #else "Courier"; #endif -char sys_fontweight[] = "bold "; /* currently only used for iemguis */ +char sys_fontweight[] = "bold "; static int sys_main_srate; static int sys_main_advance; static int sys_main_callback; @@ -297,7 +296,7 @@ int sys_main(int argc, char **argv) pd_version, pd_compiletime, pd_compiledate); if (sys_version) /* if we were just asked our version, exit here. */ return (0); - if (sys_startgui(sys_guidir->s_name)) /* start the gui */ + if (sys_startgui(sys_libdir->s_name)) /* start the gui */ return(1); if (sys_externalschedlib) return (sys_run_scheduler(sys_externalschedlibname, @@ -391,7 +390,7 @@ static char *(usagemessage[]) = { "-guicmd \"cmd...\" -- start alternatve GUI program (e.g., remote via ssh)\n", "-send \"msg...\" -- send a message at startup, after patches are loaded\n", "-noprefs -- suppress loading preferences on startup\n", -#ifdef UNISTD +#ifdef HAVE_UNISTD_H "-rt or -realtime -- use real-time priority\n", "-nrt -- don't use real-time priority\n", #endif @@ -441,7 +440,7 @@ void sys_findprogdir(char *progname) { char sbuf[MAXPDSTRING], sbuf2[MAXPDSTRING], *sp; char *lastslash; -#ifdef UNISTD +#ifdef HAVE_UNISTD_H struct stat statbuf; #endif @@ -451,7 +450,7 @@ void sys_findprogdir(char *progname) sbuf2[MAXPDSTRING-1] = 0; sys_unbashfilename(sbuf2, sbuf); #endif /* MSW */ -#ifdef UNISTD +#ifdef HAVE_UNISTD_H strncpy(sbuf, progname, MAXPDSTRING); sbuf[MAXPDSTRING-1] = 0; #endif @@ -483,22 +482,23 @@ void sys_findprogdir(char *progname) pd was found in. We now want to infer the "lib" directory and the "gui" directory. In "simple" unix installations, the layout is .../bin/pd - .../bin/pd-gui + .../bin/pd-watchdog (etc) + .../tcl/pd.tcl .../doc and in "complicated" unix installations, it's: .../bin/pd - .../lib/pd/bin/pd-gui + .../lib/pd/bin/pd-watchdog + .../lib/tcl/pd.tcl .../lib/pd/doc To decide which, we stat .../lib/pd; if that exists, we assume it's the complicated layout. In MSW, it's the "simple" layout, but - the gui program is straight wish80: + "wish" is found in bin: .../bin/pd .../bin/wish80.exe .../doc */ #ifdef MSW sys_libdir = gensym(sbuf2); - sys_guidir = &s_; /* in MSW the guipath just depends on the libdir */ #else strncpy(sbuf, sbuf2, MAXPDSTRING-30); sbuf[MAXPDSTRING-30] = 0; @@ -507,21 +507,11 @@ void sys_findprogdir(char *progname) { /* complicated layout: lib dir is the one we just stat-ed above */ sys_libdir = gensym(sbuf); - /* gui lives in .../lib/pd/bin */ - strncpy(sbuf, sbuf2, MAXPDSTRING-30); - sbuf[MAXPDSTRING-30] = 0; - strcat(sbuf, "/lib/pd/bin"); - sys_guidir = gensym(sbuf); } else { /* simple layout: lib dir is the parent */ sys_libdir = gensym(sbuf2); - /* gui lives in .../bin */ - strncpy(sbuf, sbuf2, MAXPDSTRING-30); - sbuf[MAXPDSTRING-30] = 0; - strcat(sbuf, "/bin"); - sys_guidir = gensym(sbuf); } #endif } @@ -839,7 +829,7 @@ int sys_argparse(int argc, char **argv) sys_noautopatch = 1; argc--; argv++; } -#ifdef UNISTD +#ifdef HAVE_UNISTD_H else if (!strcmp(*argv, "-rt") || !strcmp(*argv, "-realtime")) { sys_hipriority = 1; diff --git a/pd/src/s_midi.c b/pd/src/s_midi.c index 67e5e4c7..11669366 100644 --- a/pd/src/s_midi.c +++ b/pd/src/s_midi.c @@ -7,7 +7,7 @@ #include "m_pd.h" #include "s_stuff.h" #include "m_imp.h" -#ifdef UNISTD +#ifdef HAVE_UNISTD_H #include #include #ifdef HAVE_BSTRING_H diff --git a/pd/src/s_midi_alsa.c b/pd/src/s_midi_alsa.c index dcc50006..d0d82f30 100644 --- a/pd/src/s_midi_alsa.c +++ b/pd/src/s_midi_alsa.c @@ -6,7 +6,7 @@ /* MIDI I/O for Linux using ALSA */ #include -#ifdef UNISTD +#ifdef HAVE_UNISTD_H #include #endif #include diff --git a/pd/src/s_midi_oss.c b/pd/src/s_midi_oss.c index 5c11bae3..15d77253 100644 --- a/pd/src/s_midi_oss.c +++ b/pd/src/s_midi_oss.c @@ -6,7 +6,7 @@ /* MIDI I/O for Linux using OSS */ #include -#ifdef UNISTD +#ifdef HAVE_UNISTD_H #include #endif #include diff --git a/pd/src/s_midi_pm.c b/pd/src/s_midi_pm.c index 831f3f06..e1c05b1a 100644 --- a/pd/src/s_midi_pm.c +++ b/pd/src/s_midi_pm.c @@ -10,7 +10,7 @@ #include "m_pd.h" #include "s_stuff.h" #include -#ifdef UNISTD +#ifdef HAVE_UNISTD_H #include #include #include diff --git a/pd/src/s_path.c b/pd/src/s_path.c index d74aa0f6..f9c232a3 100644 --- a/pd/src/s_path.c +++ b/pd/src/s_path.c @@ -14,7 +14,7 @@ #define DEBUG(x) #include -#ifdef UNISTD +#ifdef HAVE_UNISTD_H #include #include #endif @@ -228,7 +228,7 @@ int sys_trytoopenone(const char *dir, const char *name, const char* ext, if ((fd=open(dirresult,O_RDONLY | MSWOPENFLAG(bin))) >= 0) { /* in unix, further check that it's not a directory */ -#ifdef UNISTD +#ifdef HAVE_UNISTD_H struct stat statbuf; int ok = ((fstat(fd, &statbuf) >= 0) && !S_ISDIR(statbuf.st_mode)); diff --git a/pd/src/t_main.c b/pd/src/t_main.c deleted file mode 100644 index 2ed68841..00000000 --- a/pd/src/t_main.c +++ /dev/null @@ -1,115 +0,0 @@ -/* 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. */ - -/* This file should be compared with the corresponding thing in the TK -* distribution whenever updating to newer versions of TCL/TK. */ - -/* - * Copyright (c) 1993 The Regents of the University of California. - * Copyright (c) 1994 Sun Microsystems, Inc. - * - * See the file "license.terms" for information on usage and redistribution - * of this file, and for a DISCLAIMER OF ALL WARRANTIES. - */ - - -#ifndef __APPLE__ /* linux and IRIX only; in __APPLE__ we don't link this in */ -#include "tk.h" -#include - -/* - *---------------------------------------------------------------------- - * - * main -- - * - * This is the main program for the application. - * - * Results: - * None: Tk_Main never returns here, so this procedure never - * returns either. - * - * Side effects: - * Whatever the application does. - * - *---------------------------------------------------------------------- - */ - -void pdgui_startup(Tcl_Interp *interp); -void pdgui_setname(char *name); -void pdgui_setsock(int port); -void pdgui_sethost(char *name); - -int -main(int argc, char **argv) -{ - pdgui_setname(argv[0]); - if (argc >= 2) - { - pdgui_setsock(atoi(argv[1])); - argc--; argv++; - argv[0] = "Pd"; - } - if (argc >= 2) - { - pdgui_sethost(argv[1]); - argc--; argv++; - argv[0] = "Pd"; - } - Tk_Main(argc, argv, Tcl_AppInit); - return 0; /* Needed only to prevent compiler warning. */ -} - - -/* - *---------------------------------------------------------------------- - * - * Tcl_AppInit -- - * - * This procedure performs application-specific initialization. - * Most applications, especially those that incorporate additional - * packages, will have their own version of this procedure. - * - * Results: - * Returns a standard Tcl completion code, and leaves an error - * message in interp->result if an error occurs. - * - * Side effects: - * Depends on the startup script. - * - *---------------------------------------------------------------------- - */ - - -int -Tcl_AppInit(interp) - Tcl_Interp *interp; /* Interpreter for application. */ -{ - Tk_Window mainwindow; - - if (Tcl_Init(interp) == TCL_ERROR) { - return TCL_ERROR; - } - if (Tk_Init(interp) == TCL_ERROR) { - return TCL_ERROR; - } - - /* setup specific to pd-gui: */ - - pdgui_startup(interp); - - /* - * Specify a user-specific startup file to invoke if the application - * is run interactively. Typically the startup file is "~/.apprc" - * where "app" is the name of the application. If this line is deleted - * then no user-specific startup file will be run under any conditions. - */ - -#if 0 - tcl_RcFileName = "~/.apprc"; -#endif - - return TCL_OK; -} - -#endif /* __APPLE__ */ diff --git a/pd/src/t_tk.h b/pd/src/t_tk.h deleted file mode 100644 index a6943679..00000000 --- a/pd/src/t_tk.h +++ /dev/null @@ -1,10 +0,0 @@ -/* 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. */ - -void pdgui_vmess(char *fmt, ...); -void pdgui_mess(char *s); - -void pdgui_evalfile(char *s); - -#define GUISTRING 1000 diff --git a/pd/src/t_tkcmd.c b/pd/src/t_tkcmd.c deleted file mode 100644 index b8cac71e..00000000 --- a/pd/src/t_tkcmd.c +++ /dev/null @@ -1,669 +0,0 @@ -/* 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. */ - -#ifndef MSW /* in unix this only works first; in MSW it only works last. */ -#include "tk.h" -#endif - -#include "t_tk.h" -#include -#include -#include -#include -#include - -#ifndef MSW -#include -#include -#include -#include -#include -#ifdef HAVE_BSTRING_H -#include -#endif -#include -#include -#include -#endif -#ifdef MSW -#include -#include -#endif - -/* These pragmas are only used for MSVC, not MinGW or Cygwin */ -#ifdef _MSC_VER -#pragma warning( disable : 4305 ) /* uncast const double to float */ -#pragma warning( disable : 4244 ) /* uncast double to float */ -#pragma warning( disable : 4101 ) /* unused local variables */ -#endif - -#ifdef MSW -#include "tk.h" -#endif - -#ifdef __APPLE__ -#define STARTGUI -#endif - -#ifdef __linux__ -#define STARTGUI -#endif - -#define FIRSTPORTNUM 5600 - -void tcl_mess(char *s); -static Tcl_Interp *tk_pdinterp; -static int pd_portno = 0; - - -/***************** the socket setup code ********************/ - -/* If this is reset by pdgui_setsock(), it's the port number Pd will try to -connect to; but if zero, that means we should set it and start Pd ourselves. */ - - - /* some installations of linux don't know about "localhost" so give - the loopback address; NT, on the other hand, can't understand the - hostname "127.0.0.1". */ -char hostname[100] = -#ifdef __linux__ - "127.0.0.1"; -#else - "localhost"; -#endif - -void pdgui_setsock(int port) -{ - pd_portno = port; -} - - /* why is this here??? probably never used (see t_main.c). */ -void pdgui_sethost(char *name) -{ - strncpy(hostname, name, 100); - hostname[99] = 0; -} - -static void pdgui_sockerror(char *s) -{ -#ifdef MSW - int err = WSAGetLastError(); -#endif -#ifndef MSW - int err = errno; -#endif - - fprintf(stderr, "%s: %s (%d)\n", s, strerror(err), err); - tcl_mess("exit\n"); - exit(1); -} - -static int sockfd; - -/* The "pd_readsocket" command, which polls the socket. */ - -#define CHUNKSIZE 20000 /* chunks to allocate memory for reading socket */ -#define READSIZE 10000 /* size of read to issue */ - -static char *pd_tkbuf = 0; /* buffer for reading */ -static int pd_tkbufsize = 0; /* current buffer size */ -static int pd_buftail = 0; /* number of bytes already in buffer */ -static int pd_bufhead = 0; /* index of first byte to read */ - - /* mask argument unused but is here to follow tcl's prototype. */ -static void pd_readsocket(ClientData cd, int mask) -{ - fd_set readset, writeset, exceptset; - struct timeval timout; - - timout.tv_sec = 0; - timout.tv_usec = 0; - FD_ZERO(&writeset); - FD_ZERO(&readset); - FD_ZERO(&exceptset); - FD_SET(sockfd, &readset); - FD_SET(sockfd, &exceptset); - if (!pd_tkbuf) - { - if (!(pd_tkbuf = malloc(CHUNKSIZE))) - { - fprintf(stderr, "pd-gui: out of memory\n"); - tcl_mess("exit\n"); - } - pd_tkbufsize = CHUNKSIZE; - } - if (pd_buftail + READSIZE + 1 > pd_tkbufsize) - { - int newsize = pd_tkbufsize + CHUNKSIZE; - char *newbuf = realloc(pd_tkbuf, newsize); - if (!newbuf) - { - fprintf(stderr, "pd-gui: out of memory\n"); - tcl_mess("exit\n"); - } - pd_tkbuf = newbuf; - pd_tkbufsize = newsize; - } - if (select(sockfd+1, &readset, &writeset, &exceptset, &timout) < 0) - perror("select"); - if (FD_ISSET(sockfd, &exceptset) || FD_ISSET(sockfd, &readset)) - { - int ret; - ret = recv(sockfd, pd_tkbuf + pd_buftail, READSIZE, 0); - if (ret < 0) - pdgui_sockerror("socket receive error"); - else if (ret == 0) - { - /* fprintf(stderr, "read %d\n", SOCKSIZE - pd_buftail); */ - fprintf(stderr, "pd_gui: pd process exited\n"); - tcl_mess("exit\n"); - } - else - { - pd_buftail += ret; - while (1) - { - char lastc = 0, *gotcr = 0, *bp = pd_tkbuf + pd_bufhead, - *ep = pd_tkbuf + pd_buftail; - int brace = 0; - /* search for locations that terminate a complete TK - command. These are carriage returns which are not inside - any braces. Braces can be escaped with backslashes (but - backslashes themselves can't.) */ - while (bp < ep) - { - char c = *bp; - if (c == '}' && brace) - brace--; - else if (c == '{') - brace++; - else if (!brace && c == '\n' && lastc != '\\') - { - gotcr = bp; - break; - } - lastc = c; - bp++; - } - /* if gotcr is set there is at least one complete TK - command in the buffer, and gotcr terminates the first one. - Because sending the command to tcl may cause this code to - be reentered, we first copy the command and take it out of - the buffer, then execute the command. - Execute it and slide any - extra bytes to beginning of the buffer. */ - if (gotcr) - { - int bytesincmd = (gotcr - (pd_tkbuf+pd_bufhead)) + 1; - char smallcmdbuf[1000], *realcmdbuf; - if (gotcr - (pd_tkbuf+pd_bufhead) < 998) - realcmdbuf = smallcmdbuf; - else realcmdbuf = malloc(bytesincmd+1); - if (realcmdbuf) - { - strncpy(realcmdbuf, pd_tkbuf+pd_bufhead, bytesincmd); - realcmdbuf[bytesincmd] = 0; - } - pd_bufhead += bytesincmd; - if (realcmdbuf) - { - tcl_mess(realcmdbuf); - if (realcmdbuf != smallcmdbuf) - free(realcmdbuf); - } - if (pd_buftail < pd_bufhead) - fprintf(stderr, "tkcmd bug\n"); - } - else break; - } - if (pd_bufhead) - { - if (pd_buftail > pd_bufhead) - memmove(pd_tkbuf, pd_tkbuf + pd_bufhead, - pd_buftail-pd_bufhead); - pd_buftail -= pd_bufhead; - pd_bufhead = 0; - } - } - } -} - -#ifdef MSW - /* if we're in Gatesland, we add a tcl command to poll the - socket for data. */ -static int pd_pollsocketCmd(ClientData cd, Tcl_Interp *interp, - int argc, char **argv) -{ - pd_readsocket(cd, 0); - return (TCL_OK); -} -#endif - -static void pd_sockerror(char *s) -{ -#ifdef MSW - int err = WSAGetLastError(); - if (err == 10054) return; - else if (err == 10044) - { - fprintf(stderr, - "Warning: you might not have TCP/IP \"networking\" turned on\n"); - fprintf(stderr, "which is needed for Pd to talk to its GUI layer.\n"); - } -#else - int err = errno; -#endif - fprintf(stderr, "%s: %s (%d)\n", s, strerror(err), err); -} - -static void pdgui_connecttosocket(void) -{ - struct sockaddr_in server; - struct hostent *hp; -#ifndef MSW - int retry = 10; -#else - int retry = 1; -#endif -#ifdef MSW - short version = MAKEWORD(2, 0); - WSADATA nobby; - - if (WSAStartup(version, &nobby)) pdgui_sockerror("setup"); -#endif - - /* create a socket */ - sockfd = socket(AF_INET, SOCK_STREAM, 0); - if (sockfd < 0) pdgui_sockerror("socket"); - - /* connect socket using hostname provided in command line */ - server.sin_family = AF_INET; - - hp = gethostbyname(hostname); - - if (hp == 0) - { - fprintf(stderr, - "localhost not found (inet protocol not installed?)\n"); - exit(1); - } - memcpy((char *)&server.sin_addr, (char *)hp->h_addr, hp->h_length); - - /* assign client port number */ - server.sin_port = htons((unsigned short)pd_portno); - - /* try to connect */ - while (1) - { - if (connect(sockfd, (struct sockaddr *) &server, sizeof (server)) >= 0) - goto gotit; - retry--; - if (retry <= 0) - break; - /* In unix there's a race condition; the child won't be - able to connect before the parent (pd) has shed its - setuid-ness. In case this is the problem, sleep and - retry. */ - else - { -#ifndef MSW - fd_set readset, writeset, exceptset; - struct timeval timout; - - timout.tv_sec = 0; - timout.tv_usec = 100000; - FD_ZERO(&writeset); - FD_ZERO(&readset); - FD_ZERO(&exceptset); - fprintf(stderr, "retrying connect...\n"); - if (select(1, &readset, &writeset, &exceptset, &timout) < 0) - perror("select"); -#endif /* !MSW */ - } - } - pdgui_sockerror("connecting stream socket"); -gotit: ; -#ifndef MSW - /* normally we ask TK to call us back; but in MSW we have to poll. */ - Tk_CreateFileHandler(sockfd, TK_READABLE | TK_EXCEPTION, - pd_readsocket, 0); -#endif /* !MSW */ -} - -#ifdef STARTGUI - -/* #define DEBUGCONNECT */ - -#ifdef DEBUGCONNECT -static FILE *debugfd; -#endif - - -static void pd_startfromgui( void) -{ - pid_t childpid; - char cmdbuf[1000], pdbuf[1000], *lastchar; - const char *arg0; - struct sockaddr_in server; - int msgsock; - int len = sizeof(server), nchar; - int ntry = 0, portno = FIRSTPORTNUM; - int xsock = -1; - char morebuf[256]; -#ifdef MSW - short version = MAKEWORD(2, 0); - WSADATA nobby; - char scriptbuf[1000], wishbuf[1000], portbuf[80]; - int spawnret; - char intarg; -#else - int intarg; -#endif - - arg0 = Tcl_GetVar(tk_pdinterp, "argv0", 0); - if (!arg0) - { - fprintf(stderr, "Pd-gui: can't get arg 0\n"); - return; - } - lastchar = strrchr(arg0, '/'); - if (lastchar) - snprintf(pdbuf, lastchar - arg0 + 1, "%s", arg0); - else strcpy(pdbuf, "."); - strcat(pdbuf, "/../bin/pd"); -#ifdef DEBUGCONNECT - fprintf(stderr, "pdbuf is %s\n", pdbuf); -#endif - -#ifdef MSW - if (WSAStartup(version, &nobby)) - pd_sockerror("WSAstartup"); -#endif - - /* create a socket */ - xsock = socket(AF_INET, SOCK_STREAM, 0); - if (xsock < 0) pd_sockerror("socket"); - intarg = 1; - if (setsockopt(xsock, IPPROTO_TCP, TCP_NODELAY, - &intarg, sizeof(intarg)) < 0) - fprintf(stderr, "setsockopt (TCP_NODELAY) failed\n"); - - server.sin_family = AF_INET; - server.sin_addr.s_addr = INADDR_ANY; - - /* assign server port number */ - server.sin_port = htons((unsigned short)portno); - - /* name the socket */ - while (bind(xsock, (struct sockaddr *)&server, sizeof(server)) < 0) - { -#ifdef MSW - int err = WSAGetLastError(); -#else - int err = errno; -#endif - if ((ntry++ > 20) || (err != EADDRINUSE)) - { - perror("bind"); - fprintf(stderr, - "couldn't open GUI-to-pd network connection\n"); - return; - } - portno++; - server.sin_port = htons((unsigned short)(portno)); - } - -#ifdef DEBUGCONNECT - fprintf(debugfd, "port %d\n", portno); - fflush(debugfd); -#endif - -#ifdef UNISTD - sprintf(cmdbuf, "\"%s\" -guiport %d\n", pdbuf, portno); - childpid = fork(); - if (childpid < 0) - { - if (errno) perror("sys_startgui"); - else fprintf(stderr, "sys_startgui failed\n"); - return; - } - else if (!childpid) /* we're the child */ - { -#ifdef DEBUGCONNECT - fprintf(debugfd, "%s", cmdbuf); - fflush(debugfd); -#endif - execl("/bin/sh", "sh", "-c", cmdbuf, (char*)0); - perror("pd: exec"); - _exit(1); - } -#endif /* UNISTD */ - -#ifdef MSW - -#error not yet used.... sys_bashfilename() not filled in here - - strcpy(cmdbuf, pdcmd); - strcat(cmdbuf, "/pd.exe"); - sys_bashfilename(scriptbuf, scriptbuf); - - sprintf(portbuf, "%d", portno); - - spawnret = _spawnl(P_NOWAIT, cmdbuf, "pd.exe", "-port", portbuf, 0); - if (spawnret < 0) - { - perror("spawnl"); - fprintf(stderr, "%s: couldn't start\n", cmdbuf); - return; - } - -#endif /* MSW */ - -#ifdef DEBUGCONNECT - fprintf(stderr, "Waiting for connection request... \n"); -#endif - if (listen(xsock, 5) < 0) pd_sockerror("listen"); - sockfd = accept(xsock, (struct sockaddr *) &server, (unsigned int *)&len); - if (sockfd < 0) pd_sockerror("accept"); -#ifdef DEBUGCONNECT - fprintf(stderr, "... connected\n"); -#endif - -#ifndef MSW - /* normally we ask TK to call us back; but in MSW we have to poll. */ - Tk_CreateFileHandler(sockfd, TK_READABLE | TK_EXCEPTION, - pd_readsocket, 0); -#endif /* !MSW */ -} - -#endif /* STARTGUI */ - -static void pdgui_setupsocket(void) -{ -#ifdef MSW - pdgui_connecttosocket(); -#else - if (pd_portno) - pdgui_connecttosocket(); - else pd_startfromgui() ; -#endif -} - -/**************************** commands ************************/ -static char *pdgui_path; - -/* The "pd" command, which cats its args together and throws the result -* at the Pd interpreter. -*/ -#define MAXWRITE 1024 - -static int pdCmd(ClientData cd, Tcl_Interp *interp, int argc, char **argv) -{ - if (argc == 2) - { - int n = strlen(argv[1]); - if (send(sockfd, argv[1], n, 0) < n) - { - perror("stdout"); - tcl_mess("exit\n"); - } - } - else - { - int i; - char buf[MAXWRITE]; - buf[0] = 0; - for (i = 1; i < argc; i++) - { - if (strlen(argv[i]) + strlen(buf) + 2 > MAXWRITE) - { - interp->result = "pd: arg list too long"; - return (TCL_ERROR); - } - if (i > 1) strcat(buf, " "); - strcat(buf, argv[i]); - } - if (send(sockfd, buf, strlen(buf), 0) < 0) - { - perror("stdout"); - tcl_mess("exit\n"); - } - } - return (TCL_OK); -} - -/*********** "c" level access to tk functions. ******************/ - -void tcl_mess(char *s) -{ - int result; - result = Tcl_Eval(tk_pdinterp, s); - if (result != TCL_OK) - { - if (*tk_pdinterp->result) printf("%s\n", tk_pdinterp->result); - } -} - - /* in linux, we load the tk code from here (in MSW and MACOS, this - is done by passing the name of the file as a startup argument to - the wish shell.) */ -#if !defined(MSW) && !defined(__APPLE__) -void pdgui_doevalfile(Tcl_Interp *interp, char *s) -{ - char buf[GUISTRING]; - sprintf(buf, "set pd_guidir \"%s\"\n", pdgui_path); - tcl_mess(buf); - strcpy(buf, pdgui_path); - strcat(buf, "/bin/"); - strcat(buf, s); - if (Tcl_EvalFile(interp, buf) != TCL_OK) - { - char buf2[1000]; - sprintf(buf2, "puts [concat tcl: %s: can't open script]\n", - buf); - tcl_mess(buf2); - } -} - -void pdgui_evalfile(char *s) -{ - pdgui_doevalfile(tk_pdinterp, s); -} -#endif - -void pdgui_startup(Tcl_Interp *interp) -{ - /* save pointer to the main interpreter */ - tk_pdinterp = interp; - - /* add our own TK commands */ - Tcl_CreateCommand(interp, "pd", (Tcl_CmdProc*)pdCmd, (ClientData)NULL, - (Tcl_CmdDeleteProc *)NULL); -#ifdef MSW - Tcl_CreateCommand(interp, "pd_pollsocket",(Tcl_CmdProc*) pd_pollsocketCmd, - (ClientData)NULL, (Tcl_CmdDeleteProc *)NULL); -#endif - pdgui_setupsocket(); - /* read in the startup file */ -#if !defined(MSW) && !defined(__APPLE__) - pdgui_evalfile("pd.tk"); -#endif -} - -#ifndef MSW -void pdgui_setname(char *s) -{ - char *t; - char *str; - int n; - if (t = strrchr(s, '/')) str = s, n = (t-s) + 1; - else str = "./", n = 2; - if (n > GUISTRING-100) n = GUISTRING-100; - pdgui_path = malloc(n+9); - - strncpy(pdgui_path, str, n); - while (strlen(pdgui_path) > 0 && pdgui_path[strlen(pdgui_path)-1] == '/') - pdgui_path[strlen(pdgui_path)-1] = 0; - if (t = strrchr(pdgui_path, '/')) - *t = 0; -} -#endif - - /* this is called when an off-the-shelf "wish" has to "load" this module - at runtime. In Linux, this module is linked in and Pdtcl_Init() is not - called; instead, the code in t_main.c calls pdgui_setsock() and - pdgui_startup(). */ - -int Pdtcl_Init(Tcl_Interp *interp) -{ - const char *argv = Tcl_GetVar(interp, "argv", 0); - int portno = 0, i; - if (argv) - { - /* search for arg of form "-guiport %d"; if so we're the - child. For some reason, the second version is too stringent - a test on MSW so the first, incorrect one, is conditionally - used. */ -#ifdef MSW - for (i = 0; i < (int)strlen(argv) - 1; i++) - if (argv[i] >= '0' && argv[i] <= '9') - { - portno = atoi(argv+i); - break; - } -#else - for (i = 0; i < (int)strlen(argv) - 3; i++) - if (argv[i] == ' ' && - argv[i+1] >= '0' && argv[i+1] <= '9') - { - portno = atoi(argv+i+1); - break; - } -#endif - } - if (portno) - pdgui_setsock(portno); -#ifdef DEBUGCONNECT - debugfd = fopen("/tmp/bratwurst", "w"); - fprintf(debugfd, "turning stderr back on\n"); - fflush(debugfd); - dup2(fileno(debugfd), 2); - fprintf(stderr, "duped to stderr?\n"); - fprintf(stderr, "portno %d\n", pd_portno); - fprintf(stderr, "argv %s\n", argv); -#endif - tk_pdinterp = interp; - pdgui_startup(interp); - interp->result = "loaded pdtcl_init"; - - return (TCL_OK); -} - -#if 0 -int Pdtcl_SafeInit(Tcl_Interp *interp) { - fprintf(stderr, "Pdtcl_Safeinit 51\n"); - return (TCL_OK); -} -#endif - diff --git a/pd/src/u_main.tk b/pd/src/u_main.tk deleted file mode 100644 index 8834d232..00000000 --- a/pd/src/u_main.tk +++ /dev/null @@ -1,4489 +0,0 @@ -#!/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 this changes are labeled with #######iemlib########## - -# set pd_nt (bad name) 0 for unix, 1 for microsoft, and 2 for Mac OSX. -if { $tcl_platform(platform) == "windows" } { - set pd_nt 1 - set defaultFontFamily {Bitstream Vera Sans Mono} - set defaultFontWeight normal - font create menuFont -family Tahoma -size -11 -} elseif { $tcl_platform(os) == "Darwin" } { - set pd_nt 2 - set defaultFontFamily Monaco - set defaultFontWeight normal -} else { - set pd_nt 0 - set defaultFontFamily Courier - set defaultFontWeight bold -} - -# 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 -12 \ - -weight $defaultFontWeight -# this font is for text in Pd windows -font create text_font -family {Times} -size -14 -weight normal -# for text in Properties Panels and other panes -font create highlight_font -family $defaultFontFamily -size -14 -weight bold - -# end Pd-extended font hacks ----------------------------- - - -# Tearoff is set to true by default: -set pd_tearoff 1 - -# 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 - -if {$pd_nt == 1} { - global pd_guidir - global pd_tearoff - set pd_gui2 [string range $argv0 0 [expr [string last \\ $argv0 ] - 1]] - regsub -all \\\\ $pd_gui2 / pd_gui3 - set pd_guidir $pd_gui3/.. - load $pd_guidir/bin/pdtcl.dll - set pd_tearoff 1 -} - -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 2 - global pd_guidir - global pd_tearoff - set pd_gui2 [string range $argv0 0 [expr [string last / $argv0 ] - 1]] - set pd_guidir $pd_gui2/.. - load $pd_guidir/bin/libPdTcl.dylib - set pd_tearoff 0 - 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 - } - } - } -} - -# 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 12 bold} - -set help_top_directory $pd_guidir/doc - -# it's unfortunate but we seem to have to turn off global bindings -# for Text objects to get control-s and control-t to do what we want for -# "text" dialogs below. Also we have to get rid of tab's changing the focus. - -bind all "" -bind all <> "" -bind Text {} -bind Text {} -# puts stderr [bind all] - -################## set up main window ######################### -# the menus are instantiated here for the main window -# for the patch windows, they are created by pdtk_canvas_new -menu .mbar - -frame .controls -pack .controls -side top -fill x -menu .mbar.file -tearoff $pd_tearoff -.mbar add cascade -label "File" -menu .mbar.file -menu .mbar.find -tearoff $pd_tearoff -.mbar add cascade -label "Find" -menu .mbar.find -menu .mbar.windows -postcommand [concat pdtk_fixwindowmenu] -tearoff $pd_tearoff -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 - 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 - 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.find configure -font menuFont - .mbar.windows configure -font menuFont - .mbar.audio configure -font menuFont - .mbar.help configure -font menuFont -} - -set ctrls_audio_on 0 -set ctrls_meter_on 0 -set ctrls_inlevel 0 -set ctrls_outlevel 0 - -frame .controls.switches -checkbutton .controls.switches.audiobutton -text {compute audio} \ - -variable ctrls_audio_on \ - -command {pd [concat pd dsp $ctrls_audio_on \;]} - -checkbutton .controls.switches.meterbutton -text {peak meters} \ - -variable ctrls_meter_on \ - -command {pd [concat pd meters $ctrls_meter_on \;]} - -pack .controls.switches.audiobutton .controls.switches.meterbutton \ - -side top -anchor w - -frame .controls.inout -frame .controls.inout.in -label .controls.inout.in.label -text IN -entry .controls.inout.in.level -textvariable ctrls_inlevel -width 3 -button .controls.inout.in.clip -text {CLIP} -state disabled -pack .controls.inout.in.label .controls.inout.in.level \ - .controls.inout.in.clip -side top -pady 2 - -frame .controls.inout.out -label .controls.inout.out.label -text OUT -entry .controls.inout.out.level -textvariable ctrls_outlevel -width 3 -button .controls.inout.out.clip -text {CLIP} -state disabled -pack .controls.inout.out.label .controls.inout.out.level \ - .controls.inout.out.clip -side top -pady 2 - -button .controls.dio -text "DIO\nerrors" \ - -command {pd [concat pd audiostatus \;]} -button .controls.clear -text "clear\nprintout" \ - -command {.printout.text delete 0.0 end} - -pack .controls.inout.in .controls.inout.out -side left -padx 6 -pack .controls.inout -side left -padx 14 -pack .controls.switches -side left -pack .controls.dio -side left -padx 20 -pack .controls.clear -side right -padx 6 - -frame .printout -text .printout.text -relief raised -bd 2 -font console_font \ - -yscrollcommand ".printout.scroll set" -width 80 -# .printout.text insert end "\n\n\n\n\n\n\n\n\n\n" -scrollbar .printout.scroll -command ".printout.text yview" -pack .printout.scroll -side right -fill y -pack .printout.text -side left -fill both -expand 1 -pack .printout -side bottom -fill both -expand 1 - -proc pdtk_post {stuff} { - .printout.text insert end $stuff - .printout.text yview end-2char -} - -proc pdtk_standardkeybindings {id} { - global pd_nt - bind $id {pdtk_pd_ctrlkey %W %K 0} - bind $id {pdtk_pd_ctrlkey %W %K 1} - if {$pd_nt == 2} { - bind $id {pdtk_canvas_ctrlkey %W %K 0} - bind $id {pdtk_canvas_ctrlkey %W %K 1} - } -} - -pdtk_standardkeybindings . - -wm title . "Pd" -. configure -menu .mbar -width 200 -height 150 - -# Intercept closing the main pd window: MP 20060413: -wm protocol . WM_DELETE_WINDOW menu_quit - -############### set up global variables ################################ - -set untitled_number 1 -set untitled_directory [pwd] -set saveas_client doggy -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 - 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} -} - -set menu_windowlist {} - -proc pdtk_fixwindowmenu {} { - global menu_windowlist - .mbar.windows delete 0 end - 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 - pd [concat pd filename Untitled-$untitled_number $untitled_directory \;] - pd { - #N canvas; - #X pop 1; - } - set untitled_number [expr $untitled_number + 1] -} - -################## the "Open" menu command ######################### - -proc menu_open {parent} { - global pd_opendir - set filename [tk_getOpenFile -defaultextension .pd -parent $parent\ - -filetypes { {{pd files} {.pd}} {{max files} {.pat}}} \ - -initialdir $pd_opendir] - if {$filename != ""} {open_file $filename} -} - -proc open_file {filename} { - global pd_opendir - set directory [string range $filename 0 [expr [string last / $filename] - 1]] - set pd_opendir $directory - set basename [string range $filename [expr [string last / $filename] + 1] end] - if {[string last .pd $filename] >= 0} { - pd "pd open [pdtk_enquote $basename] [pdtk_enquote $directory] ;" - } -} - -catch { - package require tkdnd - dnd bindtarget . text/uri-list { - foreach file %D {open_file $file} - } -} - -################## the "Message" menu command ######################### -proc menu_send {} { - toplevel .sendpanel - entry .sendpanel.entry -textvariable send_textvariable - pack .sendpanel.entry -side bottom -fill both -ipadx 100 - .sendpanel.entry select from 0 - .sendpanel.entry select adjust end - bind .sendpanel.entry { - pd [concat $send_textvariable \;] - } - pdtk_standardkeybindings .sendpanel.entry - focus .sendpanel.entry -} - -################## the "Quit" menu command ######################### -proc menu_really_quit {} {pd {pd quit;}} - -proc menu_quit {} {pd {pd verifyquit;}} - -######### the "Pd" menu command, which puts the Pd window on top ######## -proc menu_pop_pd {} {raise .} - -######### 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 - set name [format ".help%d" $doc_number] - toplevel $name - text $name.text -relief raised -bd 2 -font text_font \ - -yscrollcommand "$name.scroll set" -background white - scrollbar $name.scroll -command "$name.text yview" - pack $name.scroll -side right -fill y - pack $name.text -side left -fill both -expand 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 - $name.text insert end $bigstring3 - } - close $f - set doc_number [expr $doc_number + 1] -} - -# 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 "file://%s" $filename] & - } -} - -proc menu_doc_open {subdir basename} { - global pd_guidir - - set dirname $pd_guidir/$subdir - - if {[regexp ".*\.(txt|c)$" $basename]} { - menu_opentext $dirname/$basename - } elseif {[regexp ".*\.html?$" $basename]} { - menu_openhtml $dirname/$basename - } else { - pd [concat pd open [pdtk_enquote $basename] \ - [pdtk_enquote $dirname] \;] - } -} - - -################## help browser and support functions ######################### -proc menu_doc_browser {dir} { - global .mbar - if {![file isdirectory $dir]} { - puts stderr "menu_doc_browser non-directory $dir\n" - } - if { [winfo exists .help_browser.frame] } { - raise .help_browser - } else { - toplevel .help_browser -menu .mbar - wm title .help_browser "Pd Documentation Browser" - frame .help_browser.frame - pack .help_browser.frame -side top -fill both - doc_make_listbox .help_browser.frame $dir 0 - } - } - -proc doc_make_listbox {base dir count} { - # check for [file readable]? - #if { [info tclversion] >= 8.5 } { - # requires Tcl 8.5 but probably deals with special chars better -# destroy {expand}[lrange [winfo children $base] [expr {2 * $count}] end] - #} else { - if { [catch { eval destroy [lrange [winfo children $base] \ - [expr { 2 * $count }] end] } \ - errorMessage] } { - puts stderr "doc_make_listbox: error listing $dir\n" - } - #} - # exportselection 0 looks good, but selection gets easily out-of-sync - set current_listbox [listbox "[set b "$base.listbox$count"]-list" -yscrollcommand \ - [list "$b-scroll" set] -height 20 -exportselection 0] - pack $current_listbox [scrollbar "$b-scroll" -command [list $current_listbox yview]] \ - -side left -expand 1 -fill y -anchor w - foreach item [concat [lsort -dictionary [glob -directory $dir -nocomplain -types {d} -- *]] \ - [lsort -dictionary [glob -directory $dir -nocomplain -types {f} -- *]]] { - $current_listbox insert end "[file tail $item][expr {[file isdirectory $item] ? {/} : {}}]" - } - bind $current_listbox [list doc_navigate $dir $count %W %x %y] - bind $current_listbox [list doc_double_button $dir $count %W %x %y] -} - -proc doc_navigate {dir count width x y} { - if {[set newdir [$width get [$width index "@$x,$y"]]] eq {}} { - return - } - set dir_to_open [file join $dir $newdir] - if {[file isdirectory $dir_to_open]} { - doc_make_listbox [winfo parent $width] $dir_to_open [incr count] - } -} - -proc doc_double_button {dir count width x y} { - global pd_guidir - if {[set newdir [$width get [$width index "@$x,$y"]]] eq {}} { - return - } - set dir_to_open [file join $dir $newdir] - if {[file isdirectory $dir_to_open]} { - doc_navigate $dir $count $width $x $y - } else { - regsub -- $pd_guidir [file dirname $dir_to_open] "" subdir - set file [file tail $dir_to_open] - if { [catch {menu_doc_open $subdir $file} fid] } { - puts stderr "Could not open $pd_guidir/$subdir/$file\n" - } - return; - } -} - -############# 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} - for {set x 0} {$x<[llength $pd_apilist]} {incr x} { - $mbar.audio add radiobutton -label [lindex [lindex $pd_apilist $x] 0] \ - -command {menu_audio 0} -variable pd_whichapi \ - -value [lindex [lindex $pd_apilist $x] 1]\ - -command {pd [concat pd audio-setapi $pd_whichapi \;]} - } - for {set x 0} {$x<[llength $pd_midiapilist]} {incr x} { - $mbar.audio add radiobutton -label [lindex [lindex $pd_midiapilist $x] 0] \ - -command {menu_midi 0} -variable pd_whichmidiapi \ - -value [lindex [lindex $pd_midiapilist $x] 1]\ - -command {pd [concat pd midi-setapi $pd_whichmidiapi \;]} - } - if {$pd_nt != 2} { - $mbar.audio add command -label {Audio settings...} \ - -command {pd pd audio-properties \;} - $mbar.audio add command -label {MIDI settings...} \ - -command {pd pd midi-properties \;} - } - - $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. -# 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} \ - -command {menu_doc_open doc/1.manual 1.introduction.txt} - } - $mbar.help add command -label {Html ...} \ - -command {menu_doc_open doc/1.manual index.htm} - $mbar.help add command -label {Browser ...} \ - -command {menu_doc_browser $help_top_directory} -} - -#################### the "File" menu for the Pd window ############## - -.mbar.file add command -label New -command {menu_new} \ - -accelerator [accel_munge "Ctrl+n"] -.mbar.file add command -label Open -command {menu_open .} \ - -accelerator [accel_munge "Ctrl+o"] -.mbar.file add separator -.mbar.file add command -label Message -command {menu_send} \ - -accelerator [accel_munge "Ctrl+m"] -# On MacOS X, these are in the standard HIG locations -# i.e. the Preferences menu under "Pd" -if {$pd_nt != 2} { -.mbar.file add command -label Path... \ - -command {pd pd start-path-dialog \;} -.mbar.file add command -label Startup... \ - -command {pd pd start-startup-dialog \;} -} -.mbar.file add separator -.mbar.file add command -label Quit -command {menu_quit} \ - -accelerator [accel_munge "Ctrl+q"] - -#################### the "Find" menu for the Pd window ############## -.mbar.find add command -label {Find last error} -command {menu_finderror} - -########### functions for menu functions on document windows ######## - -proc menu_save {name} { - pdtk_canvas_checkgeometry $name - pd [concat $name menusave \;] -} - -proc menu_saveas {name} { - pdtk_canvas_checkgeometry $name - pd [concat $name menusaveas \;] -} - -proc menu_print {name} { - set filename [tk_getSaveFile -initialfile pd.ps \ - -defaultextension .ps \ - -filetypes { {{postscript} {.ps}} }] - - if {$filename != ""} { - $name.c postscript -file $filename - } -} - -proc menu_close {name} { - pdtk_canvas_checkgeometry $name - pd [concat $name menuclose 0 \;] -} - -proc menu_really_close {name} { - pdtk_canvas_checkgeometry $name - pd [concat $name menuclose 1 \;] -} - -proc menu_undo {name} { - global pd_undoaction - global pd_redoaction - global pd_undocanvas - if {$name == $pd_undocanvas && $pd_undoaction != "no"} { - pd [concat $name undo \;] - } -} - -proc menu_redo {name} { - global pd_undoaction - global pd_redoaction - global pd_undocanvas - if {$name == $pd_undocanvas && $pd_redoaction != "no"} { - pd [concat $name redo \;] - } -} - -proc menu_cut {name} { - pd [concat $name cut \;] -} - -proc menu_copy {name} { - pd [concat $name copy \;] -} - -proc menu_paste {name} { - pd [concat $name paste \;] -} - -proc menu_duplicate {name} { - pd [concat $name duplicate \;] -} - -proc menu_selectall {name} { - pd [concat $name selectall \;] -} - -proc menu_texteditor {name} { - pd [concat $name texteditor \;] -} - -proc menu_font {name} { - pd [concat $name menufont \;] -} - -proc menu_tidyup {name} { - pd [concat $name tidy \;] -} - -proc menu_editmode {name} { - pd [concat $name editmode 0 \;] -} - -proc menu_object {name accel} { - pd [concat $name obj $accel \;] -} - -proc menu_message {name accel} { - pd [concat $name msg $accel \;] -} - -proc menu_floatatom {name accel} { - pd [concat $name floatatom $accel \;] -} - -proc menu_symbolatom {name accel} { - pd [concat $name symbolatom $accel \;] -} - -proc menu_comment {name accel} { - pd [concat $name text $accel \;] -} - -proc menu_graph {name} { - pd [concat $name graph \;] -} - -proc menu_array {name} { - pd [concat $name menuarray \;] -} - -############iemlib################## -proc menu_bng {name accel} { - pd [concat $name bng $accel \;] -} - -proc menu_toggle {name accel} { - pd [concat $name toggle $accel \;] -} - -proc menu_numbox {name accel} { - pd [concat $name numbox $accel \;] -} - -proc menu_vslider {name accel} { - pd [concat $name vslider $accel \;] -} - -proc menu_hslider {name accel} { - pd [concat $name hslider $accel \;] -} - -proc menu_hradio {name accel} { - pd [concat $name hradio $accel \;] -} - -proc menu_vradio {name accel} { - pd [concat $name vradio $accel \;] -} - -proc menu_vumeter {name accel} { - pd [concat $name vumeter $accel \;] -} - -proc menu_mycnv {name accel} { - pd [concat $name mycnv $accel \;] -} - -############iemlib################## - -# correct edit menu, enabling or disabling undo/redo -# LATER also cut/copy/paste -proc menu_fixeditmenu {name} { - global pd_undoaction - global pd_redoaction - global pd_undocanvas -# puts stderr [concat menu_fixeditmenu $name $pd_undocanvas $pd_undoaction] - if {$name == $pd_undocanvas && $pd_undoaction != "no"} { - $name.m.edit entryconfigure "Undo*" -state normal \ - -label [concat "Undo " $pd_undoaction] - } else { - $name.m.edit entryconfigure "Undo*" -state disabled -label "Undo" - } - if {$name == $pd_undocanvas && $pd_redoaction != "no"} { - $name.m.edit entryconfigure "Redo*" -state normal\ - -label [concat "Redo " $pd_redoaction] - } else { - $name.m.edit entryconfigure "Redo*" -state disabled - } -} - -# message from Pd to update the currently available undo/redo action -proc pdtk_undomenu {name undoaction redoaction} { - global pd_undoaction - global pd_redoaction - global pd_undocanvas -# puts stderr [concat pdtk_undomenu $name $undoaction $redoaction] - set pd_undocanvas $name - set pd_undoaction $undoaction - set pd_redoaction $redoaction - if {$name != "nobody"} { -# unpleasant way of avoiding a more unpleasant bug situation --atl 2002.11.25 - menu_fixeditmenu $name - } -} - -proc menu_windowparent {name} { - pd [concat $name findparent \;] -} - -proc menu_findagain {name} { - pd [concat $name findagain \;] -} - -proc menu_finderror {} { - pd [concat pd finderror \;] -} - -proc menu_domenuwindow {i} { - raise $i -} - -proc menu_fixwindowmenu {name} { - global menu_windowlist - global pd_tearoff - $name.m.windows add command - if $pd_tearoff { - $name.m.windows delete 4 end - } else { - $name.m.windows delete 3 end - } - foreach i $menu_windowlist { - $name.m.windows add command -label [lindex $i 0] \ - -command [concat menu_domenuwindow [lindex $i 1]] - } -} - -################## the "find" menu item ################### - -set find_canvas nobody -set find_string "" -set find_count 1 -set find_wholeword 1 - -proc find_apply {name} { - global find_string find_canvas find_wholeword - pd [concat $find_canvas find [pdtk_encodedialog $find_string] \ - $find_wholeword \;] - after 50 destroy $name -} - -proc find_cancel {name} { - after 50 destroy $name -} - -proc menu_findobject {canvas} { - global find_string find_canvas find_count find_wholeword - - set name [format ".find%d" $find_count] - set find_count [expr $find_count + 1] - - set find_canvas $canvas - - toplevel $name - - label $name.label -text {find...} - pack $name.label -side top - - entry $name.entry -textvariable find_string - pack $name.entry -side top - checkbutton $name.wholeword -variable find_wholeword \ - -text {whole word} -anchor e - pack $name.wholeword -side bottom - - frame $name.buttonframe - pack $name.buttonframe -side bottom -fill x -pady 2m - button $name.buttonframe.cancel -text {Cancel}\ - -command "find_cancel $name" - button $name.buttonframe.ok -text {OK}\ - -command "find_apply $name" - pack $name.buttonframe.cancel -side left -expand 1 - pack $name.buttonframe.ok -side left -expand 1 - - $name.entry select from 0 - $name.entry select adjust end - bind $name.entry [ concat find_apply $name] - pdtk_standardkeybindings $name.entry - focus $name.entry -} - - -############# pdtk_canvas_new -- create a new canvas ############### -proc pdtk_canvas_new {name width height geometry editable} { - global pd_opendir - global pd_tearoff - global pd_nt - global tcl_version - - toplevel $name -menu $name.m - # if we're a mac, refuse to make window so big you can't get to - # the resizing control - if {$pd_nt == 2} { - if {$width > [winfo screenwidth $name] - 80} { - set width [expr [winfo screenwidth $name] - 80] - } - if {$height > [winfo screenheight $name] - 80} { - set height [expr [winfo screenheight $name] - 80] - } - } - -# slide offscreen windows into view - if {$tcl_version >= 8.4} { - set geometry [split $geometry +] - set i 1 - foreach geo {width height} { - set screen($geo) [winfo screen$geo .] - if {[expr [lindex $geometry $i] + [set $geo]] > $screen($geo)} { - set pos($geo) [expr $screen($geo) - [set $geo]] - if {$pos($geo) < 0} {set pos($geo) 0} - lset geometry $i $pos($geo) - } - incr i - } - set geometry [join $geometry +] - } - wm geometry $name $geometry - canvas $name.c -width $width -height $height -background white \ - -yscrollcommand "$name.scrollvert set" \ - -xscrollcommand "$name.scrollhort set" \ - -scrollregion [concat 0 0 $width $height] - - scrollbar $name.scrollvert -command "$name.c yview" - scrollbar $name.scrollhort -command "$name.c xview" \ - -orient horizontal - - pack $name.scrollhort -side bottom -fill x - pack $name.scrollvert -side right -fill y - pack $name.c -side left -expand 1 -fill both - wm minsize $name 1 1 - wm geometry $name $geometry -# the file menu - -# The menus are instantiated here for the patch windows. -# For the main window, they are created on load, at the -# top of this file. - menu $name.m - menu $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} \ - -accelerator [accel_munge "Ctrl+n"] - - $name.m.file add command -label Open -command [concat menu_open $name] \ - -accelerator [accel_munge "Ctrl+o"] - - $name.m.file add separator - $name.m.file add command -label Message -command {menu_send} \ - -accelerator [accel_munge "Ctrl+m"] - - # arrange menus according to Apple HIG - # these are now part of Preferences... - if {$pd_nt != 2 } { - $name.m.file add command -label Path... \ - -command {pd pd start-path-dialog \;} - - $name.m.file add command -label Startup... \ - -command {pd pd start-startup-dialog \;} - } - - $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"] - - $name.m.file add command -label "Save as..." \ - -command [concat menu_saveas $name] \ - -accelerator [accel_munge "Ctrl+S"] - - $name.m.file add command -label Print -command [concat menu_print $name] \ - -accelerator [accel_munge "Ctrl+p"] - - $name.m.file add separator - - $name.m.file add command -label Quit -command {menu_quit} \ - -accelerator [accel_munge "Ctrl+q"] - -# the edit menu - menu $name.m.edit -postcommand [concat menu_fixeditmenu $name] -tearoff $pd_tearoff - $name.m add cascade -label Edit -menu $name.m.edit - - $name.m.edit add command -label Undo -command [concat menu_undo $name] \ - -accelerator [accel_munge "Ctrl+z"] - - $name.m.edit add command -label Redo -command [concat menu_redo $name] \ - -accelerator [accel_munge "Ctrl+Z"] - - $name.m.edit add separator - - $name.m.edit add command -label Cut -command [concat menu_cut $name] \ - -accelerator [accel_munge "Ctrl+x"] - - $name.m.edit add command -label Copy -command [concat menu_copy $name] \ - -accelerator [accel_munge "Ctrl+c"] - - $name.m.edit add command -label Paste \ - -command [concat menu_paste $name] \ - -accelerator [accel_munge "Ctrl+v"] - - $name.m.edit add command -label Duplicate \ - -command [concat menu_duplicate $name] \ - -accelerator [accel_munge "Ctrl+d"] - - $name.m.edit add command -label {Select all} \ - -command [concat menu_selectall $name] \ - -accelerator [accel_munge "Ctrl+a"] - - $name.m.edit add command -label {Reselect} \ - -command [concat menu_reselect $name] \ - -accelerator "Ctrl+Enter" - - $name.m.edit add separator - - $name.m.edit add command -label {Text Editor} \ - -command [concat menu_texteditor $name] \ - -accelerator [accel_munge "Ctrl+t"] - - $name.m.edit add command -label Font \ - -command [concat menu_font $name] - - $name.m.edit add command -label {Tidy Up} \ - -command [concat menu_tidyup $name] - - $name.m.edit add separator - -# Apple, Microsoft, and others put find functions in the Edit menu. - $name.m.edit add command -label {Find...} \ - -accelerator [accel_munge "Ctrl+f"] \ - -command [concat menu_findobject $name] - $name.m.edit add command -label {Find Again} \ - -accelerator [accel_munge "Ctrl+g"] \ - -command [concat menu_findagain $name] - $name.m.edit add command -label {Find last error} \ - -command [concat menu_finderror] - - $name.m.edit add separator - -############iemlib################## -# instead of "red = #BC3C60" we take "grey85", so there is no difference, -# if widget is selected or not. - - $name.m.edit add checkbutton -label "Edit mode" \ - -indicatoron true -selectcolor grey85 \ - -command [concat menu_editmode $name] \ - -accelerator [accel_munge "Ctrl+e"] - - if { $editable == 0 } { - $name.m.edit entryconfigure "Edit mode" -indicatoron false } - - -############iemlib################## - - -# the put menu - menu $name.m.put -tearoff $pd_tearoff - $name.m add cascade -label Put -menu $name.m.put - - $name.m.put add command -label Object \ - -command [concat menu_object $name 0] \ - -accelerator [accel_munge "Ctrl+1"] - - $name.m.put add command -label Message \ - -command [concat menu_message $name 0] \ - -accelerator [accel_munge "Ctrl+2"] - - $name.m.put add command -label Number \ - -command [concat menu_floatatom $name 0] \ - -accelerator [accel_munge "Ctrl+3"] - - $name.m.put add command -label Symbol \ - -command [concat menu_symbolatom $name 0] \ - -accelerator [accel_munge "Ctrl+4"] - - $name.m.put add command -label Comment \ - -command [concat menu_comment $name 0] \ - -accelerator [accel_munge "Ctrl+5"] - - $name.m.put add separator - -############iemlib################## - - $name.m.put add command -label Bang \ - -command [concat menu_bng $name 0] \ - -accelerator [accel_munge "Shift+Ctrl+b"] - - $name.m.put add command -label Toggle \ - -command [concat menu_toggle $name 0] \ - -accelerator [accel_munge "Shift+Ctrl+t"] - - $name.m.put add command -label Number2 \ - -command [concat menu_numbox $name 0] \ - -accelerator [accel_munge "Shift+Ctrl+n"] - - $name.m.put add command -label Vslider \ - -command [concat menu_vslider $name 0] \ - -accelerator [accel_munge "Shift+Ctrl+v"] - - $name.m.put add command -label Hslider \ - -command [concat menu_hslider $name 0] \ - -accelerator [accel_munge "Shift+Ctrl+h"] - - $name.m.put add command -label Vradio \ - -command [concat menu_vradio $name 0] \ - -accelerator [accel_munge "Shift+Ctrl+d"] - - $name.m.put add command -label Hradio \ - -command [concat menu_hradio $name 0] \ - -accelerator [accel_munge "Shift+Ctrl+i"] - - $name.m.put add command -label VU \ - -command [concat menu_vumeter $name 0] \ - -accelerator [accel_munge "Shift+Ctrl+u"] - - $name.m.put add command -label Canvas \ - -command [concat menu_mycnv $name 0] \ - -accelerator [accel_munge "Shift+Ctrl+c"] - -############iemlib################## - - $name.m.put add separator - - $name.m.put add command -label Graph \ - -command [concat menu_graph $name] - - $name.m.put add command -label Array \ - -command [concat menu_array $name] - -# the find menu -# Apple, Microsoft, and others put find functions in the Edit menu. -# But in order to move these items to the Edit menu, the Find menu -# handling needs to be dealt with, including this line in g_canvas.c: -# sys_vgui(".mbar.find delete %d\n", i); -# - menu $name.m.find -tearoff $pd_tearoff - $name.m add cascade -label Find -menu $name.m.find - - $name.m.find add command -label {Find...} \ - -accelerator [accel_munge "Ctrl+f"] \ - -command [concat menu_findobject $name] - $name.m.find add command -label {Find Again} \ - -accelerator [accel_munge "Ctrl+g"] \ - -command [concat menu_findagain $name] - $name.m.find add command -label {Find last error} \ - -command [concat menu_finderror] - -# the window menu - menu $name.m.windows -postcommand [concat menu_fixwindowmenu $name] \ - -tearoff $pd_tearoff - - $name.m.windows add command -label {parent window}\ - -command [concat menu_windowparent $name] - $name.m.windows add command -label {Pd window} -command menu_pop_pd - $name.m.windows add separator - -# the audio menu - menu $name.m.audio -tearoff $pd_tearoff - - if {$pd_nt != 2} { - $name.m add cascade -label Windows -menu $name.m.windows - $name.m add cascade -label Media -menu $name.m.audio - } else { - $name.m add cascade -label Media -menu $name.m.audio - $name.m add cascade -label Window -menu $name.m.windows -# the MacOS X app menu - menu $name.m.apple -tearoff $pd_tearoff - $name.m add cascade -label "Apple" -menu $name.m.apple - } - -# the help menu - - menu $name.m.help -tearoff $pd_tearoff - $name.m add cascade -label Help -menu $name.m.help - - menu_addstd $name.m - -# the popup menu - menu $name.popup -tearoff false - $name.popup add command -label {Properties} \ - -command [concat popup_action $name 0] - $name.popup add command -label {Open} \ - -command [concat popup_action $name 1] - $name.popup add command -label {Help} \ - -command [concat popup_action $name 2] - -# fix menu font size on Windows with tk scaling = 1 -if {$pd_nt == 1} { - $name.m.file configure -font menuFont - $name.m.edit configure -font menuFont - $name.m.find configure -font menuFont - $name.m.put configure -font menuFont - $name.m.windows configure -font menuFont - $name.m.audio configure -font menuFont - $name.m.help configure -font menuFont - $name.popup configure -font menuFont -} - -# WM protocol - wm protocol $name WM_DELETE_WINDOW [concat menu_close $name] - -# bindings. -# this is idiotic -- how do you just sense what mod keys are down and -# pass them on? I can't find it anywhere. -# Here we encode shift as 1, control 2, alt 4, in agreement -# with definitions in g_canvas.c. The third button gets "8" but we don't -# bother with modifiers there. -# We don't handle multiple clicks yet. - - bind $name.c