diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index b773ba8fb9e..2186203eb6d 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 abef0b3d0c6..095cc803dd9 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 8d83b2a7e36..1d78f1f5c3b 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -839,6 +839,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 diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el new file mode 100644 index 00000000000..57122f89153 --- /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 . + +;;; 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 00000000000..41fcde04f21 --- /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 . + +;;; 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