Merge remote-tracking branch 'origin/master' into feature/pgtk
This commit is contained in:
Po Lu
commit
32b9b22f66
18 changed files with 976 additions and 105 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,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
|
||||
|
|
|
|||
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
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
439
lisp/emacs-lisp/multisession.el
Normal file
439
lisp/emacs-lisp/multisession.el
Normal file
|
|
@ -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
|
||||
|
|
@ -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."
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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."
|
||||
|
|
|
|||
18
lisp/ses.el
18
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))
|
||||
|
|
|
|||
|
|
@ -70,12 +70,16 @@
|
|||
("tabwindow" ?f nil nil 1)))
|
||||
|
||||
(rotating "Sidewaysfigure and table"
|
||||
(("sidewaysfigure" ?f nil nil caption)
|
||||
("sidewaystable" ?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 "CSfigure and SCtable"
|
||||
(("SCfigure" ?f nil nil caption)
|
||||
("SCtable" ?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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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,
|
||||
|
|
|
|||
12
src/dynlib.c
12
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)
|
||||
{
|
||||
|
|
@ -269,6 +275,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);
|
||||
}
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
||||
|
|
|
|||
|
|
@ -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",
|
||||
|
|
|
|||
|
|
@ -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;
|
||||
|
|
|
|||
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
|
||||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue