241 lines
8.6 KiB
EmacsLisp
241 lines
8.6 KiB
EmacsLisp
;;; mu4e-dbus.el --- DBus support -*- lexical-binding: t-*-
|
|
|
|
;; Copyright (C) 2025-2026 Dirk-Jan C. Binnema
|
|
|
|
;; Author: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
|
;; Maintainer: Dirk-Jan C. Binnema <djcb@djcbsoftware.nl>
|
|
|
|
;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
|
|
;; mu4e 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.
|
|
|
|
;; mu4e 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 mu4e. If not, see <http://www.gnu.org/licenses/>.
|
|
|
|
;;; Commentary:
|
|
;;; Export Mu4e information over D-Bus.
|
|
|
|
;;; Code:
|
|
|
|
(eval-when-compile (require 'dbus nil 'noerror))
|
|
(require 'dbus nil 'noerror)
|
|
|
|
(require 'mu4e-helpers)
|
|
(require 'mu4e-query-items)
|
|
(require 'mu4e-context)
|
|
|
|
(defconst mu4e-dbus-service "nl.djcbsoftware.Mu4e"
|
|
"Mu4e's DBus service name.")
|
|
|
|
(defconst mu4e-dbus-interface "nl.djcbsoftware.Mu4e"
|
|
"Mu4e's DBus interface.")
|
|
|
|
(defconst mu4e-dbus-object-path "/nl/djcbsoftware/Mu4e"
|
|
"Mu4e's DBus object path.")
|
|
;; We could use different object paths for allowing multiple mu4e's. But let's
|
|
;; not add that complication for now.
|
|
|
|
(defconst mu4e-dbus-introspection-xml
|
|
"<node>
|
|
<interface name='org.freedesktop.DBus.Introspectable'>
|
|
<method name='Introspect'>
|
|
<arg name='xml_data' type='s' direction='out'/>
|
|
</method>
|
|
</interface>
|
|
<interface name='org.freedesktop.DBus.Properties'>
|
|
<method name='Get'>
|
|
<arg type='s' name='interface_name' direction='in'/>
|
|
<arg type='s' name='property_name' direction='in'/>
|
|
<arg type='v' name='value' direction='out'/>
|
|
</method>
|
|
<method name='GetAll'>
|
|
<arg type='s' name='interface_name' direction='in'/>
|
|
<arg type='a{sv}' name='properties' direction='out'/>
|
|
</method>
|
|
<method name='Set'>
|
|
<arg type='s' name='interface_name' direction='in'/>
|
|
<arg type='s' name='property_name' direction='in'/>
|
|
<arg type='v' name='value' direction='in'/>
|
|
</method>
|
|
<signal name='PropertiesChanged'>
|
|
<arg type='s' name='interface_name'/>
|
|
<arg type='a{sv}' name='changed_properties'/>
|
|
<arg type='as' name='invalidated_properties'/>
|
|
</signal>
|
|
</interface>
|
|
<interface name='nl.djcbsoftware.Mu4e'>
|
|
<property name='Version' type='s' access='read'/>
|
|
<property name='DatabasePath' type='s' access='read'/>
|
|
<property name='RootMaildir' type='s' access='read'/>
|
|
<property name='Context' type='s' access='readwrite'/>
|
|
<property name='QueryInfo' type='aa{sv}' access='readwrite'/>
|
|
</interface>
|
|
</node>"
|
|
"The XML blob used for DBus introspection.
|
|
|
|
Apart from the properties boilerplate, the
|
|
\"nl.djcbsoftware.Mu4e\" interface supports the following:
|
|
|
|
1) properties:
|
|
- Version (string): the mu/mu4e version
|
|
- Context (string): the current mu4e context, if any
|
|
- QueryInfo (array-of-vardict):
|
|
information about bookmarks / queries, i.e., a
|
|
subset of the `mu4e-query-items' information.
|
|
|
|
Each item describes a bookmark/maildir item with
|
|
entries:
|
|
- name (string) -> name of the item
|
|
- query (string) -> query for this item
|
|
- count (number) -> number of matching messages
|
|
- unread (number) -> the number of unread messages
|
|
- delta-unread (number) -> number of unread, since baseline
|
|
- favorite (bool) -> this is the favorite entry
|
|
(optional, at most one entry has this).")
|
|
|
|
;; Introspection... although not strictly required, it is very useful for
|
|
;; clients (including tools like d-spy) to find out the methods we support. We
|
|
;; need to implement introspection methods on each hierarchical level of the
|
|
;; object path... a lot of boilerplate
|
|
;;
|
|
;; I think Emacs could technically generate much of this, but it doesn't seem to
|
|
;; do so now....
|
|
|
|
(defun mu4e--dbus-introspect-parents ()
|
|
"Set up introspection for the parent object paths."
|
|
(seq-do
|
|
(lambda (path-child)
|
|
(let ((path (car path-child)) (child (cdr path-child)))
|
|
(dbus-register-method
|
|
:session mu4e-dbus-service
|
|
path
|
|
dbus-interface-introspectable
|
|
"Introspect"
|
|
`(lambda ()
|
|
,(format "<node><node name='%s'/></node>" child)))))
|
|
'(("/" . "nl")
|
|
("/nl" . "djcbsoftware")
|
|
("/nl/djcbsoftware" . "Mu4e"))))
|
|
|
|
(defun mu4e--dbus-introspect-nl-djcbsoftware-mu4e ()
|
|
"Mu4e introspection for /nl/djcbsoftware/Mu4e."
|
|
(dbus-register-method
|
|
:session
|
|
mu4e-dbus-service
|
|
mu4e-dbus-object-path
|
|
dbus-interface-introspectable
|
|
"Introspect"
|
|
(lambda () mu4e-dbus-introspection-xml)))
|
|
|
|
(defun mu4e--dbus-register-property (name access value)
|
|
"Register mu4e DBus property with NAME to VALUE.
|
|
|
|
ACCESS is a symbol, either `:read', `:write' or `:readwrite'.
|
|
|
|
There are read-only, i.e. only writable from here. Thus,
|
|
setting a property means (re)registering it."
|
|
(dbus-register-property
|
|
:session
|
|
mu4e-dbus-service
|
|
mu4e-dbus-object-path
|
|
mu4e-dbus-interface
|
|
name access value))
|
|
|
|
(defun mu4e--dbus-set-property (name value)
|
|
"Update mu4e DBus property with NAME to VALUE."
|
|
(dbus-set-property
|
|
:session
|
|
mu4e-dbus-service
|
|
mu4e-dbus-object-path
|
|
mu4e-dbus-interface
|
|
name value))
|
|
|
|
;; Convert to D-Bus format - list of dict entries
|
|
(defun mu4e--dbus-query-info ()
|
|
"Return an array of dbus vardicts with query-items information.
|
|
this filters / maps the information from `mu4e-query-items'."
|
|
;; D-Bus signature: aa{sv} (array of dict with string keys and variant values)
|
|
;; Return an array of dbus vardicts with query-items information.
|
|
;; This filters / maps the information from `mu4e-query-items'."
|
|
;; D-Bus signature: aa{sv} (array of dict with string keys and variant values)
|
|
(cons ':array
|
|
(mapcar
|
|
(lambda (plist)
|
|
(let ((dict))
|
|
(while plist
|
|
(let* ((key (car plist)) (val (cadr plist)))
|
|
(when (memq key '(:name :query :count :unread :delta-unread :favorite))
|
|
(push (list :dict-entry (substring (symbol-name key) 1) ; decolonize
|
|
(list :variant val)) dict))
|
|
(setq plist (cddr plist))))
|
|
(cons ':array dict)))
|
|
(mu4e-query-items))))
|
|
|
|
(defun mu4e--dbus-update-query-info ()
|
|
"(Re-)register the query-info property."
|
|
(mu4e--dbus-set-property "QueryInfo" (mu4e--dbus-query-info)))
|
|
|
|
(defun mu4e--dbus-update-context ()
|
|
"(Re-)register the current mu4e context."
|
|
(let ((ctx (mu4e-context-current)))
|
|
(mu4e--dbus-set-property
|
|
"Context" (if ctx (mu4e-context-name ctx) ""))))
|
|
|
|
(defun mu4e--dbus-init ()
|
|
"Initialize mu4e's DBus interface."
|
|
(dbus-register-service
|
|
:session mu4e-dbus-service
|
|
:allow-replacement :replace-existing)
|
|
|
|
;; setup introspection
|
|
(mu4e--dbus-introspect-parents)
|
|
(mu4e--dbus-introspect-nl-djcbsoftware-mu4e)
|
|
|
|
;; Register properties
|
|
(mu4e--dbus-register-property "Version" :read mu4e-mu-version)
|
|
(mu4e--dbus-register-property "DatabasePath" :read
|
|
(plist-get (mu4e-server-properties) :database-path))
|
|
(mu4e--dbus-register-property "RootMaildir" :read
|
|
(plist-get (mu4e-server-properties) :root-maildir))
|
|
(mu4e--dbus-register-property "MessageCounbt" :readwrite
|
|
(plist-get (mu4e-server-properties) :doccount))
|
|
(mu4e--dbus-register-property "Context" :readwrite mu4e-mu-version)
|
|
(mu4e--dbus-register-property "QueryInfo" :readwrite (mu4e--dbus-query-info))
|
|
|
|
;; auto-update context
|
|
(mu4e--dbus-update-context)
|
|
(add-hook 'mu4e-context-changed-hook #'mu4e--dbus-update-context)
|
|
|
|
;; auto-update query info, and update when it changes.
|
|
(mu4e--dbus-update-query-info)
|
|
(add-hook 'mu4e-query-items-updated-hook #'mu4e--dbus-update-query-info))
|
|
|
|
(defun mu4e--dbus-uninit ()
|
|
"Un-initialize mu4e's DBus interface."
|
|
(ignore-errors (dbus-unregister-service :session mu4e-dbus-service))
|
|
(remove-hook 'mu4e-context-changed-hook #'mu4e--dbus-update-context)
|
|
(remove-hook 'mu4e-query-items-updated-hook #'mu4e--dbus-update-query-info))
|
|
|
|
;;;###autoload
|
|
(define-minor-mode mu4e-dbus-mode
|
|
"Minor mode for enabling and disable the mu4e DBus service."
|
|
:global t
|
|
:group 'mu4e
|
|
:lighter nil
|
|
(unless (featurep 'dbus)
|
|
(mu4e-error "DBus support is required but not found"))
|
|
(if mu4e-dbus-mode
|
|
(mu4e--dbus-init)
|
|
(mu4e--dbus-uninit)))
|
|
|
|
(provide 'mu4e-dbus)
|
|
;;; mu4e-dbus.el ends here
|