diff options
Diffstat (limited to 'lib/net')
| -rw-r--r-- | lib/net/jao-frm.el | 222 | ||||
| -rw-r--r-- | lib/net/jao-maildir.el | 155 | ||||
| -rw-r--r-- | lib/net/jao-proton-utils.el | 131 | ||||
| -rw-r--r-- | lib/net/randomsig.el | 724 | ||||
| -rw-r--r-- | lib/net/signel.org | 546 |
5 files changed, 1778 insertions, 0 deletions
diff --git a/lib/net/jao-frm.el b/lib/net/jao-frm.el new file mode 100644 index 0000000..2658687 --- /dev/null +++ b/lib/net/jao-frm.el @@ -0,0 +1,222 @@ +;;; jao-frm.el --- use frm to show mailbox + +;; Copyright (C) 2004, 2005, 2006, 2007, 2008, 2009, 2010, 2019, 2020 + +;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org> +;; Keywords: mail + +;; This file 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, or (at your option) +;; any later version. + +;; This file 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; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; Little hack to see the contents of your mailbox using GNU mailutils' +;; `frm' program. +;; +;; Just put (require 'jao-frm) in your .emacs, and M-x jao-frm will pop up a +;; new window with your mailbox contents (from and subject) as +;; printed by frm. In this buffer, use `n' and `p' to move, `q' to close +;; the window. `g' will call Gnus. +;; + +;;; Code: + +;;;; Customisation: + +(defgroup jao-frm nil + "Frm-base mailbox checker" + :group 'mail + :prefix "jao-frm-") + +(defcustom jao-frm-exec-path "frm" + "frm executable path" + :group 'jao-frm + :type 'file) + +(defcustom jao-frm-mail-command 'gnus + "Emacs function to invoke when `g' is pressed on an frm buffer." + :group 'jao-frm + :type 'symbol) + +(defcustom jao-frm-mailboxes nil + "List of mailboxes to check, or directory containing them." + :group 'jao-frm + :type '(choice directory (repeat file))) + +(defface jao-frm-mailno-face '((t (:foreground "dark slate grey"))) + "Face for the mail number." + :group 'jao-frm) + +(defface jao-frm-from-face '((t (:foreground "slate grey"))) + "Face for From: header." + :group 'jao-frm) + +(defface jao-frm-subject-face '((t (:foreground "slate blue"))) + "Face for Subject: header." + :group 'jao-frm) + +(defface jao-frm-mailbox-face '((t (:bold t :weight bold))) + "Face for mailbox name." + :group 'jao-frm) + +;;;; Mode: + +(defvar jao-frm-mode-map + (let ((map (make-keymap))) + (suppress-keymap map) + (define-key map [?q] 'jao-frm-delete-window) + (define-key map [?n] 'next-line) + (define-key map [?p] 'previous-line) + (define-key map [?r] 'jao-frm) + (define-key map [?g] (lambda () + (interactive) + (funcall jao-frm-mail-command))) + (define-key map [(control k)] 'jao-frm-delete-message) + map)) + +(setq jao-frm-font-lock-keywords + '(("^[^ :]+:" . 'jao-frm-mailbox-face) + ("^\\([ 0-9]+\\):\t+\\([^\t]+\\)\t+\\([^\n]+$\\)" + (1 'jao-frm-mailno-face) + (2 'jao-frm-from-face) + (3 'jao-frm-subject-face)))) + +(defvar jao-frm-mode-syntax-table + (let ((st (make-syntax-table))) + st)) + +(defun jao-frm-mode () + "Major mode for displaying frm output." + (interactive) + (kill-all-local-variables) + (buffer-disable-undo) + (use-local-map jao-frm-mode-map) + (set (make-local-variable 'font-lock-defaults) + '(jao-frm-font-lock-keywords)) + (set (make-local-variable 'truncate-lines) t) + (set (make-local-variable 'kill-whole-line) t) + (set (make-local-variable 'next-line-add-newlines) nil) + (setq major-mode 'jao-frm-mode) + (setq mode-name "frm") + (read-only-mode 1) + (goto-char 1)) + +;;;; Mode commands: +(defvar jao-frm-last-config nil) + +(defun jao-frm-delete-window () + "Delete frm window and restore last win config" + (interactive) + (if (and (consp jao-frm-last-config) + (window-configuration-p (car jao-frm-last-config))) + (progn + (set-window-configuration (car jao-frm-last-config)) + (goto-char (cadr jao-frm-last-config)) + (setq jao-frm-last-config nil)) + (bury-buffer))) + +(defun jao-frm-delete-message () + "Delete message at point" + (interactive) + (when (eq (current-buffer) (get-buffer "*frm*")) + (beginning-of-line) + (when (search-forward-regexp "^ +\\([0-9]+\\):" nil t) + (let ((mn (string-to-number (match-string 1)))) + (when (y-or-n-p (format "Delete message number %d? " mn)) + (read-only-mode -1) + (shell-command (format "echo 'd %d'|mail" mn) t) + (jao-frm) + (when (= (point-max) (point-min)) + (jao-frm-delete-window) + (message "Mailbox is empty"))))))) + +;;;; Activate frm: +(defun jao-frm-mbox-mails (mbox) + (let ((no (ignore-errors + (substring + (shell-command-to-string (format "frm -s n %s|wc -l" mbox)) + 0 -1)))) + (if (stringp no) (string-to-number no) 0))) + +(defun jao-frm-mail-number () + (let ((no 0)) + (dolist (b (jao-frm-mboxes) no) (setq no (+ no (jao-frm-mbox-mails b)))))) + +(defun jao-frm-default-count-formatter (m n) + (format "%s: %s" (file-name-sans-extension (file-name-nondirectory m)) n)) + +(defun jao-frm-mail-counts (fmt) + (let ((fmt (or fmt 'jao-frm-default-count-formatter))) + (remove nil + (mapcar (lambda (m) + (let ((n (jao-frm-mbox-mails m))) + (unless (zerop n) (funcall fmt m n)))) + (jao-frm-mboxes))))) + +(defun jao-frm-display-mailbox (mbox) + (when (not (zerop (jao-frm-mbox-mails mbox))) + (insert (or (file-name-nondirectory mbox) mbox) ":\n\n") + (apply 'call-process + `(,jao-frm-exec-path nil ,(current-buffer) nil + "-s" "n" "-n" "-t" ,@(and mbox (list mbox)))) + (newline 2))) + +(defun jao-frm-mboxes () + (cond ((null jao-frm-mailboxes) (list (getenv "MAIL"))) + ((listp jao-frm-mailboxes) jao-frm-mailboxes) + ((stringp jao-frm-mailboxes) + (if (file-directory-p jao-frm-mailboxes) + (directory-files jao-frm-mailboxes t "^[^.]") + (list jao-frm-mailboxes))) + (t (error "Error in mbox specification. Check `jao-frm-mailboxes'")))) + +;;;###autoload +(defun jao-frm () + "Run frm." + (interactive) + (let ((fbuff (get-buffer-create "*frm*")) + (inhibit-read-only t)) + (if (not (eq fbuff (current-buffer))) + (setq jao-frm-last-config + (list (current-window-configuration) (point-marker)))) + (with-current-buffer fbuff + (delete-region (point-min) (point-max)) + (mapc 'jao-frm-display-mailbox (jao-frm-mboxes)) + (unless (eq major-mode 'jao-frm-mode) + (jao-frm-mode)) + (goto-char (point-min)) + (if (= (point-min) (point-max)) + (message "Mailbox is empty.") + (pop-to-buffer fbuff)) + (when (and (boundp 'display-time-mode) display-time-mode) + (display-time-update))))) + +;;;###autoload +(defun jao-frm-show-mail-numbers (&optional fmt) + (interactive) + (let ((counts (jao-frm-mail-counts fmt))) + (message (if counts (mapconcat 'identity counts ", ") "No mail")))) + +;;;###autoload +(defun jao-frm-mail-string () + (let ((counts (jao-frm-mail-counts + (lambda (m n) + (let ((m (substring (file-name-nondirectory m) 0 1))) + (format "%s%s" (capitalize m) n)))))) + (mapconcat 'identity counts " "))) + +(provide 'jao-frm) + +;;; jao-frm.el ends here diff --git a/lib/net/jao-maildir.el b/lib/net/jao-maildir.el new file mode 100644 index 0000000..76a9f9e --- /dev/null +++ b/lib/net/jao-maildir.el @@ -0,0 +1,155 @@ +;; jao-maildir.el -- Utilities for reading maildirs -*- lexical-binding: t; -*- + +;; Copyright (c) 2019, 2020, 2021 jao + +;; Author: jao <mail@jao.io> +;; Start date: Sun Dec 01, 2019 15:48 +;; Keywords: mail + +;; This file 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, or (at your option) +;; any later version. + +;; This file 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; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Comentary: + +;; Inspecting the contents of maildirs and reporting it. + +;;; Code: + +(require 'seq) +(require 'jao-minibuffer) + +(defvar jao-maildir-debug-p nil) +(defvar jao-maildir-echo-p t) +(defvar jao-maildir-tracked-maildirs nil) +(defvar jao-maildir-info-string "") + +(defgroup jao-maildir-faces nil "Faces" + :group 'faces) +(defun jao-maildir--maildir-new (mbox) (expand-file-name "new" mbox)) + +(defun jao-maildir--maildir-new-count (mbox) + (- (length (directory-files (jao-maildir--maildir-new mbox))) 2)) + +(defface jao-maildir-emph '((t :inherit font-lock-keyword-face)) + "Face used to highlihgt non-boring tracked maildirs" + :group 'jao-maildir-faces) + +(defvar jao-maildir--maildirs nil) +(defvar jao-maildir--counts nil) +(defvar jao-maildir--label-mboxes nil) +(defvar jao-maildir--trackers nil) +(defvar jao-maildir--track-strings ()) + +(defun jao-maildir--update-counts () + (dolist (mbox jao-maildir--maildirs) + (puthash mbox (jao-maildir--maildir-new-count mbox) jao-maildir--counts))) + +(defun jao-maildir--init-counts (maildirs) + (setq jao-maildir--counts (make-hash-table :test 'equal)) + (setq jao-maildir--maildirs maildirs) + (jao-maildir--update-counts)) + +(defun jao-maildir--set-trackers (maildirs tracked-maildirs) + (jao-maildir--init-counts maildirs) + (let* ((label-mboxes (make-hash-table :test 'equal)) + (trackers (seq-map-indexed + (lambda (track idx) + (puthash (car track) () label-mboxes) + (let ((tr (seq-take track 2)) + (l (elt track 2))) + (append tr + (cond ((eq l t) '(jao-maildir-emph)) + ((null l) '(default)) + (t (list l))) + (list (or (elt track 3) idx))))) + tracked-maildirs))) + (dolist (mbox maildirs) + (let ((lb (seq-find (lambda (lb) (when lb (string-match-p lb mbox))) + (hash-table-keys label-mboxes)))) + (puthash lb (cons mbox (gethash lb label-mboxes)) label-mboxes))) + (setq jao-maildir--label-mboxes label-mboxes) + (setq jao-maildir--trackers trackers))) + +(defun jao-maildir--tracked-count (track) + (seq-reduce (lambda (c k) (+ c (gethash k jao-maildir--counts 0))) + (gethash (car track) jao-maildir--label-mboxes) + 0)) + +(defun jao-maildir--update-track-string (mbox) + (when-let ((track (seq-find (lambda (td) (string-match-p (car td) mbox)) + jao-maildir--trackers))) + (let* ((label (cadr track)) + (other (assoc-delete-all label jao-maildir--track-strings)) + (cnt (jao-maildir--tracked-count track))) + (if (> cnt 0) + (let* ((face (car (last (butlast track)))) + (order (car (last track))) + (str (propertize (format "%s%s" label cnt) 'face face)) + (str (cons label (cons order str)))) + (setq jao-maildir--track-strings (cons str other))) + (setq jao-maildir--track-strings other))))) + +;;;###autoload +(defun jao-maildir-update-info-string (&optional mbox) + (cond ((eq mbox t) + (seq-do 'jao-maildir--update-track-string jao-maildir--maildirs)) + ((stringp mbox) + (puthash mbox (jao-maildir--maildir-new-count mbox) jao-maildir--counts) + (jao-maildir--update-track-string mbox))) + (let* ((s (seq-sort-by #'cadr #'< jao-maildir--track-strings)) + (s (mapconcat 'identity (mapcar 'cddr s) " "))) + (setq jao-maildir-info-string (if (string-blank-p s) "" (concat s " ")))) + (when jao-maildir-echo-p (jao-minibuffer-refresh))) + +(defvar jao-maildir--watches nil) + +(defun jao-maildir-cancel-watchers () + (dolist (w jao-maildir--watches) (file-notify-rm-watch w)) + (setq jao-maildir--watches nil)) + +(defun jao-maildir--log-watch (mbox e) + (when jao-maildir-debug-p + (message "[%s] watch: %s: %s" (current-time-string) mbox e))) + +(defun jao-maildir--watcher (mbox cb) + (lambda (e) + (jao-maildir--log-watch e mbox) + (when (memq (cadr e) '(created deleted)) + (jao-maildir-update-info-string mbox) + (when cb (funcall cb mbox))))) + +(defun jao-maildir--setup-watches (cb) + (jao-maildir-cancel-watchers) + (setq jao-maildir--watches + (mapcar (lambda (mbox) + (file-notify-add-watch (jao-maildir--maildir-new mbox) + '(change attribute-change) + (jao-maildir--watcher mbox cb))) + jao-maildir--maildirs))) + +;;;###autoload +(defun jao-maildir-setup (maildirs trackers mode-line &optional cb) + (jao-maildir--set-trackers maildirs trackers) + (cond ((eq 'mode-line mode-line) + (add-to-list 'global-mode-string 'jao-maildir-info-string t)) + ((numberp mode-line) + (jao-minibuffer-add-variable 'jao-maildir-info-string mode-line) + (jao-maildir-update-info-string t)) + (t (error "Invalid mode-line value"))) + (jao-maildir--setup-watches cb)) + + +(provide 'jao-maildir) +;;; jao-maildir.el ends here diff --git a/lib/net/jao-proton-utils.el b/lib/net/jao-proton-utils.el new file mode 100644 index 0000000..012a2ff --- /dev/null +++ b/lib/net/jao-proton-utils.el @@ -0,0 +1,131 @@ +;; jao-proton-utils.el -- simple interaction with Proton mail and vpn + +;; Copyright (c) 2018, 2019, 2020 Jose Antonio Ortega Ruiz + +;; This file 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, or (at your option) +;; any later version. + +;; This file 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; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;; Author: Jose Antonio Ortega Ruiz <mail@jao.io> +;; Start date: Fri Dec 21, 2018 23:56 + +;;; Comentary: + +;; This is a very simple comint-derived mode to run the CLI version +;; of PM's Bridge within the comfort of emacs. + +;;; Code: + +(define-derived-mode proton-bridge-mode comint-mode "proton-bridge" + "A very simple comint-based mode to run ProtonMail's bridge" + (setq comint-prompt-read-only t) + (setq comint-prompt-regexp "^>>> ")) + +;;;###autoload +(defun run-proton-bridge () + "Run or switch to an existing bridge process, using its CLI" + (interactive) + (pop-to-buffer (make-comint "proton-bridge" "protonmail-bridge" nil "-c")) + (unless (eq major-mode 'proton-bridge-mode) + (proton-bridge-mode))) + +(defvar proton-vpn-mode-map) + +(defvar jao-proton-vpn-font-lock-keywords '("\\[.+\\]")) + +;;;###autoload +(defun proton-vpn-mode () + "A very simple mode to show the output of ProtonVPN commands" + (interactive) + (kill-all-local-variables) + (buffer-disable-undo) + (use-local-map proton-vpn-mode-map) + (setq-local font-lock-defaults '(jao-proton-vpn-font-lock-keywords)) + (setq-local truncate-lines t) + (setq-local next-line-add-newlines nil) + (setq major-mode 'proton-vpn-mode) + (setq mode-name "proton-vpn") + (read-only-mode 1)) + +(defvar jao-proton-vpn--buffer "*pvpn*") + +(defun jao-proton-vpn--do (things) + (let ((b (pop-to-buffer (get-buffer-create jao-proton-vpn--buffer)))) + (let ((inhibit-read-only t) + (cmd (format "protonvpn-cli %s" things))) + (delete-region (point-min) (point-max)) + (message "Running: %s ...." cmd) + (shell-command cmd b) + (message "")) + (proton-vpn-mode))) + +;;;###autoload +(defun proton-vpn-status () + (interactive) + (jao-proton-vpn--do "s")) + +(defun proton-vpn--get-status () + (or (when-let ((b (get-buffer jao-proton-vpn--buffer))) + (with-current-buffer b + (goto-char (point-min)) + (if (re-search-forward "^Status: *\\(.+\\)$" nil t) + (match-string-no-properties 1) + (when (re-search-forward "^Connected!$") + "Connected")))) + "Disconnected")) + +;;;###autoload +(defun proton-vpn-connect (cc) + (interactive "P") + (let ((cc (when cc (read-string "Country code: ")))) + (jao-proton-vpn--do (if cc (format "c --cc %s" cc) "c --sc")) + (proton-vpn-status))) + +(defun proton-vpn-reconnect () + (interactive) + (jao-proton-vpn--do "r")) + +(setenv "PVPN_WAIT" "300") + +;;;###autoload +(defun proton-vpn-maybe-reconnect () + (interactive) + (when (string= "Connected" (proton-vpn--get-status)) + (jao-proton-vpn--do "d") + (sit-for 5) + (jao-proton-vpn--do "r"))) + +;;;###autoload +(defun proton-vpn-disconnect () + (interactive) + (jao-proton-vpn--do "d")) + +(setq proton-vpn-mode-map + (let ((map (make-keymap))) + (suppress-keymap map) + (define-key map [?q] 'bury-buffer) + (define-key map [?n] 'next-line) + (define-key map [?p] 'previous-line) + (define-key map [?g] 'proton-vpn-status) + (define-key map [?r] 'proton-vpn-reconnect) + (define-key map [?d] (lambda () + (interactive) + (when (y-or-n-p "Disconnect?") + (proton-vpn-disconnect)))) + (define-key map [?c] 'proton-vpn-connect) + map)) + + +(provide 'jao-proton-utils) +;;; jao-proton.el ends here diff --git a/lib/net/randomsig.el b/lib/net/randomsig.el new file mode 100644 index 0000000..d07e676 --- /dev/null +++ b/lib/net/randomsig.el @@ -0,0 +1,724 @@ +;;; randomsig.el --- insert a randomly selected signature + +;; Copyright (C) 2001, 2002, 2013, 2020 Hans-Jürgen Ficker + +;; Emacs Lisp Archive Entry +;; Author: Hans-Juergen Ficker <hj@backmes.de> +;; Version: 0.7.0 +;; X-CVS-Version: $Id: randomsig.el,v 1.1.1.1 2003/09/17 22:49:45 jao Exp $ +;; Keywords: mail random signature + +;; This file is not currently part of GNU Emacs. + +;; This program 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 2, or (at +;; your option) any later version. + +;; This program 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 this program ; see the file COPYING. If not, write to +;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. + +;;; Commentary: + +;; This is yet another implementation to insert a randomly choosen +;; signature into a mail. + +;; It is only tested with gnus. + +;; To make it work, put the following lines into your ~/.gnus: + +;; (require 'randomsig) +;; (define-key message-mode-map (kbd "C-c s") 'randomsig-replace-sig) +;; (define-key message-mode-map (kbd "C-c S") 'randomsig-select-sig) +;; (require 'gnus-sum) ; probably required for `gnus-summary-save-map' +;; (define-key gnus-summary-save-map "-" 'gnus/randomsig-summary-read-sig) +;; (setq randomsig-dir "/some/directory") +;; (setq randomsig-files '("some" "files")) +;; ;; or (setq randomsig-files (randomsig-search-sigfiles)) +;; ;; or (setq randomsig-files 'randomsig-search-sigfiles) +;; (setq message-signature 'randomsig-signature) + +;; This will also define the shortcut `C-c s' in message-mode to +;; change the signature, `C-c S' in message-mode to interactively +;; select the signature to replace the current signature, and `O -' in +;; gnus-summary-mode to read the signature from the selected mail. + +;; `randomsig-files' must be a list of existing files, an existing +;; file, or a function returning a list of existing files. If these +;; don't have absolute paths, they are located in `randomsig-dir'. + +;; File format: Each file must contain at least one signature. +;; Signatures are separated with `randomsig-delimiter-pattern'. If +;; there is only one signature in the file, the delimiter can be +;; omitted, so real .signature-files can be used. + +;; `randomsig-delimiter' is used when inserting new signatures with +;; `randomsig-message-read-sig' into the signature file. So +;; `randomsig-delimiter' should match `randomsig-delimiter-pattern'. + +;; `randomsig-static-string' is put in front of every random signature +;; if non-`nil'. + +;; The *-read-sig functions read the signature of a message, or use +;; the marked text, and write it to a signature-file, for which the +;; name is asked. If the file does not exist, it will be generated. +;; When called with any prefix, the signatures will be offered to edit +;; before saving. + +;; if `randomsig-replace-sig' is called with any prefix, it will ask +;; for a file to get the signature from. + +;; `randomsig-select-sig' will offer a list of signatures to select +;; from in an extra buffer. n will jump to the next signature, p to +;; the previous, RET will insert the selected signature, q will exit +;; the selection buffer without replacing the current signature, R +;; will reload the signature-files, and e will open a buffer for +;; editing the signature at the point. When called with any prefix, it +;; will ask for a file to get the signatures from + +;; `randomsig-search-sigfiles' will search for regular files in +;; `randomsig-dir', which do not match `randomsig-search-unwanted'. A +;; subdirectory of `randomsig-dir' can be given as optional argument. + +;; Completion will only work for files in `randomsig-files', though +;; others files can be used, too. + +;;; Changelog: + +;; 2001/04/12 0.1 +;; * Initial release + +;; 2001/04/19 0.2 +;; * inserted `randomsig-delimiter' to add the capability to change +;; the delimiter between the signatures (thanks to Andreas Büsching +;; <crunchy@tzi.de>) + +;; 2001/04/25 0.3 +;; * new function `randomsig-search-sigfiles', to search all regular files +;; in directory `randomsig-dir' +;; * normal signatures only worked, when using only one signature. Fixed. + +;; 2001/04/25 0.3.1 +;; * Fixed a bug in `randomsig-search-sigfiles' + +;; 2001/04/26 0.3.2 +;; * replaced `point-at-eol' with `line-end-position' (Don't know where +;; `point-at-eol' is defined) +;; * require cl +;; * require message in some functions + +;; 2001/07/09 0.3.3 +;; * don't (setq message-signature 'randomsig-signature) by default, +;; the user can do this in his .gnus +;; * remove unnecessary optional arguments to `find-file-noselect' to +;; make it work with XEmacs +;; (Thanks to Micha Wiedenmann <Micha.Wiedenmann@gmx.net> for both +;; suggestions) +;; * documentation updates + +;; 2001/07/12 0.3.4 +;; * more fixes for XEmacs +;; * more documentation Updates + +;; 2001/07/20 0.4.0 +;; * new command `randomsig-select-sig' to interactively select a signature +;; * new mode `randomsig-select-mode' (for `randomsig-select-sig') +;; * `randomsig-files' can also be function returning a list of +;; Signature files +;; * `randomsig-replace-sig' does not remove old signature when interrupted + +;; 2001/07/22 0.4.1 +;; * (require 'message) only when needed + +;; 2001/08/13 0.5.0 +;; * doesn't require message anymore, so it should work without gnus + +;; 2001/08/20 0.5.1 +;; * add (random t) to initialize random seed (thanks to Evgeny +;; Roubinchtein <evgenyr@cs.washington.edu> for pointing this out +;; * insert a newline if it is missing at the end of a signature file + +;; 2001/09/17 0.5.2 +;; * new variable `randomsig-static-string' (thanks to Raymond Scholz +;; <rscholz@zonix.de>) + +;; 2001/10/01 0.5.3 +;; * Documentation updates + +;; 2002/01/20 0.5.99 +;; * It is now possible to edit signatures before saving, or to edit +;; single signatures from the selection buffer. +;; * Mark many variables as user option +;; * randomsig-files-to-list works recursive + +;; 2002/03/04 0.6.0 +;; * `randomsig-replace-signature-in-signature-files' should be safer now +;; * `randomsig-files-to-list' did endless recursion when called +;; with nil. Fixed. +;; * Some error-handling for non-existing `randomsig-dir'. + +;; 2002/09/21 0.7.0 +;; * most variables customizable +;; * `randomsig-static-string' works for `randomsig-select-sig', too +;; (thanks to Mark Trettin <mtr-dev0@gmx.de> for pointing this out) +;; * documentation updates + +(eval-when-compile + (require 'cl-lib)) + + +(defconst randomsig-version "0.7.0") + + +(defvar randomsig-dir "~/.signatures" + "*Directory for signature-files. See also `randomsig-files'") + + +(defgroup randomsig nil + "insert a randomly choosen signature into a mail." + :group 'mail + :group 'news) + +(defcustom randomsig-files '("default") + "*Files with random signatures. +This variable may be a list of strings, a string, or a function returning a +list of strings. +The files are searched in `randomsig-dir', if they don't have absolute paths. +The signatures have to be separated by lines matching +`randomsig-delimiter-pattern' at the beginning." + :type '(choice + (repeat + :tag "List of filenames" + (string :tag "filename")) + (function + :tag "function returning the signature files" + :value randomsig-search-sigfiles)) + :group 'randomsig) + +(defcustom randomsig-delimiter "-- " + "*delimiter used when adding new signatures in signature file. +You have to change `randomsig-delimiter-pattern', too, if you change this." + :type '(string) + :group 'randomsig) + + +(defcustom randomsig-delimiter-pattern + (concat "^" (regexp-quote randomsig-delimiter) "$") + "*Regular expression that matches the delimiters between signatures. +`randomsig-delimiter' must match `randomsig-delimiter-pattern'." + :type '(regexp) + :group 'randomsig) + + +(defcustom randomsig-search-unwanted "\\(/\\|^\\)\\(CVS\\|RCS\\|.*~\\)$" + "*Regular expression matching unwanted files when scanning with +`randomsig-search-sigfiles'" + :type '(regexp) + :group 'randomsig) + + +(defcustom randomsig-static-string nil + "*Static string to be inserted above every random signature. +You probably want to have a newline at the end of it." + :type '(choice + (const :tag "none" nil) + (string)) + :group 'randomsig) + + +(defvar randomsig-buffer-name "*Signatures*" + "Name for the (temporary) buffer for the signatures") + +(defvar randomsig-edit-buffer-name "*Edit Signature*" + "Name for the (temporary) buffer for editing the signatures") + +(defvar randomsig-select-original-buffer nil) +(defvar randomsig-select-original-position nil) + +(defvar randomsig-history nil) + +(defvar randomsig-buffer-file-pos-list nil) + +(defvar randomsig-select-edit-bufferpos nil) + +(defvar randomsig-loaded-files nil) + +;; definitions for XEmacs: +(unless (fboundp 'line-end-position) + (defalias 'line-end-position 'point-at-eol)) + +(defun randomsig-mark-active-p () + mark-active) ;; jao: region-active-p is defined in GNU Emacs 23 with + ;; a different meaning +;;; (if (boundp 'region-active-p) + +;;; (region-active-p) ; XEmacs + +;;; mark-active)) ; Gnu Emacs + + +(require 'cl-lib) + +(random t) ; Initialize random seed + +;;; Helper Functions + +(defun randomsig-files-to-list (files) + ;; return a list of strings + (cond ((listp files) files) + ((and (symbolp files) + (fboundp files)) (randomsig-files-to-list (funcall files))) + ((and (symbolp files) + (boundp files)) (randomsig-files-to-list (symbol-value files))) + ((stringp files) (list files)) + (t nil))) + + +(defun randomsig-prompt (&optional prompt) + ;; Prompt for a signature file. + (let ((files (randomsig-files-to-list randomsig-files))) + (completing-read (if prompt prompt "signature: ") + (mapcar 'list files) + nil + nil + (unless (cdr files) (car files)) + randomsig-history))) + + +(defun randomsig-read-signatures-to-buffer (buffer-name &optional files) + ;; read the signatures into the signature buffer + ;; save possibly local variables `randomsig-files' and `randomsig-dir' + (let ((sigfiles randomsig-files) (sigdir randomsig-dir)) + (if (get-buffer buffer-name) + (progn + (set-buffer buffer-name) + (setq buffer-read-only nil) + (delete-region (point-min) (point-max))) + (progn + (get-buffer-create buffer-name) + (set-buffer buffer-name))) + (set (make-local-variable 'randomsig-files) sigfiles) + (set (make-local-variable 'randomsig-dir) sigdir)) + + (setq randomsig-buffer-file-pos-list nil) + + (unless files + (setq files randomsig-files)) + + (setq randomsig-loaded-files files) + + ;; get a list with file names of signature files + (let ((sigfiles (randomsig-files-to-list files))) + ;; Insert all files into the newly created buffer + (mapcar + (lambda (fname) + + (let ((pos (point-max))) + ;;(add-to-list 'randomsig-buffer-file-pos-list (cons fname pos) t) + ; this does not work with XEmacs + (goto-char pos) + (insert-file-contents (expand-file-name fname randomsig-dir)) + ;; No delimiter at the beginning? Insert one. + (unless (string-match randomsig-delimiter-pattern + (buffer-substring (goto-char pos) + (line-end-position))) + (goto-char pos) + (insert randomsig-delimiter) + (insert "\n") + ;; Correct position... + (setq pos (+ pos (length randomsig-delimiter) 1))) + + (setq randomsig-buffer-file-pos-list + (append randomsig-buffer-file-pos-list + (list (cons fname pos)))) + (goto-char (point-max)) + (unless (and (char-before) + (char-equal (char-before) ?\n)) ; Newline? + (insert "\n")))) + sigfiles) + (set-buffer-modified-p nil) + (setq buffer-read-only t) + (current-buffer))) + + + +(defun randomsig-insert-signature (sig) + ;; Insert SIG as signature in current buffer + (save-excursion + (goto-char (point-max)) + (insert "\n-- \n" sig))) + + + +(defun randomsig-goto-signature () +;; This function is stolen fom message-goto signature. +;; Go to beginnig of the signature, and return t. +;; If there is no signature in current buffer, go to end of buffer, +;; and return nil. + (goto-char (point-min)) + (if (re-search-forward "^-- $" nil t) + (progn + (forward-line 1) + t) + (progn + (goto-char (point-max)) + nil))) + + + +(defun randomsig-replace-signature (sig) + ;; Replace the current signature with SIG + (save-excursion + (when (randomsig-goto-signature) + (forward-line -1) + (backward-char) + (delete-region (point) (point-max))) + + (randomsig-insert-signature sig))) + + +(defun randomsig-signature (&optional files) + "Return a randomly choosen signature. +If FILES is non-nil, a signature out of FILES will be choosen. +Else a signature out of `randomsig-files' will be choosen." + (save-excursion + + (randomsig-read-signatures-to-buffer randomsig-buffer-name files) + + (goto-char (point-min)) + (let '(count 0) 'selected + + ;; Count number of signatures + (while (search-forward-regexp randomsig-delimiter-pattern nil t) + (setq count (1+ count))) + + ;; Select random signature out out these + (setq selected (1+ (random count))) + (goto-char (point-min)) + (if (search-forward-regexp randomsig-delimiter-pattern nil t selected) + (forward-char)) + + ;; Cut signature and return it + (let '(here (point)) 'signature-string + + (if (not (search-forward-regexp randomsig-delimiter-pattern + nil t)) + (goto-char (point-max)) + (beginning-of-line)) + (setq signature-string + (concat randomsig-static-string + (buffer-substring here (point)))) + (kill-buffer randomsig-buffer-name) + signature-string)))) + + +(defun randomsig-replace-sig (arg) + "Replace the actual signature with a new one. +When called with prefix, read the filename of the signature-file +that should be used" + (interactive "P") + (save-excursion + + (randomsig-replace-signature + (randomsig-signature + (if arg + (randomsig-prompt "read from signature-lib: ") + randomsig-files))))) + + + +(defun randomsig-message-read-sig (arg) + "Get the signature of current message and copy it to a file. +If mark is active, get the marked region instead. +When called with prefix, let the user edit the signature before saving" + (interactive "P") + (save-excursion + (let '(signature-string + (if (randomsig-mark-active-p) + + (buffer-substring (point) (mark)) + + (progn + (if (randomsig-goto-signature) + (let `(here (point)) + (goto-char (point-max)) + (while (char-equal (char-before) 10) + (backward-char)) + (buffer-substring here (point))) + nil)))) + (when signature-string + (if arg + (progn + ;; make sure this is nil... + (setq randomsig-select-edit-bufferpos nil) + (randomsig-edit signature-string)) + (randomsig-write-signature signature-string)))))) + + +(defun randomsig-write-signature (signature-string) + (set-buffer (find-file-noselect + (expand-file-name + (randomsig-prompt "Write to signature-lib: ") + randomsig-dir))) + + (goto-char (point-max)) + (insert (concat randomsig-delimiter "\n")) + (insert signature-string) + (insert "\n") + (save-buffer)) + + +(defun gnus/randomsig-summary-read-sig (arg) + "Get the signature of current message and copy it to a file" + (interactive "P") + (progn ;save-excursion + ;; FIXME: Doesn't return to summary buffer (save-excursion should do this) + (gnus-summary-select-article-buffer) + (randomsig-message-read-sig arg))) + + +(defun randomsig-search-sigfiles (&optional file) + "Scan `randomsig-dir' and its subdirectories for regular files. +If FILE is given, only FILE and its subdirectory will be searched." + (unless (file-exists-p randomsig-dir) + (error "\"%s\" does not exist" randomsig-dir)) + (unless (file-directory-p randomsig-dir) + (error "\"%s\" is not a directory" randomsig-dir)) + (unless file + (setq file "")) + + (if (or (string-match "\\(/\\|^\\)\\(\\.\\|\\.\\.\\)$" file) + (string-match randomsig-search-unwanted file)) + ;; unwanted... + nil + + (let '(path (expand-file-name file randomsig-dir)) + (if (file-directory-p path) + (mapcan (lambda (f) + (randomsig-search-sigfiles (if (string= file "") + f + (concat file "/" f)))) + (directory-files path)) + (if (file-regular-p path) + (list file) + nil))))) + + +;;; Commands/Function for randomsig-edit-mode + +(defun randomsig-edit (signature) + (if (get-buffer randomsig-edit-buffer-name) + (kill-buffer randomsig-edit-buffer-name)) + (switch-to-buffer (get-buffer-create randomsig-edit-buffer-name)) + (insert signature) + (goto-char (point-min)) + (set-buffer-modified-p t) + (setq buffer-read-only nil) + (randomsig-edit-mode)) + + + +(defun randomsig-replace-signature-in-signature-files (signature) + (if (not randomsig-select-edit-bufferpos) + (error "Not in select buffer previously")) + (set-buffer randomsig-buffer-name) + (let* ((fname (randomsig-buffer-which-file)) + (sig_end + ;; point in selection buffer, where signature ends + (progn + (if (search-forward-regexp randomsig-delimiter-pattern nil t) + (search-backward-regexp randomsig-delimiter-pattern nil nil)) + (point))) + (sig_start + ;; point in selection buffer, where signature starts + (progn + (if (search-backward-regexp randomsig-delimiter-pattern nil t) + (progn + (search-forward-regexp randomsig-delimiter-pattern nil nil) + (forward-char))) + (point))) + (f_start + ;; point in selection buffer, where signature file starts + (- (cdr (assoc fname randomsig-buffer-file-pos-list)) + (point-min))) + ;; point in file, where Signature starts/ends + (f_sig_start (- sig_start f_start)) + (f_sig_end (- sig_end f_start)) + ;; old signature + (old_sig (randomsig-signature-at-point))) + (set-buffer (find-file-noselect (expand-file-name fname randomsig-dir))) + + (if (not (string= old_sig (buffer-substring f_sig_start f_sig_end))) + (error "Signature file has changed")) + (delete-region f_sig_start f_sig_end) + (goto-char f_sig_start) + (insert signature) + (save-buffer)) + (randomsig-select-reload)) + + +(defun randomsig-edit-done () + (interactive) + (let ((signature-string (buffer-string)) + (edit-buffer (current-buffer))) + (if randomsig-select-edit-bufferpos + (randomsig-replace-signature-in-signature-files signature-string) + (randomsig-write-signature signature-string)) + (kill-buffer edit-buffer))) + + +(define-derived-mode randomsig-edit-mode text-mode + "Randomsig Edit" + "A major mode for editing signatures. +You most likely do not want to call `randomsig-edit-mode' directly. + +\\{randomsig-edit-mode-map}" + (define-key randomsig-edit-mode-map + (kbd "C-c C-c") 'randomsig-edit-done)) + + +;;; Commands for randomsig-select-mode + +(defun randomsig-select-next () + "Goto next signature." + (interactive) + (if (search-forward-regexp randomsig-delimiter-pattern nil t) + (forward-char))) + + +(defun randomsig-select-prev () + "Goto next signature." + (interactive) + (if (search-backward-regexp randomsig-delimiter-pattern nil t 2) + (forward-line))) + + +(defun randomsig-signature-at-point() + ;; Return the signature at current cursor position + (save-excursion + (if (search-backward-regexp randomsig-delimiter-pattern nil t) + (forward-line)) + (let ((beginning (point))) + (if (search-backward-regexp randomsig-delimiter-pattern nil t) + (forward-line)) + (if (not (search-forward-regexp randomsig-delimiter-pattern + nil t)) + (goto-char (point-max)) + (beginning-of-line)) + (buffer-substring beginning (point))))) + + +(defun randomsig-select-replace () + "Replace the signature in `randomsig-select-original-buffer' +with the signature at the current position, and quit selection." + (interactive) + (let ((sig (randomsig-signature-at-point))) + (kill-buffer randomsig-buffer-name) + (switch-to-buffer randomsig-select-original-buffer) + (randomsig-replace-signature (concat randomsig-static-string sig)) + (goto-char randomsig-select-original-position))) + + +(defun randomsig-select-quit () + "Quit the signature-buffer without selection of a signature." + (interactive) + (kill-buffer randomsig-buffer-name)) + + +(defun randomsig-select-abort () + "Abort the selection from signature-buffer." + (interactive) + (ding) + (kill-buffer randomsig-buffer-name)) + + +(defun randomsig-select-reload () + "Reload the current randomsig-buffer" + (interactive) + (set-buffer randomsig-buffer-name) + (let ((pos (point))) + (randomsig-read-signatures-to-buffer randomsig-buffer-name + randomsig-loaded-files) + (goto-char pos))) + + +(defun randomsig-select-edit () + "Edit the signature at point" + (interactive) + (setq randomsig-select-edit-bufferpos (point)) + (randomsig-edit (randomsig-signature-at-point))) + + +(defun randomsig-buffer-which-file () + (let ((p 0) + (fname "") + (l randomsig-buffer-file-pos-list)) + (while (progn + (setq fname (car (car l))) + (setq l (cdr l)) + (setq p (cdr (car l))) + (and l (<= p (point))))) + fname)) + + +(define-derived-mode randomsig-select-mode fundamental-mode + "Randomsig Select" + "A major mode for selecting signatures. +You most likely do not want to call `randomsig-select-mode' directly; use +`randomsig-select-sig' instead. + +\\{randomsig-select-mode-map}" + + (define-key randomsig-select-mode-map (kbd "n") 'randomsig-select-next) + (define-key randomsig-select-mode-map (kbd "p") 'randomsig-select-prev) + (define-key randomsig-select-mode-map (kbd "?") 'describe-mode) + (define-key randomsig-select-mode-map (kbd "h") 'describe-mode) + (define-key randomsig-select-mode-map (kbd "RET") 'randomsig-select-replace) + (define-key randomsig-select-mode-map (kbd "R") 'randomsig-select-reload) + (define-key randomsig-select-mode-map (kbd "e") 'randomsig-select-edit) + (define-key randomsig-select-mode-map (kbd "q") 'randomsig-select-quit) + (define-key randomsig-select-mode-map (kbd "C-g") 'randomsig-select-abort) + + ;; Experimental: show the file + ;; FIXME: this does only work for Gnu Emacs 21 + (and (not (boundp 'xemacs-codename)) + (>= emacs-major-version 21) + (setq mode-line-buffer-identification + '(:eval (format "%-12s" + (concat "[" + (randomsig-buffer-which-file) + "]")))))) + +(defun randomsig-select-sig (arg) + "Select a new signature from a list. +If called with prefix argument, read the filename of the signature-file +that should be used." + (interactive "P") + + (setq randomsig-select-original-buffer (current-buffer)) + (setq randomsig-select-original-position (point)) + + + (switch-to-buffer + (randomsig-read-signatures-to-buffer + randomsig-buffer-name + (if arg + (randomsig-prompt "read from signature-lib: ") + randomsig-files))) + (goto-char 0) + (forward-line) + (randomsig-select-mode)) + + + +(provide 'randomsig) + + +;;; randomsig.el ends here diff --git a/lib/net/signel.org b/lib/net/signel.org new file mode 100644 index 0000000..25b7d25 --- /dev/null +++ b/lib/net/signel.org @@ -0,0 +1,546 @@ +#+title: signel, a barebones signal chat on top of signal-cli +#+date: <2020-02-23 05:03> +#+filetags: emacs +#+PROPERTY: header-args :tangle yes :comments yes :results silent + +Unlike most chat systems in common use, [[https://signal.org][Signal]] lacks a decent emacs +client. All i could find was [[https://github.com/mrkrd/signal-msg][signal-msg]], which is able only to send +messages and has a readme that explicitly warns that its is /not/ a chat +application. Skimming over signal-msg's code i learnt about +[[https://github.com/AsamK/signal-cli][signal-cli]], a java-based daemon that knows how to send and receive +signal messages, and how to link to a nearby phone, or register new +users. And playing with it i saw that it can output its activities +formatted as JSON, and that offers (when run in daemon mode) a DBUS +service that can be used to send messages. + +Now, emacs knows how to run a process and capture its output handling +it to a filter function, and comes equipped with a JSON parser and +a set of built-in functions to talk to DBUS buses. + +So how about writing a simple Signal chat app for emacs? Let's call it +/signel/, and write it as [[https://gitlab.com/jaor/elibs/-/blob/master/net/signel.org][a blog post in literate org-mode]]. + +* Starting a process + +We are going to need a variable for our identity (telephone number), +and a list of contact names (until i discover how to get them directly +from signal-cli): + +#+begin_src emacs-lisp +(require 'cl-lib) + +(defvar signel-cli-user "+44744xxxxxx") +(defvar signel-contact-names '(("+447xxxxxxxx" . "john") + ("+346xxxxxxxx" . "anna"))) +#+end_src + +and a simple function to get a contact name given its telephone +number: + +#+begin_src emacs-lisp +(defun signel--contact-name (src) + (or (alist-get src signel-contact-names nil nil #'string-equal) src)) +#+end_src + +We are also going to need the path for our signal-cli executable + +#+begin_src emacs-lisp +(defvar signel-cli-exec "signal-cli") +#+end_src + +Starting the signal-cli process is easy: ~make-process~ provides all the +necessary bits. What we need is essentially calling + +#+begin_src shell +signal-cli -u +44744xxxxxx daemon --json +#+end_src + +associating to the process a buffer selected by the function +~signel--proc-buffer~ . While we are at it, we'll write also little +helpers for users of our API. + +#+begin_src emacs-lisp +(defun signel--proc-buffer () + (get-buffer-create "*signal-cli*")) + +(defun signel-signal-cli-buffer () + (get-buffer "*signal-cli*")) + +(defun signel-signal-cli-process () + (when-let ((proc (get-buffer-process (signel-signal-cli-buffer)))) + (and (process-live-p proc) proc))) +#+end_src + +#+begin_src emacs-lisp +(defun signel-start () + "Start the underlying signal-cli process if needed." + (interactive) + (if (signel-signal-cli-process) + (message "signal-cli is already running!") + (let ((b (signel--proc-buffer))) + (make-process :name "signal-cli" + :buffer b + :command `(,signel-cli-exec + "-u" + ,signel-cli-user + "daemon" "--json") + :filter #'signel--filter) + (message "Listening to signals!")))) +#+end_src + +* Parsing JSON + +We've told emacs to handle any ouput of the process to the function +~signel--filter~, which we're going to write next. This function will +receive the process object and its latest output as a string +representing a JSON object. Here's an example of the kind of outputs +that signal-cli emits: + +#+begin_src json :tangle no +{ + "envelope": { + "source": "+4473xxxxxxxx", + "sourceDevice": 1, + "relay": null, + "timestamp": 1582396178696, + "isReceipt": false, + "dataMessage": { + "timestamp": 1582396178696, + "message": "Hello there!", + "expiresInSeconds": 0, + "attachments": [], + "groupInfo": null + }, + "syncMessage": null, + "callMessage": null, + "receiptMessage": null + } +} +#+end_src + +Everything seems to be always inside ~envelope~, which contains objects +for the possible messages received. In the example above, we're +receiving a message from a /source/ contact. We can also receive +receipt messages, telling us whether our last message has been +received or read; e.g.: + +#+begin_src json :tangle no +{ + "envelope": { + "source": "+4473xxxxxxxx", + "sourceDevice": 1, + "relay": null, + "timestamp": 1582397117584, + "isReceipt": false, + "dataMessage": null, + "syncMessage": null, + "callMessage": null, + "receiptMessage": { + "when": 1582397117584, + "isDelivery": true, + "isRead": false, + "timestamps": [ + 1582397111524 + ] + } + } +} +#+end_src + +A bit confusingly, that delivery notification has a ~receiptMessage~, +but its ~isReceipt~ flag is set to ~false~. At other times, we get +~isReceipt~ but no ~receiptMessage~: + +#+begin_src json :tangle no +{ + "envelope": { + "source": "+346xxxxxxxx", + "sourceDevice": 1, + "relay": null, + "timestamp": 1582476539281, + "isReceipt": true, + "dataMessage": null, + "syncMessage": null, + "callMessage": null, + "receiptMessage": null + } +} +#+end_src + +It is very easy to parse JSON in emacs and extract signal-cli's +envelopes (and it's become faster in emacs 27, but the interface is a +bit different): + +#+begin_src emacs-lisp +(defun signel--parse-json (str) + (if (> emacs-major-version 26) + (json-parse-string str + :null-object nil + :false-object nil + :object-type 'alist + :array-type 'list) + (json-read-from-string str))) + +(defun signel--msg-contents (str) + (alist-get 'envelope (ignore-errors (signel--parse-json str)))) +#+end_src + +Here i am being old-school and opting to receive JSON dicitionaries as +alists (rather than hash maps, the default), and arrays as lists +rather than vectors just because lisps are lisps for a reason. I'm +also going to do some mild [[https://lispcast.com/nil-punning/][nil punning]], +hence the choice for null and false representations. + +Once the contents of the envelope is extracted, it's trivial (and +boring) to get into its components: + +#+begin_src emacs-lisp +(defun signel--msg-source (msg) (alist-get 'source msg)) + +(defun signel--msg-data (msg) + (alist-get 'message (alist-get 'dataMessage msg))) + +(defun signel--msg-timestamp (msg) + (if-let (msecs (alist-get 'timestamp msg)) + (format-time-string "%H:%M" (/ msecs 1000)) + "")) + +;; emacs 26 compat +(defun signel--not-false (x) + (and (not (eq :json-false x)) x)) + +(defun signel--msg-receipt (msg) + (alist-get 'receiptMessage msg)) + +(defun signel--msg-is-receipt (msg) + (signel--not-false (alist-get 'isReceipt msg))) + +(defun signel--msg-receipt-timestamp (msg) + (when-let (msecs (alist-get 'when (signel--msg-receipt msg))) + (format-time-string "%H:%M" (/ msecs 1000)))) + +(defun signel--msg-is-delivery (msg) + (when-let ((receipt (signel--msg-receipt msg))) + (signel--not-false (alist-get 'isDelivery msg)))) + +(defun signel--msg-is-read (msg) + (when-let ((receipt (signel--msg-receipt msg))) + (signel--not-false (alist-get 'isRead msg)))) +#+end_src + +* A process output filter + +We're almost ready to write our filter. It will: + +- For debugging purposes, insert the raw JSON string in the process + buffer. +- Parse the received JSON string and extract its envelope contents. +- Check wether it has a source and either message data or a receipt + timestamp. +- Dispatch to a helper function that will insert the data or + notification in a chat buffer. + +Or, in elisp: + +#+begin_src emacs-lisp +(defvar signel--line-buffer "") + +(defun signel--filter (proc str) + (signel--ordinary-insertion-filter proc str) + (let ((str (concat signel--line-buffer str))) + (if-let ((msg (signel--msg-contents str))) + (let ((source (signel--msg-source msg)) + (stamp (signel--msg-timestamp msg)) + (data (signel--msg-data msg)) + (rec-stamp (signel--msg-receipt-timestamp msg))) + (setq signel--line-buffer "") + (when source + (signel--update-chat-buffer source data stamp rec-stamp msg))) + (setq signel--line-buffer + (if (string-match-p ".*\n$" str) "" str))))) +#+end_src + +We've had to take care of the case when the filter receives input that +is not a complete JSON expression: in the case of signal-cli, that +only happens when we haven't seen yet an end of line. + +The function to insert the raw contents in the process buffer is +surprisingly hard to get right, but the emacs manual spells out a +reasonable implementation, which i just copied: + +#+begin_src emacs-lisp +(defun signel--ordinary-insertion-filter (proc string) + (when (and proc (buffer-live-p (process-buffer proc))) + (with-current-buffer (process-buffer proc) + (let ((moving (= (point) (process-mark proc)))) + (save-excursion + ;; Insert the text, advancing the process marker. + (goto-char (process-mark proc)) + (insert string) + (set-marker (process-mark proc) (point))) + (if moving (goto-char (process-mark proc))))))) +#+end_src + +* It's not an emacs app if it doesn't have a new mode + +With that out of the way, we just have to insert our data in an +appropriate buffer. We are going to associate a separate buffer to +each /source/, using for that its name: + +#+begin_src emacs-lisp +(defvar-local signel-user nil) + +(defun signel--contact-buffer (source) + (let* ((name (format "*%s" (signel--contact-name source))) + (buffer (get-buffer name))) + (unless buffer + (setq buffer (get-buffer-create name)) + (with-current-buffer buffer + (signel-chat-mode) + (setq-local signel-user source) + (insert signel-prompt))) + buffer)) +#+end_src + +where, as is often the case in emacs, we are going to have a dedicated +major mode for chat buffers, called ~signel-chat-mode~. For now, let's +keep it really simple (for the record, this is essentially a copy of +what ERC does for its erc-mode): + +#+begin_src emacs-lisp +(defvar signel-prompt ": ") + +(define-derived-mode signel-chat-mode fundamental-mode "Signal" + "Major mode for Signal chats." + (when (boundp 'next-line-add-newlines) + (set (make-local-variable 'next-line-add-newlines) nil)) + (setq line-move-ignore-invisible t) + (set (make-local-variable 'paragraph-separate) + (concat "\C-l\\|\\(^" (regexp-quote signel-prompt) "\\)")) + (set (make-local-variable 'paragraph-start) + (concat "\\(" (regexp-quote signel-prompt) "\\)")) + (setq-local completion-ignore-case t)) +#+end_src + +Note how, in ~signel--contact-buffer~, we're storing the user identity +associated with the buffer (its /source/) in a buffer-local variable +named ~signel-user~ that is set /after/ enabling ~signel-chat-mode~: order +here matters because the major mode activation cleans up the values of +any local variables previously set (i always forget that!). + +* And a customization group + +We're going to need a couple of new faces for the different parts of +inserted messages, so we'll take the chance to be tidy and introduce a +customization group: + +#+begin_src emacs-lisp +(defgroup signel nil "Signel") + +(defface signel-contact '((t :weight bold)) + "Face for contact names." + :group 'signel) + +(defface signel-timestamp '((t :foreground "grey70")) + "Face for timestamp names." + :group 'signel) + +(defface signel-notice '((t :inherit signel-timestamp)) + "Face for delivery notices." + :group 'signel) + +(defface signel-prompt '((t :weight bold)) + "Face for the input prompt marker." + :group 'signel) + +(defface signel-user '((t :foreground "orangered")) + "Face for sent messages." + :group 'signel) + +(defface signel-notification '((t :foreground "burlywood")) + "Face for notifications shown by tracking, when available." + :group 'signel) + +#+end_src + + +* Displaying incoming messages + +We have now almost all the ingredients to write +~signel--update-chat-buffer~, the function that inserts the received +message data into the chat buffer. Let's define a few little +functions to format those parts: + +#+begin_src emacs-lisp +(defun signel--contact (name) + (propertize name 'face 'signel-contact)) + +(defun signel--timestamp (&rest p) + (propertize (apply #'concat p) 'face 'signel-timestamp)) + +(defun signel--notice (notice) + (propertize notice 'face 'signel-notice)) + +(defun signel--insert-prompt () + (let ((inhibit-read-only t) + (p (point))) + (insert signel-prompt) + (set-text-properties p (- (point) 1) + '(face signel-prompt + read-only t front-sticky t rear-sticky t)))) + +(defun signel--delete-prompt () + (when (looking-at-p (regexp-quote signel-prompt)) + (let ((inhibit-read-only t)) + (delete-char (length signel-prompt))))) + +(defun signel--delete-last-prompt () + (goto-char (point-max)) + (when (re-search-backward (concat "^" (regexp-quote signel-prompt))) + (signel--delete-prompt))) + +#+end_src + +With that, we're finally ready to insert messages in our signel chat +buffers: + +#+begin_src emacs-lisp +(defcustom signel-report-deliveries nil + "Whether to show message delivery notices." + :group 'signel + :type 'boolean) + +(defcustom signel-report-read t + "Whether to show message read notices." + :group 'signel + :type 'boolean) + +(defun signel--prompt-and-notify () + (signel--insert-prompt) + (when (fboundp 'tracking-add-buffer) + (tracking-add-buffer (current-buffer) '(signel-notification)))) + +(defun signel--needs-insert-p (data stamp rec-stamp msg) + (or data + (and (or rec-stamp stamp) + (not (string= source signel-cli-user)) + (or signel-report-deliveries + (and signel-report-read (signel--msg-is-read msg)))))) + +(defun signel--update-chat-buffer (source data stamp rec-stamp msg) + (when (signel--needs-insert-p data stamp rec-stamp msg) + (when-let ((b (signel--contact-buffer source))) + (with-current-buffer b + (signel--delete-last-prompt) + (if data + (let ((p (point))) + (insert (signel--timestamp "[" stamp "] ") + (signel--contact (signel--contact-name source)) + signel-prompt + data + "\n") + (fill-region p (point))) + (let ((is-read (signel--msg-is-read msg))) + (insert (signel--timestamp "*" (or rec-stamp stamp) "* ") + (signel--notice (if is-read "(read)" "(delivered)")) + "\n"))) + (signel--prompt-and-notify) + (end-of-line))))) +#+end_src + +There are some rough edges in the above implementation that must be +polished should signel ever be released in the wild. For one, proper +handling of timestamps and their formats. And of course notifications +should be much more customizable (here i'm using [[https://github.com/jorgenschaefer/circe/blob/master/tracking.el][Circe's tracking.el]] +if available). + +* Sending messages: the DBUS interface + +With that, we're going to receive and display messages and simple +receipts, and i'm sure that we will feel the urge to answer some of +them. As mentioned above, signal-cli let's us send messages via its +[[https://github.com/AsamK/signal-cli/wiki/DBus-service][DBUS interface]]. +In a nutshell, if you want to send ~MESSAGETEXT~ to a +~RECIPIENT~ you'd invoke something like: + +#+begin_src shell :tangle no +dbus-send --session --type=method_call \ + --dest="org.asamk.Signal" \ + /org/asamk/Signal \ + org.asamk.Signal.sendMessage \ + string:MESSAGETEXT array:string: string:RECIPIENT +#+end_src + +That is, call the method ~sendMessage~ of the corresponding service +interface with three arguments (the second one empty). Using emacs' +dbus libray one can write the above as: + +#+begin_src emacs-lisp +(defun signel--send-message (user msg) + (dbus-call-method :session "org.asamk.Signal" "/org/asamk/Signal" + "org.asamk.Signal" "sendMessage" + :string msg + '(:array) + :string user)) +#+end_src + +The only complicated bit is being careful with the specification of +the types of the method arguments: if one gets them wrong, DBUS will +simply complain and say that the method is not defined, which was +confusing me at first (but of course makes sense because DBUS allows +overloading method names, so the full method spec must include its +signature). + +We want to read whatever our user writes after the last prompt and +send it via the little helper above. Here's our interactive command +for that: + +#+begin_src emacs-lisp +(defun signel-send () + "Read text inserted in the current buffer after the last prompt and send it. + +The recipient of the message is looked up in a local variable set +when the buffer was created." + (interactive) + (goto-char (point-max)) + (beginning-of-line) + (let* ((p (point)) + (plen (length signel-prompt)) + (msg (buffer-substring (+ p plen) (point-max)))) + (signel--delete-prompt) + (signel--send-message signel-user msg) + (insert (signel--timestamp (format-time-string "(%H:%M) "))) + (fill-region p (point-max)) + (goto-char (point-max)) + (set-text-properties p (point) '(face signel-user)) + (insert "\n") + (signel--insert-prompt))) +#+end_src + +and we can bind it to the return key in signal chat buffers: + +#+begin_src emacs-lisp +(define-key signel-chat-mode-map "\C-m" #'signel-send) +#+end_src + +And we are going sometimes to want to talk to contacts that don't have +yet said anything and have, therefore, no associated chat buffer: + +#+begin_src emacs-lisp +(defun signel-query (contact) + "Start a conversation with a signal contact." + (interactive (list (completing-read "Signal to: " + (mapcar #'cdr-safe signel-contact-names)))) + (let ((phone (alist-get contact + (cl-pairlis (mapcar #'cdr signel-contact-names) + (mapcar #'car signel-contact-names)) + nil nil #'string-equal))) + (when (not phone) + (error "Unknown contact %s" contact)) + (pop-to-buffer (signel--contact-buffer phone)))) +#+end_src + +There are of course lots of rough edges and missing functionality in +this incipient signel, but it's already usable and a nice +demonstration of how easy it is to get the ball rolling in this lisp +machine of ours! |