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 (require 'dbus)
  38
  39 (defconst notifications-specification-version "1.2"
  40   "The version of the Desktop Notifications Specification implemented.")
  41
  42 (defconst notifications-application-name "Emacs"
  43   "Default application name.")
  44
  45 (defconst notifications-application-icon
  46   (expand-file-name
  47    "images/icons/hicolor/scalable/apps/emacs.svg"
  48    data-directory)
  49   "Default application icon.")
  50
  51 (defconst notifications-service "org.freedesktop.Notifications"
  52   "D-Bus notifications service name.")
  53
  54 (defconst notifications-path "/org/freedesktop/Notifications"
  55   "D-Bus notifications service path.")
  56
  57 (defconst notifications-interface "org.freedesktop.Notifications"
  58   "D-Bus notifications service interface.")
  59
  60 (defconst notifications-notify-method "Notify"
  61   "D-Bus notifications notify method.")
  62
  63 (defconst notifications-close-notification-method "CloseNotification"
  64   "D-Bus notifications close notification method.")
  65
  66 (defconst notifications-get-capabilities-method "GetCapabilities"
  67   "D-Bus notifications get capabilities method.")
  68
  69 (defconst notifications-action-signal "ActionInvoked"
  70   "D-Bus notifications action signal.")
  71
  72 (defconst notifications-closed-signal "NotificationClosed"
  73   "D-Bus notifications closed signal.")
  74
  75 (defconst notifications-closed-reason
  76   '((1 expired)
  77     (2 dismissed)
  78     (3 close-notification)
  79     (4 undefined))
  80   "List of reasons why a notification has been closed.")
  81
  82 (defvar notifications-on-action-map nil
  83   "Mapping between notification and action callback functions.")
  84
  85 (defvar notifications-on-action-object nil
  86   "Object for registered on-action signal.")
  87
  88 (defvar notifications-on-close-map nil
  89   "Mapping between notification and close callback functions.")
  90
  91 (defvar notifications-on-close-object nil
  92   "Object for registered on-close signal.")
  93
  94 (defun notifications-on-action-signal (id action)
  95   "Dispatch signals to callback functions from `notifications-on-action-map'."
  96   (let* ((bus (dbus-event-bus-name last-input-event))
  97          (unique-name (dbus-event-service-name last-input-event))
  98          (entry (assoc (list bus unique-name id) notifications-on-action-map)))
  99     (when entry
 100       (funcall (cadr entry) id action)
 101       (when (and (not (setq notifications-on-action-map
 102                             (remove entry notifications-on-action-map)))
 103                  notifications-on-action-object)
 104         (dbus-unregister-object notifications-on-action-object)
 105         (setq notifications-on-action-object nil)))))
 106
 107 (defun notifications-on-closed-signal (id &optional reason)
 108   "Dispatch signals to callback functions from `notifications-on-closed-map'."
 109   ;; notification-daemon prior 0.4.0 does not send a reason.  So we
 110   ;; make it optional, and assume `undefined' as default.
 111   (let* ((bus (dbus-event-bus-name last-input-event))
 112          (unique-name (dbus-event-service-name last-input-event))
 113          (entry (assoc (list bus unique-name id) notifications-on-close-map))
 114          (reason (or reason 4)))
 115     (when entry
 116       (funcall (cadr entry)
 117                id (cadr (assoc reason notifications-closed-reason)))
 118       (when (and (not (setq notifications-on-close-map
 119                             (remove entry notifications-on-close-map)))
 120                  notifications-on-close-object)
 121         (dbus-unregister-object notifications-on-close-object)
 122         (setq notifications-on-close-object nil)))))
 123
 124 (defun notifications-notify (&rest params)
 125   "Send notification via D-Bus using the Freedesktop notification protocol.
 126 Various PARAMS can be set:
 127
 128  :bus            The D-Bus bus, if different from `:session'.
 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 ((bus (or (plist-get params :bus) :session))
 203         (title (plist-get params :title))
 204         (body (plist-get params :body))
 205         (app-name (plist-get params :app-name))
 206         (replaces-id (plist-get params :replaces-id))
 207         (app-icon (plist-get params :app-icon))
 208         (actions (plist-get params :actions))
 209         (timeout (plist-get params :timeout))
 210         ;; Hints
 211         (hints '())
 212         (urgency (plist-get params :urgency))
 213         (category (plist-get params :category))
 214         (desktop-entry (plist-get params :desktop-entry))
 215         (image-data (plist-get params :image-data))
 216         (image-path (plist-get params :image-path))
 217         (action-items (plist-get params :action-items))
 218         (sound-file (plist-get params :sound-file))
 219         (sound-name (plist-get params :sound-name))
 220         (suppress-sound (plist-get params :suppress-sound))
 221         (resident (plist-get params :resident))
 222         (transient (plist-get params :transient))
 223         (x (plist-get params :x))
 224         (y (plist-get params :y))
 225         id)
 226     ;; Build hints array
 227     (when urgency
 228       (add-to-list 'hints `(:dict-entry
 229                             "urgency"
 230                             (:variant :byte ,(pcase urgency
 231                                                (`low 0)
 232                                                (`critical 2)
 233                                                (_ 1)))) t))
 234     (when category
 235       (add-to-list 'hints `(:dict-entry
 236                             "category"
 237                             (:variant :string ,category)) t))
 238     (when desktop-entry
 239       (add-to-list 'hints `(:dict-entry
 240                             "desktop-entry"
 241                             (:variant :string ,desktop-entry)) t))
 242     (when image-data
 243       (add-to-list 'hints `(:dict-entry
 244                             "image-data"
 245                             (:variant :struct ,image-data)) t))
 246     (when image-path
 247       (add-to-list 'hints `(:dict-entry
 248                             "image-path"
 249                             (:variant :string ,image-path)) t))
 250     (when action-items
 251       (add-to-list 'hints `(:dict-entry
 252                             "action-items"
 253                             (:variant :boolean ,action-items)) t))
 254     (when sound-file
 255       (add-to-list 'hints `(:dict-entry
 256                             "sound-file"
 257                             (:variant :string ,sound-file)) t))
 258     (when sound-name
 259       (add-to-list 'hints `(:dict-entry
 260                             "sound-name"
 261                             (:variant :string ,sound-name)) t))
 262     (when suppress-sound
 263       (add-to-list 'hints `(:dict-entry
 264                             "suppress-sound"
 265                             (:variant :boolean ,suppress-sound)) t))
 266     (when resident
 267       (add-to-list 'hints `(:dict-entry
 268                             "resident"
 269                             (:variant :boolean ,resident)) t))
 270     (when transient
 271       (add-to-list 'hints `(:dict-entry
 272                             "transient"
 273                             (:variant :boolean ,transient)) t))
 274     (when x
 275       (add-to-list 'hints `(:dict-entry "x" (:variant :int32 ,x)) t))
 276     (when y
 277       (add-to-list 'hints `(:dict-entry "y" (:variant :int32 ,y)) t))
 278
 279     ;; Call Notify method.
 280     (setq id
 281           (dbus-call-method bus
 282                             notifications-service
 283                             notifications-path
 284                             notifications-interface
 285                             notifications-notify-method
 286                             :string (or app-name
 287                                         notifications-application-name)
 288                             :uint32 (or replaces-id 0)
 289                             :string (if app-icon
 290                                         (expand-file-name app-icon)
 291                                       ;; If app-icon is nil because user
 292                                       ;; requested it to be so, send the
 293                                       ;; empty string
 294                                       (if (plist-member params :app-icon)
 295                                           ""
 296                                         ;; Otherwise send the default icon path
 297                                         notifications-application-icon))
 298                             :string (or title "")
 299                             :string (or body "")
 300                             `(:array ,@actions)
 301                             (or hints '(:array :signature "{sv}"))
 302                             :int32 (or timeout -1)))
 303
 304     ;; Register close/action callback function.  We must also remember
 305     ;; the daemon's unique name, because the daemon could have
 306     ;; restarted.
 307     (let ((on-action (plist-get params :on-action))
 308           (on-close (plist-get params :on-close))
 309           (unique-name (dbus-get-name-owner bus notifications-service)))
 310       (when on-action
 311         (add-to-list 'notifications-on-action-map
 312                      (list (list bus unique-name id) on-action))
 313         (unless notifications-on-action-object
 314           (setq notifications-on-action-object
 315                 (dbus-register-signal
 316                  bus
 317                  nil
 318                  notifications-path
 319                  notifications-interface
 320                  notifications-action-signal
 321                  'notifications-on-action-signal))))
 322
 323       (when on-close
 324         (add-to-list 'notifications-on-close-map
 325                      (list (list bus unique-name id) on-close))
 326         (unless notifications-on-close-object
 327           (setq notifications-on-close-object
 328                 (dbus-register-signal
 329                  bus
 330                  nil
 331                  notifications-path
 332                  notifications-interface
 333                  notifications-closed-signal
 334                  'notifications-on-closed-signal)))))
 335
 336     ;; Return notification id
 337     id))
 338
 339 (defun notifications-close-notification (id &optional bus)
 340   "Close a notification with identifier ID.
 341 BUS can be a string denoting a D-Bus connection, the default is `:session'."
 342   (dbus-call-method (or bus :session)
 343                     notifications-service
 344                     notifications-path
 345                     notifications-interface
 346                     notifications-close-notification-method
 347                     :int32 id))
 348
 349 (defvar dbus-debug) ; used in the macroexpansion of dbus-ignore-errors
 350
 351 (defun notifications-get-capabilities (&optional bus)
 352   "Return the capabilities of the notification server, a list of strings.
 353 BUS can be a string denoting a D-Bus connection, the default is `:session'.
 354 The following capabilities can be expected:
 355
 356   :actions         The server will provide the specified actions
 357                    to the user.
 358   :action-icons    Supports using icons instead of text for
 359                    displaying actions.
 360   :body            Supports body text.
 361   :body-hyperlinks The server supports hyperlinks in the notifications.
 362   :body-images     The server supports images in the notifications.
 363   :body-markup     Supports markup in the body text.
 364   :icon-multi      The server will render an animation of all the
 365                    frames in a given image array.
 366   :icon-static     Supports display of exactly 1 frame of any
 367                    given image array.  This value is mutually exclusive
 368                    with `:icon-multi'.
 369   :persistence     The server supports persistence of notifications.
 370   :sound           The server supports sounds on notifications.
 371
 372 Further vendor-specific caps start with `:x-vendor', like `:x-gnome-foo-cap'."
 373   (dbus-ignore-errors
 374    (mapcar
 375     (lambda (x) (intern (concat ":" x)))
 376     (dbus-call-method (or bus :session)
 377                       notifications-service
 378                       notifications-path
 379                       notifications-interface
 380                       notifications-get-capabilities-method))))
 381
 382 (provide 'notifications)