lisp/notifications.el

   1 ;;; notifications.el --- Client interface to desktop notifications.
   2
   3 ;; Copyright (C) 2010-2017 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 <https://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-get-server-information-method "GetServerInformation"
  70   "D-Bus notifications get server information 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* ((bus (dbus-event-bus-name last-input-event))
 100          (unique-name (dbus-event-service-name last-input-event))
 101          (entry (assoc (list bus unique-name id) notifications-on-action-map)))
 102     (when entry
 103       (funcall (cadr entry) id action)
 104       (when (and (not (setq notifications-on-action-map
 105                             (remove entry notifications-on-action-map)))
 106                  notifications-on-action-object)
 107         (dbus-unregister-object notifications-on-action-object)
 108         (setq notifications-on-action-object nil)))))
 109
 110 (defun notifications-on-closed-signal (id &optional reason)
 111   "Dispatch signals to callback functions from `notifications-on-closed-map'."
 112   ;; notification-daemon prior 0.4.0 does not send a reason.  So we
 113   ;; make it optional, and assume `undefined' as default.
 114   (let* ((bus (dbus-event-bus-name last-input-event))
 115          (unique-name (dbus-event-service-name last-input-event))
 116          (entry (assoc (list bus unique-name id) notifications-on-close-map))
 117          (reason (or reason 4)))
 118     (when entry
 119       (funcall (cadr entry)
 120                id (cadr (assoc reason notifications-closed-reason)))
 121       (when (and (not (setq notifications-on-close-map
 122                             (remove entry notifications-on-close-map)))
 123                  notifications-on-close-object)
 124         (dbus-unregister-object notifications-on-close-object)
 125         (setq notifications-on-close-object nil)))))
 126
 127 (defun notifications-notify (&rest params)
 128   "Send notification via D-Bus using the Freedesktop notification protocol.
 129 Various PARAMS can be set:
 130
 131  :bus            The D-Bus bus, if different from `:session'.
 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  :action-items   Whether the TITLE of the actions is interpreted as
 158                  a named icon.
 159  :category       The type of notification this is.
 160  :desktop-entry  This specifies the name of the desktop filename representing
 161                  the calling program.
 162  :image-data     This is a raw data image format which describes the width,
 163                  height, rowstride, has alpha, bits per sample, channels and
 164                  image data respectively.
 165  :image-path     This is represented either as a URI (file:// is the
 166                  only URI schema supported right now) or a name
 167                  in a freedesktop.org-compliant icon theme.
 168  :sound-file     The path to a sound file to play when the notification pops up.
 169  :sound-name     A themable named sound from the freedesktop.org sound naming
 170                  specification to play when the notification pops up.
 171                  Similar to icon-name,only for sounds. An example would
 172                  be \"message-new-instant\".
 173  :suppress-sound Causes the server to suppress playing any sounds, if it has
 174                  that ability.
 175  :resident       When set the server will not automatically remove the
 176                  notification when an action has been invoked.
 177  :transient      When set the server will treat the notification as transient
 178                  and by-pass the server's persistence capability, if it
 179                  should exist.
 180  :x              Specifies the X location on the screen that the notification
 181                  should point to.  The \"y\" hint must also be specified.
 182  :y              Specifies the Y location on the screen that the notification
 183                  should point to.  The \"x\" hint must also be specified.
 184  :on-action      Function to call when an action is invoked.
 185                  The notification id and the key of the action are passed
 186                  as arguments to the function.
 187  :on-close       Function to call when the notification has been closed
 188                  by timeout or by the user.
 189                  The function receive the notification id and the closing
 190                  reason as arguments:
 191                    - `expired' if the notification has expired
 192                    - `dismissed' if the notification was dismissed by the user
 193                    - `close-notification' if the notification was closed
 194                      by a call to CloseNotification
 195                    - `undefined' if the notification server hasn't provided
 196                      a reason
 197
 198 Which parameters are accepted by the notification server can be
 199 checked via `notifications-get-capabilities'.
 200
 201 This function returns a notification id, an integer, which can be
 202 used to manipulate the notification item with
 203 `notifications-close-notification' or the `:replaces-id' argument
 204 of another `notifications-notify' call."
 205   (with-demoted-errors
 206     (let ((bus (or (plist-get params :bus) :session))
 207           (title (plist-get params :title))
 208           (body (plist-get params :body))
 209           (app-name (plist-get params :app-name))
 210           (replaces-id (plist-get params :replaces-id))
 211           (app-icon (plist-get params :app-icon))
 212           (actions (plist-get params :actions))
 213           (timeout (plist-get params :timeout))
 214           ;; Hints
 215           (hints '())
 216           (urgency (plist-get params :urgency))
 217           (category (plist-get params :category))
 218           (desktop-entry (plist-get params :desktop-entry))
 219           (image-data (plist-get params :image-data))
 220           (image-path (plist-get params :image-path))
 221           (action-items (plist-get params :action-items))
 222           (sound-file (plist-get params :sound-file))
 223           (sound-name (plist-get params :sound-name))
 224           (suppress-sound (plist-get params :suppress-sound))
 225           (resident (plist-get params :resident))
 226           (transient (plist-get params :transient))
 227           (x (plist-get params :x))
 228           (y (plist-get params :y))
 229           id)
 230       ;; Build hints array
 231       (when urgency
 232         (add-to-list 'hints `(:dict-entry
 233                               "urgency"
 234                               (:variant :byte ,(pcase urgency
 235                                                  (`low 0)
 236                                                  (`critical 2)
 237                                                  (_ 1)))) t))
 238       (when category
 239         (add-to-list 'hints `(:dict-entry
 240                               "category"
 241                               (:variant :string ,category)) t))
 242       (when desktop-entry
 243         (add-to-list 'hints `(:dict-entry
 244                               "desktop-entry"
 245                               (:variant :string ,desktop-entry)) t))
 246       (when image-data
 247         (add-to-list 'hints `(:dict-entry
 248                               "image-data"
 249                               (:variant :struct ,image-data)) t))
 250       (when image-path
 251         (add-to-list 'hints `(:dict-entry
 252                               "image-path"
 253                               (:variant :string ,image-path)) t))
 254       (when action-items
 255         (add-to-list 'hints `(:dict-entry
 256                               "action-items"
 257                               (:variant :boolean ,action-items)) t))
 258       (when sound-file
 259         (add-to-list 'hints `(:dict-entry
 260                               "sound-file"
 261                               (:variant :string ,sound-file)) t))
 262       (when sound-name
 263         (add-to-list 'hints `(:dict-entry
 264                               "sound-name"
 265                               (:variant :string ,sound-name)) t))
 266       (when suppress-sound
 267         (add-to-list 'hints `(:dict-entry
 268                               "suppress-sound"
 269                               (:variant :boolean ,suppress-sound)) t))
 270       (when resident
 271         (add-to-list 'hints `(:dict-entry
 272                               "resident"
 273                               (:variant :boolean ,resident)) t))
 274       (when transient
 275         (add-to-list 'hints `(:dict-entry
 276                               "transient"
 277                               (:variant :boolean ,transient)) t))
 278       (when x
 279         (add-to-list 'hints `(:dict-entry "x" (:variant :int32 ,x)) t))
 280       (when y
 281         (add-to-list 'hints `(:dict-entry "y" (:variant :int32 ,y)) t))
 282
 283       ;; Call Notify method.
 284       (setq id
 285             (dbus-call-method bus
 286                               notifications-service
 287                               notifications-path
 288                               notifications-interface
 289                               notifications-notify-method
 290                               :string (or app-name
 291                                           notifications-application-name)
 292                               :uint32 (or replaces-id 0)
 293                               :string (if app-icon
 294                                           (expand-file-name app-icon)
 295                                         ;; If app-icon is nil because user
 296                                         ;; requested it to be so, send the
 297                                         ;; empty string
 298                                         (if (plist-member params :app-icon)
 299                                             ""
 300                                           ;; Otherwise send the
 301                                           ;; default icon path
 302                                           notifications-application-icon))
 303                               :string (or title "")
 304                               :string (or body "")
 305                               `(:array ,@actions)
 306                               (or hints '(:array :signature "{sv}"))
 307                               :int32 (or timeout -1)))
 308
 309       ;; Register close/action callback function.  We must also
 310       ;; remember the daemon's unique name, because the daemon could
 311       ;; have restarted.
 312       (let ((on-action (plist-get params :on-action))
 313             (on-close (plist-get params :on-close))
 314             (unique-name (dbus-get-name-owner bus notifications-service)))
 315         (when on-action
 316           (add-to-list 'notifications-on-action-map
 317                        (list (list bus unique-name id) on-action))
 318           (unless notifications-on-action-object
 319             (setq notifications-on-action-object
 320                   (dbus-register-signal
 321                    bus
 322                    nil
 323                    notifications-path
 324                    notifications-interface
 325                    notifications-action-signal
 326                    'notifications-on-action-signal))))
 327
 328         (when on-close
 329           (add-to-list 'notifications-on-close-map
 330                        (list (list bus unique-name id) on-close))
 331           (unless notifications-on-close-object
 332             (setq notifications-on-close-object
 333                   (dbus-register-signal
 334                    bus
 335                    nil
 336                    notifications-path
 337                    notifications-interface
 338                    notifications-closed-signal
 339                    'notifications-on-closed-signal)))))
 340
 341       ;; Return notification id
 342       id)))
 343
 344 (defun notifications-close-notification (id &optional bus)
 345   "Close a notification with identifier ID.
 346 BUS can be a string denoting a D-Bus connection, the default is `:session'."
 347   (dbus-call-method (or bus :session)
 348                     notifications-service
 349                     notifications-path
 350                     notifications-interface
 351                     notifications-close-notification-method
 352                     :uint32 id))
 353
 354 (defvar dbus-debug) ; used in the macroexpansion of dbus-ignore-errors
 355
 356 (defun notifications-get-capabilities (&optional bus)
 357   "Return the capabilities of the notification server, a list of symbols.
 358 BUS can be a string denoting a D-Bus connection, the default is `:session'.
 359 The following capabilities can be expected:
 360
 361   :actions         The server will provide the specified actions
 362                    to the user.
 363   :action-icons    Supports using icons instead of text for
 364                    displaying actions.
 365   :body            Supports body text.
 366   :body-hyperlinks The server supports hyperlinks in the notifications.
 367   :body-images     The server supports images in the notifications.
 368   :body-markup     Supports markup in the body text.
 369   :icon-multi      The server will render an animation of all the
 370                    frames in a given image array.
 371   :icon-static     Supports display of exactly 1 frame of any
 372                    given image array.  This value is mutually exclusive
 373                    with `:icon-multi'.
 374   :persistence     The server supports persistence of notifications.
 375   :sound           The server supports sounds on notifications.
 376
 377 Further vendor-specific caps start with `:x-vendor', like `:x-gnome-foo-cap'."
 378   (dbus-ignore-errors
 379     (mapcar
 380      (lambda (x) (intern (concat ":" x)))
 381      (dbus-call-method (or bus :session)
 382                        notifications-service
 383                        notifications-path
 384                        notifications-interface
 385                        notifications-get-capabilities-method))))
 386
 387 (defun notifications-get-server-information (&optional bus)
 388   "Return information on the notification server, a list of strings.
 389 BUS can be a string denoting a D-Bus connection, the default is `:session'.
 390 The returned list is (NAME VENDOR VERSION SPEC-VERSION).
 391
 392   NAME         The product name of the server.
 393   VENDOR       The vendor name.  For example, \"KDE\", \"GNOME\".
 394   VERSION      The server's version number.
 395   SPEC-VERSION The specification version the server is compliant with.
 396
 397 If SPEC_VERSION is missing, the server supports a specification
 398 prior to \"1.0\".
 399
 400 See `notifications-specification-version' for the specification
 401 version this library is compliant with."
 402   (dbus-ignore-errors
 403     (dbus-call-method (or bus :session)
 404                       notifications-service
 405                       notifications-path
 406                       notifications-interface
 407                       notifications-get-server-information-method)))
 408
 409 (provide 'notifications)