master bfc38ff: Add support for multisession variables

[Lars Ingebrigtsen]

branch: master
commit bfc38ff05826631fecc7ff5a1acf522763fa9d51
Author: Lars Ingebrigtsen <larsi@gnus.org>
Commit: Lars Ingebrigtsen <larsi@gnus.org>

    Add support for multisession variables
    
    * doc/lispref/elisp.texi (Top): Add to menu.
    (Top):
    * doc/lispref/variables.texi (Variables): Ditto.
    (Multisession Variables): Document multisession variables.
    
    * lisp/emacs-lisp/multisession.el: New file.
---
 doc/lispref/elisp.texi                     |   5 +
 doc/lispref/variables.texi                 | 137 +++++++++
 etc/NEWS                                   |   6 +
 lisp/emacs-lisp/multisession.el            | 429 +++++++++++++++++++++++++++++
 test/lisp/emacs-lisp/multisession-tests.el | 201 ++++++++++++++
 5 files changed, 778 insertions(+)

diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index b773ba8..2186203 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -526,6 +526,7 @@ Variables
 * Variables with Restricted Values::  Non-constant variables whose value can
                                         @emph{not} be an arbitrary Lisp object.
 * Generalized Variables::   Extending the concept of variables.
+* Multisession Variables::  Variables that survive restarting Emacs.
 
 Scoping Rules for Variable Bindings
 
@@ -547,6 +548,10 @@ Generalized Variables
 * Setting Generalized Variables::   The @code{setf} macro.
 * Adding Generalized Variables::    Defining new @code{setf} forms.
 
+Multisession Variables
+
+* Multisession Variables::      Variables that survive restarting Emacs.
+
 Functions
 
 * What Is a Function::      Lisp functions vs. primitives; terminology.
diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi
index abef0b3..095cc80 100644
--- a/doc/lispref/variables.texi
+++ b/doc/lispref/variables.texi
@@ -44,6 +44,7 @@ representing the variable.
 * Variables with Restricted Values::  Non-constant variables whose value can
                                         @emph{not} be an arbitrary Lisp object.
 * Generalized Variables::       Extending the concept of variables.
+* Multisession Variables::      Variables that survive restarting Emacs.
 @end menu
 
 @node Global Variables
@@ -2752,3 +2753,139 @@ form that has not already had an appropriate expansion 
defined.  In
 Common Lisp, this is not an error since the function @code{(setf
 @var{func})} might be defined later.
 @end quotation
+
+@node Multisession Variables
+@section Multisession Variables
+
+@cindex multisession variable
+  When you set a variable to a value and then close Emacs and restart
+Emacs, this value won't be automatically restored.  Users usually set
+normal variables in their startup files, or use Customize to set a
+user option permanently, and various packages have various files that
+they store the data in (Gnus stores this in @file{.newsrc.eld} and the
+URL library stores cookies in @file{~/.emacs.d/url/cookies}.
+
+For things in between these two extremes (i.e., configuration which
+goes in the startup file, and massive application state that goes into
+separate files), Emacs provides a facility to replicate data between
+sessions called @dfn{multisession variables}.  (This may not be
+available on all systems.)  To give you an idea of how these are meant
+to be used, here's a small example:
+
+@lisp
+(define-multisession-variable foo-var 0)
+(defun my-adder (num)
+  (interactive "nAdd number: ")
+  (setf (multisession-value foo)
+        (+ (multisession-value foo) num))
+  (message "The new number is: %s" (multisession-value foo)))
+@end lisp
+
+This defines the variable @code{foo-var} and binds it to a special
+multisession object which is initialized with the value @samp{0} (if
+the variable doesn't already exist from a previous session).  The
+@code{my-adder} command queries the user for a number, adds this to
+the old (possibly saved value), and then saves the new value.
+
+This facility isn't meant to be used for huge data structures, but
+should be performant for most values.
+
+@defmac define-multisession-variable name initial-value &optional doc &rest 
args
+This macro defines @var{name} as a multisession variable, with using
+@var{initial-value} is this variable hasn't been stored earlier.
+@var{doc} is the doc string, and some keyword arguments are possible:
+
+@table @code
+@item :package symbol
+This keyword says what package a multisession variable belongs to.
+The combination of @var{package} and @var{name} has to be unique.  If
+@var{package} isn't given, this will default to the first ``section''
+of the @var{name} symbol name.  For instance, if @var{name} is
+@code{foo-var} and @var{package} isn't given, @var{package} will
+default to @code{foo}.
+
+@item :synchronized bool
+Multisession variables can be @dfn{synchronized} if this keyword is
+non-@code{nil}.  This means that if there's two concurrent Emacs
+instances running, and the other Emacs changes the multisession
+variable @code{foo-var}, the current Emacs instance will retrieve that
+data when accessing the value.  If @var{synchronized} is @code{nil} or
+missing, this won't happen, and the variable in all Emacs sessions
+will be independent.
+
+@item :storage storage
+The storage method to use.  This can be either @code{sqlite} (on Emacs
+versions with SQLite support) or @code{files}.  If not given, this
+defaults to the value of the @code{multisession-storage} variable.
+@end table
+@end defmac
+
+@defun multisession-value variable
+This function returns the current value of @var{variable}.  If this
+variable hasn't been accessed before in this Emacs session, or if it's
+changed externally, it will be read in from external storage.  If not,
+the current value in this session is returned as is.
+
+Values retrieved via @code{multisession-value} may or may not be
+@code{eq} to each other, but they will always be @code{equal}.
+
+This is a generalized variable (@pxref{Generalized Variables}), so the
+way to update a variable is to say, for instance:
+
+@lisp
+(setf (multisession-value foo-bar) 'zot)
+@end lisp
+
+Only Emacs Lisp values that have a readable print syntax can be saved
+this way.
+
+If the multisession variable is synchronized, setting it may update
+the value first.  For instance:
+
+@lisp
+(cl-incf (multisession-value foo-bar))
+@end lisp
+
+This will first check whether the value has changed in a different
+Emacs instance, retrieve that value, and then add 1 to that value, and
+then store it.  But note that this is done without locking, so if many
+instances are updating the value at the same time, it's unpredictable
+which instance ``wins''.
+@end defun
+
+@defun multisession-delete object
+This function will delete the value from the backend storage.
+@end defun
+
+@defun make-multisession
+You can also make persistent values that aren't tied to a specific
+variable, but is tied to an explicit package and key.
+
+@example
+(setq foo (make-multisession :package "mail"
+                             :key "friends"))
+(setf (multisession-value foo) 'everybody)
+@end example
+
+This supports the same keywords as
+@code{define-multisession-variable}, but also supports a
+@code{:initial-value} keyword, which specifies the default value.
+@end defun
+
+@defopt multisession-storage
+This variable controls how the multisession variables are stored.  This
+value defaults to @code{files}, which means that the values are stored
+inin a one-file-per-value structure.  If this value is @code{sqlite}
+instead, the values are stored in an SQLite database instead.
+@end defopt
+
+@defopt multisession-directory
+The multisession variables are stored under this directory, and it
+defaults to @file{multisession/} under @code{user-emacs-directory},
+typically @file{~/.emacs.d/multisession/}.
+@end defopt
+
+@defun list-multisession-values
+This function will pop up a new window that lists all multisession
+variables, and allows you to delete and edit them.
+@end defun
diff --git a/etc/NEWS b/etc/NEWS
index 8d83b2a..1d78f1f 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -840,6 +840,12 @@ This change is now applied in 'dired-insert-directory'.
 * Lisp Changes in Emacs 29.1
 
 +++
+** New facility for handling session state: 'multisession-value'.
+This can be used as a convenient way to store (simple) application
+state, and 'M-x list-multisession-values' allows users to list
+(and edit) this data.
+
++++
 ** New function 'get-display-property'.
 This is like 'get-text-property', but works on the 'display' text
 property.
diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el
new file mode 100644
index 0000000..57122f8
--- /dev/null
+++ b/lisp/emacs-lisp/multisession.el
@@ -0,0 +1,429 @@
+;;; multisession.el --- Multisession storage for variables  -*- 
lexical-binding: t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs 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.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'eieio)
+(require 'sqlite)
+(require 'url)
+(require 'tabulated-list)
+
+(defcustom multisession-storage 'files
+  "Storage method for multisession variables.
+Valid methods are `sqlite' and `files'."
+  :type '(choice (const :tag "SQLite" sqlite)
+                 (const :tag "Files" files))
+  :version "29.1"
+  :group 'files)
+
+(defcustom multisession-directory (expand-file-name "multisession/"
+                                                    user-emacs-directory)
+  "Directory to store multisession variables."
+  :type 'file
+  :version "29.1"
+  :group 'files)
+
+;;;###autoload
+(defmacro define-multisession-variable (name initial-value &optional doc
+                                             &rest args)
+  "Make NAME into a multisession variable initialized from INITIAL-VALUE.
+DOC should be a doc string, and ARGS are keywords as applicable to
+`make-multisession'."
+  (declare (indent defun))
+  (unless (plist-get args :package)
+    (setq args (nconc (list :package
+                            (replace-regexp-in-string "-.*" ""
+                                                      (symbol-name name)))
+                      args)))
+  `(defvar ,name
+     (make-multisession :key ,(symbol-name name)
+                        :initial-value ,initial-value
+                        ,@args)
+     ,@(list doc)))
+
+(defconst multisession--unbound (make-symbol "unbound"))
+
+(cl-defstruct (multisession
+               (:constructor nil)
+               (:constructor multisession--create)
+               (:conc-name multisession--))
+  "A persistent variable that will live across Emacs invocations."
+  key
+  (initial-value nil)
+  package
+  (storage multisession-storage)
+  (synchronized nil)
+  (cached-value multisession--unbound)
+  (cached-sequence 0))
+
+(cl-defun make-multisession (&key key initial-value package synchronized
+                                  storage)
+  "Create a multisession object."
+  (unless package
+    (error "No package for the multisession object"))
+  (unless key
+    (error "No key for the multisession object"))
+  (unless (stringp package)
+    (error "The package has to be a string"))
+  (unless (stringp key)
+    (error "The key has to be a string"))
+  (multisession--create
+   :key key
+   :synchronized synchronized
+   :initial-value initial-value
+   :package package
+   :storage (or storage multisession-storage)))
+
+(defun multisession-value (object)
+  "Return the value of the multisession OBJECT."
+  (if (null user-init-file)
+      ;; If we don't have storage, then just return the value from the
+      ;; object.
+      (if (eq (multisession--cached-value object) multisession--unbound)
+          (multisession--initial-value object)
+        (multisession--cached-value object))
+    ;; We have storage, so we update from storage.
+    (multisession-backend-value (multisession--storage object) object)))
+
+(defun multisession--set-value (object value)
+  "Set the stored value of OBJECT to VALUE."
+  (if (null user-init-file)
+      ;; We have no backend, so just store the value.
+      (setf (multisession--cached-value object) value)
+    ;; We have a backend.
+    (multisession--backend-set-value (multisession--storage object)
+                                     object value)))
+
+(defun multisession-delete (object)
+  "Delete OBJECT from the backend storage."
+  (multisession--backend-delete (multisession--storage object) object))
+
+(gv-define-simple-setter multisession-value multisession--set-value)
+
+;; SQLite Backend
+
+(declare-function sqlite-execute "sqlite.c")
+(declare-function sqlite-select "sqlite.c")
+(declare-function sqlite-open "sqlite.c")
+(declare-function sqlite-pragma "sqlite.c")
+
+(defvar multisession--db nil)
+
+(defun multisession--ensure-db ()
+  (unless multisession--db
+    (let* ((file (expand-file-name "sqlite/multisession.sqlite"
+                                   multisession-directory))
+           (dir (file-name-directory file)))
+      (unless (file-exists-p dir)
+        (make-directory dir t))
+      (setq multisession--db (sqlite-open file)))
+    (with-sqlite-transaction multisession--db
+      ;; Use a write-ahead-log (available since 2010), which makes
+      ;; writes a lot faster.
+      (sqlite-pragma multisession--db "journal_mode = WAL")
+      (sqlite-pragma multisession--db "synchronous = NORMAL")
+      (unless (sqlite-select
+               multisession--db
+               "select name from sqlite_master where type = 'table' and name = 
'multisession'")
+        ;; Tidy up the database automatically.
+        (sqlite-pragma multisession--db "auto_vacuum = FULL")
+        ;; Create the table.
+        (sqlite-execute
+         multisession--db
+         "create table multisession (package text not null, key text not null, 
sequence number not null default 1, value text not null)")
+        (sqlite-execute
+         multisession--db
+         "create unique index multisession_idx on multisession (package, 
key)")))))
+
+(cl-defmethod multisession-backend-value ((_type (eql sqlite)) object)
+  (multisession--ensure-db)
+  (let ((id (list (multisession--package object)
+                  (multisession--key object))))
+    (cond
+     ;; We have no value yet; check the database.
+     ((eq (multisession--cached-value object) multisession--unbound)
+      (let ((stored
+             (car
+              (sqlite-select
+               multisession--db
+               "select value, sequence from multisession where package = ? and 
key = ?"
+               id))))
+        (if stored
+            (let ((value (car (read-from-string (car stored)))))
+              (setf (multisession--cached-value object) value
+                    (multisession--cached-sequence object) (cadr stored))
+              value)
+          ;; Nothing; return the initial value.
+          (multisession--initial-value object))))
+     ;; We have a value, but we want to update in case some other
+     ;; Emacs instance has updated.
+     ((multisession--synchronized object)
+      (let ((stored
+             (car
+              (sqlite-select
+               multisession--db
+               "select value, sequence from multisession where sequence > ? 
and package = ? and key = ?"
+               (cons (multisession--cached-sequence object) id)))))
+        (if stored
+            (let ((value (car (read-from-string (car stored)))))
+              (setf (multisession--cached-value object) value
+                    (multisession--cached-sequence object) (cadr stored))
+              value)
+          ;; Nothing, return the cached value.
+          (multisession--cached-value object))))
+     ;; Just return the cached value.
+     (t
+      (multisession--cached-value object)))))
+
+(cl-defmethod multisession--backend-set-value ((_type (eql sqlite))
+                                               object value)
+  (catch 'done
+    (let ((i 0))
+      (while (< i 10)
+        (condition-case nil
+            (throw 'done (multisession--set-value-sqlite object value))
+          (sqlite-locked-error
+           (setq i (1+ i))
+           (sleep-for (+ 0.1 (/ (float (random 10)) 10))))))
+      (signal 'sqlite-locked-error "Database is locked"))))
+
+(defun multisession--set-value-sqlite (object value)
+  (multisession--ensure-db)
+  (with-sqlite-transaction multisession--db
+    (let ((id (list (multisession--package object)
+                    (multisession--key object)))
+          (pvalue
+           (let ((print-length nil)
+                 (print-circle t)
+                 (print-level nil))
+             (prin1-to-string value))))
+      (condition-case nil
+          (ignore (read-from-string pvalue))
+        (error (error "Unable to store unreadable value: %s" pvalue)))
+      (sqlite-execute
+       multisession--db
+       "insert into multisession(package, key, sequence, value) values(?, ?, 
1, ?) on conflict(package, key) do update set sequence = sequence + 1, value = 
?"
+       (append id (list pvalue pvalue)))
+      (setf (multisession--cached-sequence object)
+            (caar (sqlite-select
+                   multisession--db
+                   "select sequence from multisession where package = ? and 
key = ?"
+                   id)))
+      (setf (multisession--cached-value object) value))))
+
+(cl-defmethod multisession--backend-values ((_type (eql sqlite)))
+  (multisession--ensure-db)
+  (sqlite-select
+   multisession--db
+   "select package, key, value from multisession order by package, key"))
+
+(cl-defmethod multisession--backend-delete ((_type (eql sqlite)) object)
+  (sqlite-execute multisession--db
+                  "delete from multisession where package = ? and key = ?"
+                  (list (multisession--package object)
+                        (multisession--key object))))
+
+;; Files Backend
+
+(defun multisession--encode-file-name (name)
+  (url-hexify-string name))
+
+(defun multisession--update-file-value (file object)
+  (with-temp-buffer
+    (let* ((time (file-attribute-modification-time
+                  (file-attributes file)))
+           (coding-system-for-read 'utf-8))
+      (insert-file-contents file)
+      (let ((stored (read (current-buffer))))
+        (setf (multisession--cached-value object) stored
+              (multisession--cached-sequence object) time)
+        stored))))
+
+(defun multisession--object-file-name (object)
+  (expand-file-name
+   (concat "files/"
+           (multisession--encode-file-name (multisession--package object))
+           "/"
+           (multisession--encode-file-name (multisession--key object))
+           ".value")
+   multisession-directory))
+
+(cl-defmethod multisession-backend-value ((_type (eql files)) object)
+  (let ((file (multisession--object-file-name object)))
+    (cond
+     ;; We have no value yet; see whether it's stored.
+     ((eq (multisession--cached-value object) multisession--unbound)
+      (if (file-exists-p file)
+          (multisession--update-file-value file object)
+        ;; Nope; return the initial value.
+        (multisession--initial-value object)))
+     ;; We have a value, but we want to update in case some other
+     ;; Emacs instance has updated.
+     ((multisession--synchronized object)
+      (if (and (file-exists-p file)
+               (time-less-p (multisession--cached-sequence object)
+                            (file-attribute-modification-time
+                             (file-attributes file))))
+          (multisession--update-file-value file object)
+        ;; Nothing, return the cached value.
+        (multisession--cached-value object)))
+     ;; Just return the cached value.
+     (t
+      (multisession--cached-value object)))))
+
+(cl-defmethod multisession--backend-set-value ((_type (eql files))
+                                               object value)
+  (let ((file (multisession--object-file-name object))
+        (time (current-time)))
+    ;; Ensure that the directory exists.
+    (let ((dir (file-name-directory file)))
+      (unless (file-exists-p dir)
+        (make-directory dir t)))
+    (with-temp-buffer
+      (let ((print-length nil)
+            (print-circle t)
+            (print-level nil))
+        (prin1 value (current-buffer)))
+      (goto-char (point-min))
+      (condition-case nil
+          (read (current-buffer))
+        (error (error "Unable to store unreadable value: %s" (buffer-string))))
+      ;; Write to a temp file in the same directory and rename to the
+      ;; file for somewhat better atomicity.
+      (let ((coding-system-for-write 'utf-8)
+            (create-lockfiles nil)
+            (temp (make-temp-name file)))
+        (write-region (point-min) (point-max) temp nil 'silent)
+        (rename-file temp file t)))
+    (setf (multisession--cached-sequence object) time
+          (multisession--cached-value object) value)))
+
+(cl-defmethod multisession--backend-values ((_type (eql files)))
+  (mapcar (lambda (file)
+            (let ((bits (file-name-split file)))
+              (list (url-unhex-string (car (last bits 2)))
+                    (url-unhex-string
+                     (file-name-sans-extension (car (last bits))))
+                    (with-temp-buffer
+                      (let ((coding-system-for-read 'utf-8))
+                        (insert-file-contents file)
+                        (read (current-buffer)))))))
+          (directory-files-recursively
+           (expand-file-name "files" multisession-directory)
+           "\\.value\\'")))
+
+(cl-defmethod multisession--backend-delete ((_type (eql files)) object)
+  (let ((file (multisession--object-file-name object)))
+    (when (file-exists-p file)
+      (delete-file file))))
+
+;; Mode for editing.
+
+(defvar-keymap multisession-edit-mode-map
+  :parent tabulated-list-mode-map
+  "d" #'multisession-delete-value
+  "e" #'multisession-edit-value)
+
+(define-derived-mode multisession-edit-mode special-mode "Multisession"
+  "This mode lists all elements in the \"multisession\" database."
+  :interactive nil
+  (buffer-disable-undo)
+  (setq-local buffer-read-only t
+              truncate-lines t)
+  (setq tabulated-list-format
+        [("Package" 10)
+         ("Key" 30)
+         ("Value" 30)])
+  (setq-local revert-buffer-function #'multisession-edit-mode--revert))
+
+;;;###autoload
+(defun list-multisession-values (&optional choose-storage)
+  "List all values in the \"multisession\" database.
+If CHOOSE-STORAGE (interactively, the prefix), query for the
+storage method to list."
+  (interactive "P")
+  (let ((storage
+         (if choose-storage
+             (intern (completing-read "Storage method: " '(sqlite files) nil 
t))
+           multisession-storage)))
+    (pop-to-buffer (get-buffer-create (format "*Multisession %s*" storage)))
+    (multisession-edit-mode)
+    (setq-local multisession-storage storage)
+    (multisession-edit-mode--revert)
+    (goto-char (point-min))))
+
+(defun multisession-edit-mode--revert (&rest _)
+  (let ((inhibit-read-only t)
+        (id (get-text-property (point) 'tabulated-list-id)))
+    (erase-buffer)
+    (tabulated-list-init-header)
+    (setq tabulated-list-entries
+          (mapcar (lambda (elem)
+                    (list
+                     (cons (car elem) (cadr elem))
+                     (vector (car elem) (cadr elem)
+                             (string-replace "\n" "\\n"
+                                             (format "%s" (caddr elem))))))
+                  (multisession--backend-values multisession-storage)))
+    (tabulated-list-print t)
+    (goto-char (point-min))
+    (when id
+      (when-let ((match
+                  (text-property-search-forward 'tabulated-list-id id t)))
+        (goto-char (prop-match-beginning match))))))
+
+(defun multisession-delete-value (id)
+  "Delete the value at point."
+  (interactive (list (get-text-property (point) 'tabulated-list-id))
+               multisession-edit-mode)
+  (unless id
+    (error "No value on the current line"))
+  (unless (yes-or-no-p "Really delete this item? ")
+    (user-error "Not deleting"))
+  (multisession--backend-delete multisession-storage
+                                (make-multisession :package (car id)
+                                                   :key (cdr id)))
+  (let ((inhibit-read-only t))
+    (beginning-of-line)
+    (delete-region (point) (progn (forward-line 1) (point)))))
+
+(defun multisession-edit-value (id)
+  "Edit the value at point."
+  (interactive (list (get-text-property (point) 'tabulated-list-id))
+               multisession-edit-mode)
+  (unless id
+    (error "No value on the current line"))
+  (let* ((object (make-multisession
+                  :package (car id)
+                  :key (cdr id)
+                  :storage multisession-storage))
+         (value (multisession-value object)))
+    (setf (multisession-value object)
+          (car (read-from-string
+                (read-string "New value: " (prin1-to-string value))))))
+  (multisession-edit-mode--revert))
+
+(provide 'multisession)
+
+;;; multisession.el ends here
diff --git a/test/lisp/emacs-lisp/multisession-tests.el 
b/test/lisp/emacs-lisp/multisession-tests.el
new file mode 100644
index 0000000..41fcde0
--- /dev/null
+++ b/test/lisp/emacs-lisp/multisession-tests.el
@@ -0,0 +1,201 @@
+;;; multisession-tests.el --- Tests for multisession.el  -*- lexical-binding: 
t; -*-
+
+;; Copyright (C) 2021 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs 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.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'multisession)
+(require 'ert)
+(require 'ert-x)
+(require 'cl-lib)
+
+(ert-deftest multi-test-sqlite-simple ()
+  (skip-unless (sqlite-available-p))
+  (ert-with-temp-file dir
+    :directory t
+    (let ((user-init-file "/tmp/foo.el")
+          (multisession-storage 'sqlite)
+          (multisession-directory dir))
+      (unwind-protect
+          (progn
+            (define-multisession-variable foo 0
+              ""
+              :synchronized t)
+            (should (= (multisession-value foo) 0))
+            (cl-incf (multisession-value foo))
+            (should (= (multisession-value foo) 1))
+            (call-process
+             (concat invocation-directory invocation-name)
+             nil t nil
+             "-Q" "-batch"
+             "--eval" (prin1-to-string
+                       `(progn
+                          (require 'multisession)
+                          (let ((multisession-directory ,dir)
+                                (multisession-storage 'sqlite)
+                                (user-init-file "/tmp/foo.el"))
+                            (define-multisession-variable foo 0
+                              ""
+                              :synchronized t)
+                            (cl-incf (multisession-value foo))))))
+            (should (= (multisession-value foo) 2)))
+        (sqlite-close multisession--db)
+        (setq multisession--db nil)))))
+
+(ert-deftest multi-test-sqlite-busy ()
+  (skip-unless (and t (sqlite-available-p)))
+  (ert-with-temp-file dir
+    :directory t
+    (let ((user-init-file "/tmp/foo.el")
+          (multisession-directory dir)
+          (multisession-storage 'sqlite)
+          proc)
+      (unwind-protect
+          (progn
+            (define-multisession-variable bar 0
+              ""
+              :synchronized t)
+            (should (= (multisession-value bar) 0))
+            (cl-incf (multisession-value bar))
+            (should (= (multisession-value bar) 1))
+            (setq proc
+                  (start-process
+                   "other-emacs"
+                   nil
+                   (concat invocation-directory invocation-name)
+                   "-Q" "-batch"
+                   "--eval" (prin1-to-string
+                             `(progn
+                                (require 'multisession)
+                                (let ((multisession-directory ,dir)
+                                      (multisession-storage 'sqlite)
+                                      (user-init-file "/tmp/bar.el"))
+                                  (define-multisession-variable bar 0
+                                    "" :synchronized t)
+                                  (dotimes (i 100)
+                                    (cl-incf (multisession-value bar))))))))
+            (while (process-live-p proc)
+              (ignore-error 'sqlite-locked-error
+                (message "bar %s" (multisession-value bar))
+                ;;(cl-incf (multisession-value bar))
+                )
+              (sleep-for 0.1))
+            (message "bar ends up as %s" (multisession-value bar))
+            (should (< (multisession-value bar) 1003)))
+        (sqlite-close multisession--db)
+        (setq multisession--db nil)))))
+
+(ert-deftest multi-test-files-simple ()
+  (ert-with-temp-file dir
+    :directory t
+    (let ((user-init-file "/tmp/sfoo.el")
+          (multisession-storage 'files)
+          (multisession-directory dir))
+      (define-multisession-variable sfoo 0
+        ""
+        :synchronized t)
+      (should (= (multisession-value sfoo) 0))
+      (cl-incf (multisession-value sfoo))
+      (should (= (multisession-value sfoo) 1))
+      (call-process
+       (concat invocation-directory invocation-name)
+       nil t nil
+       "-Q" "-batch"
+       "--eval" (prin1-to-string
+                 `(progn
+                    (require 'multisession)
+                    (let ((multisession-directory ,dir)
+                          (multisession-storage 'files)
+                          (user-init-file "/tmp/sfoo.el"))
+                      (define-multisession-variable sfoo 0
+                        ""
+                        :synchronized t)
+                      (cl-incf (multisession-value sfoo))))))
+      (should (= (multisession-value sfoo) 2)))))
+
+(ert-deftest multi-test-files-busy ()
+  (skip-unless (and t (sqlite-available-p)))
+  (ert-with-temp-file dir
+    :directory t
+    (let ((user-init-file "/tmp/foo.el")
+          (multisession-storage 'files)
+          (multisession-directory dir)
+          proc)
+      (define-multisession-variable sbar 0
+        ""
+        :synchronized t)
+      (should (= (multisession-value sbar) 0))
+      (cl-incf (multisession-value sbar))
+      (should (= (multisession-value sbar) 1))
+      (setq proc
+            (start-process
+             "other-emacs"
+             nil
+             (concat invocation-directory invocation-name)
+             "-Q" "-batch"
+             "--eval" (prin1-to-string
+                       `(progn
+                          (require 'multisession)
+                          (let ((multisession-directory ,dir)
+                                (multisession-storage 'files)
+                                (user-init-file "/tmp/sbar.el"))
+                            (define-multisession-variable sbar 0
+                              "" :synchronized t)
+                            (dotimes (i 1000)
+                              (cl-incf (multisession-value sbar))))))))
+      (while (process-live-p proc)
+        (message "sbar %s" (multisession-value sbar))
+        ;;(cl-incf (multisession-value sbar))
+        (sleep-for 0.1))
+      (message "sbar ends up as %s" (multisession-value sbar))
+      (should (< (multisession-value sbar) 2000)))))
+
+(ert-deftest multi-test-files-some-values ()
+  (ert-with-temp-file dir
+    :directory t
+    (let ((user-init-file "/tmp/sfoo.el")
+          (multisession-storage 'files)
+          (multisession-directory dir))
+      (define-multisession-variable foo1 nil)
+      (should (eq (multisession-value foo1) nil))
+      (setf (multisession-value foo1) nil)
+      (should (eq (multisession-value foo1) nil))
+      (setf (multisession-value foo1) t)
+      (should (eq (multisession-value foo1) t))
+
+      (define-multisession-variable foo2 t)
+      (setf (multisession-value foo2) nil)
+      (should (eq (multisession-value foo2) nil))
+      (setf (multisession-value foo2) t)
+      (should (eq (multisession-value foo2) t))
+
+      (define-multisession-variable foo3 t)
+      (should-error (setf (multisession-value foo3) (make-marker)))
+
+      (let ((string (with-temp-buffer
+                      (set-buffer-multibyte nil)
+                      (insert 0 1 2)
+                      (buffer-string))))
+        (should-not (multibyte-string-p string))
+        (define-multisession-variable foo4 nil)
+        (setf (multisession-value foo4) string)
+        (should (equal (multisession-value foo4) string))))))
+
+;;; multisession-tests.el ends here