Merge from origin/emacs-26
8ac621b
(origin/emacs-26) Document DEFUN attributes16d0cc7
* etc/NEWS: Add an entry for auth-source-pass.cc1702f
Fix the MSDOS builddaa9e85
Improve warning and error messages7612dd1
Adjust eieio persistence tests for expected failuref0cf4dc
Let eieio-persistent-read read what object-write has written40ad1ff
Handle possible classtype values in eieio-persistent-read4ec935d
Add new tests for eieio persistence47917d8
* lisp/gnus/gnus-cloud.el (gnus-cloud-synced-files): Fix doc ...e32f352
* lisp/ibuf-ext.el (ibuffer-never-search-content-mode): Fix t...5268f30
* doc/lispref/windows.texi (Selecting Windows): Fix a typo.143b485
* doc/lispref/internals.texi (Writing Emacs Primitives): Fix ...4ab4551
Firm up documentation of generalized variablesa5bf099
Improve documentation of Auto-Revert modeed05eaa
Improvements in dired.texi Conflicts: etc/NEWS
This commit is contained in:
commit
0afb436eeb
11 changed files with 249 additions and 66 deletions
|
@ -12,7 +12,8 @@
|
|||
Dired makes an Emacs buffer containing a listing of a directory, and
|
||||
optionally some of its subdirectories as well. You can use the normal
|
||||
Emacs commands to move around in this buffer, and special Dired
|
||||
commands to operate on the listed files.
|
||||
commands to operate on the listed files. Dired works with both local
|
||||
and remote directories.
|
||||
|
||||
The Dired buffer is normally read-only, and inserting text in it is
|
||||
not allowed (however, the Wdired mode allows that, @pxref{Wdired}).
|
||||
|
@ -109,8 +110,9 @@ default) means to perform the check; any other non-@code{nil} value
|
|||
means to use the @samp{--dired} option; and @code{nil} means not to
|
||||
use the @samp{--dired} option.
|
||||
|
||||
On MS-Windows and MS-DOS systems, Emacs emulates @command{ls}.
|
||||
@xref{ls in Lisp}, for options and peculiarities of this emulation.
|
||||
On MS-Windows and MS-DOS systems, and also on some remote systems,
|
||||
Emacs emulates @command{ls}. @xref{ls in Lisp}, for options and
|
||||
peculiarities of this emulation.
|
||||
|
||||
@findex dired-other-window
|
||||
@kindex C-x 4 d
|
||||
|
@ -131,10 +133,13 @@ deletes its window if the window was created just for that buffer.
|
|||
|
||||
@kindex C-n @r{(Dired)}
|
||||
@kindex C-p @r{(Dired)}
|
||||
@findex dired-next-line
|
||||
@findex dired-previous-line
|
||||
All the usual Emacs cursor motion commands are available in Dired
|
||||
buffers. The keys @kbd{C-n} and @kbd{C-p} are redefined to put the
|
||||
cursor at the beginning of the file name on the line, rather than at
|
||||
the beginning of the line.
|
||||
buffers. The keys @kbd{C-n} and @kbd{C-p} are redefined to run
|
||||
@code{dired-next-line} and @code{dired-previous-line}, respectively,
|
||||
and they put the cursor at the beginning of the file name on the line,
|
||||
rather than at the beginning of the line.
|
||||
|
||||
@kindex SPC @r{(Dired)}
|
||||
For extra convenience, @key{SPC} and @kbd{n} in Dired are equivalent
|
||||
|
@ -235,10 +240,11 @@ the buffer, and no files actually deleted.
|
|||
You can delete empty directories just like other files, but normally
|
||||
Dired cannot delete directories that are nonempty. If the variable
|
||||
@code{dired-recursive-deletes} is non-@code{nil}, then Dired can
|
||||
delete nonempty directories including all their contents. That can
|
||||
be somewhat risky.
|
||||
Even if you have set @code{dired-recursive-deletes} to @code{nil},
|
||||
you might want sometimes to delete recursively directories
|
||||
delete nonempty directories including all their contents. That can be
|
||||
somewhat risky. If the value of the variable is @code{always}, Dired
|
||||
will delete nonempty directories recursively, which is even more
|
||||
risky. Even if you have set @code{dired-recursive-deletes} to
|
||||
@code{nil}, you might want sometimes to delete recursively directories
|
||||
without being asked for confirmation for all of them. This is handy
|
||||
when you have marked many directories for deletion and you are very
|
||||
sure that all of them can safely be deleted. For every nonempty
|
||||
|
@ -252,6 +258,9 @@ questions.
|
|||
directories into the operating system's Trash, instead of deleting
|
||||
them outright. @xref{Misc File Ops}.
|
||||
|
||||
An alternative way of deleting files is to mark them with @kbd{m}
|
||||
and delete with @kbd{D}, see @ref{Operating on Files}.
|
||||
|
||||
@node Flagging Many Files
|
||||
@section Flagging Many Files at Once
|
||||
@cindex flagging many files for deletion (in Dired)
|
||||
|
@ -420,7 +429,9 @@ Mark the current file with @samp{*} (@code{dired-mark}). If the
|
|||
region is active, mark all files in the region instead; otherwise, if
|
||||
a numeric argument @var{n} is supplied, mark the next @var{n} files
|
||||
instead, starting with the current file (if @var{n} is negative, mark
|
||||
the previous @minus{}@var{n} files).
|
||||
the previous @minus{}@var{n} files). If invoked on a subdirectory
|
||||
header line (@pxref{Subdirectories in Dired}), this command marks all
|
||||
the files in that subdirectory.
|
||||
|
||||
@item * *
|
||||
@kindex * * @r{(Dired)}
|
||||
|
@ -578,10 +589,10 @@ command will look in the buffer without revisiting the file, so the results
|
|||
might be inconsistent with the file on disk if its contents have changed
|
||||
since it was last visited. If you don't want this, you may wish to
|
||||
revert the files you have visited in your buffers, or to turn on
|
||||
@code{auto-revert} mode in those buffers, before invoking this
|
||||
command. @xref{Reverting}. If you prefer that this command should always
|
||||
Auto-Revert mode in those buffers, before invoking this command.
|
||||
@xref{Reverting}. If you prefer that this command should always
|
||||
revisit the file, without you having to revert the file or enable
|
||||
@code{auto-revert} mode, you might want to set
|
||||
Auto-Revert mode, you might want to set
|
||||
@code{dired-always-read-filesystem} to non-@code{nil}.
|
||||
|
||||
@item C-/
|
||||
|
@ -766,7 +777,9 @@ suitable guess made using the variables @code{lpr-command} and
|
|||
@item Z
|
||||
Compress the specified files (@code{dired-do-compress}). If the file
|
||||
appears to be a compressed file already, uncompress it instead. Each
|
||||
marked file is compressed into its own archive.
|
||||
marked file is compressed into its own archive. This uses the
|
||||
@command{gzip} program if it is available, otherwise it uses
|
||||
@command{compress}.
|
||||
|
||||
@findex dired-do-compress-to
|
||||
@kindex c @r{(Dired)}
|
||||
|
@ -1048,6 +1061,9 @@ minibuffer is the file at the mark (i.e., the ordinary Emacs mark,
|
|||
not a Dired mark; @pxref{Setting Mark}). Otherwise, if the file at
|
||||
point has a backup file (@pxref{Backup}), that is the default.
|
||||
|
||||
You could also compare files using @code{ediff-files}, see
|
||||
@ref{Major Entry Points,,, ediff, Ediff User's Manual}.
|
||||
|
||||
@node Subdirectories in Dired
|
||||
@section Subdirectories in Dired
|
||||
@cindex subdirectories in Dired
|
||||
|
@ -1476,7 +1492,7 @@ space.
|
|||
each marked file. With just @kbd{C-u} as the prefix argument, it uses
|
||||
file names relative to the Dired buffer's default directory. (This
|
||||
can still contain slashes if in a subdirectory.) As a special case,
|
||||
if point is on a directory headerline, @kbd{w} gives you the absolute
|
||||
if point is on a directory header line, @kbd{w} gives you the absolute
|
||||
name of that directory. Any prefix argument or marked files are
|
||||
ignored in this case.
|
||||
|
||||
|
|
|
@ -991,6 +991,9 @@ Auto-Revert Tail mode works also for remote files.
|
|||
When a buffer is auto-reverted, a message is generated. This can be
|
||||
suppressed by setting @code{auto-revert-verbose} to @code{nil}.
|
||||
|
||||
In Dired buffers (@pxref{Dired}), Auto-Revert mode refreshes the
|
||||
buffer when a file is created or deleted in the buffer's directory.
|
||||
|
||||
@xref{VC Undo}, for commands to revert to earlier versions of files
|
||||
under version control. @xref{VC Mode Line}, for Auto Revert
|
||||
peculiarities when visiting files under version control.
|
||||
|
|
|
@ -735,7 +735,7 @@ Lisp form. For example:
|
|||
|
||||
@example
|
||||
@group
|
||||
DEFUN ("foo", Ffoo, Sfoo, 0, UNEVALLED,
|
||||
DEFUN ("foo", Ffoo, Sfoo, 0, UNEVALLED, 0
|
||||
"(list (read-char-by-name \"Insert character: \")\
|
||||
(prefix-numeric-value current-prefix-arg)\
|
||||
t))",
|
||||
|
@ -768,6 +768,43 @@ the actual documentation. The others have placeholders beginning with
|
|||
All the usual rules for documentation strings in Lisp code
|
||||
(@pxref{Documentation Tips}) apply to C code documentation strings
|
||||
too.
|
||||
|
||||
The documentation string can be followed by a list of C function
|
||||
attributes for the C function that implements the primitive, like
|
||||
this:
|
||||
|
||||
@example
|
||||
@group
|
||||
DEFUN ("bar", Fbar, Sbar, 0, UNEVALLED, 0
|
||||
doc: /* @dots{} /*
|
||||
attributes: @var{attr1} @var{attr2} @dots{})
|
||||
@end group
|
||||
@end example
|
||||
|
||||
@noindent
|
||||
You can specify more than a single attribute, one after the other.
|
||||
Currently, only the following attributes are recognized:
|
||||
|
||||
@table @code
|
||||
@item noreturn
|
||||
Declares the C function as one that never returns. This corresponds
|
||||
to the C11 keyword @code{_Noreturn} and to @w{@code{__attribute__
|
||||
((__noreturn__))}} attribute of GCC (@pxref{Function Attributes,,,
|
||||
gcc, Using the GNU Compiler Collection}).
|
||||
|
||||
@item const
|
||||
Declares that the function does not examine any values except its
|
||||
arguments, and has no effects except the return value. This
|
||||
corresponds to @w{@code{__attribute__ ((__const__))}} attribute of
|
||||
GCC.
|
||||
|
||||
@item noinline
|
||||
This corresponds to @w{@code{__attribute__ ((__noinline__))}}
|
||||
attribute of GCC, which prevents the function from being considered
|
||||
for inlining. This might be needed, e.g., to countermand effects of
|
||||
link-time optimizations on stack-based variables.
|
||||
@end table
|
||||
|
||||
@end table
|
||||
|
||||
After the call to the @code{DEFUN} macro, you must write the
|
||||
|
@ -850,7 +887,7 @@ defined with @code{DEFVAR_BOOL} are automatically added to the list
|
|||
@code{byte-boolean-vars} used by the byte compiler.
|
||||
|
||||
@cindex defining customization variables in C
|
||||
If you want to make a Lisp variables that is defined in C behave
|
||||
If you want to make a Lisp variable that is defined in C behave
|
||||
like one declared with @code{defcustom}, add an appropriate entry to
|
||||
@file{cus-start.el}.
|
||||
|
||||
|
|
|
@ -2317,11 +2317,12 @@ Attempting to assign them any other value will result in an error:
|
|||
|
||||
@cindex generalized variable
|
||||
@cindex place form
|
||||
A @dfn{generalized variable} or @dfn{place form} is one of the many places
|
||||
in Lisp memory where values can be stored. The simplest place form is
|
||||
a regular Lisp variable. But the @sc{car}s and @sc{cdr}s of lists, elements
|
||||
of arrays, properties of symbols, and many other locations are also
|
||||
places where Lisp values are stored.
|
||||
A @dfn{generalized variable} or @dfn{place form} is one of the many
|
||||
places in Lisp memory where values can be stored using the @code{setf}
|
||||
macro (@pxref{Setting Generalized Variables}). The simplest place
|
||||
form is a regular Lisp variable. But the @sc{car}s and @sc{cdr}s of
|
||||
lists, elements of arrays, properties of symbols, and many other
|
||||
locations are also places where Lisp values get stored.
|
||||
|
||||
Generalized variables are analogous to lvalues in the C
|
||||
language, where @samp{x = a[i]} gets an element from an array
|
||||
|
@ -2342,8 +2343,8 @@ variables. The @code{setf} form is like @code{setq}, except that it
|
|||
accepts arbitrary place forms on the left side rather than just
|
||||
symbols. For example, @code{(setf (car a) b)} sets the car of
|
||||
@code{a} to @code{b}, doing the same operation as @code{(setcar a b)},
|
||||
but without having to remember two separate functions for setting and
|
||||
accessing every type of place.
|
||||
but without you having to use two separate functions for setting and
|
||||
accessing this type of place.
|
||||
|
||||
@defmac setf [place form]@dots{}
|
||||
This macro evaluates @var{form} and stores it in @var{place}, which
|
||||
|
@ -2353,18 +2354,19 @@ just as with @code{setq}. @code{setf} returns the value of the last
|
|||
@var{form}.
|
||||
@end defmac
|
||||
|
||||
The following Lisp forms will work as generalized variables, and
|
||||
so may appear in the @var{place} argument of @code{setf}:
|
||||
The following Lisp forms are the forms in Emacs that will work as
|
||||
generalized variables, and so may appear in the @var{place} argument
|
||||
of @code{setf}:
|
||||
|
||||
@itemize
|
||||
@item
|
||||
A symbol naming a variable. In other words, @code{(setf x y)} is
|
||||
exactly equivalent to @code{(setq x y)}, and @code{setq} itself is
|
||||
strictly speaking redundant given that @code{setf} exists. Many
|
||||
programmers continue to prefer @code{setq} for setting simple
|
||||
variables, though, purely for stylistic or historical reasons.
|
||||
The macro @code{(setf x y)} actually expands to @code{(setq x y)},
|
||||
so there is no performance penalty for using it in compiled code.
|
||||
A symbol. In other words, @code{(setf x y)} is exactly equivalent to
|
||||
@code{(setq x y)}, and @code{setq} itself is strictly speaking
|
||||
redundant given that @code{setf} exists. Most programmers will
|
||||
continue to prefer @code{setq} for setting simple variables, though,
|
||||
for stylistic and historical reasons. The macro @code{(setf x y)}
|
||||
actually expands to @code{(setq x y)}, so there is no performance
|
||||
penalty for using it in compiled code.
|
||||
|
||||
@item
|
||||
A call to any of the following standard Lisp functions:
|
||||
|
|
|
@ -1772,7 +1772,7 @@ raise the frame or make sure input focus is directed to that frame.
|
|||
@end defun
|
||||
|
||||
@cindex select window hook
|
||||
@cindex running a hook when a windows gets selected
|
||||
@cindex running a hook when a window gets selected
|
||||
For historical reasons, Emacs does not run a separate hook whenever a
|
||||
window gets selected. Applications and internal routines often
|
||||
temporarily select a window to perform a few actions on it. They do
|
||||
|
|
|
@ -1274,6 +1274,10 @@ specialized for editing freedesktop.org desktop entries.
|
|||
** New major mode 'less-css-mode' (a minor variant of 'css-mode') for
|
||||
editing Less files.
|
||||
|
||||
+++
|
||||
** New package 'auth-source-pass' integrates 'auth-source' with the
|
||||
password manager password-store (http://passwordstore.org).
|
||||
|
||||
|
||||
* Incompatible Lisp Changes in Emacs 26.1
|
||||
|
||||
|
|
|
@ -219,7 +219,7 @@ for CLASS. Optional ALLOW-SUBCLASS says that it is ok for
|
|||
`eieio-persistent-read' to load in subclasses of class instead of
|
||||
being pedantic."
|
||||
(unless class
|
||||
(message "Unsafe call to `eieio-persistent-read'."))
|
||||
(warn "`eieio-persistent-read' called without specifying a class"))
|
||||
(when class (cl-check-type class class))
|
||||
(let ((ret nil)
|
||||
(buffstr nil))
|
||||
|
@ -234,13 +234,16 @@ being pedantic."
|
|||
;; the current buffer will work.
|
||||
(setq ret (read buffstr))
|
||||
(when (not (child-of-class-p (car ret) 'eieio-persistent))
|
||||
(error "Corrupt object on disk: Unknown saved object"))
|
||||
(error
|
||||
"Invalid object: %s is not a subclass of `eieio-persistent'"
|
||||
(car ret)))
|
||||
(when (and class
|
||||
(not (or (eq (car ret) class ) ; same class
|
||||
(and allow-subclass
|
||||
(child-of-class-p (car ret) class)) ; subclasses
|
||||
)))
|
||||
(error "Corrupt object on disk: Invalid saved class"))
|
||||
(not (or (eq (car ret) class) ; same class
|
||||
(and allow-subclass ; subclass
|
||||
(child-of-class-p (car ret) class)))))
|
||||
(error
|
||||
"Invalid object: %s is not an object of class %s nor a subclass"
|
||||
(car ret) class))
|
||||
(setq ret (eieio-persistent-convert-list-to-object ret))
|
||||
(oset ret file filename))
|
||||
(kill-buffer " *tmp eieio read*"))
|
||||
|
@ -332,7 +335,8 @@ Second, any text properties will be stripped from strings."
|
|||
;; We have a predicate, but it doesn't satisfy the predicate?
|
||||
(dolist (PV (cdr proposed-value))
|
||||
(unless (child-of-class-p (car PV) (car classtype))
|
||||
(error "Corrupt object on disk")))
|
||||
(error "Invalid object: slot member %s does not match class %s"
|
||||
(car PV) (car classtype))))
|
||||
|
||||
;; We have a list of objects here. Lets load them
|
||||
;; in.
|
||||
|
@ -349,7 +353,7 @@ Second, any text properties will be stripped from strings."
|
|||
(seq-some
|
||||
(lambda (elt)
|
||||
(child-of-class-p (car proposed-value) elt))
|
||||
classtype))
|
||||
(if (listp classtype) classtype (list classtype))))
|
||||
(eieio-persistent-convert-list-to-object
|
||||
proposed-value))
|
||||
(t
|
||||
|
@ -360,19 +364,28 @@ Second, any text properties will be stripped from strings."
|
|||
((hash-table-p proposed-value)
|
||||
(maphash
|
||||
(lambda (key value)
|
||||
(when (class-p (car-safe value))
|
||||
(setf (gethash key proposed-value)
|
||||
(eieio-persistent-convert-list-to-object
|
||||
value))))
|
||||
(cond ((class-p (car-safe value))
|
||||
(setf (gethash key proposed-value)
|
||||
(eieio-persistent-convert-list-to-object
|
||||
value)))
|
||||
((and (consp value)
|
||||
(eq (car value) 'quote))
|
||||
(setf (gethash key proposed-value)
|
||||
(cadr value)))))
|
||||
proposed-value)
|
||||
proposed-value)
|
||||
|
||||
((vectorp proposed-value)
|
||||
(dotimes (i (length proposed-value))
|
||||
(when (class-p (car-safe (aref proposed-value i)))
|
||||
(aset proposed-value i
|
||||
(eieio-persistent-convert-list-to-object
|
||||
(aref proposed-value i)))))
|
||||
(let ((val (aref proposed-value i)))
|
||||
(cond ((class-p (car-safe val))
|
||||
(aset proposed-value i
|
||||
(eieio-persistent-convert-list-to-object
|
||||
(aref proposed-value i))))
|
||||
((and (consp val)
|
||||
(eq (car val) 'quote))
|
||||
(aset proposed-value i
|
||||
(cadr val))))))
|
||||
proposed-value)
|
||||
|
||||
((stringp proposed-value)
|
||||
|
|
|
@ -48,10 +48,14 @@
|
|||
"~/.authinfo.gpg"
|
||||
"~/.gnus.el"
|
||||
(:directory "~/News" :match ".*.SCORE\\'"))
|
||||
"List of file regexps that should be kept up-to-date via the cloud."
|
||||
"List of files that should be kept up-to-date via the cloud.
|
||||
Each element may be either a string or a property list.
|
||||
The latter should have a :directory element whose value is a string,
|
||||
and a :match element whose value is a regular expression to match
|
||||
against the basename of files in said directory."
|
||||
:group 'gnus-cloud
|
||||
;; FIXME this type does not match the default. Nor does the documentation.
|
||||
:type '(repeat regexp))
|
||||
:type '(repeat (choice (string :tag "File")
|
||||
(plist :tag "Property list"))))
|
||||
|
||||
(defcustom gnus-cloud-storage-method (if (featurep 'epg) 'epg 'base64-gzip)
|
||||
"Storage method for cloud data, defaults to EPG if that's available."
|
||||
|
@ -290,6 +294,8 @@ Use old data if FORCE-OLDER is not nil."
|
|||
(dolist (elem gnus-cloud-synced-files)
|
||||
(cond
|
||||
((stringp elem)
|
||||
;; This seems fragile. String comparison, with no
|
||||
;; expand-file-name to resolve ~, etc.
|
||||
(when (equal elem file-name)
|
||||
(setq matched t)))
|
||||
((consp elem)
|
||||
|
|
|
@ -114,7 +114,7 @@ Buffers whose name matches a regexp in this list, are not searched."
|
|||
"A list of major modes ignored by `ibuffer-mark-by-content-regexp'.
|
||||
Buffers whose major mode is in this list, are not searched."
|
||||
:version "26.1"
|
||||
:type '(repeat regexp)
|
||||
:type '(repeat (symbol :tag "Major mode"))
|
||||
:require 'ibuf-ext
|
||||
:group 'ibuffer)
|
||||
|
||||
|
|
|
@ -32,6 +32,7 @@
|
|||
/^#undef DOS_NT *$/s/^.*$/#define DOS_NT/
|
||||
/^#undef FLOAT_CHECK_DOMAIN *$/s/^.*$/#define FLOAT_CHECK_DOMAIN/
|
||||
/^#undef HAVE_ALLOCA *$/s/^.*$/#define HAVE_ALLOCA 1/
|
||||
/^#undef HAVE_SBRK *$/s/^.*$/#define HAVE_SBRK 1/
|
||||
/^#undef HAVE_SETITIMER *$/s/^.*$/#define HAVE_SETITIMER 1/
|
||||
/^#undef HAVE_STRUCT_UTIMBUF *$/s/^.*$/#define HAVE_STRUCT_UTIMBUF 1/
|
||||
/^#undef LOCALTIME_CACHE *$/s/^.*$/#define LOCALTIME_CACHE 1/
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
;;; eieio-persist.el --- Tests for eieio-persistent class
|
||||
;;; eieio-test-persist.el --- Tests for eieio-persistent class
|
||||
|
||||
;; Copyright (C) 2011-2018 Free Software Foundation, Inc.
|
||||
|
||||
|
@ -40,6 +40,17 @@ This is usually a symbol that starts with `:'."
|
|||
(car tuple)
|
||||
nil)))
|
||||
|
||||
(defun hash-equal (hash1 hash2)
|
||||
"Compare two hash tables to see whether they are equal."
|
||||
(and (= (hash-table-count hash1)
|
||||
(hash-table-count hash2))
|
||||
(catch 'flag
|
||||
(maphash (lambda (x y)
|
||||
(or (equal (gethash x hash2) y)
|
||||
(throw 'flag nil)))
|
||||
hash1)
|
||||
(throw 'flag t))))
|
||||
|
||||
(defun persist-test-save-and-compare (original)
|
||||
"Compare the object ORIGINAL against the one read fromdisk."
|
||||
|
||||
|
@ -49,8 +60,8 @@ This is usually a symbol that starts with `:'."
|
|||
(class (eieio-object-class original))
|
||||
(fromdisk (eieio-persistent-read file class))
|
||||
(cv (cl--find-class class))
|
||||
(slots (eieio--class-slots cv))
|
||||
)
|
||||
(slots (eieio--class-slots cv)))
|
||||
|
||||
(unless (object-of-class-p fromdisk class)
|
||||
(error "Persistent class %S != original class %S"
|
||||
(eieio-object-class fromdisk)
|
||||
|
@ -62,18 +73,24 @@ This is usually a symbol that starts with `:'."
|
|||
(origvalue (eieio-oref original oneslot))
|
||||
(fromdiskvalue (eieio-oref fromdisk oneslot))
|
||||
(initarg-p (eieio--attribute-to-initarg
|
||||
(cl--find-class class) oneslot))
|
||||
)
|
||||
(cl--find-class class) oneslot)))
|
||||
|
||||
(if initarg-p
|
||||
(unless (equal origvalue fromdiskvalue)
|
||||
(unless
|
||||
(cond ((and (hash-table-p origvalue) (hash-table-p fromdiskvalue))
|
||||
(hash-equal origvalue fromdiskvalue))
|
||||
(t (equal origvalue fromdiskvalue)))
|
||||
(error "Slot %S Original Val %S != Persistent Val %S"
|
||||
oneslot origvalue fromdiskvalue))
|
||||
;; Else !initarg-p
|
||||
(unless (equal (cl--slot-descriptor-initform slot) fromdiskvalue)
|
||||
(let ((origval (cl--slot-descriptor-initform slot))
|
||||
(diskval fromdiskvalue))
|
||||
(unless
|
||||
(cond ((and (hash-table-p origval) (hash-table-p diskval))
|
||||
(hash-equal origval diskval))
|
||||
(t (equal origval diskval)))
|
||||
(error "Slot %S Persistent Val %S != Default Value %S"
|
||||
oneslot fromdiskvalue (cl--slot-descriptor-initform slot))))
|
||||
))))
|
||||
oneslot diskval origvalue))))))))
|
||||
|
||||
;;; Simple Case
|
||||
;;
|
||||
|
@ -203,13 +220,16 @@ persistent class.")
|
|||
((slot1 :initarg :slot1
|
||||
:type (or persistent-random-class null persist-not-persistent))
|
||||
(slot2 :initarg :slot2
|
||||
:type (or persist-not-persistent persist-random-class null))))
|
||||
:type (or persist-not-persistent persistent-random-class null))
|
||||
(slot3 :initarg :slot3
|
||||
:type persistent-random-class)))
|
||||
|
||||
(ert-deftest eieio-test-multiple-class-slot ()
|
||||
(let ((persist
|
||||
(persistent-multiclass-slot
|
||||
:slot1 (persistent-random-class)
|
||||
:slot2 (persist-not-persistent)
|
||||
:slot3 (persistent-random-class)
|
||||
:file (concat default-directory "test-ps5.pt"))))
|
||||
(unwind-protect
|
||||
(persist-test-save-and-compare persist)
|
||||
|
@ -235,4 +255,85 @@ persistent class.")
|
|||
(persist-test-save-and-compare persist-wols)
|
||||
(delete-file (oref persist-wols file))))
|
||||
|
||||
;;; Tests targeted at popular libraries in the wild.
|
||||
|
||||
;; Objects inside hash tables and vectors (pcache), see bug#29220.
|
||||
(defclass person ()
|
||||
((name :type string :initarg :name)))
|
||||
|
||||
(defclass classy (eieio-persistent)
|
||||
((teacher
|
||||
:type person
|
||||
:initarg :teacher)
|
||||
(students
|
||||
:initarg :students :initform (make-hash-table :test 'equal))
|
||||
(janitors
|
||||
:type list
|
||||
:initarg :janitors)
|
||||
(random-vector
|
||||
:type vector
|
||||
:initarg :random-vector)))
|
||||
|
||||
(ert-deftest eieio-test-persist-hash-and-vector ()
|
||||
(let* ((jane (make-instance 'person :name "Jane"))
|
||||
(bob (make-instance 'person :name "Bob"))
|
||||
(hans (make-instance 'person :name "Hans"))
|
||||
(dierdre (make-instance 'person :name "Dierdre"))
|
||||
(class (make-instance 'classy
|
||||
:teacher jane
|
||||
:janitors (list [tuesday nil]
|
||||
[friday nil])
|
||||
:random-vector [nil]
|
||||
:file (concat default-directory "classy-" emacs-version ".eieio"))))
|
||||
(puthash "Bob" bob (slot-value class 'students))
|
||||
(aset (slot-value class 'random-vector) 0
|
||||
(make-instance 'persistent-random-class))
|
||||
(unwind-protect
|
||||
(persist-test-save-and-compare class)
|
||||
(delete-file (oref class file)))
|
||||
(aset (car (slot-value class 'janitors)) 1 hans)
|
||||
(aset (nth 1 (slot-value class 'janitors)) 1 dierdre)
|
||||
(unwind-protect
|
||||
;; FIXME: This should not error.
|
||||
(should-error (persist-test-save-and-compare class))
|
||||
(delete-file (oref class file)))))
|
||||
|
||||
;; Extra quotation of lists inside other objects (Gnus registry), also
|
||||
;; bug#29220.
|
||||
|
||||
(defclass eieio-container (eieio-persistent)
|
||||
((alist
|
||||
:initarg :alist
|
||||
:type list)
|
||||
(vec
|
||||
:initarg :vec
|
||||
:type vector)
|
||||
(htab
|
||||
:initarg :htab
|
||||
:type hash-table)))
|
||||
|
||||
(ert-deftest eieio-test-persist-interior-lists ()
|
||||
(let* ((thing (make-instance
|
||||
'eieio-container
|
||||
:vec [nil]
|
||||
:htab (make-hash-table :test #'equal)
|
||||
:file (concat default-directory
|
||||
"container-" emacs-version ".eieio")))
|
||||
(john (make-instance 'person :name "John"))
|
||||
(alexie (make-instance 'person :name "Alexie"))
|
||||
(alst '(("first" (one two three))
|
||||
("second" (four five six)))))
|
||||
(setf (slot-value thing 'alist) alst)
|
||||
(puthash "alst" alst (slot-value thing 'htab))
|
||||
(aset (slot-value thing 'vec) 0 alst)
|
||||
(unwind-protect
|
||||
(persist-test-save-and-compare thing)
|
||||
(delete-file (slot-value thing 'file)))
|
||||
(setf (nth 2 (cadar alst)) john
|
||||
(nth 2 (cadadr alst)) alexie)
|
||||
(unwind-protect
|
||||
;; FIXME: Should not error.
|
||||
(should-error (persist-test-save-and-compare thing))
|
||||
(delete-file (slot-value thing 'file)))))
|
||||
|
||||
;;; eieio-test-persist.el ends here
|
||||
|
|
Loading…
Add table
Reference in a new issue