* 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
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
--- /dev/null
+;;; 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
--- /dev/null
+;;; 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
projects / emacs.git / commitdiff