Signal: signel chats with voice calls, names instead of numbersHEADmain

signel talks to signal-cli over JSON-RPC and starts with Doom when
signel-account is set (from the private overlay). Voice calls ride on
signal-cli 0.14's callEvent notifications: call, answer, decline and
hang up from a chat, a desktop notification with Answer/Decline, a
modeline segment, and PulseAudio loopbacks joining each call's virtual
devices to the default microphone and speakers.

Chats are keyed by Signal ID and named the way the phone names them,
from listContacts and listGroups, so phone numbers the phone hides are
never shown.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>

1 files changed, 427 insertions, 0 deletions

diff --git a/config.el b/config.el
index 94cf0df..0b9be80 100644
--- a/config.el
+++ b/config.el
@@ -3145,6 +3145,433 @@ PASS-ENTRY names the password-store entry holding JID's password.")
 (map! :leader :desc "IRC" "o i" #'=irc)
 ;; IRC:2 ends here
 
+;; [[file:config.org::*Signal][Signal:1]]
+(defun my/signel-start-h ()
+  "Start signel if `signel-account' is set."
+  (when (bound-and-true-p signel-account)
+    (condition-case err
+        (signel-start)
+      (error (warn "Signal: not starting: %s" (error-message-string err))))))
+
+(use-package! signel
+  :init
+  (add-hook 'doom-after-init-hook #'my/signel-start-h)
+  (map! :leader :desc "Signal" "o C" #'signel-dashboard))
+;; Signal:1 ends here
+
+;; [[file:config.org::*Phone numbers][Phone numbers:1]]
+(defvar my/signel--number-ids (make-hash-table :test 'equal)
+  "Signal IDs by phone number, from signal-cli's list of recipients.
+Used only to move a chat opened by number onto its ID; never shown.")
+
+(defvar my/signel--contacts-requests nil
+  "IDs of the listContacts requests not yet answered.")
+
+(defvar my/signel--profiles-asked nil
+  "Non-nil once unnamed recipients have been asked about by ID.")
+
+(defvar my/signel--groups-requests nil
+  "IDs of the listGroups requests not yet answered.")
+
+(defvar my/signel--groups-asked (make-hash-table :test 'equal)
+  "Group IDs that a message has already sent a listGroups request for.")
+
+(defun my/signel--name (id)
+  "The name to show for the person or group with ID.
+Signel's contact map holds both; without an entry, a person is \"Unknown\"
+and a group \"Unnamed group\"."
+  (gethash id signel--contact-map
+           (if (signel--is-group-id id) "Unnamed group" "Unknown")))
+
+(defun my/signel--buffer-name (id)
+  "Buffer name for the chat with ID."
+  (format "*Signel: %s*" (my/signel--name id)))
+
+(defun my/signel--hide-numbers-a (args)
+  "Key the message in ARGS by the sender's Signal ID, without numbers.
+The sender becomes their ID and loses their number, gets a name if they
+came without one, and a synced message of yours goes to its recipient's ID."
+  (let* ((params (car args))
+         (envelope (alist-get 'envelope params))
+         (id (alist-get 'sourceUuid envelope))
+         (sync (alist-get 'syncMessage envelope))
+         (sent (alist-get 'sentMessage sync))
+         (group (alist-get 'groupId (alist-get 'groupInfo
+                                               (alist-get 'dataMessage envelope)))))
+    (when (and group
+               (not (gethash group signel--contact-map))
+               (not (gethash group my/signel--groups-asked)))
+      (puthash group t my/signel--groups-asked)
+      (my/signel--request-groups))
+    (when id
+      (setf (alist-get 'source envelope) id))
+    (unless (alist-get 'sourceName envelope)
+      (setf (alist-get 'sourceName envelope)
+            (my/signel--name (alist-get 'source envelope))))
+    (setf (alist-get 'sourceNumber envelope nil 'remove) nil)
+    (when sent
+      (setf (alist-get 'destinationNumber sent) (alist-get 'destinationUuid sent)
+            (alist-get 'sentMessage sync) sent
+            (alist-get 'syncMessage envelope) sync))
+    (setf (alist-get 'envelope params) envelope)
+    (list params)))
+
+(defun my/signel--get-buffer-a (id)
+  "The chat buffer for ID, found by ID rather than by name, or a new one."
+  (or (seq-find (lambda (buffer)
+                  (equal (buffer-local-value 'signel--chat-id buffer) id))
+                (buffer-list))
+      (with-current-buffer (generate-new-buffer (my/signel--buffer-name id))
+        (signel-chat-mode)
+        (setq signel--chat-id id)
+        (signel--draw-prompt)
+        (current-buffer))))
+
+(defun my/signel--dashboard-draw-a ()
+  "Draw the chat list with names only."
+  (let ((inhibit-read-only t))
+    (erase-buffer)
+    (insert "Active Chats:\n-------------\n")
+    (maphash (lambda (id _)
+               (insert-button (my/signel--name id)
+                              'action #'signel--dashboard-open-entry
+                              'signel-id id
+                              'follow-link t)
+               (insert "\n"))
+             signel--active-chats)))
+
+(defun my/signel--request-contacts (&optional ids)
+  "Ask signal-cli for everyone it knows, or, with IDS, for just those.
+Naming them makes signal-cli fetch their profiles first."
+  (push (signel--send-rpc "listContacts"
+                          `((allRecipients . t)
+                            ,@(and ids `((recipient . ,(vconcat ids))))))
+        my/signel--contacts-requests))
+
+(defun my/signel--request-groups ()
+  "Ask signal-cli for every group, to name group chats by."
+  (push (signel--send-rpc "listGroups" (make-hash-table))
+        my/signel--groups-requests))
+
+(defun my/signel--request-names-a (&rest _)
+  "Ask for people's and groups' names afresh after signel starts."
+  (setq my/signel--contacts-requests nil
+        my/signel--profiles-asked nil
+        my/signel--groups-requests nil)
+  (clrhash my/signel--groups-asked)
+  (my/signel--request-contacts)
+  (my/signel--request-groups))
+
+(defun my/signel--contact-name (contact)
+  "The name the phone shows for CONTACT, from listContacts, or nil."
+  (let ((profile (alist-get 'profile contact)))
+    (seq-find (lambda (name) (not (string-empty-p name)))
+              (mapcar (lambda (parts) (string-trim (string-join (delq nil parts) " ")))
+                      (list (list (alist-get 'nickName contact))
+                            (list (alist-get 'nickGivenName contact)
+                                  (alist-get 'nickFamilyName contact))
+                            (list (alist-get 'name contact))
+                            (list (alist-get 'givenName profile)
+                                  (alist-get 'familyName profile)))))))
+
+(defun my/signel--rekey-chat (buffer id)
+  "Make chat BUFFER, opened by number, the chat with Signal ID instead.
+If a chat with ID is already open, BUFFER's history moves to the top of
+that one, which takes BUFFER's place in its windows, and BUFFER goes."
+  (let ((old (buffer-local-value 'signel--chat-id buffer))
+        (existing (seq-find (lambda (other)
+                              (and (not (eq other buffer))
+                                   (equal (buffer-local-value 'signel--chat-id other) id)))
+                            (buffer-list))))
+    (when (gethash old signel--active-chats)
+      (remhash old signel--active-chats)
+      (puthash id t signel--active-chats))
+    (remhash old signel--contact-map)
+    (if (not existing)
+        (with-current-buffer buffer
+          (setq signel--chat-id id))
+      (let ((history (with-current-buffer buffer
+                       (buffer-substring (point-min)
+                                         (save-excursion
+                                           (goto-char signel--input-marker)
+                                           (line-beginning-position))))))
+        (with-current-buffer existing
+          (let ((inhibit-read-only t))
+            (save-excursion
+              (goto-char (point-min))
+              (insert history)))))
+      (dolist (window (get-buffer-window-list buffer nil t))
+        (set-window-buffer window existing))
+      (kill-buffer buffer))))
+
+(defun my/signel--rename-chats ()
+  "Rename every open chat, and the chat list, by what's now known."
+  (dolist (buffer (buffer-list))
+    (when-let* ((chat (buffer-local-value 'signel--chat-id buffer)))
+      (with-current-buffer buffer
+        (rename-buffer (my/signel--buffer-name chat) t))))
+  (signel--dashboard-refresh))
+
+(defun my/signel--handle-contacts (contacts)
+  "Learn names and IDs from CONTACTS, and rename and rekey open chats."
+  (let (unnamed)
+    (seq-doseq (contact contacts)
+      (when-let* ((id (alist-get 'uuid contact)))
+        (when-let* ((number (alist-get 'number contact)))
+          (puthash number id my/signel--number-ids))
+        (if-let* ((name (my/signel--contact-name contact)))
+            (puthash id name signel--contact-map)
+          (push id unnamed))))
+    (dolist (buffer (buffer-list))
+      (when-let* ((chat (buffer-local-value 'signel--chat-id buffer))
+                  ((not (signel--is-group-id chat)))
+                  (id (gethash chat my/signel--number-ids)))
+        (my/signel--rekey-chat buffer id)))
+    (my/signel--rename-chats)
+    (when (and unnamed (not my/signel--profiles-asked))
+      (setq my/signel--profiles-asked t)
+      (my/signel--request-contacts unnamed))))
+
+(defun my/signel--handle-groups (groups)
+  "Learn group names from GROUPS, a listGroups answer, and rename chats.
+Only each group's ID and name are read; its member lists carry numbers."
+  (seq-doseq (group groups)
+    (when-let* ((id (alist-get 'id group))
+                (name (alist-get 'name group))
+                ((not (string-empty-p name))))
+      (puthash id name signel--contact-map)))
+  (my/signel--rename-chats))
+
+(defun my/signel--dispatch-names-a (json)
+  "Handle JSON first if it answers a listContacts or listGroups request."
+  (when-let* ((id (alist-get 'id json)))
+    (cond
+     ((memql id my/signel--contacts-requests)
+      (setq my/signel--contacts-requests (delq id my/signel--contacts-requests))
+      (when-let* ((contacts (alist-get 'result json)))
+        (my/signel--handle-contacts contacts)))
+     ((memql id my/signel--groups-requests)
+      (setq my/signel--groups-requests (delq id my/signel--groups-requests))
+      (when-let* ((groups (alist-get 'result json)))
+        (my/signel--handle-groups groups))))))
+
+(defun my/signel--chat-by-id-a (args)
+  "Open a chat asked for by a known number under that person's ID."
+  (list (gethash (car args) my/signel--number-ids (car args))))
+
+(after! signel
+  (advice-add 'signel--handle-receive :filter-args #'my/signel--hide-numbers-a)
+  (advice-add 'signel--get-buffer :override #'my/signel--get-buffer-a)
+  (advice-add 'signel--dashboard-draw :override #'my/signel--dashboard-draw-a)
+  (advice-add 'signel-start :after #'my/signel--request-names-a)
+  (advice-add 'signel--dispatch :before #'my/signel--dispatch-names-a)
+  (advice-add 'signel-chat :filter-args #'my/signel--chat-by-id-a))
+;; Phone numbers:1 ends here
+
+;; [[file:config.org::*Voice calls][Voice calls:1]]
+(defvar my/signel-calls (make-hash-table :test 'eql)
+  "Calls signal-cli has reported, keyed by call ID.
+Each value is a plist: :peer (number or UUID), :state (as signal-cli names
+it), :input and :output (the tunnel's audio devices), :modules (the
+PulseAudio loopbacks connecting them) and :notification (the incoming-call
+notification's ID).")
+
+(defun my/signel--subscribe-calls-a (&rest _)
+  "Ask signal-cli for call events, which it otherwise doesn't send."
+  (signel--send-rpc "subscribeCallEvents" (make-hash-table)))
+
+(defun my/signel--dispatch-call-a (json)
+  "Handle JSON first if it is a callEvent notification."
+  (when (equal (alist-get 'method json) "callEvent")
+    (my/signel--handle-call-event (alist-get 'result (alist-get 'params json)))))
+
+(defun my/signel--state-text (state &optional reason)
+  "Describe call STATE for a person; REASON is why an ended call ended."
+  (pcase state
+    ("RINGING_INCOMING" "incoming call (C-c C-y answers, C-c C-n declines)")
+    ("RINGING_OUTGOING" "ringing")
+    ("CONNECTING" "connecting")
+    ("CONNECTED" "call connected")
+    ("RECONNECTING" "reconnecting")
+    ("ENDED" (if reason (format "call ended (%s)" reason) "call ended"))
+    (_ (downcase state))))
+
+(defun my/signel--handle-call-event (event)
+  "Record call EVENT, note it in its chat, and act on its new state."
+  (let* ((id (alist-get 'callId event))
+         (state (alist-get 'state event))
+         (call (gethash id my/signel-calls))
+         ;; By ID, like every chat (see Phone numbers), and the same chat
+         ;; for the whole call.
+         (peer (or (plist-get call :peer) (alist-get 'uuid event)
+                   (alist-get 'number event))))
+    (setq call (plist-put call :peer peer))
+    (setq call (plist-put call :state state))
+    ;; The device names come once the tunnel is up; later events may leave
+    ;; them out, so they're only ever added.
+    (pcase-dolist (`(,field . ,key) '((inputDeviceName . :input)
+                                      (outputDeviceName . :output)))
+      (when-let* ((value (alist-get field event)))
+        (setq call (plist-put call key value))))
+    (puthash id call my/signel-calls)
+    (when-let* ((notification (plist-get call :notification))
+                ((not (equal state "RINGING_INCOMING"))))
+      (notifications-close-notification notification)
+      (puthash id (plist-put call :notification nil) my/signel-calls))
+    (when peer
+      (with-current-buffer (signel--get-buffer peer)
+        (signel--insert-system-msg
+         (my/signel--state-text state (alist-get 'reason event)) 'shadow)))
+    (pcase state
+      ("RINGING_INCOMING" (my/signel--ring id peer))
+      ("CONNECTED" (my/signel--connect-audio id))
+      ("ENDED" (my/signel--forget-call id)))
+    (when (fboundp 'my/modeline-astro-update)
+      (my/modeline-astro-update))))
+
+(defun my/signel--ring (id peer)
+  "Show the chat with PEER and raise a notification for incoming call ID."
+  (display-buffer (signel--get-buffer peer))
+  (puthash id
+           (plist-put
+            (gethash id my/signel-calls) :notification
+            (notifications-notify
+             :title (format "Signal call from %s" (my/signel--name peer))
+             :urgency 'critical
+             :actions '("answer" "Answer" "decline" "Decline")
+             :on-action (lambda (_notification action)
+                          (pcase action
+                            ("answer" (my/signel-answer id))
+                            ("decline" (my/signel-decline id))))))
+           my/signel-calls))
+
+(defun my/signel--find-call (states what)
+  "ID of a call in one of STATES, preferring this chat's.
+WHAT finishes the error message when there's none, as in \"No call WHAT\"."
+  (let ((chat (bound-and-true-p signel--chat-id))
+        here any)
+    (maphash (lambda (id call)
+               (when (member (plist-get call :state) states)
+                 (if (equal (plist-get call :peer) chat)
+                     (setq here id)
+                   (setq any (or any id)))))
+             my/signel-calls)
+    (or here any (user-error "No call %s" what))))
+
+(defun my/signel-call (recipient)
+  "Start a voice call to RECIPIENT, this chat's contact by default."
+  (interactive
+   (list (or (and (derived-mode-p 'signel-chat-mode) signel--chat-id)
+             (read-string "Call (+Phone): "))))
+  (when (signel--is-group-id recipient)
+    (user-error "signal-cli can't make group calls"))
+  (signel--send-rpc "startCall" `((recipient . ,recipient))
+                    (signel--get-buffer recipient)))
+
+(defun my/signel-answer (id)
+  "Answer the ringing call ID."
+  (interactive (list (my/signel--find-call '("RINGING_INCOMING") "to answer")))
+  (signel--send-rpc "acceptCall" `((callId . ,id))))
+
+(defun my/signel-decline (id)
+  "Decline the ringing call ID."
+  (interactive (list (my/signel--find-call '("RINGING_INCOMING") "to decline")))
+  (signel--send-rpc "rejectCall" `((callId . ,id))))
+
+(defun my/signel-hangup (id)
+  "Hang up call ID, or stop it ringing if it's outgoing."
+  (interactive
+   (list (my/signel--find-call
+          '("RINGING_OUTGOING" "CONNECTING" "CONNECTED" "RECONNECTING")
+          "to hang up")))
+  (signel--send-rpc "hangupCall" `((callId . ,id))))
+
+(defun my/signel-call-modeline ()
+  "📞 while a Signal call is ringing or up; who, and its state, on hover."
+  (let (calls)
+    (maphash (lambda (_id call)
+               (push (format "%s: %s"
+                             (my/signel--name (plist-get call :peer))
+                             (my/signel--state-text (plist-get call :state)))
+                     calls))
+             my/signel-calls)
+    (when calls
+      (propertize "📞" 'help-echo (string-join calls "\n")))))
+
+(after! signel
+  (add-to-list 'my/modeline-segments #'my/signel-call-modeline t)
+  (advice-add 'signel-start :after #'my/signel--subscribe-calls-a)
+  (advice-add 'signel--dispatch :before #'my/signel--dispatch-call-a)
+  (advice-add 'signel-stop :before #'my/signel--forget-all-calls-a)
+  (map! :map signel-chat-mode-map
+        "C-c C-v" #'my/signel-call
+        "C-c C-y" #'my/signel-answer
+        "C-c C-n" #'my/signel-decline
+        "C-c C-k" #'my/signel-hangup
+        :localleader
+        :desc "Call" "c" #'my/signel-call
+        :desc "Answer" "a" #'my/signel-answer
+        :desc "Decline" "d" #'my/signel-decline
+        :desc "Hang up" "h" #'my/signel-hangup))
+;; Voice calls:1 ends here
+
+;; [[file:config.org::*Call audio][Call audio:1]]
+(defvar my/signel-call-source nil
+  "PulseAudio source to send on calls; nil follows the default source.")
+
+(defvar my/signel-call-sink nil
+  "PulseAudio sink to play calls on; nil follows the default sink.")
+
+(defvar my/signel-call-latency 30
+  "Latency, in milliseconds, asked of each call-audio loopback.")
+
+(defun my/signel--loopback (source sink)
+  "Load a loopback from SOURCE to SINK and return its module index.
+A nil SOURCE or SINK leaves PulseAudio to use (and follow) the default."
+  (string-to-number
+   (car (apply #'process-lines "pactl" "load-module" "module-loopback"
+               (format "latency_msec=%d" my/signel-call-latency)
+               (delq nil (list (and source (concat "source=" source))
+                               (and sink (concat "sink=" sink))))))))
+
+(defun my/signel--connect-audio (id)
+  "Join call ID's devices to the microphone and speakers, once."
+  (let ((call (gethash id my/signel-calls)))
+    (unless (plist-get call :modules)
+      (condition-case err
+          (progn
+            (unless (and (plist-get call :input) (plist-get call :output))
+              (error "signal-cli never named the call's audio devices"))
+            (puthash id
+                     (plist-put
+                      call :modules
+                      (list (my/signel--loopback
+                             my/signel-call-source
+                             (concat "sink_for_" (plist-get call :input)))
+                            (my/signel--loopback
+                             (concat (plist-get call :output) ".monitor")
+                             my/signel-call-sink)))
+                     my/signel-calls))
+        (error (message "Signal: couldn't connect call audio: %s"
+                        (error-message-string err)))))))
+
+(defun my/signel--forget-call (id)
+  "Unload call ID's loopbacks, close its notification, and drop it."
+  (let ((call (gethash id my/signel-calls)))
+    (dolist (module (plist-get call :modules))
+      (call-process "pactl" nil nil nil "unload-module" (number-to-string module)))
+    (when-let* ((notification (plist-get call :notification)))
+      (notifications-close-notification notification))
+    (remhash id my/signel-calls)))
+
+(defun my/signel--forget-all-calls-a (&rest _)
+  "Drop every call, since stopping signal-cli ends them all."
+  (dolist (id (hash-table-keys my/signel-calls))
+    (my/signel--forget-call id))
+  (when (fboundp 'my/modeline-astro-update)
+    (my/modeline-astro-update)))
+;; Call audio:1 ends here
+
 ;; [[file:config.org::*Spelling][Spelling:1]]
 (after! ispell
   (setq ispell-dictionary "en_US,de_DE")