mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-29 07:58:28 +00:00
Code Issues Releases Activity
ecf08f0621
emacs/lisp/notifications.el
Po Lu ecf08f0621 Merge from savannah/emacs-29 
dc4e6b1329 ; Update copyright years in more files
64b3777631 ; Run set-copyright from admin.el
8e1c56ae46 ; Add 2024 to copyright years

# Conflicts:
#	doc/misc/modus-themes.org
#	doc/misc/texinfo.tex
#	etc/NEWS
#	etc/refcards/ru-refcard.tex
#	etc/themes/modus-operandi-theme.el
#	etc/themes/modus-themes.el
#	etc/themes/modus-vivendi-theme.el
#	lib/alloca.in.h
#	lib/binary-io.h
#	lib/c-ctype.h
#	lib/c-strcasecmp.c
#	lib/c-strncasecmp.c
#	lib/careadlinkat.c
#	lib/cloexec.c
#	lib/close-stream.c
#	lib/diffseq.h
#	lib/dup2.c
#	lib/filemode.h
#	lib/fpending.c
#	lib/fpending.h
#	lib/fsusage.c
#	lib/getgroups.c
#	lib/getloadavg.c
#	lib/gettext.h
#	lib/gettime.c
#	lib/gettimeofday.c
#	lib/group-member.c
#	lib/malloc.c
#	lib/md5-stream.c
#	lib/md5.c
#	lib/md5.h
#	lib/memmem.c
#	lib/memrchr.c
#	lib/nanosleep.c
#	lib/save-cwd.h
#	lib/sha1.c
#	lib/sig2str.c
#	lib/stdlib.in.h
#	lib/strtoimax.c
#	lib/strtol.c
#	lib/strtoll.c
#	lib/time_r.c
#	lib/xalloc-oversized.h
#	lisp/auth-source-pass.el
#	lisp/emacs-lisp/lisp-mnt.el
#	lisp/emacs-lisp/timer.el
#	lisp/info-look.el
#	lisp/jit-lock.el
#	lisp/loadhist.el
#	lisp/mail/rmail.el
#	lisp/net/ntlm.el
#	lisp/net/webjump.el
#	lisp/progmodes/asm-mode.el
#	lisp/progmodes/project.el
#	lisp/progmodes/sh-script.el
#	lisp/textmodes/flyspell.el
#	lisp/textmodes/reftex-toc.el
#	lisp/textmodes/reftex.el
#	lisp/textmodes/tex-mode.el
#	lisp/url/url-gw.el
#	m4/alloca.m4
#	m4/clock_time.m4
#	m4/d-type.m4
#	m4/dirent_h.m4
#	m4/dup2.m4
#	m4/euidaccess.m4
#	m4/fchmodat.m4
#	m4/filemode.m4
#	m4/fsusage.m4
#	m4/getgroups.m4
#	m4/getloadavg.m4
#	m4/getrandom.m4
#	m4/gettime.m4
#	m4/gettimeofday.m4
#	m4/gnulib-common.m4
#	m4/group-member.m4
#	m4/inttypes.m4
#	m4/malloc.m4
#	m4/manywarnings.m4
#	m4/mempcpy.m4
#	m4/memrchr.m4
#	m4/mkostemp.m4
#	m4/mktime.m4
#	m4/nproc.m4
#	m4/nstrftime.m4
#	m4/pathmax.m4
#	m4/pipe2.m4
#	m4/pselect.m4
#	m4/pthread_sigmask.m4
#	m4/readlink.m4
#	m4/realloc.m4
#	m4/sig2str.m4
#	m4/ssize_t.m4
#	m4/stat-time.m4
#	m4/stddef_h.m4
#	m4/stdint.m4
#	m4/stdio_h.m4
#	m4/stdlib_h.m4
#	m4/stpcpy.m4
#	m4/strnlen.m4
#	m4/strtoimax.m4
#	m4/strtoll.m4
#	m4/time_h.m4
#	m4/timegm.m4
#	m4/timer_time.m4
#	m4/timespec.m4
#	m4/unistd_h.m4
#	m4/warnings.m4
#	nt/configure.bat
#	nt/preprep.c
#	test/lisp/register-tests.el
2024-01-02 10:28:14 +08:00

434 lines
17 KiB
EmacsLisp
Raw Blame History

;;; notifications.el --- Client interface to desktop notifications. -*- lexical-binding: t -*-
;; Copyright (C) 2010-2024 Free Software Foundation, Inc.
;; Author: Julien Danjou <julien@danjou.info>
;; Keywords: comm desktop notifications
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This package provides an implementation of the Desktop Notifications
;; <https://developer.gnome.org/notification-spec/>.
;; In order to activate this package, you must add the following code
;; into your .emacs:
;;
;; (require 'notifications)
;; For proper usage, Emacs must be started in an environment with an
;; active D-Bus session bus.
;;; Code:
(require 'dbus)
(defconst notifications-specification-version "1.2"
"The version of the Desktop Notifications Specification implemented.")
(defconst notifications-application-name "Emacs"
"Default application name.")
(defconst notifications-application-icon
(expand-file-name
"images/icons/hicolor/scalable/apps/emacs.svg"
data-directory)
"Default application icon.")
(defconst notifications-service "org.freedesktop.Notifications"
"D-Bus notifications service name.")
(defconst notifications-path "/org/freedesktop/Notifications"
"D-Bus notifications service path.")
(defconst notifications-interface "org.freedesktop.Notifications"
"D-Bus notifications service interface.")
(defconst notifications-notify-method "Notify"
"D-Bus notifications notify method.")
(defconst notifications-close-notification-method "CloseNotification"
"D-Bus notifications close notification method.")
(defconst notifications-get-capabilities-method "GetCapabilities"
"D-Bus notifications get capabilities method.")
(defconst notifications-get-server-information-method "GetServerInformation"
"D-Bus notifications get server information method.")
(defconst notifications-action-signal "ActionInvoked"
"D-Bus notifications action signal.")
(defconst notifications-closed-signal "NotificationClosed"
"D-Bus notifications closed signal.")
(defconst notifications-closed-reason
'((1 expired)
(2 dismissed)
(3 close-notification)
(4 undefined))
"List of reasons why a notification has been closed.")
(defvar notifications-on-action-map nil
"Mapping between notification and action callback functions.")
(defvar notifications-on-action-object nil
"Object for registered on-action signal.")
(defvar notifications-on-close-map nil
"Mapping between notification and close callback functions.")
(defvar notifications-on-close-object nil
"Object for registered on-close signal.")
(defun notifications-on-action-signal (id action)
"Dispatch signals to callback functions from `notifications-on-action-map'."
(let* ((bus (dbus-event-bus-name last-input-event))
(unique-name (dbus-event-service-name last-input-event))
(entry (assoc (list bus unique-name id) notifications-on-action-map)))
(when entry
(funcall (cadr entry) id action)
(when (and (not (setq notifications-on-action-map
(remove entry notifications-on-action-map)))
notifications-on-action-object)
(dbus-unregister-object notifications-on-action-object)
(setq notifications-on-action-object nil)))))
(defun notifications-on-closed-signal (id &optional reason)
"Dispatch signals to callback functions from `notifications-on-close-map'."
;; notification-daemon prior 0.4.0 does not send a reason. So we
;; make it optional, and assume `undefined' as default.
(let* ((bus (dbus-event-bus-name last-input-event))
(unique-name (dbus-event-service-name last-input-event))
(entry (assoc (list bus unique-name id) notifications-on-close-map))
(reason (or reason 4)))
(when entry
(funcall (cadr entry)
id (cadr (assoc reason notifications-closed-reason)))
(when (and (not (setq notifications-on-close-map
(remove entry notifications-on-close-map)))
notifications-on-close-object)
(dbus-unregister-object notifications-on-close-object)
(setq notifications-on-close-object nil)))))
(defun notifications-notify (&rest params)
"Send notification via D-Bus using the Freedesktop notification protocol.
Various PARAMS can be set:
:bus The D-Bus bus, if different from `:session'.
:title The notification title.
:body The notification body text.
:app-name The name of the application sending the notification.
Default to `notifications-application-name'.
:replaces-id The notification ID that this notification replaces.
:app-icon The notification icon.
Default is `notifications-application-icon'.
Set to nil if you do not want any icon displayed.
If the value is a string, the function
interprets it as a file name and converts to
absolute by using `expand-file-name'; if it is a
symbol, the function will use its name (which is
useful when using the Icon Naming
Specification).
:actions A list of actions in the form:
(KEY TITLE KEY TITLE ...)
where KEY and TITLE are both strings.
The default action (usually invoked by clicking the
notification) should have a key named \"default\".
The title can be anything, though implementations are free
not to display it.
:timeout The timeout time in milliseconds since the display
of the notification at which the notification should
automatically close.
If -1, the notification's expiration time is dependent
on the notification server's settings, and may vary for
the type of notification.
If 0, the notification never expires.
Default value is -1.
:urgency The urgency level.
Either `low', `normal' or `critical'.
:action-items Whether the TITLE of the actions is interpreted as
a named icon.
:category The type of notification this is.
:desktop-entry This specifies the name of the desktop filename representing
the calling program.
:image-data This is a raw data image format which describes the width,
height, rowstride, has alpha, bits per sample, channels and
image data respectively.
:image-path This is represented either as a URI (file:// is the
only URI schema supported right now) or a name
in a freedesktop.org-compliant icon theme.
:sound-file The path to a sound file to play when the notification pops up.
:sound-name A themable named sound from the freedesktop.org sound naming
specification to play when the notification pops up.
Similar to icon-name, only for sounds. An example would
be \"message-new-instant\".
:suppress-sound Causes the server to suppress playing any sounds, if it has
that ability.
:resident When set the server will not automatically remove the
notification when an action has been invoked.
:transient When set the server will treat the notification as transient
and by-pass the server's persistence capability, if it
should exist.
:x Specifies the X location on the screen that the notification
should point to. The \"y\" hint must also be specified.
:y Specifies the Y location on the screen that the notification
should point to. The \"x\" hint must also be specified.
:on-action Function to call when an action is invoked.
The notification id and the key of the action are passed
as arguments to the function.
:on-close Function to call when the notification has been closed
by timeout or by the user.
The function receive the notification id and the closing
reason as arguments:
- `expired' if the notification has expired
- `dismissed' if the notification was dismissed by the user
- `close-notification' if the notification was closed
by a call to CloseNotification
- `undefined' if the notification server hasn't provided
a reason
Which parameters are accepted by the notification server can be
checked via `notifications-get-capabilities'.
This function returns a notification id, an integer, which can be
used to manipulate the notification item with
`notifications-close-notification' or the `:replaces-id' argument
of another `notifications-notify' call."
(with-demoted-errors "Notification error: %S"
(let ((bus (or (plist-get params :bus) :session))
(title (plist-get params :title))
(body (plist-get params :body))
(app-name (plist-get params :app-name))
(replaces-id (plist-get params :replaces-id))
(app-icon (plist-get params :app-icon))
(actions (plist-get params :actions))
(timeout (plist-get params :timeout))
;; Hints
(hints '())
(urgency (plist-get params :urgency))
(category (plist-get params :category))
(desktop-entry (plist-get params :desktop-entry))
(image-data (plist-get params :image-data))
(image-path (plist-get params :image-path))
(action-items (plist-get params :action-items))
(sound-file (plist-get params :sound-file))
(sound-name (plist-get params :sound-name))
(suppress-sound (plist-get params :suppress-sound))
(resident (plist-get params :resident))
(transient (plist-get params :transient))
(x (plist-get params :x))
(y (plist-get params :y))
id)
;; Build hints array
(when urgency
(push `(:dict-entry
"urgency"
(:variant :byte ,(pcase urgency
('low 0)
('critical 2)
(_ 1))))
hints))
(when category
(push `(:dict-entry
"category"
(:variant :string ,category))
hints))
(when desktop-entry
(push `(:dict-entry
"desktop-entry"
(:variant :string ,desktop-entry))
hints))
(when image-data
(push `(:dict-entry
"image-data"
(:variant :struct ,image-data))
hints))
(when image-path
(push `(:dict-entry
"image-path"
(:variant :string ,image-path))
hints))
(when action-items
(push `(:dict-entry
"action-items"
(:variant :boolean ,action-items))
hints))
(when sound-file
(push `(:dict-entry
"sound-file"
(:variant :string ,sound-file))
hints))
(when sound-name
(push `(:dict-entry
"sound-name"
(:variant :string ,sound-name))
hints))
(when suppress-sound
(push `(:dict-entry
"suppress-sound"
(:variant :boolean ,suppress-sound))
hints))
(when resident
(push `(:dict-entry
"resident"
(:variant :boolean ,resident))
hints))
(when transient
(push `(:dict-entry
"transient"
(:variant :boolean ,transient))
hints))
(when x
(push `(:dict-entry "x" (:variant :int32 ,x)) hints))
(when y
(push `(:dict-entry "y" (:variant :int32 ,y)) hints))
(setq hints (nreverse hints))
;; Call Notify method.
(setq id
(dbus-call-method bus
notifications-service
notifications-path
notifications-interface
notifications-notify-method
:string (or app-name
notifications-application-name)
:uint32 (or replaces-id 0)
:string (if app-icon
(if (stringp app-icon)
(expand-file-name app-icon)
;; Convert symbol to string
(symbol-name app-icon))
;; If app-icon is nil because user
;; requested it to be so, send the
;; empty string
(if (plist-member params :app-icon)
""
;; Otherwise send the
;; default icon path
notifications-application-icon))
:string (or title "")
:string (or body "")
`(:array ,@actions)
(or hints '(:array :signature "{sv}"))
:int32 (or timeout -1)))
;; Register close/action callback function. We must also
;; remember the daemon's unique name, because the daemon could
;; have restarted.
(let ((on-action (plist-get params :on-action))
(on-close (plist-get params :on-close))
(unique-name (dbus-get-name-owner bus notifications-service)))
(when on-action
(push (list (list bus unique-name id) on-action)
notifications-on-action-map)
(unless notifications-on-action-object
(setq notifications-on-action-object
(dbus-register-signal
bus
nil
notifications-path
notifications-interface
notifications-action-signal
'notifications-on-action-signal))))
(when on-close
(push (list (list bus unique-name id) on-close)
notifications-on-close-map)
(unless notifications-on-close-object
(setq notifications-on-close-object
(dbus-register-signal
bus
nil
notifications-path
notifications-interface
notifications-closed-signal
'notifications-on-closed-signal)))))
;; Return notification id
id)))
(defun notifications-close-notification (id &optional bus)
"Close a notification with identifier ID.
BUS can be a string denoting a D-Bus connection, the default is `:session'."
(dbus-call-method (or bus :session)
notifications-service
notifications-path
notifications-interface
notifications-close-notification-method
:uint32 id))
(defvar dbus-debug) ; used in the macroexpansion of dbus-ignore-errors
(defun notifications-get-capabilities (&optional bus)
"Return the capabilities of the notification server, a list of symbols.
BUS can be a string denoting a D-Bus connection, the default is `:session'.
The following capabilities can be expected:
:actions The server will provide the specified actions
to the user.
:action-icons Supports using icons instead of text for
displaying actions.
:body Supports body text.
:body-hyperlinks The server supports hyperlinks in the notifications.
:body-images The server supports images in the notifications.
:body-markup Supports markup in the body text.
:icon-multi The server will render an animation of all the
frames in a given image array.
:icon-static Supports display of exactly 1 frame of any
given image array. This value is mutually exclusive
with `:icon-multi'.
:persistence The server supports persistence of notifications.
:sound The server supports sounds on notifications.
Further vendor-specific caps start with `:x-vendor', like `:x-gnome-foo-cap'."
(dbus-ignore-errors
(mapcar
(lambda (x) (intern (concat ":" x)))
(dbus-call-method (or bus :session)
notifications-service
notifications-path
notifications-interface
notifications-get-capabilities-method))))
(defun notifications-get-server-information (&optional bus)
"Return information on the notification server, a list of strings.
BUS can be a string denoting a D-Bus connection, the default is `:session'.
The returned list is (NAME VENDOR VERSION SPEC-VERSION).
NAME The product name of the server.
VENDOR The vendor name. For example, \"KDE\", \"GNOME\".
VERSION The server's version number.
SPEC-VERSION The specification version the server is compliant with.
If SPEC_VERSION is missing, the server supports a specification
prior to \"1.0\".
See `notifications-specification-version' for the specification
version this library is compliant with."
(dbus-ignore-errors
(dbus-call-method (or bus :session)
notifications-service
notifications-path
notifications-interface
notifications-get-server-information-method)))
(provide 'notifications)
;;; notifications.el ends here
Reference in New Issue View Git Blame Copy Permalink