summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/lispref/elisp.texi5
-rw-r--r--doc/lispref/variables.texi155
-rw-r--r--etc/NEWS6
-rw-r--r--lisp/emacs-lisp/ert.el134
-rw-r--r--lisp/emacs-lisp/multisession.el439
-rw-r--r--lisp/international/emoji.el20
-rw-r--r--lisp/outline.el5
-rw-r--r--lisp/progmodes/hideif.el40
-rw-r--r--lisp/ses.el18
-rw-r--r--lisp/textmodes/reftex-vars.el16
-rw-r--r--lisp/vc/ediff-util.el20
-rw-r--r--src/comp.c6
-rw-r--r--src/dynlib.c12
-rw-r--r--src/dynlib.h1
-rw-r--r--src/pdumper.c2
-rw-r--r--src/xwidget.c2
-rw-r--r--test/lisp/emacs-lisp/multisession-tests.el201
-rw-r--r--test/src/sqlite-tests.el1
18 files changed, 977 insertions, 106 deletions
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..98a9487aea9 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,157 @@ 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
+it, that value won't be automatically restored. Users usually set
+normal variables in their startup files, or use Customize
+(@pxref{Customization}) to set user options permanently, and various
+packages have various files wher they store the data (e.g., 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 facility 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
+@group
+(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 group
+@end lisp
+
+@noindent
+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, and gives it
+the @var{initial-value} if this variable hasn't been assigned a value
+earlier. @var{doc} is the doc string, and several keyword arguments can
+be used in @var{args}:
+
+@table @code
+@item :package @var{package-symbol}
+This keyword says that a multisession variable belongs to the package
+specified by @var{package-symbol}. The combination of
+@var{package-symbol} and @var{name} has to be unique. If
+@var{package-symbol} isn't given, this will default to the first
+``segment'' of the @var{name} symbol's name, which is the part of its
+name up to and excluding the first @samp{-}. For instance, if
+@var{name} is @code{foo-var} and @var{package-symbol} isn't given,
+@var{package-symbol} will default to @code{foo}.
+
+@cindex synchronized multisession variables
+@item :synchronized @var{bool}
+Multisession variables can be @dfn{synchronized} if @var{bool} is
+non-@code{nil}. This means that if there're two concurrent Emacs
+instances running, and the other Emacs changes the multisession
+variable @code{foo-var}, the current Emacs instance will retrieve that
+modified data when accessing the value. If @var{synchronized} is
+@code{nil} or missing, this won't happen, and the values in all
+Emacs sessions using the variable will be independent of each other.
+
+@item :storage @var{storage}
+Use the specified @var{storage} method. This can be either
+@code{sqlite} (in Emacs compiled with SQLite support) or @code{files}.
+If not given, this defaults to the value of the
+@code{multisession-storage} variable, described below.
+@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. It is an error
+to call this function for a @var{variable} that is not a multisession
+variable.
+
+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 such 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
+(@pxref{Printed Representation}) 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 first checks whether the value has changed in a different
+Emacs instance, retrieves that value, and then adds 1 to that value and
+stores 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 deletes @var{object} and its value from its persistent
+storage.
+@end defun
+
+@c FIXME: this lacks the documentation of the form of the arguments.
+@defun make-multisession
+You can also make persistent values that aren't tied to a specific
+variable, but are 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. It
+value defaults to @code{files}, which means that the values are stored
+in a one-file-per-variable structure inside the directory specified by
+@code{multisession-directory}. If this value is @code{sqlite}
+instead, the values are stored in an SQLite database; this is only
+available if Emacs was built with SQLite support.
+@end defopt
+
+@defopt multisession-directory
+The multisession variables are stored under this directory, which
+defaults to @file{multisession/} subdirectory of the
+@code{user-emacs-directory}, which is typically
+@file{~/.emacs.d/multisession/}.
+@end defopt
+
+@findex multisession-edit-mode
+@deffn Command list-multisession-values
+This command pops up a buffer listing all the multisession variables,
+and enters a special mode @code{multisession-edit-mode} which allows
+you to delete them and edit their values.
+@end deffn
diff --git a/etc/NEWS b/etc/NEWS
index 8d83b2a7e36..1d78f1f5c3b 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/ert.el b/lisp/emacs-lisp/ert.el
index 981e23931c2..597044cf21c 100644
--- a/lisp/emacs-lisp/ert.el
+++ b/lisp/emacs-lisp/ert.el
@@ -1529,26 +1529,29 @@ the tests)."
(defun ert-write-junit-test-report (stats)
"Write a JUnit test report, generated from STATS."
- ;; https://www.ibm.com/docs/de/developer-for-zos/14.1.0?topic=formats-junit-xml-format
+ ;; https://www.ibm.com/docs/en/developer-for-zos/14.1.0?topic=formats-junit-xml-format
;; https://llg.cubic.org/docs/junit/
(unless (zerop (length (ert--stats-tests stats)))
(when-let ((test-file
(symbol-file
- (ert-test-name (aref (ert--stats-tests stats) 0)) 'ert--test)))
- (with-temp-file (file-name-with-extension test-file "xml")
+ (ert-test-name (aref (ert--stats-tests stats) 0)) 'ert--test))
+ (test-report (file-name-with-extension test-file "xml")))
+ (with-temp-file test-report
(insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
- (insert (format "<testsuites name=\"%s\" tests=\"%s\" failures=\"%s\" skipped=\"%s\" time=\"%s\">\n"
- (file-name-nondirectory test-file)
+ (insert (format "<testsuites name=\"%s\" tests=\"%s\" errors=\"%s\" failures=\"%s\" skipped=\"%s\" time=\"%s\">\n"
+ (file-name-nondirectory test-report)
(ert-stats-total stats)
+ (if (ert--stats-aborted-p stats) 1 0)
(ert-stats-completed-unexpected stats)
(ert-stats-skipped stats)
(float-time
(time-subtract
(ert--stats-end-time stats)
(ert--stats-start-time stats)))))
- (insert (format " <testsuite id=\"0\" name=\"%s\" tests=\"%s\" failures=\"%s\" skipped=\"%s\" time=\"%s\" timestamp=\"%s\">\n"
- (file-name-nondirectory test-file)
+ (insert (format " <testsuite id=\"0\" name=\"%s\" tests=\"%s\" errors=\"%s\" failures=\"%s\" skipped=\"%s\" time=\"%s\" timestamp=\"%s\">\n"
+ (file-name-nondirectory test-report)
(ert-stats-total stats)
+ (if (ert--stats-aborted-p stats) 1 0)
(ert-stats-completed-unexpected stats)
(ert-stats-skipped stats)
(float-time
@@ -1570,40 +1573,52 @@ the tests)."
(ert-test-result-expected-p test result))
(ert-test-result-duration result)))
(if (and (ert-test-result-expected-p test result)
+ (not (ert-test-aborted-with-non-local-exit-p result))
(not (ert-test-skipped-p result))
(zerop (length (ert-test-result-messages result))))
(insert "/>\n")
(insert ">\n")
- (if (ert-test-skipped-p result)
- (insert (format " <skipped message=\"%s\" type=\"%s\">\n"
- (xml-escape-string
- (string-trim
- (ert-reason-for-test-result result)))
- (ert-string-for-test-result
- result
- (ert-test-result-expected-p
- test result)))
- (xml-escape-string
- (string-trim
- (ert-reason-for-test-result result)))
- "\n"
- " </skipped>\n")
- (unless
- (ert-test-result-type-p
- result (ert-test-expected-result-type test))
- (insert (format " <failure message=\"%s\" type=\"%s\">\n"
- (xml-escape-string
- (string-trim
- (ert-reason-for-test-result result)))
- (ert-string-for-test-result
- result
- (ert-test-result-expected-p
- test result)))
- (xml-escape-string
- (string-trim
- (ert-reason-for-test-result result)))
- "\n"
- " </failure>\n")))
+ (cond
+ ((ert-test-skipped-p result)
+ (insert (format " <skipped message=\"%s\" type=\"%s\">\n"
+ (xml-escape-string
+ (string-trim
+ (ert-reason-for-test-result result)))
+ (ert-string-for-test-result
+ result
+ (ert-test-result-expected-p
+ test result)))
+ (xml-escape-string
+ (string-trim
+ (ert-reason-for-test-result result)))
+ "\n"
+ " </skipped>\n"))
+ ((ert-test-aborted-with-non-local-exit-p result)
+ (insert (format " <error message=\"%s\" type=\"%s\">\n"
+ (file-name-nondirectory test-report)
+ (ert-string-for-test-result
+ result
+ (ert-test-result-expected-p
+ test result)))
+ (format "Test %s aborted with non-local exit\n"
+ (xml-escape-string
+ (symbol-name (ert-test-name test))))
+ " </error>\n"))
+ ((not (ert-test-result-type-p
+ result (ert-test-expected-result-type test)))
+ (insert (format " <failure message=\"%s\" type=\"%s\">\n"
+ (xml-escape-string
+ (string-trim
+ (ert-reason-for-test-result result)))
+ (ert-string-for-test-result
+ result
+ (ert-test-result-expected-p
+ test result)))
+ (xml-escape-string
+ (string-trim
+ (ert-reason-for-test-result result)))
+ "\n"
+ " </failure>\n")))
(unless (zerop (length (ert-test-result-messages result)))
(insert " <system-out>\n"
(xml-escape-string
@@ -1617,21 +1632,41 @@ the tests)."
"Write a JUnit summary test report, generated from LOGFILES."
(let ((report (file-name-with-extension
(getenv "EMACS_TEST_JUNIT_REPORT") "xml"))
- (tests 0) (failures 0) (skipped 0) (time 0) (id 0))
+ (tests 0) (errors 0) (failures 0) (skipped 0) (time 0) (id 0))
(with-temp-file report
(dolist (logfile logfiles)
- (let ((test-file (file-name-with-extension logfile "xml")))
- (when (file-readable-p test-file)
- (insert-file-contents-literally test-file)
+ (let ((test-report (file-name-with-extension logfile "xml")))
+ (if (not (file-readable-p test-report))
+ (let ((logfile (file-name-with-extension logfile "log")))
+ (insert (format " <testsuite id=\"%s\" name=\"%s\" tests=\"1\" errors=\"1\" failures=\"0\" skipped=\"0\" time=\"0\" timestamp=\"%s\">\n"
+ id test-report
+ (ert--format-time-iso8601 (current-time))))
+ (insert (format " <testcase name=\"Test report missing %s\" status=\"error\" time=\"0\">\n"
+ (file-name-nondirectory test-report)))
+ (insert (format " <error message=\"Test report missing %s\" type=\"error\">\n"
+ (file-name-nondirectory test-report)))
+ (when (file-readable-p logfile)
+ (insert (xml-escape-string
+ (with-temp-buffer
+ (insert-file-contents-literally logfile)
+ (buffer-string)))))
+ (insert " </error>\n"
+ " </testcase>\n"
+ " </testsuite>\n")
+ (cl-incf errors 1)
+ (cl-incf id 1))
+
+ (insert-file-contents-literally test-report)
(when (looking-at-p
(regexp-quote "<?xml version=\"1.0\" encoding=\"utf-8\"?>"))
(delete-region (point) (line-beginning-position 2)))
(when (looking-at
- "<testsuites name=\".+\" tests=\"\\(.+\\)\" failures=\"\\(.+\\)\" skipped=\"\\(.+\\)\" time=\"\\(.+\\)\">")
+ "<testsuites name=\".+\" tests=\"\\(.+\\)\" errors=\"\\(.+\\)\" failures=\"\\(.+\\)\" skipped=\"\\(.+\\)\" time=\"\\(.+\\)\">")
(cl-incf tests (string-to-number (match-string 1)))
- (cl-incf failures (string-to-number (match-string 2)))
- (cl-incf skipped (string-to-number (match-string 3)))
- (cl-incf time (string-to-number (match-string 4)))
+ (cl-incf errors (string-to-number (match-string 2)))
+ (cl-incf failures (string-to-number (match-string 3)))
+ (cl-incf skipped (string-to-number (match-string 4)))
+ (cl-incf time (string-to-number (match-string 5)))
(delete-region (point) (line-beginning-position 2)))
(when (looking-at " <testsuite id=\"\\(0\\)\"")
(replace-match (number-to-string id) nil nil nil 1)
@@ -1639,16 +1674,17 @@ the tests)."
(goto-char (point-max))
(beginning-of-line 0)
(when (looking-at-p "</testsuites>")
- (delete-region (point) (line-beginning-position 2)))
- (narrow-to-region (point-max) (point-max)))))
+ (delete-region (point) (line-beginning-position 2))))
+
+ (narrow-to-region (point-max) (point-max))))
(insert "</testsuites>\n")
(widen)
(goto-char (point-min))
(insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n")
- (insert (format "<testsuites name=\"%s\" tests=\"%s\" failures=\"%s\" skipped=\"%s\" time=\"%s\">\n"
+ (insert (format "<testsuites name=\"%s\" tests=\"%s\" errors=\"%s\" failures=\"%s\" skipped=\"%s\" time=\"%s\">\n"
(file-name-nondirectory report)
- tests failures skipped time)))))
+ tests errors failures skipped time)))))
(defun ert-summarize-tests-batch-and-exit (&optional high)
"Summarize the results of testing.
diff --git a/lisp/emacs-lisp/multisession.el b/lisp/emacs-lisp/multisession.el
new file mode 100644
index 00000000000..17c9384134c
--- /dev/null
+++ b/lisp/emacs-lisp/multisession.el
@@ -0,0 +1,439 @@
+;;; 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")
+(declare-function sqlite-transaction "sqlite.c")
+(declare-function sqlite-commit "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)
+ (condition-case nil
+ (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)))
+ ;; If the file is contended (could happen with file locking in
+ ;; Windws) or unreadable, just return the current value.
+ (error
+ (if (eq (multisession--cached-value object) multisession--unbound)
+ (multisession--initial-value object)
+ (multisession--cached-value object)))))
+
+(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)
+ (set-file-times temp time)
+ (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/lisp/international/emoji.el b/lisp/international/emoji.el
index 5f8c358caab..a4dec973fb8 100644
--- a/lisp/international/emoji.el
+++ b/lisp/international/emoji.el
@@ -30,6 +30,7 @@
(require 'cl-lib)
(require 'cl-extra)
(require 'transient)
+(require 'multisession)
(defgroup emoji nil
"Inserting Emojis."
@@ -59,7 +60,7 @@
(defvar emoji--derived nil)
(defvar emoji--names (make-hash-table :test #'equal))
(defvar emoji--done-derived nil)
-(defvar emoji--recent (list "😀" "😖"))
+(define-multisession-variable emoji--recent (list "😀" "😖"))
(defvar emoji--insert-buffer)
;;;###autoload
@@ -83,7 +84,7 @@ of a visual interface."
(unless (fboundp 'emoji--command-Emoji)
(emoji--define-transient))
(funcall (emoji--define-transient
- (cons "Recent" emoji--recent) t)))
+ (cons "Recent" (multisession-value emoji--recent)) t)))
;;;###autoload
(defun emoji-search ()
@@ -529,15 +530,18 @@ character) under point is."
(lambda ()
(interactive)
(funcall (emoji--define-transient
- (cons "Recent" emoji--recent) t end-function))))
+ (cons "Recent" (multisession-value emoji--recent))
+ t end-function))))
(defun emoji--add-recent (glyph)
"Add GLYPH to the set of recently used emojis."
- (setq emoji--recent (delete glyph emoji--recent))
- (push glyph emoji--recent)
- ;; Shorten the list.
- (when-let ((tail (nthcdr 30 emoji--recent)))
- (setcdr tail nil)))
+ (let ((recent (multisession-value emoji--recent)))
+ (setq recent (delete glyph recent))
+ (push glyph recent)
+ ;; Shorten the list.
+ (when-let ((tail (nthcdr 30 recent)))
+ (setcdr tail nil))
+ (setf (multisession-value emoji--recent) recent)))
(defun emoji--columnize (list columns)
"Split LIST into COLUMN columns."
diff --git a/lisp/outline.el b/lisp/outline.el
index 2ede4e23eac..5e3d4e0e002 100644
--- a/lisp/outline.el
+++ b/lisp/outline.el
@@ -283,6 +283,7 @@ buffers (yet) -- that will be amended in a future version.
The `outline-minor-mode-buttons' variable specifies how the
buttons should look."
:type 'boolean
+ :safe #'booleanp
:version "29.1")
(defcustom outline-minor-mode-buttons
@@ -376,8 +377,8 @@ When point is on a heading line, then typing `TAB' cycles between `hide all',
a heading line cycles the whole buffer (`outline-cycle-buffer').
Typing these keys anywhere outside heading lines uses their default bindings."
:type 'boolean
+ :safe #'booleanp
:version "28.1")
-;;;###autoload(put 'outline-minor-mode-cycle 'safe-local-variable 'booleanp)
(defcustom outline-minor-mode-highlight nil
"Highlight headings in `outline-minor-mode' using font-lock keywords.
@@ -391,8 +392,8 @@ faces to major mode's faces."
(const :tag "Overwrite major mode faces" override)
(const :tag "Append outline faces to major mode faces" append)
(const :tag "Highlight separately from major mode faces" t))
+ :safe #'symbolp
:version "28.1")
-;;;###autoload(put 'outline-minor-mode-highlight 'safe-local-variable 'symbolp)
(defun outline-minor-mode-highlight-buffer ()
;; Fallback to overlays when font-lock is unsupported.
diff --git a/lisp/progmodes/hideif.el b/lisp/progmodes/hideif.el
index 87732c10489..538ec4df804 100644
--- a/lisp/progmodes/hideif.el
+++ b/lisp/progmodes/hideif.el
@@ -181,30 +181,24 @@ Effective only if `hide-ifdef-expand-reinclusion-guard' is t."
:type 'regexp
:version "25.1")
-(defvar hide-ifdef-mode-submap
+(defvar-keymap hide-ifdef-mode-submap
+ :doc "Keymap used by `hide-ifdef-mode' under `hide-ifdef-mode-prefix-key'."
;; Set up the submap that goes after the prefix key.
- (let ((map (make-sparse-keymap)))
- (define-key map "d" 'hide-ifdef-define)
- (define-key map "u" 'hide-ifdef-undef)
- (define-key map "D" 'hide-ifdef-set-define-alist)
- (define-key map "U" 'hide-ifdef-use-define-alist)
-
- (define-key map "h" 'hide-ifdefs)
- (define-key map "s" 'show-ifdefs)
- (define-key map "\C-d" 'hide-ifdef-block)
- (define-key map "\C-s" 'show-ifdef-block)
- (define-key map "e" 'hif-evaluate-macro)
- (define-key map "C" 'hif-clear-all-ifdef-defined)
-
- (define-key map "\C-q" 'hide-ifdef-toggle-read-only)
- (define-key map "\C-w" 'hide-ifdef-toggle-shadowing)
- (substitute-key-definition
- 'read-only-mode 'hide-ifdef-toggle-outside-read-only map)
- ;; `toggle-read-only' is obsoleted by `read-only-mode'.
- (substitute-key-definition
- 'toggle-read-only 'hide-ifdef-toggle-outside-read-only map)
- map)
- "Keymap used by `hide-ifdef-mode' under `hide-ifdef-mode-prefix-key'.")
+ "d" #'hide-ifdef-define
+ "u" #'hide-ifdef-undef
+ "D" #'hide-ifdef-set-define-alist
+ "U" #'hide-ifdef-use-define-alist
+ "h" #'hide-ifdefs
+ "s" #'show-ifdefs
+ "C-d" #'hide-ifdef-block
+ "C-s" #'show-ifdef-block
+ "e" #'hif-evaluate-macro
+ "C" #'hif-clear-all-ifdef-defined
+ "C-q" #'hide-ifdef-toggle-read-only
+ "C-w" #'hide-ifdef-toggle-shadowing
+ "<remap> <read-only-mode>" #'hide-ifdef-toggle-outside-read-only
+ ;; `toggle-read-only' is obsoleted by `read-only-mode'.
+ "<remap> <toggle-read-only>" #'hide-ifdef-toggle-outside-read-only)
(defcustom hide-ifdef-mode-prefix-key "\C-c@"
"Prefix key for all Hide-Ifdef mode commands."
diff --git a/lisp/ses.el b/lisp/ses.el
index 5e2d254881b..8496aeec8e8 100644
--- a/lisp/ses.el
+++ b/lisp/ses.el
@@ -227,12 +227,6 @@ Used for listing local printers or renamed cells.")
"w" ses-set-column-width
"x" ses-export-keymap
"\M-p" ses-read-column-printer))
- (repl '(;;We'll replace these wherever they appear in the keymap
- clipboard-kill-region ses-kill-override
- end-of-line ses-end-of-line
- kill-line ses-delete-row
- kill-region ses-kill-override
- open-line ses-insert-row))
(numeric "0123456789.-")
(newmap (make-keymap)))
;;Get rid of printables
@@ -240,13 +234,11 @@ Used for listing local printers or renamed cells.")
;;These keys insert themselves as the beginning of a numeric value
(dotimes (x (length numeric))
(define-key newmap (substring numeric x (1+ x)) 'ses-read-cell))
- ;;Override these global functions wherever they're bound
- (while repl
- (substitute-key-definition (car repl) (cadr repl) newmap
- (current-global-map))
- (setq repl (cddr repl)))
- ;;Apparently substitute-key-definition doesn't catch this?
- (define-key newmap [(menu-bar) edit cut] 'ses-kill-override)
+ (define-key newmap [remap clipboard-kill-region] #'ses-kill-override)
+ (define-key newmap [remap end-of-line] #'ses-end-of-line)
+ (define-key newmap [remap kill-line] #'ses-delete-row)
+ (define-key newmap [remap kill-region] #'ses-kill-override)
+ (define-key newmap [remap open-line] #'ses-insert-row)
;;Define our other local keys
(while keys
(define-key newmap (car keys) (cadr keys))
diff --git a/lisp/textmodes/reftex-vars.el b/lisp/textmodes/reftex-vars.el
index eedc067b868..dedd74607ae 100644
--- a/lisp/textmodes/reftex-vars.el
+++ b/lisp/textmodes/reftex-vars.el
@@ -70,12 +70,16 @@
("tabwindow" ?f nil nil 1)))
(rotating "Sidewaysfigure and table"
- (("sidewaysfigure" ?f nil nil caption)
- ("sidewaystable" ?t nil nil caption)))
-
- (sidecap "CSfigure and SCtable"
- (("SCfigure" ?f nil nil caption)
- ("SCtable" ?t nil nil caption)))
+ (("sidewaysfigure" ?f nil nil caption)
+ ("sidewaysfigure*" ?f nil nil caption)
+ ("sidewaystable" ?t nil nil caption)
+ ("sidewaystable*" ?t nil nil caption)))
+
+ (sidecap "SCfigure and SCtable"
+ (("SCfigure" ?f nil nil caption)
+ ("SCfigure*" ?f nil nil caption)
+ ("SCtable" ?t nil nil caption)
+ ("SCtable*" ?t nil nil caption)))
(subfigure "Subfigure environments/macro"
(("subfigure" ?f nil nil caption)
diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el
index d4660a179e6..c2b08bd31af 100644
--- a/lisp/vc/ediff-util.el
+++ b/lisp/vc/ediff-util.el
@@ -521,7 +521,25 @@ to invocation.")
(erase-buffer)
(ediff-set-help-message)
(insert ediff-help-message)
- (shrink-window-if-larger-than-buffer)
+ ;; With the fix for Bug#49277 and an 'ediff-setup-windows-plain'
+ ;; layout, the window of the control buffer we want to adjust here
+ ;; is no longer the lower of two windows on their frame both showing
+ ;; that control buffer but rather the bottom-most window in the
+ ;; established ediff layout for that frame. As a consequence,
+ ;; 'shrink-window-if-larger-than-buffer' will fail to show the whole
+ ;; buffer with 'ediff-toggle-help' because that window's maximum
+ ;; height is not half the height of its frame but the height of the
+ ;; control buffer's window in the established layout (Bug#52504).
+ ;;
+ ;; The form below is an attempt to emulate the behavior of Emacs 27
+ ;; as faithfully as possible in this regard (the use of 'ceiling'
+ ;; mimics the behavior of 'split-window' giving the lower window the
+ ;; residue line when the window to split has an uneven number of
+ ;; lines).
+ (when (and (window-combined-p)
+ (pos-visible-in-window-p (point-min)))
+ (fit-window-to-buffer
+ nil (ceiling (/ (window-total-height (frame-root-window)) 2.0))))
(or (ediff-multiframe-setup-p)
(ediff-indent-help-message))
(ediff-set-help-overlays)
diff --git a/src/comp.c b/src/comp.c
index fb9b1a5a2d8..1fb384840cf 100644
--- a/src/comp.c
+++ b/src/comp.c
@@ -5278,16 +5278,16 @@ LATE_LOAD has to be non-nil when loading for deferred compilation. */)
Fmake_temp_file_internal (filename, Qnil, build_string (".eln.tmp"),
Qnil);
if (NILP (Ffile_writable_p (tmp_filename)))
- comp_u->handle = dynlib_open (SSDATA (encoded_filename));
+ comp_u->handle = dynlib_open_for_eln (SSDATA (encoded_filename));
else
{
Frename_file (filename, tmp_filename, Qt);
- comp_u->handle = dynlib_open (SSDATA (ENCODE_FILE (tmp_filename)));
+ comp_u->handle = dynlib_open_for_eln (SSDATA (ENCODE_FILE (tmp_filename)));
Frename_file (tmp_filename, filename, Qnil);
}
}
else
- comp_u->handle = dynlib_open (SSDATA (encoded_filename));
+ comp_u->handle = dynlib_open_for_eln (SSDATA (encoded_filename));
if (!comp_u->handle)
xsignal2 (Qnative_lisp_load_failed, filename,
diff --git a/src/dynlib.c b/src/dynlib.c
index a8c88439615..e9a775f2d3c 100644
--- a/src/dynlib.c
+++ b/src/dynlib.c
@@ -104,6 +104,12 @@ dynlib_open (const char *dll_fname)
return (dynlib_handle_ptr) hdll;
}
+dynlib_handle_ptr
+dynlib_open_for_eln (const char *dll_fname)
+{
+ return dynlib_open (dll_fname);
+}
+
void *
dynlib_sym (dynlib_handle_ptr h, const char *sym)
{
@@ -270,6 +276,12 @@ dynlib_close (dynlib_handle_ptr h)
dynlib_handle_ptr
dynlib_open (const char *path)
{
+ return dlopen (path, RTLD_LAZY | RTLD_GLOBAL);
+}
+
+dynlib_handle_ptr
+dynlib_open_for_eln (const char *path)
+{
return dlopen (path, RTLD_LAZY);
}
diff --git a/src/dynlib.h b/src/dynlib.h
index e20d8891a23..05ba7981226 100644
--- a/src/dynlib.h
+++ b/src/dynlib.h
@@ -24,6 +24,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
typedef void *dynlib_handle_ptr;
dynlib_handle_ptr dynlib_open (const char *path);
+dynlib_handle_ptr dynlib_open_for_eln (const char *path);
int dynlib_close (dynlib_handle_ptr h);
const char *dynlib_error (void);
diff --git a/src/pdumper.c b/src/pdumper.c
index 8f03684df5a..554b53020e0 100644
--- a/src/pdumper.c
+++ b/src/pdumper.c
@@ -5353,7 +5353,7 @@ dump_do_dump_relocation (const uintptr_t dump_base,
their file names through expand-file-name and
decode-coding-string. */
comp_u->file = eln_fname;
- comp_u->handle = dynlib_open (SSDATA (eln_fname));
+ comp_u->handle = dynlib_open_for_eln (SSDATA (eln_fname));
if (!comp_u->handle)
{
fprintf (stderr, "Error using execdir %s:\n",
diff --git a/src/xwidget.c b/src/xwidget.c
index bd64f483377..63ac0555dbb 100644
--- a/src/xwidget.c
+++ b/src/xwidget.c
@@ -149,6 +149,8 @@ fails. */)
if (!EQ (type, Qwebkit))
error ("Bad xwidget type");
+ Frequire (Qxwidget, Qnil, Qnil);
+
struct xwidget *xw = allocate_xwidget ();
Lisp_Object val;
xw->type = type;
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 <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
diff --git a/test/src/sqlite-tests.el b/test/src/sqlite-tests.el
index d1076e481c4..27ba74e9d23 100644
--- a/test/src/sqlite-tests.el
+++ b/test/src/sqlite-tests.el
@@ -184,6 +184,7 @@
(ert-deftest sqlite-load-extension ()
(skip-unless (sqlite-available-p))
+ (skip-unless (fboundp 'sqlite-load-extension))
(let (db)
(setq db (sqlite-open))
(should-error
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-26 01:16:52 +0000