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.
This commit is contained in:
Lars Ingebrigtsen
parent
1c6363ff4b
commit
bfc38ff058
5 changed files with 778 additions and 0 deletions
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
6
etc/NEWS
6
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
|
||||
|
|
|
|||
429
lisp/emacs-lisp/multisession.el
Normal file
429
lisp/emacs-lisp/multisession.el
Normal file
|
|
@ -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
|
||||
201
test/lisp/emacs-lisp/multisession-tests.el
Normal file
201
test/lisp/emacs-lisp/multisession-tests.el
Normal file
|
|
@ -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
|
||||
Loading…
Add table
Reference in a new issue