summaryrefslogtreecommitdiffhomepage
path: root/lib/net
diff options
context:
space:
mode:
authorjao <jao@gnu.org>2021-02-02 05:16:17 +0000
committerjao <jao@gnu.org>2021-02-02 05:16:17 +0000
commit771abb84830678455de4625ac7f082d8100f0ea0 (patch)
tree0d303c2cb0861b949ca73a9705954f6a69c4f877 /lib/net
parent81eceb5507aa0659e9f0c9761e54e9102085c4ac (diff)
downloadelibs-771abb84830678455de4625ac7f082d8100f0ea0.tar.gz
elibs-771abb84830678455de4625ac7f082d8100f0ea0.tar.bz2
libs -> lib/
Diffstat (limited to 'lib/net')
-rw-r--r--lib/net/jao-frm.el222
-rw-r--r--lib/net/jao-maildir.el155
-rw-r--r--lib/net/jao-proton-utils.el131
-rw-r--r--lib/net/randomsig.el724
-rw-r--r--lib/net/signel.org546
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!