diff options
Diffstat (limited to 'net')
| -rw-r--r-- | net/jao-frm.el | 222 | ||||
| -rw-r--r-- | net/jao-maildir.el | 155 | ||||
| -rw-r--r-- | net/jao-proton-utils.el | 131 | ||||
| -rw-r--r-- | net/randomsig.el | 724 | ||||
| -rw-r--r-- | net/signel.org | 546 |
5 files changed, 0 insertions, 1778 deletions
diff --git a/net/jao-frm.el b/net/jao-frm.el deleted file mode 100644 index 2658687..0000000 --- a/net/jao-frm.el +++ /dev/null @@ -1,222 +0,0 @@ -;;; 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/net/jao-maildir.el b/net/jao-maildir.el deleted file mode 100644 index 76a9f9e..0000000 --- a/net/jao-maildir.el +++ /dev/null @@ -1,155 +0,0 @@ -;; 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/net/jao-proton-utils.el b/net/jao-proton-utils.el deleted file mode 100644 index 012a2ff..0000000 --- a/net/jao-proton-utils.el +++ /dev/null @@ -1,131 +0,0 @@ -;; 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/net/randomsig.el b/net/randomsig.el deleted file mode 100644 index d07e676..0000000 --- a/net/randomsig.el +++ /dev/null @@ -1,724 +0,0 @@ -;;; 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/net/signel.org b/net/signel.org deleted file mode 100644 index 25b7d25..0000000 --- a/net/signel.org +++ /dev/null @@ -1,546 +0,0 @@ -#+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! |