lisp/notifications.el

   1 ;;; notifications.el --- Client interface to desktop notifications.
   2
   3 ;; Copyright (C) 2010-2012 Free Software Foundation, Inc.
   4
   5 ;; Author: Julien Danjou <julien@danjou.info>
   6 ;; Keywords: comm desktop notifications
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; This package provides an implementation of the Desktop Notifications
  26 ;; <http://www.galago-project.org/specs/notification/>.
  27
  28 ;; In order to activate this package, you must add the following code
  29 ;; into your .emacs:
  30 ;;
  31 ;;   (require 'notifications)
  32
  33 ;; For proper usage, Emacs must be started in an environment with an
  34 ;; active D-Bus session bus.
  35
  36 ;;; Code:
  37 (eval-when-compile
  38   (require 'cl))
  39
  40 ;; Pacify byte-compiler.  D-Bus support in the Emacs core can be
  41 ;; disabled with configuration option "--without-dbus".  Declare used
  42 ;; subroutines and variables of `dbus' therefore.
  43 (declare-function dbus-call-method "dbusbind.c")
  44 (declare-function dbus-register-signal "dbusbind.c")
  45
  46 (require 'dbus)
  47
  48 (defconst notifications-specification-version "1.1"
  49   "The version of the Desktop Notifications Specification implemented.")
  50
  51 (defconst notifications-application-name "Emacs"
  52   "Default application name.")
  53
  54 (defconst notifications-application-icon
  55   (expand-file-name
  56    "images/icons/hicolor/scalable/apps/emacs.svg"
  57    data-directory)
  58   "Default application icon.")
  59
  60 (defconst notifications-service "org.freedesktop.Notifications"
  61   "D-Bus notifications service name.")
  62
  63 (defconst notifications-path "/org/freedesktop/Notifications"
  64   "D-Bus notifications service path.")
  65
  66 (defconst notifications-interface "org.freedesktop.Notifications"
  67   "D-Bus notifications service path.")
  68
  69 (defconst notifications-notify-method "Notify"
  70   "D-Bus notifications service path.")
  71
  72 (defconst notifications-close-notification-method "CloseNotification"
  73   "D-Bus notifications service path.")
  74
  75 (defconst notifications-action-signal "ActionInvoked"
  76   "D-Bus notifications action signal.")
  77
  78 (defconst notifications-closed-signal "NotificationClosed"
  79   "D-Bus notifications closed signal.")
  80
  81 (defconst notifications-closed-reason
  82   '((1 expired)
  83     (2 dismissed)
  84     (3 close-notification)
  85     (4 undefined))
  86   "List of reasons why a notification has been closed.")
  87
  88 (defvar notifications-on-action-map nil
  89   "Mapping between notification and action callback functions.")
  90
  91 (defvar notifications-on-action-object nil
  92   "Object for registered on-action signal.")
  93
  94 (defvar notifications-on-close-map nil
  95   "Mapping between notification and close callback functions.")
  96
  97 (defvar notifications-on-close-object nil
  98   "Object for registered on-close signal.")
  99
 100 (defun notifications-on-action-signal (id action)
 101   "Dispatch signals to callback functions from `notifications-on-action-map'."
 102   (let* ((unique-name (dbus-event-service-name last-input-event))
 103          (entry (assoc (cons unique-name id) notifications-on-action-map)))
 104     (when entry
 105       (funcall (cadr entry) id action)
 106       (when (and (not (setq notifications-on-action-map
 107                             (remove entry notifications-on-action-map)))
 108                  notifications-on-action-object)
 109         (dbus-unregister-object notifications-on-action-object)
 110         (setq notifications-on-action-object nil)))))
 111
 112 (defun notifications-on-closed-signal (id &optional reason)
 113   "Dispatch signals to callback functions from `notifications-on-closed-map'."
 114   ;; notification-daemon prior 0.4.0 does not send a reason.  So we
 115   ;; make it optional, and assume `undefined' as default.
 116   (let* ((unique-name (dbus-event-service-name last-input-event))
 117          (entry (assoc (cons unique-name id) notifications-on-close-map))
 118          (reason (or reason 4)))
 119     (when entry
 120       (funcall (cadr entry)
 121                id (cadr (assoc reason notifications-closed-reason)))
 122       (when (and (not (setq notifications-on-close-map
 123                             (remove entry notifications-on-close-map)))
 124                  notifications-on-close-object)
 125         (dbus-unregister-object notifications-on-close-object)
 126         (setq notifications-on-close-object nil)))))
 127
 128 (defun notifications-notify (&rest params)
 129   "Send notification via D-Bus using the Freedesktop notification protocol.
 130 Various PARAMS can be set:
 131
 132  :title          The notification title.
 133  :body           The notification body text.
 134  :app-name       The name of the application sending the notification.
 135                  Default to `notifications-application-name'.
 136  :replaces-id    The notification ID that this notification replaces.
 137  :app-icon       The notification icon.
 138                  Default is `notifications-application-icon'.
 139                  Set to nil if you do not want any icon displayed.
 140  :actions        A list of actions in the form:
 141                    (KEY TITLE KEY TITLE ...)
 142                  where KEY and TITLE are both strings.
 143                  The default action (usually invoked by clicking the
 144                  notification) should have a key named \"default\".
 145                  The title can be anything, though implementations are free
 146                  not to display it.
 147  :timeout        The timeout time in milliseconds since the display
 148                  of the notification at which the notification should
 149                  automatically close.
 150                  If -1, the notification's expiration time is dependent
 151                  on the notification server's settings, and may vary for
 152                  the type of notification.
 153                  If 0, the notification never expires.
 154                  Default value is -1.
 155  :urgency        The urgency level.
 156                  Either `low', `normal' or `critical'.
 157  :category       The type of notification this is.
 158  :desktop-entry  This specifies the name of the desktop filename representing
 159                  the calling program.
 160  :image-data     This is a raw data image format which describes the width,
 161                  height, rowstride, has alpha, bits per sample, channels and
 162                  image data respectively.
 163  :image-path     This is represented either as a URI (file:// is the
 164                  only URI schema supported right now) or a name
 165                  in a freedesktop.org-compliant icon theme.
 166  :sound-file     The path to a sound file to play when the notification pops up.
 167  :sound-name     A themable named sound from the freedesktop.org sound naming
 168                  specification to play when the notification pops up.
 169                  Similar to icon-name,only for sounds. An example would
 170                  be \"message-new-instant\".
 171  :suppress-sound Causes the server to suppress playing any sounds, if it has
 172                  that ability.
 173  :x              Specifies the X location on the screen that the notification
 174                  should point to.  The \"y\" hint must also be specified.
 175  :y              Specifies the Y location on the screen that the notification
 176                  should point to.  The \"x\" hint must also be specified.
 177  :on-action      Function to call when an action is invoked.
 178                  The notification id and the key of the action are passed
 179                  as arguments to the function.
 180  :on-close       Function to call when the notification has been closed
 181                  by timeout or by the user.
 182                  The function receive the notification id and the closing
 183                  reason as arguments:
 184                    - `expired' if the notification has expired
 185                    - `dismissed' if the notification was dismissed by the user
 186                    - `close-notification' if the notification was closed
 187                      by a call to CloseNotification
 188                    - `undefined' if the notification server hasn't provided
 189                      a reason
 190
 191 This function returns a notification id, an integer, which can be
 192 used to manipulate the notification item with
 193 `notifications-close-notification' or the `:replaces-id' argument
 194 of another `notifications-notify' call."
 195   (let ((title (plist-get params :title))
 196         (body (plist-get params :body))
 197         (app-name (plist-get params :app-name))
 198         (replaces-id (plist-get params :replaces-id))
 199         (app-icon (plist-get params :app-icon))
 200         (actions (plist-get params :actions))
 201         (timeout (plist-get params :timeout))
 202         ;; Hints
 203         (hints '())
 204         (urgency (plist-get params :urgency))
 205         (category (plist-get params :category))
 206         (desktop-entry (plist-get params :desktop-entry))
 207         (image-data (plist-get params :image-data))
 208         (image-path (plist-get params :image-path))
 209         (sound-file (plist-get params :sound-file))
 210         (sound-name (plist-get params :sound-name))
 211         (suppress-sound (plist-get params :suppress-sound))
 212         (x (plist-get params :x))
 213         (y (plist-get params :y))
 214         id)
 215     ;; Build hints array
 216     (when urgency
 217       (add-to-list 'hints `(:dict-entry
 218                             "urgency"
 219                             (:variant :byte ,(case urgency
 220                                                (low 0)
 221                                                (critical 2)
 222                                                (t 1)))) t))
 223     (when category
 224       (add-to-list 'hints `(:dict-entry
 225                             "category"
 226                             (:variant :string ,category)) t))
 227     (when desktop-entry
 228       (add-to-list 'hints `(:dict-entry
 229                             "desktop-entry"
 230                             (:variant :string ,desktop-entry)) t))
 231     (when image-data
 232       (add-to-list 'hints `(:dict-entry
 233                             "image_data"
 234                             (:variant :struct ,image-data)) t))
 235     (when image-path
 236       (add-to-list 'hints `(:dict-entry
 237                             "image_path"
 238                             (:variant :string ,image-path)) t))
 239     (when sound-file
 240       (add-to-list 'hints `(:dict-entry
 241                             "sound-file"
 242                             (:variant :string ,sound-file)) t))
 243     (when sound-name
 244       (add-to-list 'hints `(:dict-entry
 245                             "sound-name"
 246                             (:variant :string ,sound-name)) t))
 247     (when suppress-sound
 248       (add-to-list 'hints `(:dict-entry
 249                             "suppress-sound"
 250                             (:variant :boolean ,suppress-sound)) t))
 251     (when x
 252       (add-to-list 'hints `(:dict-entry "x" (:variant :int32 ,x)) t))
 253     (when y
 254       (add-to-list 'hints `(:dict-entry "y" (:variant :int32 ,y)) t))
 255
 256     ;; Call Notify method
 257     (setq id
 258           (dbus-call-method :session
 259                             notifications-service
 260                             notifications-path
 261                             notifications-interface
 262                             notifications-notify-method
 263                             :string (or app-name
 264                                         notifications-application-name)
 265                             :uint32 (or replaces-id 0)
 266                             :string (if app-icon
 267                                         (expand-file-name app-icon)
 268                                       ;; If app-icon is nil because user
 269                                       ;; requested it to be so, send the
 270                                       ;; empty string
 271                                       (if (plist-member params :app-icon)
 272                                           ""
 273                                         ;; Otherwise send the default icon path
 274                                         notifications-application-icon))
 275                             :string (or title "")
 276                             :string (or body "")
 277                             `(:array ,@actions)
 278                             (or hints '(:array :signature "{sv}"))
 279                             :int32 (or timeout -1)))
 280
 281     ;; Register close/action callback function.  We must also remember
 282     ;; the daemon's unique name, because the daemon could have
 283     ;; restarted.
 284     (let ((on-action (plist-get params :on-action))
 285           (on-close (plist-get params :on-close))
 286           (unique-name (dbus-get-name-owner :session notifications-service)))
 287       (when on-action
 288         (add-to-list 'notifications-on-action-map
 289                      (list (cons unique-name id) on-action))
 290         (unless notifications-on-action-object
 291           (setq notifications-on-action-object
 292                 (dbus-register-signal
 293                  :session
 294                  nil
 295                  notifications-path
 296                  notifications-interface
 297                  notifications-action-signal
 298                  'notifications-on-action-signal))))
 299
 300       (when on-close
 301         (add-to-list 'notifications-on-close-map
 302                      (list (cons unique-name id) on-close))
 303         (unless notifications-on-close-object
 304           (setq notifications-on-close-object
 305                 (dbus-register-signal
 306                  :session
 307                  nil
 308                  notifications-path
 309                  notifications-interface
 310                  notifications-closed-signal
 311                  'notifications-on-closed-signal)))))
 312
 313     ;; Return notification id
 314     id))
 315
 316 (defun notifications-close-notification (id)
 317   "Close a notification with identifier ID."
 318   (dbus-call-method :session
 319                     notifications-service
 320                     notifications-path
 321                     notifications-interface
 322                     notifications-close-notification-method
 323                     :int32 id))
 324
 325 (provide 'notifications)