unofficial mirror of emacs-devel@gnu.org 
 help / color / mirror / code / Atom feed
* RFC: status icon support
@ 2008-01-11 23:28 Tom Tromey
  2008-01-12  1:57 ` Dan Nicolaescu
  2008-01-14  3:47 ` YAMAMOTO Mitsuharu
  0 siblings, 2 replies; 55+ messages in thread
From: Tom Tromey @ 2008-01-11 23:28 UTC (permalink / raw)
  To: emacs-devel

Here is a patch to add status icon support to Emacs.
I think this one is ready for review and, hopefully, checkin.

It includes documentation and the necessary configure support.
I omitted the generated files from the patch, so if you apply it you
must first run autoconf and autoheader.

The xmenu.c changes are mildly ugly, IMO.  But, this was the simplest
way to make menus on status icons work, and the damage is reasonably
localized.

Note that the Gtk docs recommend using the activation time from the
GtkStatusIcon ::popup-menu signal as one of the argument to
gtk_menu_popup.  I tried this, but it did not work, I think because we
send the popup event through the event loop, perhaps invalidating this
timestamp by the time we reach the actual popup call.  So, I did what
the Gtk docs recommend as an alternative, namely using
gtk_get_current_event_time.

There are still a few libnotify features that we do not expose to the
user.  These are not critical features (and "hints", in particular,
don't seem to be documented in a way that would make them useful for
anything), and anyway support for them can be added later if needed.

If Gtk is not available, this code is not built at all.  Other
platforms (both Windows and MacOS) do provide similar functionality,
but I do not know those platforms, so someone else would have to write
that support.  I didn't break out the guts into a platform-specific
file; that would be easy to do if someone wanted to do a port.

Once this goes in I will update my status-icon-using elisp and submit
it as well.

your comments appreciated,
Tom

ChangeLog:
2008-01-11  Tom Tromey  <tromey@redhat.com>

	* configure: Rebuild.
	* configure.in: Check for GtkStatusIcon, libnotify.

doc/lispref/ChangeLog:
2008-01-11  Tom Tromey  <tromey@redhat.com>

	* frames.texi (Status Icons): New node.
	(Frames): Update.

src/ChangeLog:
2008-01-11  Tom Tromey  <tromey@redhat.com>

	* xmenu.c: Include systray.h.
	(Fx_popup_menu): Update documentation.  Handle status-icon
	position argument.
	(create_and_show_popup_menu): Add status_icon and status_button
	arguments.  Update.  Use gtk_get_current_event_time.
	(xmenu_show): Add status_icon and status_button arguments.
	Update.
	* termhooks.h (enum event_kind) <STATUS_ICON_CLICK_EVENT>: New
	constant.
	* print.c (print_object): Handle status icons.
	* lisp.h (enum pvec_type) <PVEC_STATUS_ICON> New constant.
	<PVEC_TYPE_MASK>: Update.
	(STATUS_ICONP): New macro.
	(GC_STATUS_ICONP): Likewise.
	(allocate_status_icon, syms_of_systray): Declare.
	* keyboard.c (Qstatus_icon_click_event): New global.
	(kbd_buffer_get_event): Handle STATUS_ICON_CLICK_EVENT.
	(make_lispy_event): Likewise.
	(syms_of_keyboard): Initialize Qstatus_icon_click_event.  Define
	"status-icon-click-event" event.
	* emacs.c (main): Call syms_of_systray.
	* alloc.c: Include systray.h.
	(allocate_status_icon): New function.
	* config.in: Rebuild.
	* Makefile.in (LIBNOTIFY_CFLAGS): New variable.
	(LIBNOTIFY_LIBS): Likewise.
	(ALL_CFLAGS): Add LIBNOTIFY_CFLAGS.
	(GTK_OBJ): Add systray.o
	(LIBES): Add LIBNOTIFY_LIBS.
	(systray.o): New target.
	* systray.c: New file.
	* systray.h: New file.

Index: configure.in
===================================================================
RCS file: /sources/emacs/emacs/configure.in,v
retrieving revision 1.490
diff -u -r1.490 configure.in
--- configure.in	6 Jan 2008 11:49:25 -0000	1.490
+++ configure.in	11 Jan 2008 23:47:08 -0000
@@ -4,7 +4,7 @@
 dnl in the directory containing this script.
 dnl
 dnl  Copyright (C) 1994, 1995, 1996, 1999, 2000, 2001, 2002, 2003,
-dnl    2004, 2005, 2006, 2007  Free Software Foundation, Inc.
+dnl    2004, 2005, 2006, 2007, 2008  Free Software Foundation, Inc.
 dnl
 dnl  This file is part of GNU Emacs.
 dnl
@@ -1777,6 +1777,15 @@
               [Define to 1 if GTK has both file selection and chooser dialog.])
   fi
 
+  dnl  Check if we have GtkStatusIcon.
+  HAVE_GTK_STATUS_ICON=no
+  AC_CHECK_FUNCS(gtk_status_icon_new, HAVE_GTK_STATUS_ICON=yes)
+
+  if test "$HAVE_GTK_STATUS_ICON" = yes; then
+    AC_DEFINE(HAVE_GTK_STATUS_ICON, 1,
+              [Define to 1 if GTK has GtkStatusIcon.])
+  fi
+
   dnl Check if pthreads are available.  Emacs only needs this when using
   dnl gtk_file_chooser under Gnome.
   if test "$HAVE_GTK_FILE_CHOOSER" = yes; then
@@ -1807,6 +1816,14 @@
    fi
 fi
 
+dnl  Check if we have libnotify.
+PKG_CHECK_MODULES(LIBNOTIFY, libnotify >= 0.4.1, HAVE_LIBNOTIFY=yes,
+                  HAVE_LIBNOTIFY=no)
+if test "$HAVE_LIBNOTIFY" = yes; then
+  AC_DEFINE(HAVE_LIBNOTIFY, 1,
+            [Define to 1 if the system has libnotify.])
+fi
+
 ### Link with -lXft if available to work around a bug.
 HAVE_XFT=maybe
 if test "${HAVE_GTK}" = "yes"; then
Index: doc/lispref/frames.texi
===================================================================
RCS file: /sources/emacs/emacs/doc/lispref/frames.texi,v
retrieving revision 1.5
diff -u -r1.5 frames.texi
--- doc/lispref/frames.texi	28 Dec 2007 22:26:13 -0000	1.5
+++ doc/lispref/frames.texi	11 Jan 2008 23:49:34 -0000
@@ -1,7 +1,7 @@
 @c -*-texinfo-*-
 @c This is part of the GNU Emacs Lisp Reference Manual.
 @c Copyright (C) 1990, 1991, 1992, 1993, 1994, 1995, 1998, 1999, 2001,
-@c   2002, 2003, 2004, 2005, 2006, 2007  Free Software Foundation, Inc.
+@c   2002, 2003, 2004, 2005, 2006, 2007, 2008  Free Software Foundation, Inc.
 @c See the file elisp.texi for copying conditions.
 @setfilename ../../info/frames
 @node Frames, Positions, Windows, Top
@@ -75,6 +75,7 @@
 * Text Terminal Colors::        Defining colors for text-only terminals.
 * Resources::		        Getting resource values from the server.
 * Display Feature Testing::     Determining the features of a terminal.
+* Status Icons::                Status icons and notifications.
 @end menu
 
   @xref{Display}, for information about the related topic of
@@ -2218,6 +2219,128 @@
 width and height of an X Window frame, measured in pixels.
 @end ignore
 
+@node Status Icons
+@section Status Icons and Notifications
+@cindex status icons
+@cindex system tray
+
+Some platforms provide a ``system tray'', an area holding icons tied
+to particular applications.  Applications use these icons to
+unobtrusively communicate information to the user.  Status icons also
+support ``notifications'', which are pop-up windows displaying some
+text and perhaps having some buttons.  A notification is less
+intrusive than a dialog because it does not steal the focus and need
+not be manually dismissed.  Emacs can create and manipulate status
+icons, and send notifications.
+
+If status icons are available, the feature @code{systray} is provided.
+
+@defun make-status-icon &optional alist
+This function creates and returns a new status icon.  The optional
+argument @var{alist} provides initial properties for the icon.  Some
+properties are specially recognized; unrecognized properties are
+retained (for use by @code{status-icon-parameters}) but otherwise
+ignored.
+
+The recognized properties are:
+@table @code
+@item icon-name
+The value is the file name of the image to display on the icon.
+@code{nil} means that Emacs should display a default image.
+
+@item blinking
+If the value is non-@code{nil}, the icon will blink.  The default is
+@code{nil}.
+
+@item visible
+If the value is @code{nil}, the icon will not be shown.  The default
+is @code{t}.
+
+@item help-echo
+The value is a string which will displayed as a tooltip for the icon.
+
+@item click-callback
+The value is a no-argument function which will be called when the user
+clicks on the icon.
+
+@item menu
+The value is a menu (of any kind recognized by @code{popup-menu})
+which will be displayed when the user right-clicks on the icon.
+@end table
+@end defun
+
+@defun delete-status-icon icon
+Destroy @var{icon}.
+@end defun
+
+@defun modify-status-icon-parameters icon alist
+Modify the parameters of @var{icon} according.  @var{alist} is an
+alist of parameters of the same kind accepted by
+@code{make-status-icon}.
+@end defun
+
+@defun status-iconp object
+Return non-@code{nil} if @var{object} is a status icon.
+@end defun
+
+@defun status-icon-live-p object
+Return non-@code{nil} if @var{object} is an undestroyed status icon.
+@end defun
+
+@defun status-icon-list
+Return a list of all undestroyed status icons.
+@end defun
+
+@defun show-status-icon-message icon summary &rest args
+This function creates and displays a new notification.  Note that this
+function may not be available on all platforms, and can be missing
+even if the basic status icon support is available.
+
+@var{icon} is the status icon to which the notification should attach.
+If @var{icon} is @code{nil}, then the notification will not be
+attached to an icon, but instead will display in some default
+location.
+
+@var{summary} is the summary text of the notification, a string.
+
+@var{args}, if given, is a list of key-value pairs.  The recognized
+keys and their meanings are:
+@table @code
+@item :body @var{string}
+Set the body text of the notification.  This is ordinarily displayed
+in a different font than the summary text.
+
+@item :timeout @var{value}
+By default a notification will time out.  The default timeout interval
+is system-specific.  If @var{value} is @code{nil}, the default is
+used; if it is @code{t}, the notification will never time out.
+Otherwise, if @var{value} is an integer, then it specifies the amount
+of time in milliseconds.
+
+@item :urgency @var{value}
+Set the urgency level.  @var{value} is a symbol, one of @samp{low},
+@samp{normal}, @samp{critical}.  The default is @samp{normal}.  This
+setting may affect how the notification is displayed; for instance a
+@samp{critical} notification may have a red background.
+
+@item :icon @var{value}
+Set the notification's icon.  @samp{value} is a symbol, currently one
+of @samp{warning}, @samp{info}, @samp{question}, @samp{error}.  The
+default is @samp{info}.
+
+@item :action (@var{label} . @var{function})
+Add an action to the notification, with label @var{label}.  An action
+typically appears on the notification as a small button.  Multiple
+actions can be added, to give the user a choice of how to react to a
+given event.  @var{function} is called with no arguments if the action
+is chosen.
+
+@item :closed-callback @var{function}
+Call @var{function} with no arguments when the notification is closed.
+This is not called when the user clicks an action button.
+@end table
+@end defun
+
 @ignore
    arch-tag: 94977df6-3dca-4730-b57b-c6329e9282ba
 @end ignore
Index: src/Makefile.in
===================================================================
RCS file: /sources/emacs/emacs/src/Makefile.in,v
retrieving revision 1.361
diff -u -r1.361 Makefile.in
--- src/Makefile.in	2 Dec 2007 16:23:40 -0000	1.361
+++ src/Makefile.in	11 Jan 2008 23:47:12 -0000
@@ -1,6 +1,6 @@
 # Makefile for GNU Emacs.
 # Copyright (C) 1985, 1987, 1988, 1993, 1994, 1995, 1999, 2000, 2001, 2002,
-#               2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+#               2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 # This file is part of GNU Emacs.
 
@@ -268,6 +268,11 @@
 DBUS_OBJ = dbusbind.o
 #endif
 
+#ifdef HAVE_LIBNOTIFY
+LIBNOTIFY_CFLAGS = @LIBNOTIFY_CFLAGS@
+LIBNOTIFY_LIBS = @LIBNOTIFY_LIBS@
+#endif
+
 /* DO NOT use -R.  There is a special hack described in lastfile.c
    which is used instead.  Some initialized data areas are modified
    at initial startup, then labeled as part of the text area when
@@ -281,7 +286,7 @@
 
 /* C_SWITCH_X_SITE must come before C_SWITCH_X_MACHINE and C_SWITCH_X_SYSTEM
    since it may have -I options that should override those two.  */
-ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(TOOLKIT_DEFINES) $(MYCPPFLAGS) -I. -I${srcdir} C_SWITCH_MACHINE C_SWITCH_SYSTEM C_SWITCH_SITE C_SWITCH_X_SITE C_SWITCH_X_MACHINE C_SWITCH_X_SYSTEM C_SWITCH_SYSTEM_TEMACS ${CFLAGS_SOUND} ${RSVG_CFLAGS} ${DBUS_CFLAGS} ${CFLAGS}
+ALL_CFLAGS=-Demacs -DHAVE_CONFIG_H $(TOOLKIT_DEFINES) $(MYCPPFLAGS) -I. -I${srcdir} C_SWITCH_MACHINE C_SWITCH_SYSTEM C_SWITCH_SITE C_SWITCH_X_SITE C_SWITCH_X_MACHINE C_SWITCH_X_SYSTEM C_SWITCH_SYSTEM_TEMACS ${CFLAGS_SOUND} ${RSVG_CFLAGS} ${DBUS_CFLAGS} ${LIBNOTIFY_CFLAGS} ${CFLAGS}
 .c.o:
 	$(CC) -c $(CPPFLAGS) $(ALL_CFLAGS) $<
 
@@ -309,7 +314,7 @@
 #ifdef HAVE_MENUS
 
 #ifdef USE_GTK
-GTK_OBJ= gtkutil.o
+GTK_OBJ= gtkutil.o systray.o
 #endif
 
 /* The X Menu stuff is present in the X10 distribution, but missing
@@ -945,6 +950,7 @@
    duplicated symbols.  If the standard libraries were compiled
    with GCC, we might need gnulib again after them.  */
 LIBES = $(LOADLIBES) $(LIBS) $(LIBX) $(LIBSOUND) $(RSVG_LIBS) $(DBUS_LIBS) \
+   $(LIBNOTIFY_LIBS) \
    LIBGPM LIBRESOLV LIBS_SYSTEM LIBS_MACHINE LIBS_TERMCAP \
    LIBS_DEBUG $(GETLOADAVG_LIBS) $(GNULIB_VAR) LIB_MATH LIB_STANDARD \
    $(GNULIB_VAR)
@@ -1190,6 +1196,7 @@
 sysdep.o: sysdep.c syssignal.h systty.h systime.h syswait.h blockinput.h \
    process.h dispextern.h termhooks.h termchar.h termopts.h \
    frame.h atimer.h window.h msdos.h dosfns.h keyboard.h cm.h $(config_h)
+systray.o: systray.c $(config_h) lisp.h frame.h
 term.o: term.c termchar.h termhooks.h termopts.h $(config_h) cm.h frame.h \
    disptab.h dispextern.h keyboard.h charset.h coding.h ccl.h msdos.h \
    window.h keymap.h blockinput.h atimer.h systime.h
Index: src/alloc.c
===================================================================
RCS file: /sources/emacs/emacs/src/alloc.c,v
retrieving revision 1.432
diff -u -r1.432 alloc.c
--- src/alloc.c	16 Nov 2007 21:24:59 -0000	1.432
+++ src/alloc.c	11 Jan 2008 23:47:12 -0000
@@ -1,6 +1,6 @@
 /* Storage allocation and gc for GNU Emacs Lisp interpreter.
    Copyright (C) 1985, 1986, 1988, 1993, 1994, 1995, 1997, 1998, 1999,
-      2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007  Free Software Foundation, Inc.
+      2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008  Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -56,6 +56,7 @@
 #include "charset.h"
 #include "syssignal.h"
 #include "termhooks.h"		/* For struct terminal.  */
+#include "systray.h"
 #include <setjmp.h>
 
 /* GC_MALLOC_CHECK defined means perform validity checks of malloc'd
@@ -3021,6 +3022,17 @@
   return f;
 }
 
+struct status_icon *
+allocate_status_icon ()
+{
+  struct status_icon *s = ALLOCATE_PSEUDOVECTOR (struct status_icon,
+						 notification_alist,
+						 PVEC_STATUS_ICON);
+  /* Zero out the non-GC'd fields.  FIXME: This should be made unnecessary.  */
+  bzero (&(s->param_alist),
+	 ((char*)(s+1)) - ((char*)&(s->notification_alist)));
+  return s;
+}
 
 struct Lisp_Process *
 allocate_process ()
Index: src/emacs.c
===================================================================
RCS file: /sources/emacs/emacs/src/emacs.c,v
retrieving revision 1.413
diff -u -r1.413 emacs.c
--- src/emacs.c	2 Dec 2007 16:23:40 -0000	1.413
+++ src/emacs.c	11 Jan 2008 23:47:12 -0000
@@ -1,6 +1,6 @@
 /* Fully extensible Emacs, running on Unix, intended for GNU.
    Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1997, 1998, 1999,
-                 2001, 2002, 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+                 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -1643,6 +1643,10 @@
       syms_of_dbusbind ();
 #endif /* HAVE_DBUS */
 
+#ifdef HAVE_GTK
+      syms_of_systray ();
+#endif
+
 #ifdef SYMS_SYSTEM
       SYMS_SYSTEM;
 #endif
Index: src/keyboard.c
===================================================================
RCS file: /sources/emacs/emacs/src/keyboard.c,v
retrieving revision 1.937
diff -u -r1.937 keyboard.c
--- src/keyboard.c	6 Jan 2008 21:34:57 -0000	1.937
+++ src/keyboard.c	11 Jan 2008 23:47:13 -0000
@@ -500,6 +500,8 @@
 #ifdef HAVE_DBUS
 Lisp_Object Qdbus_event;
 #endif
+Lisp_Object Qstatus_icon_click_event;
+
 /* Lisp_Object Qmouse_movement; - also an event header */
 
 /* Properties of event headers.  */
@@ -4298,6 +4300,11 @@
 	  kbd_fetch_ptr = event + 1;
 	}
 #endif
+      else if (event->kind == STATUS_ICON_CLICK_EVENT)
+	{
+	  obj = make_lispy_event (event);
+	  kbd_fetch_ptr = event + 1;
+	}
       else
 	{
 	  /* If this event is on a different frame, return a switch-frame this
@@ -6174,6 +6181,9 @@
       }
 #endif /* HAVE_DBUS */
 
+    case STATUS_ICON_CLICK_EVENT:
+      return Fcons (Qstatus_icon_click_event, event->arg);
+
 #ifdef HAVE_GPM
     case GPM_CLICK_EVENT:
       {
@@ -11781,6 +11791,9 @@
   staticpro (&Qdbus_event);
 #endif
 
+  Qstatus_icon_click_event = intern ("status-icon-click-event");
+  staticpro (&Qstatus_icon_click_event);
+
   Qmenu_enable = intern ("menu-enable");
   staticpro (&Qmenu_enable);
   Qmenu_alias = intern ("menu-alias");
@@ -12517,6 +12530,9 @@
   initial_define_lispy_key (Vspecial_event_map, "dbus-event",
 			    "dbus-handle-event");
 #endif
+
+  initial_define_lispy_key (Vspecial_event_map, "status-icon-click-event",
+			    "status-icon-handle-click-event");
 }
 
 /* Mark the pointers in the kboard objects.
Index: src/lisp.h
===================================================================
RCS file: /sources/emacs/emacs/src/lisp.h,v
retrieving revision 1.603
diff -u -r1.603 lisp.h
--- src/lisp.h	22 Nov 2007 01:01:26 -0000	1.603
+++ src/lisp.h	11 Jan 2008 23:47:14 -0000
@@ -349,7 +349,8 @@
   PVEC_HASH_TABLE = 0x40000,
   PVEC_TERMINAL = 0x80000,
   PVEC_OTHER = 0x100000,
-  PVEC_TYPE_MASK = 0x1ffe00
+  PVEC_STATUS_ICON = 0x200000,
+  PVEC_TYPE_MASK = 0x2ffe00
 
 #if 0 /* This is used to make the value of PSEUDOVECTOR_FLAG available to
 	 GDB.  It doesn't work on OS Alpha.  Moved to a variable in
@@ -1552,6 +1553,8 @@
 #define GC_BOOL_VECTOR_P(x) GC_PSEUDOVECTORP (x, PVEC_BOOL_VECTOR)
 #define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME)
 #define GC_FRAMEP(x) GC_PSEUDOVECTORP (x, PVEC_FRAME)
+#define STATUS_ICONP(x) PSEUDOVECTORP (x, PVEC_STATUS_ICON)
+#define GC_STATUS_ICONP(x) GC_PSEUDOVECTORP (x, PVEC_STATUS_ICON)
 
 #define SUB_CHAR_TABLE_P(x) (CHAR_TABLE_P (x) && NILP (XCHAR_TABLE (x)->top))
 
@@ -2616,6 +2620,7 @@
 extern struct Lisp_Hash_Table *allocate_hash_table P_ ((void));
 extern struct window *allocate_window P_ ((void));
 extern struct frame *allocate_frame P_ ((void));
+extern struct status_icon *allocate_status_icon P_ ((void));
 extern struct Lisp_Process *allocate_process P_ ((void));
 extern struct terminal *allocate_terminal P_ ((void));
 extern int gc_in_progress;
@@ -3248,6 +3253,9 @@
 extern void syms_of_sound P_ ((void));
 extern void init_sound P_ ((void));
 
+/* Defined in systray.c */
+extern void syms_of_systray P_ ((void));
+
 /* Defined in category.c */
 extern void init_category_once P_ ((void));
 extern void syms_of_category P_ ((void));
Index: src/print.c
===================================================================
RCS file: /sources/emacs/emacs/src/print.c,v
retrieving revision 1.243
diff -u -r1.243 print.c
--- src/print.c	22 Nov 2007 16:16:02 -0000	1.243
+++ src/print.c	11 Jan 2008 23:47:14 -0000
@@ -2031,6 +2031,8 @@
 	  strout (buf, -1, -1, printcharfun, 0);
 	  PRINTCHAR ('>');
 	}
+      else if (STATUS_ICONP (obj))
+	strout ("#<status-icon>", -1, -1, printcharfun, 0);
       else
 	{
 	  EMACS_INT size = XVECTOR (obj)->size;
Index: src/systray.c
===================================================================
RCS file: src/systray.c
diff -N src/systray.c
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ src/systray.c	11 Jan 2008 23:47:14 -0000
@@ -0,0 +1,680 @@
+/* Elisp bindings system tray icons
+   Copyright (C) 2007, 2008 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs; see the file COPYING.  If not, write to
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+
+#include "lisp.h"
+#include "systray.h"
+#include "frame.h"
+#include "charset.h"
+#include "coding.h"
+#include "blockinput.h"
+#include "termhooks.h"
+#include "xterm.h"
+
+#include <gtk/gtk.h>
+
+#ifdef HAVE_LIBNOTIFY
+#include <libnotify/notify.h>
+#endif
+
+#ifdef HAVE_GTK_STATUS_ICON
+
+/* FIXME: should be in a header.  */
+extern Lisp_Object Qhelp_echo;
+extern Lisp_Object Qmenu;
+extern Lisp_Object Qstatus_icon_click_event;
+
+Lisp_Object Vstatus_icon_list;
+Lisp_Object Vstandalone_icon;
+
+Lisp_Object Qblinking;
+Lisp_Object Qstatus_icon_live_p;
+Lisp_Object Qclick_callback;
+Lisp_Object QCbody, QCtimeout, QCurgency, QCicon, QCaction, QCclosed_callback;
+Lisp_Object Qlow, Qcritical, Qwarning, Qquestion, Qerror;
+Lisp_Object Qpopup_menu;
+
+#define GET_ICON(s) ((GtkStatusIcon *) ((s)->icon))
+
+/* Callback which is called when the user clicks on a status icon.  */
+static void
+activate_icon (widget, data)
+     GtkWidget *widget;
+     gpointer data;
+{
+  Lisp_Object icon = (Lisp_Object) data;
+
+  /* Just ignore garbage.  */
+  if (STATUS_ICON_LIVE_P (XSTATUS_ICON (icon)))
+    {
+      struct status_icon *sicon = XSTATUS_ICON (icon);
+      Lisp_Object elt = Fassq (Qmenu, sicon->param_alist);
+      if (CONSP (elt) && FUNCTIONP (XCDR (elt)))
+	{
+	  struct input_event event;
+	  EVENT_INIT (event);
+	  event.kind = STATUS_ICON_CLICK_EVENT;
+	  event.frame_or_window = Qnil;
+	  event.arg = XCDR (elt);
+	  kbd_buffer_store_event (&event);
+	}
+    }
+}
+
+static void
+pop_up_status_menu (gicon, button, activate_time, user_data)
+     GtkStatusIcon *gicon;
+     guint button;
+     guint activate_time;
+     gpointer user_data;
+{
+  Lisp_Object icon = (Lisp_Object) user_data;
+
+  /* Just ignore garbage.  */
+  if (STATUS_ICON_LIVE_P (XSTATUS_ICON (icon)))
+    {
+      struct status_icon *sicon = XSTATUS_ICON (icon);
+      Lisp_Object elt = Fassq (Qmenu, sicon->param_alist);
+      if (CONSP (elt) && ! NILP (XCDR (elt)))
+	{
+	  struct gcpro gcpro1;
+	  struct input_event event;
+	  Lisp_Object function;
+
+	  GCPRO1 (function);
+	  /* Construct the 'position' list.  */
+	  function = Fcons (icon,
+			    Fcons (make_number (button), Qnil));
+	  function = Fcons (Qquote,
+			    Fcons (function, Qnil));
+	  /* Construct the call to `popup-menu'.  */
+	  function = Fcons (Qpopup_menu,
+			    Fcons (Fcons (Qquote,
+					  Fcons (XCDR (elt), Qnil)),
+				   Fcons (function, Qnil)));
+	  /* Construct the function.  */
+	  function = Fcons (Qlambda,
+			    Fcons (Qnil,
+				   Fcons (function, Qnil)));
+
+	  EVENT_INIT (event);
+	  event.kind = STATUS_ICON_CLICK_EVENT;
+	  event.frame_or_window = Qnil;
+	  event.arg = function;
+	  kbd_buffer_store_event (&event);
+	}
+    }
+}
+
+/* Apply property KEY with value VALUE to icon SICON.  */
+static void
+apply_one_icon_property (sicon, key, value)
+     struct status_icon *sicon;
+     Lisp_Object key, value;
+{
+  if (EQ (key, Qicon_name))
+    {
+      struct gcpro gcpro1;
+      Lisp_Object filename = Qnil;
+      GCPRO1 (filename);
+      if (NILP (value))
+	{
+	  /* Default to the GNU.  */
+	  filename = build_string ("emacs_48.png");
+	}
+      else
+	{
+	  CHECK_STRING (value);
+	  filename = value;
+	}
+      /* Not clear if x_find_image_file returns a string with the
+	 correct encoding for Gtk.  However, it is already used this
+	 way in gtkutil.c.  */
+      filename = x_find_image_file (filename);
+      if (NILP (filename))
+	{
+	  /* No good choice, so choose a semi-appropriate stock
+	     icon.  */
+	  gtk_status_icon_set_from_stock (GET_ICON (sicon),
+					  GTK_STOCK_DIALOG_QUESTION);
+	}
+      else
+	gtk_status_icon_set_from_file (GET_ICON (sicon),
+				       (char *) SDATA (filename));
+      UNGCPRO;
+    }
+  else if (EQ (key, Qblinking))
+    gtk_status_icon_set_blinking (GET_ICON (sicon), ! NILP (value));
+  else if (EQ (key, Qvisible))
+    gtk_status_icon_set_visible (GET_ICON (sicon), ! NILP (value));
+  else if (EQ (key, Qhelp_echo))
+    {
+      struct gcpro gcpro1;
+      Lisp_Object tooltip = Qnil;
+      GCPRO1 (tooltip);
+      if (NILP (value))
+	gtk_status_icon_set_tooltip (GET_ICON (sicon), NULL);
+      else
+	{
+	  /* FIXME: should accept a sexp to eval here.  */
+	  CHECK_STRING (value);
+	  tooltip = ENCODE_UTF_8 (value);
+	  gtk_status_icon_set_tooltip (GET_ICON (sicon),
+				       (char *) SDATA (tooltip));
+	}
+      UNGCPRO;
+    }
+  else
+    {
+      /* Ignore things we don't understand.  */
+    }
+}
+
+/* Apply the ALIST of properties to status icon ICON.  */
+static void
+apply_status_icon_alist (icon, alist)
+     Lisp_Object icon, alist;
+{
+  Lisp_Object tail;
+  struct status_icon *sicon;
+
+  CHECK_LIVE_STATUS_ICON (icon);
+  sicon = XSTATUS_ICON (icon);
+
+  for (tail = alist; CONSP (tail); tail = XCDR (tail))
+    {
+      Lisp_Object key, value;
+      Lisp_Object elt = XCAR (tail);
+      if (! CONSP (elt))
+	continue;
+      key = XCAR (elt);
+      value = XCDR (elt);
+
+      apply_one_icon_property (sicon, key, value);
+
+      /* Update frame parameters.  */
+      elt = Fassq (key, sicon->param_alist);
+      if (NILP (elt))
+	sicon->param_alist = Fcons (Fcons (key, value), sicon->param_alist);
+      else
+	Fsetcdr (elt, value);
+    }
+}
+
+DEFUN ("make-status-icon", Fmake_status_icon, Smake_status_icon,
+       0, 1, 0,
+       doc: /* Return a newly created status icon.
+Optional argument ALIST is an alist of parameters for the new frame.
+See `modify-status-icon-parameters' for a list of recognized parameters.*/)
+     (alist)
+     Lisp_Object alist;
+{
+  struct status_icon *sicon;
+  Lisp_Object icon, deflist;
+  struct gcpro gcpro1;
+
+  check_x ();
+
+  BLOCK_INPUT;
+
+  sicon = allocate_status_icon ();
+  XSETSTATUS_ICON (icon, sicon);
+  sicon->param_alist = Qnil;
+  sicon->notification_alist = Qnil;
+  sicon->icon = gtk_status_icon_new ();
+
+  g_signal_connect (sicon->icon, "activate", G_CALLBACK (activate_icon),
+		    (gpointer) icon);
+  g_signal_connect (sicon->icon, "popup-menu", G_CALLBACK (pop_up_status_menu),
+		    (gpointer) icon);
+
+  Vstatus_icon_list = Fcons (icon, Vstatus_icon_list);
+
+  GCPRO1 (deflist);
+
+  /* Make some defaults.  */
+  deflist = Fcons (Fcons (Qclick_callback, Qnil),
+		   Fcons (Fcons (Qicon_name, Qnil),
+			  Fcons (Fcons (Qblinking, Qnil),
+				 Fcons (Fcons (Qvisible, Qt),
+					Fcons (Fcons (Qhelp_echo, Qnil),
+					       alist)))));
+  apply_status_icon_alist (icon, deflist);
+
+  UNBLOCK_INPUT;
+
+  RETURN_UNGCPRO (icon);
+}
+
+DEFUN ("modify-status-icon-parameters", Fmodify_status_icon_parameters,
+       Smodify_status_icon_parameters,
+       2, 2, 0,
+       doc: /* Modify the parameters of status icon ICON according to ALIST.
+Each element of alist has the form (PARM . VALUE), where PARM is a symbol.
+Undefined PARMs are ignored, but stored in the frame's parameter list
+so that `status-icon-parameters' will return them.
+
+Currently defined parameters and their values are:
+
+  icon-name       The file name of an icon to display.
+  blinking        If non-nil, the status icon will blink.
+  visible         If nil, status icon is invisible.
+  help-echo       A string which will be displayed as a tooltip for the
+                  status icon.
+  click-callback  A no-argument function which will be called when the
+                  user clicks on the icon.
+  menu            A menu which will pop up when the user clicks on the
+                  icon.  May not be available on all platforms.*/)
+     (icon, alist)
+     Lisp_Object icon, alist;
+{
+  BLOCK_INPUT;
+  apply_status_icon_alist (icon, alist);
+  UNBLOCK_INPUT;
+  return Qnil;
+}
+
+DEFUN ("status-icon-parameters", Fstatus_icon_parameters,
+       Sstatus_icon_parameters,
+       1, 1, 0,
+       doc: /* Return the parameters-alist of the status icon ICON.
+It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.*/)
+     (icon)
+     Lisp_Object icon;
+{
+  struct status_icon *sicon;
+  CHECK_LIVE_STATUS_ICON (icon);
+  sicon = XSTATUS_ICON (icon);
+  return Fcopy_alist (sicon->param_alist);
+}
+
+DEFUN ("status-icon-list", Fstatus_icon_list, Sstatus_icon_list,
+       0, 0, 0,
+       doc: /* Return a list of all status icons.  */)
+     ()
+{
+  return Fcopy_sequence (Vstatus_icon_list);
+}
+
+DEFUN ("delete-status-icon", Fdelete_status_icon, Sdelete_status_icon,
+       1, 1, 0,
+       doc: /* Delete the status icon ICON.  */)
+     (icon)
+     Lisp_Object icon;
+{
+  struct status_icon *sicon;
+  CHECK_LIVE_STATUS_ICON (icon);
+  sicon = XSTATUS_ICON (icon);
+  BLOCK_INPUT;
+  g_object_unref (sicon->icon);
+  UNBLOCK_INPUT;
+  sicon->icon = NULL;
+  Vstatus_icon_list = Fdelq (icon, Vstatus_icon_list);
+  return Qnil;
+}
+
+#ifdef HAVE_LIBNOTIFY
+
+/* Called in response to notification action clicks.  */
+static void
+handle_notification_event (notification, action_number, callback_arg)
+     NotifyNotification *notification;
+     int action_number;
+     Lisp_Object callback_arg;
+{
+  Lisp_Object icon = XCAR (callback_arg);
+  struct status_icon *sicon = XSTATUS_ICON (icon);
+  Lisp_Object callback = Fnth (make_number (action_number + 2), callback_arg);
+  if (FUNCTIONP (callback))
+    {
+      struct input_event event;
+      EVENT_INIT (event);
+      event.kind = STATUS_ICON_CLICK_EVENT;
+      event.frame_or_window = Qnil;
+      event.arg = callback;
+      kbd_buffer_store_event (&event);
+    }
+  sicon->notification_alist = Fdelq (callback_arg,
+				     sicon->notification_alist);
+  g_object_unref (notification);
+}
+
+static void
+action_click (notification, actionid, user_data)
+     NotifyNotification *notification;
+     gchar *actionid;
+     gpointer user_data;
+{
+  int id = atoi (actionid);
+  Lisp_Object callback_arg = (Lisp_Object) user_data;
+  handle_notification_event (notification, id, callback_arg);
+}
+
+static void
+cleanup_notification (notification, user_data)
+     NotifyNotification *notification;
+     gpointer user_data;
+{
+  Lisp_Object callback_arg = (Lisp_Object) user_data;
+  handle_notification_event (notification, -1, callback_arg);
+}
+
+DEFUN ("show-status-icon-message", Fshow_status_icon_message,
+       Sshow_status_icon_message,
+       2, MANY, 0,
+       doc: /* Post a notification message attached to the icon ICON.
+ICON is a status icon created by `make-status-icon', or nil for a
+standalone notification.
+SUMMARY is the message to display, a string.
+
+The remaining arguments, if any, are a property list specifying
+additional parameters of the notification:
+
+  :body STRING     Set the body text of the notification.
+  :timeout VALUE   Set the timeout value.
+                   nil means use the default.
+		   t means never time out.
+		   An integer specifies the timeout in milliseconds.
+  :urgency VALUE   Set the urgency level.  VALUE is a symbol, one of
+                   'low', 'normal', 'critical'.  The default is 'normal'.
+  :icon VALUE      Set the notification icon.  VALUE is a symbol, currently
+                   one of 'warning', 'info', 'question', 'error'.  The
+		   default is 'info'.
+  :action (LABEL . FUNCTION)
+                   Add an action to the notification, with label LABEL.
+		   FUNCTION is called with no arguments if the action
+		   is chosen.
+  :closed-callback FUNCTION
+                   Call FUNCTION with no arguments when the notification
+		   is closed.  This is not called when the user clicks
+		   an action button.
+
+usage: (show-status-icon-message ICON SUMMARY &rest ARGS)  */)
+     (nargs, args)
+     int nargs;
+     Lisp_Object *args;
+{
+  struct status_icon *sicon;
+  struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
+  Lisp_Object gc_temp = Qnil;
+  Lisp_Object callback_list = Qnil;
+  Lisp_Object closed_callback = Qnil;
+  Lisp_Object callback_arg = Qnil;
+  NotifyNotification *notification;
+
+  int i;
+  int action_count = 0;
+  Lisp_Object icon = args[0];
+  Lisp_Object summary = args[1];
+
+  check_x ();
+  if ((nargs - 2) % 2 != 0)
+    error ("Invalid number of arguments");
+
+  if (! NILP (icon))
+    CHECK_LIVE_STATUS_ICON (icon);
+  CHECK_STRING (summary);
+
+  BLOCK_INPUT;
+
+  if (! notify_is_initted () && ! notify_init ("Emacs"))
+    {
+      UNBLOCK_INPUT;
+      error ("Couldn't connect to notification server");
+    }
+
+  GCPRO4 (gc_temp, callback_list, closed_callback, callback_arg);
+  gc_temp = ENCODE_UTF_8 (summary);
+
+  /* Pre-allocate the cons that will be passed to all callbacks.  We
+     will fill it in later.  */
+  callback_arg = Fcons (Qnil, Qnil);
+
+  if (! NILP (icon))
+    {
+      sicon = XSTATUS_ICON (icon);
+      notification
+	= notify_notification_new_with_status_icon (SDATA (gc_temp), NULL,
+						    GTK_STOCK_DIALOG_INFO,
+						    GET_ICON (XSTATUS_ICON (icon)));
+    }
+  else
+    {
+      icon = Vstandalone_icon;
+      sicon = XSTATUS_ICON (icon);
+      notification
+	= notify_notification_new (SDATA (gc_temp), NULL, GTK_STOCK_DIALOG_INFO,
+				   NULL);
+    }
+
+  for (i = 2; i < nargs; i += 2)
+    {
+      Lisp_Object key = args[i];
+      Lisp_Object value = args[i + 1];
+      /* FIXME: still no access to: setting the icon from a pixbuf,
+	 maybe hints (what are they good for?), closing the
+	 notification by caller.  */
+      if (EQ (key, QCbody))
+	{
+	  /* Ignore things we don't understand.  */
+	  if (STRINGP (value))
+	    {
+	      gc_temp = ENCODE_UTF_8 (value);
+	      g_object_set (G_OBJECT (notification), "body", SDATA (gc_temp),
+			    NULL);
+	    }
+	}
+      else if (EQ (key, QCtimeout))
+	{
+	  gint timeout = NOTIFY_EXPIRES_DEFAULT;
+	  if (EQ (value, Qt))
+	    timeout = NOTIFY_EXPIRES_NEVER;
+	  else if (INTEGERP (value))
+	    {
+	      timeout = XINT (value);
+	      if (timeout <= 0)
+		timeout = NOTIFY_EXPIRES_DEFAULT;
+	    }
+	  notify_notification_set_timeout (notification, timeout);
+	}
+      else if (EQ (key, QCurgency))
+	{
+	  NotifyUrgency urgency = NOTIFY_URGENCY_NORMAL;
+	  if (EQ (value, Qlow))
+	    urgency = NOTIFY_URGENCY_LOW;
+	  else if (EQ (value, Qcritical))
+	    urgency = NOTIFY_URGENCY_CRITICAL;
+	  notify_notification_set_urgency (notification, urgency);
+	}
+      else if (EQ (key, QCicon))
+	{
+	  char *icon_name = GTK_STOCK_DIALOG_INFO;
+	  if (EQ (value, Qwarning))
+	    icon_name = GTK_STOCK_DIALOG_WARNING;
+	  else if (EQ (value, Qquestion))
+	    icon_name = GTK_STOCK_DIALOG_QUESTION;
+	  else if (EQ (value, Qerror))
+	    icon_name = GTK_STOCK_DIALOG_ERROR;
+	  g_object_set (G_OBJECT (notification), "icon-name", icon_name, NULL);
+	}
+      else if (EQ (key, QCaction))
+	{
+	  /* Ignore if we don't understand the value.  */
+	  if (CONSP (value) && STRINGP (XCAR (value)))
+	    {
+	      char actionid[20];
+	      Lisp_Object label = XCAR (value);
+	      gc_temp = ENCODE_UTF_8 (label);
+	      /* Use a plain integer for the action id, because we
+		 will use it later to look up the action.  */
+	      sprintf (actionid, "%d", action_count);
+	      ++action_count;
+	      notify_notification_add_action (notification, actionid,
+					      SDATA (gc_temp),
+					      action_click,
+					      (gpointer) callback_arg, NULL);
+
+	      /* We build the list from the back, the reverse it
+		 later.  */
+	      callback_list = Fcons (XCDR (value), callback_list);
+	    }
+	}
+      else if (EQ (key, QCclosed_callback))
+	closed_callback = value;
+    }
+
+  /* Put the callback list into the right order, then put the 'closed'
+     callback at the start of the list.  */
+  callback_list = Fcons (closed_callback, Fnreverse (callback_list));
+
+  XSETCAR (callback_arg, icon);
+  XSETCDR (callback_arg, callback_list);
+  sicon->notification_alist = Fcons (callback_arg, sicon->notification_alist);
+
+  /* Arrange to clean up when this notification goes away.  */
+  g_signal_connect (G_OBJECT (notification), "closed",
+		    G_CALLBACK (cleanup_notification),
+		    (gpointer) callback_arg);
+
+  /* Ignore errors here for now.  */
+  notify_notification_show (notification, NULL);
+
+  UNBLOCK_INPUT;
+
+  RETURN_UNGCPRO (Qnil);
+}
+
+#endif /* HAVE_LIBNOTIFY */
+
+DEFUN ("status-iconp", Fstatus_iconp, Sstatus_iconp,
+       1, 1, 0, doc: /* Return non-nil if OBJECT is a status icon.  */)
+     (object)
+     Lisp_Object object;
+{
+  return STATUS_ICONP (object) ? Qt : Qnil;
+}
+
+DEFUN ("status-icon-live-p", Fstatus_icon_live_p, Sstatus_icon_live_p,
+       1, 1, 0,
+       doc: /* Return non-nil if OBJECT is a status icon which has not been deleted.*/)
+     (object)
+     Lisp_Object object;
+{
+  return ((STATUS_ICONP (object) && STATUS_ICON_LIVE_P (XSTATUS_ICON (object)))
+	  ? Qt : Qnil);
+}
+
+DEFUN ("status-icon-handle-click-event", Fstatus_icon_handle_click_event,
+       Sstatus_icon_handle_click_event,
+       1, 1, "e",
+       doc: /* Internal handler for status icon click events.
+A status icon click event is generated in response to the user clicking
+on a status icon.  This handler calls the specified callback function,
+if any.*/)
+     (event)
+     Lisp_Object event;
+{
+  Lisp_Object fun;
+  struct gcpro gcpro1;
+
+  /* Just ignore garbage.  */
+  if (! CONSP (event) || ! EQ (XCAR (event), Qstatus_icon_click_event)
+      || ! FUNCTIONP (XCDR (event)))
+    return Qnil;
+
+  GCPRO1 (fun);
+  fun = XCDR (event);
+  Ffuncall (1, &fun);
+  RETURN_UNGCPRO (Qnil);
+}
+
+void
+syms_of_systray ()
+{
+  struct status_icon *sicon;
+
+  Qstatus_icon_live_p = intern ("status-icon-live-p");
+  staticpro (&Qstatus_icon_live_p);
+  Qblinking = intern ("blinking");
+  staticpro (&Qblinking);  
+  Qclick_callback = intern ("click-callback");
+  staticpro (&Qclick_callback);
+  QCbody = intern (":body");
+  staticpro (&QCbody);
+  QCtimeout = intern (":timeout");
+  staticpro (&QCtimeout);
+  QCurgency = intern (":urgency");
+  staticpro (&QCurgency);
+  QCicon = intern (":icon");
+  staticpro (&QCicon);
+  QCaction = intern (":action");
+  staticpro (&QCaction);
+  QCclosed_callback = intern (":closed-callback");
+  staticpro (&QCclosed_callback);
+  Qlow = intern ("low");
+  staticpro (&Qlow);
+  Qcritical = intern ("critical");
+  staticpro (&Qcritical);
+  Qwarning = intern ("warning");
+  staticpro (&Qwarning);
+  Qquestion = intern ("question");
+  staticpro (&Qquestion);
+  Qerror = intern ("error");
+  staticpro (&Qerror);
+  Qpopup_menu = intern ("popup-menu");
+  staticpro (&Qpopup_menu);
+
+  staticpro (&Vstatus_icon_list);
+  Vstatus_icon_list = Qnil;
+
+  defsubr (&Smake_status_icon);
+  defsubr (&Smodify_status_icon_parameters);
+  defsubr (&Sdelete_status_icon);
+  defsubr (&Sstatus_icon_parameters);
+  defsubr (&Sstatus_icon_list);
+#ifdef HAVE_LIBNOTIFY
+  defsubr (&Sshow_status_icon_message);
+#endif /* HAVE_LIBNOTIFY */
+  defsubr (&Sstatus_iconp);
+  defsubr (&Sstatus_icon_live_p);
+  defsubr (&Sstatus_icon_handle_click_event);
+
+  /* We make a dummy status icon so that standalone notifications have
+     a place to store their user-data.  This icon never has a GUI or
+     associated native state.  */
+  staticpro (&Vstandalone_icon);
+  sicon = allocate_status_icon ();
+  sicon->param_alist = Qnil;
+  sicon->notification_alist = Qnil;
+  XSETSTATUS_ICON (Vstandalone_icon, sicon);
+
+  Fprovide (intern ("systray"), Qnil);
+}
+
+#else /* HAVE_GTK_STATUS_ICON */
+
+void
+syms_of_systray ()
+{
+  /* Nothing.  */
+}
+
+#endif
Index: src/systray.h
===================================================================
RCS file: src/systray.h
diff -N src/systray.h
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ src/systray.h	11 Jan 2008 23:47:14 -0000
@@ -0,0 +1,56 @@
+/* Define systray object for GNU Emacs.
+   Copyright (C) 2007, 2008 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs; see the file COPYING.  If not, write to
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#ifndef EMACS_SYSTRAY_H
+#define EMACS_SYSTRAY_H
+
+extern Lisp_Object Qstatus_icon_live_p;
+
+struct status_icon
+{
+  EMACS_UINT size;
+  struct Lisp_Vector *next;
+
+  /* Parameter alist of this status icon.  */
+  Lisp_Object param_alist;
+
+  /* List holding objects we want to keep live while a notification is
+     up.  */
+  Lisp_Object notification_alist;
+
+  /* Beyond here, there should be no more Lisp_Object components.  */
+
+  /* The icon widget, or NULL if it has been destroyed.  Really a
+     'GtkStatusIcon *'.  */
+  void *icon;
+};
+
+#define XSTATUS_ICON(p) \
+  (eassert (GC_STATUS_ICONP (p)), (struct status_icon *) XPNTR (p))
+
+#define XSETSTATUS_ICON(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_STATUS_ICON))
+
+#define STATUS_ICON_LIVE_P(s) (((s)->icon) != 0)
+
+#define CHECK_LIVE_STATUS_ICON(s)					\
+  CHECK_TYPE (STATUS_ICONP (s) && STATUS_ICON_LIVE_P (XSTATUS_ICON (s)), \
+	      Qstatus_icon_live_p, s)
+
+#endif /* EMACS_SYSTRAY_H */
Index: src/termhooks.h
===================================================================
RCS file: /sources/emacs/emacs/src/termhooks.h,v
retrieving revision 1.90
diff -u -r1.90 termhooks.h
--- src/termhooks.h	2 Dec 2007 16:23:40 -0000	1.90
+++ src/termhooks.h	11 Jan 2008 23:47:14 -0000
@@ -201,6 +201,8 @@
   , DBUS_EVENT
 #endif
 
+  , STATUS_ICON_CLICK_EVENT
+
 #ifdef WINDOWSNT
   /* Generated when an APPCOMMAND event is received, in response to
      Multimedia or Internet buttons on some keyboards.
Index: src/xmenu.c
===================================================================
RCS file: /sources/emacs/emacs/src/xmenu.c,v
retrieving revision 1.324
diff -u -r1.324 xmenu.c
--- src/xmenu.c	13 Oct 2007 12:10:07 -0000	1.324
+++ src/xmenu.c	11 Jan 2008 23:47:14 -0000
@@ -1,6 +1,6 @@
 /* X Communication module for terminals which understand the X protocol.
    Copyright (C) 1986, 1988, 1993, 1994, 1996, 1999, 2000, 2001, 2002, 2003,
-                 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+                 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
 
 This file is part of GNU Emacs.
 
@@ -51,6 +51,7 @@
 #include "charset.h"
 #include "coding.h"
 #include "sysselect.h"
+#include "systray.h"
 
 #ifdef MSDOS
 #include "msdos.h"
@@ -156,7 +157,7 @@
 				Lisp_Object, Lisp_Object));
 static int update_frame_menubar P_ ((struct frame *));
 static Lisp_Object xmenu_show P_ ((struct frame *, int, int, int, int,
-				   Lisp_Object, char **));
+				   Lisp_Object, char **, void *, int));
 static void keymap_panes P_ ((Lisp_Object *, int, int));
 static void single_keymap_panes P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
 				     int, int));
@@ -780,6 +781,9 @@
 corner of WINDOW.  (WINDOW may be a window or a frame object.)
 This controls the position of the top left of the menu as a whole.
 If POSITION is t, it means to use the current mouse position.
+POSITION can also be a list (STATUS-ICON BUTTON-TIME),
+where STATUS-ICON is a status icon and BUTTON is an integer.
+In this case the menu is displayed over the indicated status icon.
 
 MENU is a specifier for a menu.  For the simplest case, MENU is a keymap.
 The menu items come from key bindings that have a menu string as well as
@@ -829,6 +833,8 @@
   int for_click = 0;
   int specpdl_count = SPECPDL_INDEX ();
   struct gcpro gcpro1;
+  void *status_icon = NULL;
+  int status_button = 0;
 
 #ifdef HAVE_MENUS
   if (! NILP (position))
@@ -843,6 +849,19 @@
 	{
           get_current_pos_p = 1;
         }
+      else if (CONSP (position) && STATUS_ICONP (XCAR (position)))
+	{
+	  Lisp_Object icon = XCAR (position);
+
+	  CHECK_LIVE_STATUS_ICON (icon);
+	  status_icon = XSTATUS_ICON (icon)->icon;
+	  status_button = XINT (Fcar (Fcdr (position)));
+	  for_click = 1;
+	  /* Placate later code.  */
+	  XSETINT (x, 0);
+	  XSETINT (y, 0);
+	  window = selected_window;
+	}
       else
 	{
 	  tem = Fcar (position);
@@ -1029,7 +1048,8 @@
   BLOCK_INPUT;
 
   selection = xmenu_show (f, xpos, ypos, for_click,
-			  keymaps, title, &error_name);
+			  keymaps, title, &error_name,
+			  status_icon, status_button);
   UNBLOCK_INPUT;
 
   discard_menu_items ();
@@ -2664,18 +2684,22 @@
    menu pops down.
    menu_item_selection will be set to the selection.  */
 static void
-create_and_show_popup_menu (f, first_wv, x, y, for_click)
+create_and_show_popup_menu (f, first_wv, x, y, for_click,
+			    status_icon, status_button)
      FRAME_PTR f;
      widget_value *first_wv;
      int x;
      int y;
      int for_click;
+     void *status_icon;
+     int status_button;
 {
   int i;
   GtkWidget *menu;
   GtkMenuPositionFunc pos_func = 0;  /* Pop up at pointer.  */
   struct next_popup_x_y popup_x_y;
   int specpdl_count = SPECPDL_INDEX ();
+  gpointer user_data = &popup_x_y;
 
   if (! FRAME_X_P (f))
     abort ();
@@ -2702,6 +2726,14 @@
 
       i = 0;  /* gtk_menu_popup needs this to be 0 for a non-button popup.  */
     }
+#ifdef HAVE_GTK_STATUS_ICON
+  else if (status_icon)
+    {
+      user_data = status_icon;
+      i = status_button;
+      pos_func = gtk_status_icon_position_menu;
+    }
+#endif /* HAVE_GTK_STATUS_ICON */
   else
     {
       for (i = 0; i < 5; i++)
@@ -2711,7 +2743,8 @@
 
   /* Display the menu.  */
   gtk_widget_show_all (menu);
-  gtk_menu_popup (GTK_MENU (menu), 0, 0, pos_func, &popup_x_y, i, 0);
+  gtk_menu_popup (GTK_MENU (menu), 0, 0, pos_func, user_data, i,
+		  gtk_get_current_event_time ());
 
   record_unwind_protect (pop_down_menu, make_save_value (menu, 0));
 
@@ -2772,14 +2805,18 @@
 
 /* Pop up the menu for frame F defined by FIRST_WV at X/Y and loop until the
    menu pops down.
-   menu_item_selection will be set to the selection.  */
+   menu_item_selection will be set to the selection.
+   The status-icon-related arguments are ignore in this implementation.  */
 static void
-create_and_show_popup_menu (f, first_wv, x, y, for_click)
+create_and_show_popup_menu (f, first_wv, x, y, for_click,
+			    status_icon, status_button)
      FRAME_PTR f;
      widget_value *first_wv;
      int x;
      int y;
      int for_click;
+     void *status_icon;
+     int status_button;
 {
   int i;
   Arg av[2];
@@ -2848,7 +2885,8 @@
 #endif /* not USE_GTK */
 
 static Lisp_Object
-xmenu_show (f, x, y, for_click, keymaps, title, error)
+xmenu_show (f, x, y, for_click, keymaps, title, error,
+	    status_icon, status_button)
      FRAME_PTR f;
      int x;
      int y;
@@ -2856,6 +2894,8 @@
      int keymaps;
      Lisp_Object title;
      char **error;
+     void *status_icon;
+     int status_button;
 {
   int i;
   widget_value *wv, *save_wv = 0, *first_wv = 0, *prev_wv = 0;
@@ -3062,7 +3102,8 @@
   menu_item_selection = 0;
 
   /* Actually create and show the menu until popped down.  */
-  create_and_show_popup_menu (f, first_wv, x, y, for_click);
+  create_and_show_popup_menu (f, first_wv, x, y, for_click,
+			      status_icon, status_button);
 
   /* Free the widget_value objects we used to specify the contents.  */
   free_menubar_widget_value_tree (first_wv);
@@ -3523,6 +3564,10 @@
      int keymaps;
      Lisp_Object title;
      char **error;
+     /* Note that status-icon-related arguments are ignored in this
+	implementation  */
+     void *status_icon;
+     int status_button;
 {
   Window root;
   XMenu *menu;

^ permalink raw reply	[flat|nested] 55+ messages in thread
* RFC: status icon support
@ 2007-12-30 19:56 Tom Tromey
  2007-12-31 17:18 ` Dan Nicolaescu
  0 siblings, 1 reply; 55+ messages in thread
From: Tom Tromey @ 2007-12-30 19:56 UTC (permalink / raw)
  To: emacs-devel

This patch implements status icon support for Emacs.

A status icon is an icon that sits in a part of the panel called the
"system tray".  It can be used to display notifications that are
somewhat less intrusive than a real dialog box.  A status icon can
also have a menu (unimplemented here), react to button presses, and
can display notification messages.

This patch only works when using Gtk.  It could in theory be made to
work with other toolkits -- there is a cross-desktop systray
specification, and both Windows and the Mac support something similar.
However, I don't know these other platforms, so someone else would
have to implement that.

This patch is still incomplete.  It needs a configure change and some
#ifdefs.  It also needs a ChangeLog entry and, I think, a section in
the elisp manual.

I'm looking for feedback on the general approach, the code, etc.

FWIW I've been using a version of this based on an external utility
for about a year now.  The best use I've found for it is integrating
with ERC; I have an ERC module that I'll rewrite and submit once this
code goes in.  I've also got hacks for EMMS and the calendar, and
other things are possible (mail notification comes to mind).

Tom

Index: alloc.c
===================================================================
RCS file: /sources/emacs/emacs/src/alloc.c,v
retrieving revision 1.432
diff -u -r1.432 alloc.c
--- alloc.c	16 Nov 2007 21:24:59 -0000	1.432
+++ alloc.c	30 Dec 2007 19:47:59 -0000
@@ -56,6 +56,7 @@
 #include "charset.h"
 #include "syssignal.h"
 #include "termhooks.h"		/* For struct terminal.  */
+#include "systray.h"
 #include <setjmp.h>
 
 /* GC_MALLOC_CHECK defined means perform validity checks of malloc'd
@@ -3021,6 +3022,16 @@
   return f;
 }
 
+struct status_icon *
+allocate_status_icon ()
+{
+  struct status_icon *s = ALLOCATE_PSEUDOVECTOR (struct status_icon,
+						 param_alist, PVEC_STATUS_ICON);
+  /* Zero out the non-GC'd fields.  FIXME: This should be made unnecessary.  */
+  bzero (&(s->param_alist),
+	 ((char*)(s+1)) - ((char*)&(s->param_alist)));
+  return s;
+}
 
 struct Lisp_Process *
 allocate_process ()
Index: emacs.c
===================================================================
RCS file: /sources/emacs/emacs/src/emacs.c,v
retrieving revision 1.413
diff -u -r1.413 emacs.c
--- emacs.c	2 Dec 2007 16:23:40 -0000	1.413
+++ emacs.c	30 Dec 2007 19:48:01 -0000
@@ -1579,6 +1579,7 @@
       /* Called before init_window_once for Mac OS Classic.  */
       syms_of_search ();
       syms_of_frame ();
+      syms_of_systray ();
 #endif
       syms_of_syntax ();
       syms_of_terminal ();
Index: keyboard.c
===================================================================
RCS file: /sources/emacs/emacs/src/keyboard.c,v
retrieving revision 1.935
diff -u -r1.935 keyboard.c
--- keyboard.c	10 Dec 2007 03:48:05 -0000	1.935
+++ keyboard.c	30 Dec 2007 19:48:03 -0000
@@ -500,6 +500,8 @@
 #ifdef HAVE_DBUS
 Lisp_Object Qdbus_event;
 #endif
+Lisp_Object Qstatus_icon_click_event;
+
 /* Lisp_Object Qmouse_movement; - also an event header */
 
 /* Properties of event headers.  */
@@ -4298,6 +4300,11 @@
 	  kbd_fetch_ptr = event + 1;
 	}
 #endif
+      else if (event->kind == STATUS_ICON_CLICK_EVENT)
+	{
+	  obj = make_lispy_event (event);
+	  kbd_fetch_ptr = event + 1;
+	}
       else
 	{
 	  /* If this event is on a different frame, return a switch-frame this
@@ -6174,6 +6181,9 @@
       }
 #endif /* HAVE_DBUS */
 
+    case STATUS_ICON_CLICK_EVENT:
+      return Fcons (Qstatus_icon_click_event, event->arg);
+
 #ifdef HAVE_GPM
     case GPM_CLICK_EVENT:
       {
@@ -11780,6 +11790,9 @@
   staticpro (&Qdbus_event);
 #endif
 
+  Qstatus_icon_click_event = intern ("status-icon-click-event");
+  staticpro (&Qstatus_icon_click_event);
+
   Qmenu_enable = intern ("menu-enable");
   staticpro (&Qmenu_enable);
   Qmenu_alias = intern ("menu-alias");
@@ -12516,6 +12529,9 @@
   initial_define_lispy_key (Vspecial_event_map, "dbus-event",
 			    "dbus-handle-event");
 #endif
+
+  initial_define_lispy_key (Vspecial_event_map, "status-icon-click-event",
+			    "status-icon-handle-click-event");
 }
 
 /* Mark the pointers in the kboard objects.
Index: lisp.h
===================================================================
RCS file: /sources/emacs/emacs/src/lisp.h,v
retrieving revision 1.603
diff -u -r1.603 lisp.h
--- lisp.h	22 Nov 2007 01:01:26 -0000	1.603
+++ lisp.h	30 Dec 2007 19:48:03 -0000
@@ -349,7 +349,8 @@
   PVEC_HASH_TABLE = 0x40000,
   PVEC_TERMINAL = 0x80000,
   PVEC_OTHER = 0x100000,
-  PVEC_TYPE_MASK = 0x1ffe00
+  PVEC_STATUS_ICON = 0x200000,
+  PVEC_TYPE_MASK = 0x2ffe00
 
 #if 0 /* This is used to make the value of PSEUDOVECTOR_FLAG available to
 	 GDB.  It doesn't work on OS Alpha.  Moved to a variable in
@@ -1552,6 +1553,8 @@
 #define GC_BOOL_VECTOR_P(x) GC_PSEUDOVECTORP (x, PVEC_BOOL_VECTOR)
 #define FRAMEP(x) PSEUDOVECTORP (x, PVEC_FRAME)
 #define GC_FRAMEP(x) GC_PSEUDOVECTORP (x, PVEC_FRAME)
+#define STATUS_ICONP(x) PSEUDOVECTORP (x, PVEC_STATUS_ICON)
+#define GC_STATUS_ICONP(x) GC_PSEUDOVECTORP (x, PVEC_STATUS_ICON)
 
 #define SUB_CHAR_TABLE_P(x) (CHAR_TABLE_P (x) && NILP (XCHAR_TABLE (x)->top))
 
@@ -2616,6 +2620,7 @@
 extern struct Lisp_Hash_Table *allocate_hash_table P_ ((void));
 extern struct window *allocate_window P_ ((void));
 extern struct frame *allocate_frame P_ ((void));
+extern struct status_icon *allocate_status_icon P_ ((void));
 extern struct Lisp_Process *allocate_process P_ ((void));
 extern struct terminal *allocate_terminal P_ ((void));
 extern int gc_in_progress;
@@ -3248,6 +3253,9 @@
 extern void syms_of_sound P_ ((void));
 extern void init_sound P_ ((void));
 
+/* Defined in systray.c */
+extern void syms_of_systray P_ ((void));
+
 /* Defined in category.c */
 extern void init_category_once P_ ((void));
 extern void syms_of_category P_ ((void));
Index: print.c
===================================================================
RCS file: /sources/emacs/emacs/src/print.c,v
retrieving revision 1.243
diff -u -r1.243 print.c
--- print.c	22 Nov 2007 16:16:02 -0000	1.243
+++ print.c	30 Dec 2007 19:48:03 -0000
@@ -2031,6 +2031,8 @@
 	  strout (buf, -1, -1, printcharfun, 0);
 	  PRINTCHAR ('>');
 	}
+      else if (STATUS_ICONP (obj))
+	strout ("#<status-icon>", -1, -1, printcharfun, 0);
       else
 	{
 	  EMACS_INT size = XVECTOR (obj)->size;
Index: systray.c
===================================================================
RCS file: systray.c
diff -N systray.c
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ systray.c	30 Dec 2007 19:48:03 -0000
@@ -0,0 +1,446 @@
+/* Elisp bindings system tray icons
+   Copyright (C) 2007 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs; see the file COPYING.  If not, write to
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#include "config.h"
+
+#include "lisp.h"
+#include "systray.h"
+#include "frame.h"
+#include "charset.h"
+#include "coding.h"
+#include "blockinput.h"
+#include "termhooks.h"
+
+#include <gtk/gtk.h>
+#include <libnotify/notify.h>
+
+/* FIXME: should be in a header.  */
+extern Lisp_Object Qhelp_echo;
+extern Lisp_Object Qstatus_icon_click_event;
+
+Lisp_Object Vstatus_icon_list;
+
+Lisp_Object Qblinking;
+Lisp_Object Qstatus_icon_live_p;
+Lisp_Object Qclick_callback;
+Lisp_Object QCbody, QCtimeout, QCurgency, QCicon;
+Lisp_Object Qlow, Qcritical, Qwarning, Qquestion, Qerror;
+
+#define GET_ICON(s) ((GtkStatusIcon *) ((s)->icon))
+
+/* Callback which is called when the user clicks on a status icon.  */
+static void
+activate_icon (GtkWidget *widget, gpointer data)
+{
+  Lisp_Object icon = (Lisp_Object) data;
+  struct input_event event;
+  EVENT_INIT (event);
+  event.kind = STATUS_ICON_CLICK_EVENT;
+  event.frame_or_window = Qnil;
+  event.arg = icon;
+  kbd_buffer_store_event (&event);
+}
+
+/* Apply property KEY with value VALUE to icon SICON.  */
+static void
+apply_one_icon_property (sicon, key, value)
+     struct status_icon *sicon;
+     Lisp_Object key, value;
+{
+  if (EQ (key, Qicon_name))
+    {
+      struct gcpro gcpro1;
+      Lisp_Object filename = Qnil;
+      GCPRO1 (filename);
+      if (NILP (value))
+	{
+	  /* Default to the GNU.  */
+	  filename = build_string ("emacs_48.png");
+	}
+      else
+	{
+	  CHECK_STRING (value);
+	  filename = value;
+	}
+      /* Not clear if x_find_image_file returns a string with the
+	 correct encoding for Gtk.  However, it is already used this
+	 way in gtkutil.c.  */
+      filename = x_find_image_file (filename);
+      if (NILP (filename))
+	{
+	  /* No good choice, so choose a semi-appropriate stock
+	     icon.  */
+	  gtk_status_icon_set_from_stock (GET_ICON (sicon),
+					  GTK_STOCK_DIALOG_QUESTION);
+	}
+      else
+	gtk_status_icon_set_from_file (GET_ICON (sicon),
+				       (char *) SDATA (filename));
+      UNGCPRO;
+    }
+  else if (EQ (key, Qblinking))
+    gtk_status_icon_set_blinking (GET_ICON (sicon), ! NILP (value));
+  else if (EQ (key, Qvisible))
+    gtk_status_icon_set_visible (GET_ICON (sicon), ! NILP (value));
+  else if (EQ (key, Qhelp_echo))
+    {
+      struct gcpro gcpro1;
+      Lisp_Object tooltip = Qnil;
+      GCPRO1 (tooltip);
+      if (NILP (value))
+	gtk_status_icon_set_tooltip (GET_ICON (sicon), NULL);
+      else
+	{
+	  /* FIXME: should accept a sexp to eval here.  */
+	  CHECK_STRING (value);
+	  tooltip = ENCODE_UTF_8 (value);
+	  gtk_status_icon_set_tooltip (GET_ICON (sicon),
+				       (char *) SDATA (tooltip));
+	}
+      UNGCPRO;
+    }
+  else
+    {
+      /* Ignore things we don't understand.  */
+    }
+}
+
+/* Apply the ALIST of properties to status icon ICON.  */
+static void
+apply_status_icon_alist (icon, alist)
+     Lisp_Object icon, alist;
+{
+  Lisp_Object tail;
+  struct status_icon *sicon;
+
+  CHECK_LIVE_STATUS_ICON (icon);
+  sicon = XSTATUS_ICON (icon);
+
+  for (tail = alist; CONSP (tail); tail = XCDR (tail))
+    {
+      Lisp_Object key, value;
+      Lisp_Object elt = XCAR (tail);
+      if (! CONSP (elt))
+	continue;
+      key = XCAR (elt);
+      value = XCDR (elt);
+
+      apply_one_icon_property (sicon, key, value);
+
+      /* Update frame parameters.  */
+      elt = Fassq (key, sicon->param_alist);
+      if (NILP (elt))
+	sicon->param_alist = Fcons (Fcons (key, value), sicon->param_alist);
+      else
+	Fsetcdr (elt, value);
+    }
+}
+
+DEFUN ("make-status-icon", Fmake_status_icon, Smake_status_icon,
+       0, 1, 0,
+       doc: /* Return a newly created status icon.
+Optional argument ALIST is an alist of parameters for the new frame.
+See `modify-status-icon-parameters' for a list of recognized parameters.*/)
+     (alist)
+     Lisp_Object alist;
+{
+  struct status_icon *sicon;
+  Lisp_Object icon, deflist;
+  struct gcpro gcpro1;
+
+  BLOCK_INPUT;
+
+  sicon = allocate_status_icon ();
+  XSETSTATUS_ICON (icon, sicon);
+  sicon->param_alist = Qnil;
+  sicon->icon = gtk_status_icon_new ();
+
+  g_signal_connect (sicon->icon, "activate", G_CALLBACK (activate_icon),
+		    (gpointer) icon);
+
+  Vstatus_icon_list = Fcons (icon, Vstatus_icon_list);
+
+  GCPRO1 (deflist);
+
+  /* Make some defaults.  */
+  deflist = Fcons (Fcons (Qclick_callback, Qnil),
+		   Fcons (Fcons (Qicon_name, Qnil),
+			  Fcons (Fcons (Qblinking, Qnil),
+				 Fcons (Fcons (Qvisible, Qt),
+					Fcons (Fcons (Qhelp_echo, Qnil),
+					       alist)))));
+  apply_status_icon_alist (icon, deflist);
+
+  UNBLOCK_INPUT;
+
+  RETURN_UNGCPRO (icon);
+}
+
+DEFUN ("modify-status-icon-parameters", Fmodify_status_icon_parameters,
+       Smodify_status_icon_parameters,
+       2, 2, 0,
+       doc: /* Modify the parameters of status icon ICON according to ALIST.
+Each element of alist has the form (PARM . VALUE), where PARM is a symbol.
+Undefined PARMs are ignored, but stored in the frame's parameter list
+so that `status-icon-parameters' will return them.
+
+Currently defined parameters and their values are:
+
+  icon-name   The file name of an icon to display.
+  blinking    If non-nil, the status icon will blink.
+  visible     If nil, status icon is invisible.
+  help-echo   A string which will be displayed as a tooltip for the
+              status icon.*/)
+     (icon, alist)
+     Lisp_Object icon, alist;
+{
+  BLOCK_INPUT;
+  apply_status_icon_alist (icon, alist);
+  UNBLOCK_INPUT;
+  return Qnil;
+}
+
+DEFUN ("status-icon-parameters", Fstatus_icon_parameters,
+       Sstatus_icon_parameters,
+       1, 1, 0,
+       doc: /* Return the parameters-alist of the status icon ICON.
+It is a list of elements of the form (PARM . VALUE), where PARM is a symbol.*/)
+     (icon)
+     Lisp_Object icon;
+{
+  struct status_icon *sicon;
+  CHECK_LIVE_STATUS_ICON (icon);
+  sicon = XSTATUS_ICON (icon);
+  return Fcopy_alist (sicon->param_alist);
+}
+
+DEFUN ("status-icon-list", Fstatus_icon_list, Sstatus_icon_list,
+       0, 0, 0,
+       doc: /* Return a list of all status icons.  */)
+     ()
+{
+  return Fcopy_sequence (Vstatus_icon_list);
+}
+
+DEFUN ("delete-status-icon", Fdelete_status_icon, Sdelete_status_icon,
+       1, 1, 0,
+       doc: /* Delete the status icon ICON.  */)
+     (icon)
+     Lisp_Object icon;
+{
+  struct status_icon *sicon;
+  CHECK_LIVE_STATUS_ICON (icon);
+  sicon = XSTATUS_ICON (icon);
+  BLOCK_INPUT;
+  g_object_unref (sicon->icon);
+  UNBLOCK_INPUT;
+  sicon->icon = NULL;
+  Vstatus_icon_list = Fdelq (icon, Vstatus_icon_list);
+  return Qnil;
+}
+
+DEFUN ("show-status-icon-message", Fshow_status_icon_message,
+       Sshow_status_icon_message,
+       2, MANY, 0,
+       doc: /* Post a notification message attached to the icon ICON.
+ICON is a status icon created by `make-status-icon'.
+SUMMARY is the message to display, a string.
+
+The remaining arguments, if any, are a property list specifying
+additional parameters of the notification:
+
+  :body TEXT       Set the body text of the notification.
+  :timeout VALUE   Set the timeout value.
+                   nil means use the default.
+		   t means never time out.
+		   An integer specifies the timeout in milliseconds.
+  :urgency VALUE   Set the urgency level.  VALUE is a symbol, one of
+                   'low', 'normal', 'critical'.  The default is 'normal'.
+  :icon VALUE      Set the notification icon.  VALUE is a symbol, currently
+                   one of 'warning', 'info', 'question', 'error'.  The
+		   default is 'info'.  */)
+     (nargs, args)
+     int nargs;
+     Lisp_Object *args;
+{
+  struct status_icon *sicon;
+  struct gcpro gcpro1;
+  Lisp_Object gc_temp = Qnil;
+  GError *gerr = NULL;
+  NotifyNotification *notification;
+
+  int i;
+  Lisp_Object icon = args[0];
+  Lisp_Object summary = args[1];
+
+  if ((nargs - 2) % 2 != 0)
+    error ("Invalid number of arguments");
+
+  CHECK_LIVE_STATUS_ICON (icon);
+  CHECK_STRING (summary);
+
+  if (! notify_is_initted () && ! notify_init ("Emacs"))
+    error ("Couldn't connect to notification server");
+
+  sicon = XSTATUS_ICON (icon);
+
+  GCPRO1 (gc_temp);
+
+  gc_temp = ENCODE_UTF_8 (summary);
+
+  BLOCK_INPUT;
+
+  /* FIXME: allow actions, setting the icon, callback when the
+     notification is closed, maybe hints.  */
+  notification
+    = notify_notification_new_with_status_icon (SDATA (gc_temp), NULL,
+						GTK_STOCK_DIALOG_INFO,
+						GET_ICON (XSTATUS_ICON (icon)));
+
+  for (i = 2; i < nargs; i += 2)
+    {
+      Lisp_Object key = args[i];
+      Lisp_Object value = args[i + 1];
+      if (EQ (key, QCbody))
+	{
+	  /* Ignore things we don't understand.  */
+	  if (STRINGP (value))
+	    {
+	      gc_temp = ENCODE_UTF_8 (value);
+	      g_object_set (G_OBJECT (notification), "body", SDATA (gc_temp),
+			    NULL);
+	    }
+	}
+      else if (EQ (key, QCtimeout))
+	{
+	  gint timeout = NOTIFY_EXPIRES_DEFAULT;
+	  if (EQ (value, Qt))
+	    timeout = NOTIFY_EXPIRES_NEVER;
+	  else if (INTEGERP (value))
+	    {
+	      timeout = XINT (value);
+	      if (timeout <= 0)
+		timeout = NOTIFY_EXPIRES_DEFAULT;
+	    }
+	  notify_notification_set_timeout (notification, timeout);
+	}
+      else if (EQ (key, QCurgency))
+	{
+	  NotifyUrgency urgency = NOTIFY_URGENCY_NORMAL;
+	  if (EQ (value, Qlow))
+	    urgency = NOTIFY_URGENCY_LOW;
+	  else if (EQ (value, Qcritical))
+	    urgency = NOTIFY_URGENCY_CRITICAL;
+	  notify_notification_set_urgency (notification, urgency);
+	}
+      else if (EQ (key, QCicon))
+	{
+	  char *icon_name = GTK_STOCK_DIALOG_INFO;
+	  if (EQ (value, Qwarning))
+	    icon_name = GTK_STOCK_DIALOG_WARNING;
+	  else if (EQ (value, Qquestion))
+	    icon_name = GTK_STOCK_DIALOG_QUESTION;
+	  else if (EQ (value, Qerror))
+	    icon_name = GTK_STOCK_DIALOG_ERROR;
+	  g_object_set (G_OBJECT (notification), "icon-name", icon_name, NULL);
+	}
+    }
+
+  notify_notification_show (notification, &gerr);
+  /* FIXME: error handling?  */
+  g_object_unref (notification);
+
+  UNBLOCK_INPUT;
+
+  RETURN_UNGCPRO (Qnil);
+}
+
+DEFUN ("status-icon-handle-click-event", Fstatus_icon_handle_click_event,
+       Sstatus_icon_handle_click_event,
+       1, 1, "e",
+       doc: /* Internal handler for status icon click events.
+A status icon click event is generated in response to the user clicking
+on a status icon.  This handler calls the specified callback function,
+if any.*/)
+     (event)
+     Lisp_Object event;
+{
+  struct status_icon *sicon;
+  Lisp_Object elt;
+
+  /* Just ignore garbage.  */
+  if (! CONSP (event) || ! EQ (XCAR (event), Qstatus_icon_click_event)
+      || ! STATUS_ICONP (XCDR (event))
+      || ! STATUS_ICON_LIVE_P (XSTATUS_ICON (XCDR (event))))
+    return Qnil;
+
+  sicon = XSTATUS_ICON (XCDR (event));
+  elt = Fassq (Qclick_callback, sicon->param_alist);
+  if (CONSP (elt) && FUNCTIONP (XCDR (elt)))
+    {
+      struct gcpro gcpro1;
+      Lisp_Object fun = XCDR (elt);
+      GCPRO1 (fun);
+      Ffuncall (1, &fun);
+      UNGCPRO;
+    }
+
+  return Qnil;
+}
+
+void
+syms_of_systray ()
+{
+  Qstatus_icon_live_p = intern ("status-icon-live-p");
+  staticpro (&Qstatus_icon_live_p);
+  Qblinking = intern ("blinking");
+  staticpro (&Qblinking);  
+  Qclick_callback = intern ("click-callback");
+  staticpro (&Qclick_callback);
+  QCbody = intern (":body");
+  staticpro (&QCbody);
+  QCtimeout = intern (":timeout");
+  staticpro (&QCtimeout);
+  QCurgency = intern (":urgency");
+  staticpro (&QCurgency);
+  QCicon = intern (":icon");
+  staticpro (&QCicon);
+  Qlow = intern ("low");
+  staticpro (&Qlow);
+  Qcritical = intern ("critical");
+  staticpro (&Qcritical);
+  Qwarning = intern ("warning");
+  staticpro (&Qwarning);
+  Qquestion = intern ("question");
+  staticpro (&Qquestion);
+  Qerror = intern ("error");
+  staticpro (&Qerror);
+
+  staticpro (&Vstatus_icon_list);
+  Vstatus_icon_list = Qnil;
+
+  defsubr (&Smake_status_icon);
+  defsubr (&Smodify_status_icon_parameters);
+  defsubr (&Sdelete_status_icon);
+  defsubr (&Sstatus_icon_parameters);
+  defsubr (&Sstatus_icon_list);
+  defsubr (&Sshow_status_icon_message);
+  defsubr (&Sstatus_icon_handle_click_event);
+}
Index: systray.h
===================================================================
RCS file: systray.h
diff -N systray.h
--- /dev/null	1 Jan 1970 00:00:00 -0000
+++ systray.h	30 Dec 2007 19:48:03 -0000
@@ -0,0 +1,52 @@
+/* Define systray object for GNU Emacs.
+   Copyright (C) 2007 Free Software Foundation, Inc.
+
+This file is part of GNU Emacs.
+
+GNU Emacs is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs; see the file COPYING.  If not, write to
+the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.  */
+
+#ifndef EMACS_SYSTRAY_H
+#define EMACS_SYSTRAY_H
+
+extern Lisp_Object Qstatus_icon_live_p;
+
+struct status_icon
+{
+  EMACS_UINT size;
+  struct Lisp_Vector *next;
+
+  /* Parameter alist of this status icon.  */
+  Lisp_Object param_alist;
+
+  /* Beyond here, there should be no more Lisp_Object components.  */
+
+  /* The icon widget, or NULL if it has been destroyed.  Really a
+     'GtkStatusIcon *'.  */
+  void *icon;
+};
+
+#define XSTATUS_ICON(p) \
+  (eassert (GC_STATUS_ICONP (p)), (struct status_icon *) XPNTR (p))
+
+#define XSETSTATUS_ICON(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_STATUS_ICON))
+
+#define STATUS_ICON_LIVE_P(s) (((s)->icon) != 0)
+
+#define CHECK_LIVE_STATUS_ICON(s)					\
+  CHECK_TYPE (STATUS_ICONP (s) && STATUS_ICON_LIVE_P (XSTATUS_ICON (s)), \
+	      Qstatus_icon_live_p, s)
+
+#endif /* EMACS_SYSTRAY_H */
Index: termhooks.h
===================================================================
RCS file: /sources/emacs/emacs/src/termhooks.h,v
retrieving revision 1.90
diff -u -r1.90 termhooks.h
--- termhooks.h	2 Dec 2007 16:23:40 -0000	1.90
+++ termhooks.h	30 Dec 2007 19:48:03 -0000
@@ -201,6 +201,8 @@
   , DBUS_EVENT
 #endif
 
+  , STATUS_ICON_CLICK_EVENT
+
 #ifdef WINDOWSNT
   /* Generated when an APPCOMMAND event is received, in response to
      Multimedia or Internet buttons on some keyboards.
Index: Makefile.in
===================================================================
RCS file: /sources/emacs/emacs/src/Makefile.in,v
retrieving revision 1.361
diff -u -r1.361 Makefile.in
--- Makefile.in	2 Dec 2007 16:23:40 -0000	1.361
+++ Makefile.in	30 Dec 2007 19:47:59 -0000
@@ -593,7 +593,7 @@
 /* lastfile must follow all files
    whose initialized data areas should be dumped as pure by dump-emacs.  */
 obj=    dispnew.o frame.o scroll.o xdisp.o $(XMENU_OBJ) window.o \
-	charset.o coding.o category.o ccl.o \
+	charset.o coding.o category.o ccl.o systray.o \
 	cm.o term.o terminal.o xfaces.o $(XOBJ) $(GTK_OBJ) $(DBUS_OBJ) \
 	emacs.o keyboard.o macros.o keymap.o sysdep.o \
 	buffer.o filelock.o insdel.o marker.o \
@@ -944,7 +944,7 @@
    Note that SunOS needs -lm to come before -lc; otherwise, you get
    duplicated symbols.  If the standard libraries were compiled
    with GCC, we might need gnulib again after them.  */
-LIBES = $(LOADLIBES) $(LIBS) $(LIBX) $(LIBSOUND) $(RSVG_LIBS) $(DBUS_LIBS) \
+LIBES = $(LOADLIBES) $(LIBS) -lnotify $(LIBX) $(LIBSOUND) $(RSVG_LIBS) $(DBUS_LIBS) \
    LIBGPM LIBRESOLV LIBS_SYSTEM LIBS_MACHINE LIBS_TERMCAP \
    LIBS_DEBUG $(GETLOADAVG_LIBS) $(GNULIB_VAR) LIB_MATH LIB_STANDARD \
    $(GNULIB_VAR)
@@ -1190,6 +1190,7 @@
 sysdep.o: sysdep.c syssignal.h systty.h systime.h syswait.h blockinput.h \
    process.h dispextern.h termhooks.h termchar.h termopts.h \
    frame.h atimer.h window.h msdos.h dosfns.h keyboard.h cm.h $(config_h)
+systray.o: systray.c $(config_h) lisp.h frame.h
 term.o: term.c termchar.h termhooks.h termopts.h $(config_h) cm.h frame.h \
    disptab.h dispextern.h keyboard.h charset.h coding.h ccl.h msdos.h \
    window.h keymap.h blockinput.h atimer.h systime.h

^ permalink raw reply	[flat|nested] 55+ messages in thread

end of thread, other threads:[~2008-01-23  4:00 UTC | newest]

Thread overview: 55+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2008-01-11 23:28 RFC: status icon support Tom Tromey
2008-01-12  1:57 ` Dan Nicolaescu
2008-01-12  1:28   ` Tom Tromey
2008-01-12  1:38   ` Tom Tromey
2008-01-12  8:45     ` Ulrich Mueller
2008-01-12 17:45       ` Tom Tromey
2008-01-14  2:01         ` Richard Stallman
2008-01-14  1:35           ` Tom Tromey
2008-01-14 17:26             ` Richard Stallman
2008-01-19  5:18               ` Tom Tromey
2008-01-20  6:14                 ` Richard Stallman
2008-01-23  4:00                   ` Michael Olson
2008-01-14  1:41           ` Tom Tromey
2008-01-14  1:03     ` Michael Olson
2008-01-14  1:01       ` Tom Tromey
2008-01-14  7:03         ` Jan Djärv
2008-01-15  6:01         ` Michael Olson
2008-01-16  1:10           ` Tom Tromey
2008-01-16  4:10             ` Michael Olson
2008-01-12 11:11   ` Richard Stallman
2008-01-12 11:25     ` David Kastrup
2008-01-12 11:27       ` Andreas Schwab
2008-01-12 11:46         ` David Kastrup
2008-01-12 14:10           ` Andreas Schwab
2008-01-12 14:19             ` David Kastrup
2008-01-12 17:33               ` Andreas Schwab
2008-01-14  2:00               ` Richard Stallman
2008-01-14  2:25                 ` Stefan Monnier
2008-01-14  7:05                 ` Jan Djärv
2008-01-12 13:52     ` Dan Nicolaescu
2008-01-12 14:13       ` Andreas Schwab
2008-01-12 14:26         ` Dan Nicolaescu
2008-01-12 17:36           ` Andreas Schwab
2008-01-12 18:59             ` Dan Nicolaescu
2008-01-12 14:33         ` David Kastrup
2008-01-12 17:45           ` Andreas Schwab
2008-01-12 18:07             ` David Kastrup
2008-01-12 18:16               ` Andreas Schwab
2008-01-14  2:01           ` Richard Stallman
2008-01-14  2:47             ` Dan Nicolaescu
2008-01-14 17:26               ` Richard Stallman
2008-01-14  9:14             ` David Kastrup
2008-01-14 17:26               ` Richard Stallman
2008-01-14  3:47 ` YAMAMOTO Mitsuharu
2008-01-14  3:49   ` Tom Tromey
2008-01-14 13:35     ` Stefan Monnier
2008-01-14 21:40     ` YAMAMOTO Mitsuharu
2008-01-16  1:17       ` Tom Tromey
2008-01-16 11:55         ` YAMAMOTO Mitsuharu
2008-01-14 17:26   ` Richard Stallman
2008-01-14 17:10     ` Tom Tromey
2008-01-16  2:42       ` Richard Stallman
  -- strict thread matches above, loose matches on Subject: below --
2007-12-30 19:56 Tom Tromey
2007-12-31 17:18 ` Dan Nicolaescu
2007-12-31 18:29   ` Tom Tromey

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).