static void *zpack_new(t_symbol *s, int argc, t_atom *argv)
{
t_zpack *x = (t_zpack *)pd_new(zpack_class);
int n =0;
x->x_argc = (argc < 1)?2:argc;
if(argc<1) {
x->x_argv=(t_atom*)getbytes(2*sizeof(t_atom));
SETFLOAT(x->x_argv+0, 0.f);
SETFLOAT(x->x_argv+1, 0.f);
} else {
int i=0;
x->x_argv=(t_atom*)getbytes(x->x_argc*sizeof(t_atom));
for(i=0; i<x->x_argc; i++)
setatom(x, argv+i, i);
}
x->in = (t_inlet **)getbytes(x->x_argc * sizeof(t_inlet *));
x->x_proxy = (t_zpackproxy**)getbytes(x->x_argc * sizeof(t_zpackproxy*));
x->in[0] =0;
x->x_proxy[0]=0;
for (n = 1; n<x->x_argc; n++) {
x->x_proxy[n]=(t_zpackproxy*)pd_new(zpackproxy_class);
x->x_proxy[n]->p_master = x;
x->x_proxy[n]->id=n;
x->in[n] = inlet_new ((t_object*)x, (t_pd*)x->x_proxy[n], 0,0);
}
outlet_new(&x->x_obj, 0);
return (x);
}
void
loadstatuschange(WebKitWebView *view, GParamSpec *pspec, Client *c) {
switch(webkit_web_view_get_load_status (c->view)) {
case WEBKIT_LOAD_COMMITTED:
setatom(c, AtomUri, geturi(c));
break;
case WEBKIT_LOAD_FINISHED:
c->progress = 0;
update(c);
break;
default:
break;
}
}
Client *
newclient(void) {
int i;
Client *c;
WebKitWebSettings *settings;
GdkGeometry hints = { 1, 1 };
char *uri, *ua;
if(!(c = calloc(1, sizeof(Client))))
die("Cannot malloc!\n");
/* Window */
if(embed) {
c->win = gtk_plug_new(embed);
}
else {
c->win = gtk_window_new(GTK_WINDOW_TOPLEVEL);
/* TA: 20091214: Despite what the GNOME docs say, the ICCCM
* is always correct, so we should still call this function.
* But when doing so, we *must* differentiate between a
* WM_CLASS and a resource on the window. By convention, the
* window class (WM_CLASS) is capped, while the resource is in
* lowercase. Both these values come as a pair.
*/
gtk_window_set_wmclass(GTK_WINDOW(c->win), "surf", "surf");
/* TA: 20091214: And set the role here as well -- so that
* sessions can pick this up.
*/
gtk_window_set_role(GTK_WINDOW(c->win), "Surf");
}
gtk_window_set_default_size(GTK_WINDOW(c->win), 800, 600);
g_signal_connect(G_OBJECT(c->win), "destroy", G_CALLBACK(destroywin), c);
g_signal_connect(G_OBJECT(c->win), "key-press-event", G_CALLBACK(keypress), c);
g_signal_connect(G_OBJECT(c->win), "size-allocate", G_CALLBACK(resize), c);
if(!(c->items = calloc(1, sizeof(GtkWidget *) * LENGTH(items))))
die("Cannot malloc!\n");
/* contextmenu */
for(i = 0; i < LENGTH(items); i++) {
c->items[i] = gtk_menu_item_new_with_label(items[i].label);
g_signal_connect(G_OBJECT(c->items[i]), "activate",
G_CALLBACK(itemclick), c);
}
/* VBox */
c->vbox = gtk_vbox_new(FALSE, 0);
/* Scrolled Window */
c->scroll = gtk_scrolled_window_new(NULL, NULL);
gtk_scrolled_window_set_policy(GTK_SCROLLED_WINDOW(c->scroll),
GTK_POLICY_NEVER, GTK_POLICY_NEVER);
/* Webview */
c->view = WEBKIT_WEB_VIEW(webkit_web_view_new());
g_signal_connect(G_OBJECT(c->view), "title-changed", G_CALLBACK(titlechange), c);
g_signal_connect(G_OBJECT(c->view), "load-progress-changed", G_CALLBACK(progresschange), c);
g_signal_connect(G_OBJECT(c->view), "load-committed", G_CALLBACK(loadcommit), c);
g_signal_connect(G_OBJECT(c->view), "load-started", G_CALLBACK(loadstart), c);
g_signal_connect(G_OBJECT(c->view), "hovering-over-link", G_CALLBACK(linkhover), c);
g_signal_connect(G_OBJECT(c->view), "create-web-view", G_CALLBACK(createwindow), c);
g_signal_connect(G_OBJECT(c->view), "new-window-policy-decision-requested", G_CALLBACK(decidewindow), c);
g_signal_connect(G_OBJECT(c->view), "mime-type-policy-decision-requested", G_CALLBACK(decidedownload), c);
g_signal_connect(G_OBJECT(c->view), "download-requested", G_CALLBACK(initdownload), c);
g_signal_connect(G_OBJECT(c->view), "window-object-cleared", G_CALLBACK(windowobjectcleared), c);
g_signal_connect(G_OBJECT(c->view), "populate-popup", G_CALLBACK(context), c);
/* Indicator */
c->indicator = gtk_drawing_area_new();
gtk_widget_set_size_request(c->indicator, 0, 2);
g_signal_connect (G_OBJECT (c->indicator), "expose_event",
G_CALLBACK (exposeindicator), c);
/* Arranging */
gtk_container_add(GTK_CONTAINER(c->scroll), GTK_WIDGET(c->view));
gtk_container_add(GTK_CONTAINER(c->win), c->vbox);
gtk_container_add(GTK_CONTAINER(c->vbox), c->scroll);
gtk_container_add(GTK_CONTAINER(c->vbox), c->indicator);
/* Setup */
gtk_box_set_child_packing(GTK_BOX(c->vbox), c->indicator, FALSE, FALSE, 0, GTK_PACK_START);
gtk_box_set_child_packing(GTK_BOX(c->vbox), c->scroll, TRUE, TRUE, 0, GTK_PACK_START);
gtk_widget_grab_focus(GTK_WIDGET(c->view));
gtk_widget_show(c->vbox);
gtk_widget_show(c->indicator);
gtk_widget_show(c->scroll);
gtk_widget_show(GTK_WIDGET(c->view));
gtk_widget_show(c->win);
gtk_window_set_geometry_hints(GTK_WINDOW(c->win), NULL, &hints, GDK_HINT_MIN_SIZE);
gdk_window_set_events(GTK_WIDGET(c->win)->window, GDK_ALL_EVENTS_MASK);
gdk_window_add_filter(GTK_WIDGET(c->win)->window, processx, c);
webkit_web_view_set_full_content_zoom(c->view, TRUE);
settings = webkit_web_view_get_settings(c->view);
if(!(ua = getenv("SURF_USERAGENT")))
ua = useragent;
g_object_set(G_OBJECT(settings), "user-agent", ua, NULL);
uri = g_strconcat("file://", stylefile, NULL);
g_object_set(G_OBJECT(settings), "user-stylesheet-uri", uri, NULL);
g_free(uri);
setatom(c, findprop, "");
c->download = NULL;
c->title = NULL;
c->next = clients;
clients = c;
if(showxid) {
gdk_display_sync(gtk_widget_get_display(c->win));
printf("%u\n", (guint)GDK_WINDOW_XID(GTK_WIDGET(c->win)->window));
fflush(NULL);
}
return c;
}
void
loadcommit(WebKitWebView *view, WebKitWebFrame *f, Client *c) {
setatom(c, uriprop, geturi(c));
}
static void zpack_list(t_zpackproxy *y, t_symbol *s, int argc, t_atom *argv)
{
if(argc>0)
setatom(y->p_master, argv, y->id);
}
static void zpack_list0(t_zpack*x, t_symbol *s, int argc, t_atom *argv) {
int i=0;
for(i=0; i<argc && i<x->x_argc; i++)
setatom(x, argv+i, i);
zpack_bang(x);
}
LISP eval (LISP expr, LISP *ctxp)
{
LISP ctx = ctxp ? *ctxp : NIL;
LISP func;
again:
if (expr == NIL)
return (NIL);
/* Если это символ, берем его значение */
if (istype (expr, TSYMBOL)) {
/* Поиск значения по контексту */
LISP pair = findatom (expr, ctx);
if (pair == NIL) {
fprintf (stderr, "unbound symbol: `%s'\n", symname (expr));
return (NIL);
}
return (cdr (pair));
}
/* Все, что не атом и не список, не вычисляется */
if (! istype (expr, TPAIR))
return (expr);
/* Перебираем специальные формы.
* quote define set! begin lambda let let* letrec if
* and or cond else => quasiquote unquote unquote-splicing
*/
/* Зарезервированные имена:
* delay do case
*/
func = car (expr);
if (istype (func, TSYMBOL)) {
char *funcname = symname (func);
if (!strcmp (funcname, "quote")) {
if (! istype (expr = cdr (expr), TPAIR))
return (NIL);
return (car (expr));
}
if (!strcmp (funcname, "define")) {
LISP value, atom, pair, arg;
int lambda;
if (! istype (expr = cdr (expr), TPAIR))
return (NIL);
lambda = istype (atom = car (expr), TPAIR);
if (lambda) {
/* define, совмещенный с lambda */
arg = cdr (atom);
atom = car (atom);
}
if (! istype (atom, TSYMBOL) ||
! istype (expr = cdr (expr), TPAIR))
return (NIL);
pair = findatom (atom, ctx);
if (pair == NIL) {
/* Расширяем контекст */
pair = cons (atom, NIL);
if (ctxp)
/* локальный контекст */
*ctxp = ctx = cons (pair, ctx);
else
/* контекст верхнего уровня */
ENV = cons (pair, ENV);
}
if (lambda)
value = closure (cons (arg, expr), ctx);
else
value = evalblock (expr, ctx);
setcdr (pair, value);
return (value);
}
if (!strcmp (funcname, "set!")) {
LISP value = NIL;
if (! istype (expr = cdr (expr), TPAIR))
return (NIL);
if (istype (cdr (expr), TPAIR))
value = evalblock (cdr (expr), ctx);
setatom (car (expr), value, ctx);
return (value);
}
if (!strcmp (funcname, "begin"))
return (evalblock (cdr (expr), ctx));
if (!strcmp (funcname, "lambda")) {
LISP arg = NIL;
if (istype (expr = cdr (expr), TPAIR)) {
arg = car (expr);
if (! istype (expr = cdr (expr), TPAIR))
expr = NIL;
}
return (closure (cons (arg, expr), ctx));
}
if (!strcmp (funcname, "let")) {
LISP arg = NIL, oldctx = ctx;
if (istype (expr = cdr (expr), TPAIR)) {
arg = car (expr);
if (! istype (expr = cdr (expr), TPAIR))
expr = NIL;
}
/* Расширяем контекст новыми переменными */
while (istype (arg, TPAIR)) {
LISP var = car (arg);
arg = cdr (arg);
/* Значения вычисляем в старом контексте */
if (istype (var, TPAIR))
ctx = cons (cons (car (var),
evalblock (cdr (var), oldctx)),
ctx);
else if (istype (var, TSYMBOL))
ctx = cons (cons (var, NIL), ctx);
}
return (evalblock (expr, ctx));
}
if (!strcmp (funcname, "let*")) {
LISP arg = NIL;
if (istype (expr = cdr (expr), TPAIR)) {
arg = car (expr);
if (! istype (expr = cdr (expr), TPAIR))
expr = NIL;
}
/* Расширяем контекст новыми переменными */
while (istype (arg, TPAIR)) {
LISP var = car (arg);
arg = cdr (arg);
/* Значения вычисляем в текущем контексте */
if (istype (var, TPAIR))
ctx = cons (cons (car (var),
evalblock (cdr (var), ctx)),
ctx);
else if (istype (var, TSYMBOL))
ctx = cons (cons (var, NIL), ctx);
}
return (evalblock (expr, ctx));
}
if (!strcmp (funcname, "letrec")) {
LISP arg = NIL, a;
if (istype (expr = cdr (expr), TPAIR)) {
arg = car (expr);
if (! istype (expr = cdr (expr), TPAIR))
expr = NIL;
}
/* Расширяем контекст новыми переменными с пустыми значениями */
for (a=arg; istype (a, TPAIR); a=cdr(a)) {
LISP var = car (a);
if (istype (var, TPAIR))
ctx = cons (cons (car (var), NIL), ctx);
else if (istype (var, TSYMBOL))
ctx = cons (cons (var, NIL), ctx);
}
/* Вычисляем значения в новом контексте */
for (a=arg; istype (a, TPAIR); a=cdr(a)) {
LISP var = car (a);
if (istype (var, TPAIR))
setatom (car (var),
evalblock (cdr (var), ctx),
ctx);
}
return (evalblock (expr, ctx));
}
if (!strcmp (funcname, "if")) {
LISP iftrue = NIL, iffalse = NIL, test;
if (! istype (expr = cdr (expr), TPAIR))
return (NIL);
test = car (expr);
if (istype (expr = cdr (expr), TPAIR)) {
iftrue = car (expr);
iffalse = cdr (expr);
}
if (eval (test, &ctx) != NIL)
return (eval (iftrue, &ctx));
return (evalblock (iffalse, ctx));
}
if (!strcmp (funcname, "and")) {
while (istype (expr = cdr (expr), TPAIR))
if (eval (car (expr), &ctx) == NIL)
return (NIL);
return (T);
}
if (!strcmp (funcname, "or")) {
while (istype (expr = cdr (expr), TPAIR))
if (eval (car (expr), &ctx) == NIL)
return (T);
return (NIL);
}
if (!strcmp (funcname, "cond")) {
LISP oldctx = ctx, test, clause;
while (istype (expr = cdr (expr), TPAIR)) {
if (! istype (clause = car (expr), TPAIR))
continue;
ctx = oldctx;
if (istype (car (clause), TSYMBOL) &&
! strcmp (symname (car (clause)), "else"))
return (evalblock (cdr (clause), ctx));
test = eval (car (clause), &ctx);
if (test == NIL ||
! istype (clause = cdr (clause), TPAIR))
continue;
if (istype (car (clause), TSYMBOL) &&
! strcmp (symname (car (clause)), "=>")) {
clause = evalblock (cdr (clause), ctx);
if (istype (clause, THARDW))
return ((*hardwval (clause)) (cons (test, NIL), ctx));
if (istype (clause, TCLOSURE))
return (evalclosure (clause, cons (test, NIL)));
return (NIL);
}
return (evalblock (clause, ctx));
}
return (NIL);
}
if (!strcmp (funcname, "quasiquote")) {
if (! istype (expr = cdr (expr), TPAIR))
return (NIL);
return (quasiquote (car (expr), ctx, 0));
}
if (!strcmp (funcname, "unquote") ||
!strcmp (funcname, "unquote-splicing")) {
if (! istype (expr = cdr (expr), TPAIR))
return (NIL);
expr = car (expr);
goto again;
}
}
/* Вычисляем все аргументы */
expr = evallist (expr, ctx);
return (evalfunc (car (expr), cdr (expr), ctxp ? *ctxp : TOPLEVEL));
}
