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://developer.gnome.org/notification-spec/>.
  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 (require 'dbus)
  41
  42 (defconst notifications-specification-version "1.2"
  43   "The version of the Desktop Notifications Specification implemented.")
  44
  45 (defconst notifications-application-name "Emacs"
  46   "Default application name.")
  47
  48 (defconst notifications-application-icon
  49   (expand-file-name
  50    "images/icons/hicolor/scalable/apps/emacs.svg"
  51    data-directory)
  52   "Default application icon.")
  53
  54 (defconst notifications-service "org.freedesktop.Notifications"
  55   "D-Bus notifications service name.")
  56
  57 (defconst notifications-path "/org/freedesktop/Notifications"
  58   "D-Bus notifications service path.")
  59
  60 (defconst notifications-interface "org.freedesktop.Notifications"
  61   "D-Bus notifications service interface.")
  62
  63 (defconst notifications-notify-method "Notify"
  64   "D-Bus notifications notify method.")
  65
  66 (defconst notifications-close-notification-method "CloseNotification"
  67   "D-Bus notifications close notification method.")
  68
  69 (defconst notifications-get-capabilities-method "GetCapabilities"
  70   "D-Bus notifications get capabilities method.")
  71
  72 (defconst notifications-action-signal "ActionInvoked"
  73   "D-Bus notifications action signal.")
  74
  75 (defconst notifications-closed-signal "NotificationClosed"
  76   "D-Bus notifications closed signal.")
  77
  78 (defconst notifications-closed-reason
  79   '((1 expired)
  80     (2 dismissed)
  81     (3 close-notification)
  82     (4 undefined))
  83   "List of reasons why a notification has been closed.")
  84
  85 (defvar notifications-on-action-map nil
  86   "Mapping between notification and action callback functions.")
  87
  88 (defvar notifications-on-action-object nil
  89   "Object for registered on-action signal.")
  90
  91 (defvar notifications-on-close-map nil
  92   "Mapping between notification and close callback functions.")
  93
  94 (defvar notifications-on-close-object nil
  95   "Object for registered on-close signal.")
  96
  97 (defun notifications-on-action-signal (id action)
  98   "Dispatch signals to callback functions from `notifications-on-action-map'."
  99   (let* ((unique-name (dbus-event-service-name last-input-event))
 100          (entry (assoc (cons unique-name id) notifications-on-action-map)))
 101     (when entry
 102       (funcall (cadr entry) id action)
 103       (when (and (not (setq notifications-on-action-map
 104                             (remove entry notifications-on-action-map)))
 105                  notifications-on-action-object)
 106         (dbus-unregister-object notifications-on-action-object)
 107         (setq notifications-on-action-object nil)))))
 108
 109 (defun notifications-on-closed-signal (id &optional reason)
 110   "Dispatch signals to callback functions from `notifications-on-closed-map'."
 111   ;; notification-daemon prior 0.4.0 does not send a reason.  So we
 112   ;; make it optional, and assume `undefined' as default.
 113   (let* ((unique-name (dbus-event-service-name last-input-event))
 114          (entry (assoc (cons unique-name id) notifications-on-close-map))
 115          (reason (or reason 4)))
 116     (when entry
 117       (funcall (cadr entry)
 118                id (cadr (assoc reason notifications-closed-reason)))
 119       (when (and (not (setq notifications-on-close-map
 120                             (remove entry notifications-on-close-map)))
 121                  notifications-on-close-object)
 122         (dbus-unregister-object notifications-on-close-object)
 123         (setq notifications-on-close-object nil)))))
 124
 125 (defun notifications-notify (&rest params)
 126   "Send notification via D-Bus using the Freedesktop notification protocol.
 127 Various PARAMS can be set:
 128
 129  :title          The notification title.
 130  :body           The notification body text.
 131  :app-name       The name of the application sending the notification.
 132                  Default to `notifications-application-name'.
 133  :replaces-id    The notification ID that this notification replaces.
 134  :app-icon       The notification icon.
 135                  Default is `notifications-application-icon'.
 136                  Set to nil if you do not want any icon displayed.
 137  :actions        A list of actions in the form:
 138                    (KEY TITLE KEY TITLE ...)
 139                  where KEY and TITLE are both strings.
 140                  The default action (usually invoked by clicking the
 141                  notification) should have a key named \"default\".
 142                  The title can be anything, though implementations are free
 143                  not to display it.
 144  :timeout        The timeout time in milliseconds since the display
 145                  of the notification at which the notification should
 146                  automatically close.
 147                  If -1, the notification's expiration time is dependent
 148                  on the notification server's settings, and may vary for
 149                  the type of notification.
 150                  If 0, the notification never expires.
 151                  Default value is -1.
 152  :urgency        The urgency level.
 153                  Either `low', `normal' or `critical'.
 154  :action-items   Whether the TITLE of the actions is interpreted as
 155                  a named icon.
 156  :category       The type of notification this is.
 157  :desktop-entry  This specifies the name of the desktop filename representing
 158                  the calling program.
 159  :image-data     This is a raw data image format which describes the width,
 160                  height, rowstride, has alpha, bits per sample, channels and
 161                  image data respectively.
 162  :image-path     This is represented either as a URI (file:// is the
 163                  only URI schema supported right now) or a name
 164                  in a freedesktop.org-compliant icon theme.
 165  :sound-file     The path to a sound file to play when the notification pops up.
 166  :sound-name     A themable named sound from the freedesktop.org sound naming
 167                  specification to play when the notification pops up.
 168                  Similar to icon-name,only for sounds. An example would
 169                  be \"message-new-instant\".
 170  :suppress-sound Causes the server to suppress playing any sounds, if it has
 171                  that ability.
 172  :resident       When set the server will not automatically remove the
 173                  notification when an action has been invoked.
 174  :transient      When set the server will treat the notification as transient
 175                  and by-pass the server's persistence capability, if it
 176                  should exist.
 177  :x              Specifies the X location on the screen that the notification
 178                  should point to.  The \"y\" hint must also be specified.
 179  :y              Specifies the Y location on the screen that the notification
 180                  should point to.  The \"x\" hint must also be specified.
 181  :on-action      Function to call when an action is invoked.
 182                  The notification id and the key of the action are passed
 183                  as arguments to the function.
 184  :on-close       Function to call when the notification has been closed
 185                  by timeout or by the user.
 186                  The function receive the notification id and the closing
 187                  reason as arguments:
 188                    - `expired' if the notification has expired
 189                    - `dismissed' if the notification was dismissed by the user
 190                    - `close-notification' if the notification was closed
 191                      by a call to CloseNotification
 192                    - `undefined' if the notification server hasn't provided
 193                      a reason
 194
 195 Which parameters are accepted by the notification server can be
 196 checked via `notifications-get-capabilities'.
 197
 198 This function returns a notification id, an integer, which can be
 199 used to manipulate the notification item with
 200 `notifications-close-notification' or the `:replaces-id' argument
 201 of another `notifications-notify' call."
 202   (let ((title (plist-get params :title))
 203         (body (plist-get params :body))
 204         (app-name (plist-get params :app-name))
 205         (replaces-id (plist-get params :replaces-id))
 206         (app-icon (plist-get params :app-icon))
 207         (actions (plist-get params :actions))
 208         (timeout (plist-get params :timeout))
 209         ;; Hints
 210         (hints '())
 211         (urgency (plist-get params :urgency))
 212         (category (plist-get params :category))
 213         (desktop-entry (plist-get params :desktop-entry))
 214         (image-data (plist-get params :image-data))
 215         (image-path (plist-get params :image-path))
 216         (action-items (plist-get params :action-items))
 217         (sound-file (plist-get params :sound-file))
 218         (sound-name (plist-get params :sound-name))
 219         (suppress-sound (plist-get params :suppress-sound))
 220         (resident (plist-get params :resident))
 221         (transient (plist-get params :transient))
 222         (x (plist-get params :x))
 223         (y (plist-get params :y))
 224         id)
 225     ;; Build hints array
 226     (when urgency
 227       (add-to-list 'hints `(:dict-entry
 228                             "urgency"
 229                             (:variant :byte ,(case urgency
 230                                                (low 0)
 231                                                (critical 2)
 232                                                (t 1)))) t))
 233     (when category
 234       (add-to-list 'hints `(:dict-entry
 235                             "category"
 236                             (:variant :string ,category)) t))
 237     (when desktop-entry
 238       (add-to-list 'hints `(:dict-entry
 239                             "desktop-entry"
 240                             (:variant :string ,desktop-entry)) t))
 241     (when image-data
 242       (add-to-list 'hints `(:dict-entry
 243                             "image-data"
 244                             (:variant :struct ,image-data)) t))
 245     (when image-path
 246       (add-to-list 'hints `(:dict-entry
 247                             "image-path"
 248                             (:variant :string ,image-path)) t))
 249     (when action-items
 250       (add-to-list 'hints `(:dict-entry
 251                             "action-items"
 252                             (:variant :boolean ,action-items)) t))
 253     (when sound-file
 254       (add-to-list 'hints `(:dict-entry
 255                             "sound-file"
 256                             (:variant :string ,sound-file)) t))
 257     (when sound-name
 258       (add-to-list 'hints `(:dict-entry
 259                             "sound-name"
 260                             (:variant :string ,sound-name)) t))
 261     (when suppress-sound
 262       (add-to-list 'hints `(:dict-entry
 263                             "suppress-sound"
 264                             (:variant :boolean ,suppress-sound)) t))
 265     (when resident
 266       (add-to-list 'hints `(:dict-entry
 267                             "resident"
 268                             (:variant :boolean ,resident)) t))
 269     (when transient
 270       (add-to-list 'hints `(:dict-entry
 271                             "transient"
 272                             (:variant :boolean ,transient)) t))
 273     (when x
 274       (add-to-list 'hints `(:dict-entry "x" (:variant :int32 ,x)) t))
 275     (when y
 276       (add-to-list 'hints `(:dict-entry "y" (:variant :int32 ,y)) t))
 277
 278     ;; Call Notify method
 279     (setq id
 280           (dbus-call-method :session
 281                             notifications-service
 282                             notifications-path
 283                             notifications-interface
 284                             notifications-notify-method
 285                             :string (or app-name
 286                                         notifications-application-name)
 287                             :uint32 (or replaces-id 0)
 288                             :string (if app-icon
 289                                         (expand-file-name app-icon)
 290                                       ;; If app-icon is nil because user
 291                                       ;; requested it to be so, send the
 292                                       ;; empty string
 293                                       (if (plist-member params :app-icon)
 294                                           ""
 295                                         ;; Otherwise send the default icon path
 296                                         notifications-application-icon))
 297                             :string (or title "")
 298                             :string (or body "")
 299                             `(:array ,@actions)
 300                             (or hints '(:array :signature "{sv}"))
 301                             :int32 (or timeout -1)))
 302
 303     ;; Register close/action callback function.  We must also remember
 304     ;; the daemon's unique name, because the daemon could have
 305     ;; restarted.
 306     (let ((on-action (plist-get params :on-action))
 307           (on-close (plist-get params :on-close))
 308           (unique-name (dbus-get-name-owner :session notifications-service)))
 309       (when on-action
 310         (add-to-list 'notifications-on-action-map
 311                      (list (cons unique-name id) on-action))
 312         (unless notifications-on-action-object
 313           (setq notifications-on-action-object
 314                 (dbus-register-signal
 315                  :session
 316                  nil
 317                  notifications-path
 318                  notifications-interface
 319                  notifications-action-signal
 320                  'notifications-on-action-signal))))
 321
 322       (when on-close
 323         (add-to-list 'notifications-on-close-map
 324                      (list (cons unique-name id) on-close))
 325         (unless notifications-on-close-object
 326           (setq notifications-on-close-object
 327                 (dbus-register-signal
 328                  :session
 329                  nil
 330                  notifications-path
 331                  notifications-interface
 332                  notifications-closed-signal
 333                  'notifications-on-closed-signal)))))
 334
 335     ;; Return notification id
 336     id))
 337
 338 (defun notifications-close-notification (id)
 339   "Close a notification with identifier ID."
 340   (dbus-call-method :session
 341                     notifications-service
 342                     notifications-path
 343                     notifications-interface
 344                     notifications-close-notification-method
 345                     :int32 id))
 346
 347 (defvar dbus-debug) ; used in the macroexpansion of dbus-ignore-errors
 348
 349 (defun notifications-get-capabilities ()
 350   "Return the capabilities of the notification server, a list of strings.
 351 The following capabilities can be expected:
 352
 353   :actions         The server will provide the specified actions
 354                    to the user.
 355   :action-icons    Supports using icons instead of text for
 356                    displaying actions.
 357   :body            Supports body text.
 358   :body-hyperlinks The server supports hyperlinks in the notifications.
 359   :body-images     The server supports images in the notifications.
 360   :body-markup     Supports markup in the body text.
 361   :icon-multi      The server will render an animation of all the
 362                    frames in a given image array.
 363   :icon-static     Supports display of exactly 1 frame of any
 364                    given image array.  This value is mutually exclusive
 365                    with `:icon-multi'.
 366   :persistence     The server supports persistence of notifications.
 367   :sound           The server supports sounds on notifications.
 368
 369 Further vendor-specific caps start with `:x-vendor', like `:x-gnome-foo-cap'."
 370   (dbus-ignore-errors
 371    (mapcar
 372     (lambda (x) (intern (concat ":" x)))
 373     (dbus-call-method :session
 374                       notifications-service
 375                       notifications-path
 376                       notifications-interface
 377                       notifications-get-capabilities-method))))
 378
 379 (provide 'notifications)