lisp/notifications.el

   1 ;;; notifications.el --- Client interface to desktop notifications.
   2
   3 ;; Copyright (C) 2010 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 ;;; Code:
  34 (eval-when-compile
  35   (require 'cl))
  36
  37 ;; Pacify byte-compiler.  D-Bus support in the Emacs core can be
  38 ;; disabled with configuration option "--without-dbus".  Declare used
  39 ;; subroutines and variables of `dbus' therefore.
  40 (declare-function dbus-call-method "dbusbind.c")
  41 (declare-function dbus-register-signal "dbusbind.c")
  42
  43 (require 'dbus)
  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 path.")
  62
  63 (defconst notifications-notify-method "Notify"
  64   "D-Bus notifications service path.")
  65
  66 (defconst notifications-close-notification-method "CloseNotification"
  67   "D-Bus notifications service path.")
  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-close-map nil
  86   "Mapping between notification and close callback functions.")
  87
  88 (defun notifications-on-action-signal (id action)
  89   "Dispatch signals to callback functions from `notifications-on-action-map'."
  90   (let ((entry (assoc id notifications-on-action-map)))
  91     (when entry
  92       (funcall (cadr entry) id action)
  93       (remove entry 'notifications-on-action-map))))
  94
  95 (dbus-register-signal
  96  :session
  97  notifications-service
  98  notifications-path
  99  notifications-interface
 100  notifications-action-signal
 101  'notifications-on-action-signal)
 102
 103 (defun notifications-on-closed-signal (id reason)
 104   "Dispatch signals to callback functions from `notifications-on-closed-map'."
 105   (let ((entry (assoc id notifications-on-close-map)))
 106     (when entry
 107       (funcall (cadr entry)
 108                id (cadr (assoc reason notifications-closed-reason)))
 109       (remove entry 'notifications-on-close-map))))
 110
 111 (dbus-register-signal
 112  :session
 113  notifications-service
 114  notifications-path
 115  notifications-interface
 116  notifications-closed-signal
 117  'notifications-on-closed-signal)
 118
 119 (defun notifications-notify (&rest params)
 120   "Send notification via D-Bus using the Freedesktop notification protocol.
 121 Various PARAMS can be set:
 122
 123  :title          The notification title.
 124  :body           The notification body text.
 125  :app-name       The name of the application sending the notification.
 126                  Default to `notifications-application-name'.
 127  :replaces-id    The notification ID that this notification replaces.
 128  :app-icon       The notification icon.
 129                  Default is `notifications-application-icon'.
 130                  Set to nil if you do not want any icon displayed.
 131  :actions        A list of actions in the form:
 132                    (KEY TITLE KEY TITLE ...)
 133                  where KEY and TITLE are both strings.
 134                  The default action (usually invoked by clicking the
 135                  notification) should have a key named \"default\".
 136                  The title can be anything, though implementations are free
 137                  not to display it.
 138  :timeout        The timeout time in milliseconds since the display
 139                  of the notification at which the notification should
 140                  automatically close.
 141                  If -1, the notification's expiration time is dependent
 142                  on the notification server's settings, and may vary for
 143                  the type of notification.
 144                  If 0, the notification never expires.
 145                  Default value is -1.
 146  :urgency        The urgency level.
 147                  Either `low', `normal' or `critical'.
 148  :category       The type of notification this is.
 149  :desktop-entry  This specifies the name of the desktop filename representing
 150                  the calling program.
 151  :image-data     This is a raw data image format which describes the width,
 152                  height, rowstride, has alpha, bits per sample, channels and
 153                  image data respectively.
 154  :sound-file     The path to a sound file to play when the notification pops up.
 155  :suppress-sound Causes the server to suppress playing any sounds, if it has
 156                  that ability.
 157  :x              Specifies the X location on the screen that the notification
 158                  should point to.  The \"y\" hint must also be specified.
 159  :y              Specifies the Y location on the screen that the notification
 160                  should point to.  The \"x\" hint must also be specified.
 161  :on-action      Function to call when an action is invoked.
 162                  The notification id and the key of the action are passed
 163                  as arguments to the function.
 164  :on-close       Function to call when the notification has been closed
 165                  by timeout or by the user.
 166                  The function receive the notification id and the closing
 167                  reason as arguments:
 168                    - `expired' if the notification has expired
 169                    - `dismissed' if the notification was dismissed by the user
 170                    - `close-notification' if the notification was closed
 171                      by a call to CloseNotification
 172
 173 This function returns a notification id, an integer, which can be
 174 used to manipulate the notification item with
 175 `notifications-close'."
 176   (let ((title (plist-get params :title))
 177         (body (plist-get params :body))
 178         (app-name (plist-get params :app-name))
 179         (replaces-id (plist-get params :replaces-id))
 180         (app-icon (plist-get params :app-icon))
 181         (actions (plist-get params :actions))
 182         (timeout (plist-get params :timeout))
 183         ;; Hints
 184         (hints '())
 185         (urgency (plist-get params :urgency))
 186         (category (plist-get params :category))
 187         (desktop-entry (plist-get params :desktop-entry))
 188         (image-data (plist-get params :image-data))
 189         (sound-file (plist-get params :sound-file))
 190         (suppress-sound (plist-get params :suppress-sound))
 191         (x (plist-get params :x))
 192         (y (plist-get params :y))
 193         id)
 194     ;; Build hints array
 195     (when urgency
 196       (add-to-list 'hints `(:dict-entry
 197                             "urgency"
 198                             (:variant :byte ,(case urgency
 199                                                ('low 0)
 200                                                ('critical 2)
 201                                                (t 1)))) t))
 202     (when category
 203       (add-to-list 'hints `(:dict-entry
 204                             "category"
 205                             (:variant :string ,category)) t))
 206     (when desktop-entry
 207       (add-to-list 'hints `(:dict-entry
 208                             "desktop-entry"
 209                             (:variant :string ,desktop-entry)) t))
 210     (when image-data
 211       (add-to-list 'hints `(:dict-entry
 212                             "image_data"
 213                             (:variant :struct ,image-data)) t))
 214     (when sound-file
 215       (add-to-list 'hints `(:dict-entry
 216                             "sound-file"
 217                             (:variant :string ,sound-file)) t))
 218     (when suppress-sound
 219       (add-to-list 'hints `(:dict-entry
 220                             "suppress-sound"
 221                             (:variant :boolean ,suppress-sound)) t))
 222     (when x
 223       (add-to-list 'hints `(:dict-entry "x" (:variant :int32 ,x)) t))
 224     (when y
 225       (add-to-list 'hints `(:dict-entry "y" (:variant :int32 ,y)) t))
 226
 227     ;; Call Notify method
 228     (setq id
 229           (dbus-call-method :session
 230                             notifications-service
 231                             notifications-path
 232                             notifications-interface
 233                             notifications-notify-method
 234                             :string (or app-name
 235                                         notifications-application-name)
 236                             :uint32 (or replaces-id 0)
 237                             :string (if app-icon
 238                                         (expand-file-name app-icon)
 239                                       ;; If app-icon is nil because user
 240                                       ;; requested it to be so, send the
 241                                       ;; empty string
 242                                       (if (plist-member params :app-icon)
 243                                           ""
 244                                         ;; Otherwise send the default icon path
 245                                         notifications-application-icon))
 246                             :string (or title "")
 247                             :string (or body "")
 248                             `(:array ,@actions)
 249                             (or hints '(:array :signature "{sv}"))
 250                             :int32 (or timeout -1)))
 251
 252     ;; Register close/action callback function
 253     (let ((on-action (plist-get params :on-action))
 254           (on-close (plist-get params :on-close)))
 255       (when on-action
 256         (add-to-list 'notifications-on-action-map (list id on-action)))
 257       (when on-close
 258         (add-to-list 'notifications-on-close-map (list id on-close))))
 259
 260     ;; Return notification id
 261     id))
 262
 263 (defun notifications-close-notification (id)
 264   "Close a notification with identifier ID."
 265   (dbus-call-method :session
 266                     notifications-service
 267                     notifications-path
 268                     notifications-interface
 269                     notifications-close-notification-method
 270                     :int32 id))
 271
 272 (provide 'notifications)