Allow plist-get/plist-put/plist-member to take a comparison function

* doc/lispref/lists.texi (Plist Access): Document it.

* lisp/filesets.el (filesets-reset-fileset)
(filesets-ingroup-cache-get):
(filesets-ingroup-cache-put):
(filesets-build-menu-now): Don't use lax-plist functions.

* lisp/simple.el (lax-plist-put, lax-plist-get): Moved here from
fns.c and make obsolete.

* lisp/emacs-lisp/byte-opt.el (side-effect-free-fns): Don't mark
plist functions as side-effect-free or pure.

* lisp/emacs-lisp/comp.el (comp-known-type-specifiers): Adjust type.

* lisp/emacs-lisp/shortdoc.el (list): Don't document deprecated
functions.

* src/xdisp.c (build_desired_tool_bar_string):
(display_mode_element):
(store_mode_line_string):
(display_string):
(produce_stretch_glyph):
(note_mode_line_or_margin_highlight):
(note_mouse_highlight):
* src/w32.c (serial_configure):
* src/sysdep.c (serial_configure):
* src/sound.c (parse_sound):
* src/process.c (Fset_process_buffer):
(Fset_process_sentinel):
(Fprocess_contact):
(Fmake_process):
(Fmake_pipe_process):
(Fset_network_process_option):
(Fserial_process_configure):
(Fmake_serial_process):
(set_network_socket_coding_system):
(finish_after_tls_connection):
(connect_network_socket):
(Fmake_network_process):
(server_accept_connection):
* src/lread.c (ADDPARAM):
(hash_table_from_plist):
* src/keyboard.c (make_lispy_position):
* src/indent.c (check_display_width):
* src/image.c (postprocess_image):
* src/gnutls.c (gnutls_verify_boot):
(Fgnutls_boot):
(gnutls_symmetric):
(Fgnutls_hash_mac):
(Fgnutls_hash_digest):
* src/dired.c (filter):
* src/data.c (add_to_function_history):
* src/coding.c (Fcoding_system_put): Adjust callers from
Fplist_put (etc) to plist_put.

* src/fns.c (plist_get):
(plist_put):
(plist_member): New functions (without optional third parameter)
to be used in C code.

* src/fns.c (Fplist_get, Fplist_put, Fplist_member): Take an
optional predicate parameter (bug#47425).

* src/lisp.h: Declare new plist_put, plist_get and plist_member
functions.

* test/lisp/json-tests.el (test-json-add-to-plist): Use plist-get.

* test/src/fns-tests.el (test-cycle-lax-plist-get):
(test-cycle-lax-plist-put):
(lax-plist-get/odd-number-of-elements):
(test-plist): Remove lax-plist tests, since semantics have changed
(they no longer error out on cycles).
This commit is contained in:
Lars Ingebrigtsen 2022-06-27 12:22:05 +02:00
parent 5b1bb1af03
commit 513acdc9b4
28 changed files with 334 additions and 345 deletions

View file

@ -1925,9 +1925,10 @@ and later discarded; this is not possible with a property list.
The following functions can be used to manipulate property lists.
They all compare property names using @code{eq}.
@defun plist-get plist property
@defun plist-get plist property &optional predicate
This returns the value of the @var{property} property stored in the
property list @var{plist}. It accepts a malformed @var{plist}
property list @var{plist}. Comparisons are done with @var{predicate},
and defaults to @code{eq}. It accepts a malformed @var{plist}
argument. If @var{property} is not found in the @var{plist}, it
returns @code{nil}. For example,
@ -1943,9 +1944,10 @@ returns @code{nil}. For example,
@end example
@end defun
@defun plist-put plist property value
@defun plist-put plist property value &optional predicate
This stores @var{value} as the value of the @var{property} property in
the property list @var{plist}. It may modify @var{plist} destructively,
the property list @var{plist}. Comparisons are done with @var{predicate},
and defaults to @code{eq}. It may modify @var{plist} destructively,
or it may construct a new list structure without altering the old. The
function returns the modified property list, so you can store that back
in the place where you got @var{plist}. For example,
@ -1961,19 +1963,20 @@ in the place where you got @var{plist}. For example,
@end defun
@defun lax-plist-get plist property
Like @code{plist-get} except that it compares properties
using @code{equal} instead of @code{eq}.
This obsolete function is like @code{plist-get} except that it
compares properties using @code{equal} instead of @code{eq}.
@end defun
@defun lax-plist-put plist property value
Like @code{plist-put} except that it compares properties
using @code{equal} instead of @code{eq}.
This obsolete function is like @code{plist-put} except that it
compares properties using @code{equal} instead of @code{eq}.
@end defun
@defun plist-member plist property
@defun plist-member plist property &optional predicate
This returns non-@code{nil} if @var{plist} contains the given
@var{property}. Unlike @code{plist-get}, this allows you to distinguish
between a missing property and a property with the value @code{nil}.
The value is actually the tail of @var{plist} whose @code{car} is
@var{property}.
@var{property}. Comparisons are done with @var{predicate}, and
defaults to @code{eq}. Unlike @code{plist-get}, this allows you to
distinguish between a missing property and a property with the value
@code{nil}. The value is actually the tail of @var{plist} whose
@code{car} is @var{property}.
@end defun

View file

@ -2150,6 +2150,10 @@ patcomp.el, pc-mode.el, pc-select.el, s-region.el, and sregex.el.
* Lisp Changes in Emacs 29.1
+++
** 'plist-get', 'plist-put' and 'plist-member' are no longer limited to 'eq'.
These function now take an optional comparison predicate argument.
+++
** 'read-multiple-choice' can now use long-form answers.

View file

@ -1361,7 +1361,7 @@ See Info node `(elisp) Integer Basics'."
match-beginning match-end
member memq memql min minibuffer-selected-window minibuffer-window
mod multibyte-char-to-unibyte next-window nth nthcdr number-to-string
parse-colon-path plist-get plist-member
parse-colon-path
prefix-numeric-value previous-window prin1-to-string propertize
degrees-to-radians
radians-to-degrees rassq rassoc read-from-string regexp-opt
@ -1483,7 +1483,7 @@ See Info node `(elisp) Integer Basics'."
;; `assoc' and `assoc-default' are excluded since they are
;; impure if the test function is (consider `string-match').
assq rassq rassoc
plist-get lax-plist-get plist-member
lax-plist-get
aref elt
base64-decode-string base64-encode-string base64url-encode-string
bool-vector-subsetp

View file

@ -475,8 +475,8 @@ Useful to hook into pass checkers.")
(one-window-p (function (&optional t t) boolean))
(overlayp (function (t) boolean))
(parse-colon-path (function (string) cons))
(plist-get (function (list t) t))
(plist-member (function (list t) list))
(plist-get (function (list t &optional t) t))
(plist-member (function (list t &optional t) list))
(point (function () integer))
(point-marker (function () marker))
(point-max (function () integer))

View file

@ -691,11 +691,6 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'),
(plist-put
:no-eval (setq plist (plist-put plist 'd 4))
:eq-result (a 1 b 2 c 3 d 4))
(lax-plist-get
:eval (lax-plist-get '("a" 1 "b" 2 "c" 3) "b"))
(lax-plist-put
:no-eval (setq plist (lax-plist-put plist "d" 4))
:eq-result '("a" 1 "b" 2 "c" 3 "d" 4))
(plist-member
:eval (plist-member '(a 1 b 2 c 3) 'b))
"Data About Lists"

View file

@ -208,7 +208,7 @@ COND-FN takes one argument: the current element."
(defun filesets-reset-fileset (&optional fileset no-cache)
"Reset the cached values for one or all filesets."
(setq filesets-submenus (if fileset
(lax-plist-put filesets-submenus fileset nil)
(plist-put filesets-submenus fileset nil #'equal)
nil))
(setq filesets-has-changed-flag t)
(setq filesets-update-cache-file-flag (or filesets-update-cache-file-flag
@ -1999,7 +1999,7 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
(defun filesets-ingroup-cache-get (master)
"Access to `filesets-ingroup-cache'."
(lax-plist-get filesets-ingroup-cache master))
(plist-get filesets-ingroup-cache master #'equal))
(defun filesets-ingroup-cache-put (master file)
"Access to `filesets-ingroup-cache'."
@ -2008,7 +2008,7 @@ LOOKUP-NAME is used as lookup name for retrieving fileset specific settings."
(cons file (filesets-ingroup-cache-get emaster))
nil)))
(setq filesets-ingroup-cache
(lax-plist-put filesets-ingroup-cache emaster this))))
(plist-put filesets-ingroup-cache emaster this #'equal))))
(defun filesets-ingroup-collect-files (fs &optional remdupl-flag master depth)
"Helper function for `filesets-ingroup-collect'. Collect file names."
@ -2305,12 +2305,12 @@ bottom up, set `filesets-submenus' to nil, first.)"
((null data))
(let* ((this (car data))
(name (filesets-data-get-name this))
(cached (lax-plist-get filesets-submenus name))
(cached (plist-get filesets-submenus name #'equal))
(submenu (or cached
(filesets-build-submenu count name this))))
(unless cached
(setq filesets-submenus
(lax-plist-put filesets-submenus name submenu)))
(plist-put filesets-submenus name submenu #'equal)))
(unless (filesets-entry-get-dormant-flag this)
(setq filesets-menu-cache
(append filesets-menu-cache (list submenu))))))

View file

@ -10640,6 +10640,15 @@ If the buffer doesn't exist, create it first."
(string-to-number value)
(intern (concat "sig" (downcase value))))))
(defun lax-plist-get (plist prop)
"Extract a value from a property list, comparing with `equal'."
(declare (obsolete plist-get "29.1"))
(plist-get plist prop #'equal))
(defun lax-plist-put (plist prop val)
"Change value in PLIST of PROP to VAL, comparing with `equal'."
(declare (obsolete plist-put "29.1"))
(plist-put plist prop val #'equal))
(provide 'simple)

View file

@ -11499,7 +11499,7 @@ DEFUN ("coding-system-put", Fcoding_system_put, Scoding_system_put,
}
ASET (attrs, coding_attr_plist,
Fplist_put (CODING_ATTR_PLIST (attrs), prop, val));
plist_put (CODING_ATTR_PLIST (attrs), prop, val));
return val;
}

View file

@ -874,7 +874,7 @@ add_to_function_history (Lisp_Object symbol, Lisp_Object olddef)
if (NILP (XCDR (tail)) && STRINGP (XCAR (tail)))
file = XCAR (tail);
Lisp_Object tem = Fplist_member (past, file);
Lisp_Object tem = plist_member (past, file);
if (!NILP (tem))
{ /* New def from a file used before.
Overwrite the previous record associated with this file. */

View file

@ -482,8 +482,8 @@ file_name_completion (Lisp_Object file, Lisp_Object dirname, bool all_flag,
decoded names in order to filter false positives, such as "a"
falsely matching "a-ring". */
if (!NILP (file_encoding)
&& !NILP (Fplist_get (Fcoding_system_plist (file_encoding),
Qdecomposed_characters)))
&& !NILP (plist_get (Fcoding_system_plist (file_encoding),
Qdecomposed_characters)))
{
check_decoded = true;
if (STRING_MULTIBYTE (file))

153
src/fns.c
View file

@ -2276,17 +2276,37 @@ merge_c (Lisp_Object org_l1, Lisp_Object org_l2, bool (*less) (Lisp_Object, Lisp
/* This does not check for quits. That is safe since it must terminate. */
DEFUN ("plist-get", Fplist_get, Splist_get, 2, 2, 0,
DEFUN ("plist-get", Fplist_get, Splist_get, 2, 3, 0,
doc: /* Extract a value from a property list.
PLIST is a property list, which is a list of the form
\(PROP1 VALUE1 PROP2 VALUE2...).
This function returns the value corresponding to the given PROP, or
nil if PROP is not one of the properties on the list. The comparison
with PROP is done using `eq'.
with PROP is done using PREDICATE, which defaults to `eq'.
This function never signals an error. */)
(Lisp_Object plist, Lisp_Object prop)
This function doesn't signal an error if PLIST is invalid. */)
(Lisp_Object plist, Lisp_Object prop, Lisp_Object predicate)
{
Lisp_Object tail = plist;
if (NILP (predicate))
return plist_get (plist, prop);
FOR_EACH_TAIL_SAFE (tail)
{
if (! CONSP (XCDR (tail)))
break;
if (!NILP (call2 (predicate, prop, XCAR (tail))))
return XCAR (XCDR (tail));
tail = XCDR (tail);
}
return Qnil;
}
/* Faster version of the above that works with EQ only */
Lisp_Object
plist_get (Lisp_Object plist, Lisp_Object prop)
{
Lisp_Object tail = plist;
FOR_EACH_TAIL_SAFE (tail)
@ -2297,7 +2317,6 @@ This function never signals an error. */)
return XCAR (XCDR (tail));
tail = XCDR (tail);
}
return Qnil;
}
@ -2307,25 +2326,55 @@ This is the last value stored with `(put SYMBOL PROPNAME VALUE)'. */)
(Lisp_Object symbol, Lisp_Object propname)
{
CHECK_SYMBOL (symbol);
Lisp_Object propval = Fplist_get (CDR (Fassq (symbol, Voverriding_plist_environment)),
propname);
Lisp_Object propval = plist_get (CDR (Fassq (symbol,
Voverriding_plist_environment)),
propname);
if (!NILP (propval))
return propval;
return Fplist_get (XSYMBOL (symbol)->u.s.plist, propname);
return plist_get (XSYMBOL (symbol)->u.s.plist, propname);
}
DEFUN ("plist-put", Fplist_put, Splist_put, 3, 3, 0,
DEFUN ("plist-put", Fplist_put, Splist_put, 3, 4, 0,
doc: /* Change value in PLIST of PROP to VAL.
PLIST is a property list, which is a list of the form
\(PROP1 VALUE1 PROP2 VALUE2 ...).
The comparison with PROP is done using `eq'.
The comparison with PROP is done using PREDICATE, which defaults to `eq'.
If PROP is already a property on the list, its value is set to VAL,
otherwise the new PROP VAL pair is added. The new plist is returned;
use `(setq x (plist-put x prop val))' to be sure to use the new value.
The PLIST is modified by side effects. */)
(Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
(Lisp_Object plist, Lisp_Object prop, Lisp_Object val, Lisp_Object predicate)
{
Lisp_Object prev = Qnil, tail = plist;
if (NILP (predicate))
return plist_put (plist, prop, val);
FOR_EACH_TAIL (tail)
{
if (! CONSP (XCDR (tail)))
break;
if (!NILP (call2 (predicate, prop, XCAR (tail))))
{
Fsetcar (XCDR (tail), val);
return plist;
}
prev = tail;
tail = XCDR (tail);
}
CHECK_TYPE (NILP (tail), Qplistp, plist);
Lisp_Object newcell
= Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
if (NILP (prev))
return newcell;
Fsetcdr (XCDR (prev), newcell);
return plist;
}
Lisp_Object
plist_put (Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
{
Lisp_Object prev = Qnil, tail = plist;
FOR_EACH_TAIL (tail)
@ -2358,64 +2407,10 @@ It can be retrieved with `(get SYMBOL PROPNAME)'. */)
{
CHECK_SYMBOL (symbol);
set_symbol_plist
(symbol, Fplist_put (XSYMBOL (symbol)->u.s.plist, propname, value));
(symbol, plist_put (XSYMBOL (symbol)->u.s.plist, propname, value));
return value;
}
DEFUN ("lax-plist-get", Flax_plist_get, Slax_plist_get, 2, 2, 0,
doc: /* Extract a value from a property list, comparing with `equal'.
This function is otherwise like `plist-get', but may signal an error
if PLIST isn't a valid plist. */)
(Lisp_Object plist, Lisp_Object prop)
{
Lisp_Object tail = plist;
FOR_EACH_TAIL (tail)
{
if (! CONSP (XCDR (tail)))
break;
if (! NILP (Fequal (prop, XCAR (tail))))
return XCAR (XCDR (tail));
tail = XCDR (tail);
}
CHECK_TYPE (NILP (tail), Qplistp, plist);
return Qnil;
}
DEFUN ("lax-plist-put", Flax_plist_put, Slax_plist_put, 3, 3, 0,
doc: /* Change value in PLIST of PROP to VAL, comparing with `equal'.
PLIST is a property list, which is a list of the form
\(PROP1 VALUE1 PROP2 VALUE2 ...). PROP and VAL are any objects.
If PROP is already a property on the list, its value is set to VAL,
otherwise the new PROP VAL pair is added. The new plist is returned;
use `(setq x (lax-plist-put x prop val))' to be sure to use the new value.
The PLIST is modified by side effects. */)
(Lisp_Object plist, Lisp_Object prop, Lisp_Object val)
{
Lisp_Object prev = Qnil, tail = plist;
FOR_EACH_TAIL (tail)
{
if (! CONSP (XCDR (tail)))
break;
if (! NILP (Fequal (prop, XCAR (tail))))
{
Fsetcar (XCDR (tail), val);
return plist;
}
prev = tail;
tail = XCDR (tail);
}
CHECK_TYPE (NILP (tail), Qplistp, plist);
Lisp_Object newcell = list2 (prop, val);
if (NILP (prev))
return newcell;
Fsetcdr (XCDR (prev), newcell);
return plist;
}
DEFUN ("eql", Feql, Seql, 2, 2, 0,
doc: /* Return t if the two args are `eq' or are indistinguishable numbers.
Integers with the same value are `eql'.
@ -3183,22 +3178,25 @@ FILENAME are suppressed. */)
bottleneck of Widget operation. Here is their translation to C,
for the sole reason of efficiency. */
DEFUN ("plist-member", Fplist_member, Splist_member, 2, 2, 0,
DEFUN ("plist-member", Fplist_member, Splist_member, 2, 3, 0,
doc: /* Return non-nil if PLIST has the property PROP.
PLIST is a property list, which is a list of the form
\(PROP1 VALUE1 PROP2 VALUE2 ...).
The comparison with PROP is done using `eq'.
The comparison with PROP is done using PREDICATE, which defaults to
`eq'.
Unlike `plist-get', this allows you to distinguish between a missing
property and a property with the value nil.
The value is actually the tail of PLIST whose car is PROP. */)
(Lisp_Object plist, Lisp_Object prop)
(Lisp_Object plist, Lisp_Object prop, Lisp_Object predicate)
{
Lisp_Object tail = plist;
if (NILP (predicate))
predicate = Qeq;
FOR_EACH_TAIL (tail)
{
if (EQ (XCAR (tail), prop))
if (!NILP (call2 (predicate, XCAR (tail), prop)))
return tail;
tail = XCDR (tail);
if (! CONSP (tail))
@ -3208,13 +3206,22 @@ The value is actually the tail of PLIST whose car is PROP. */)
return Qnil;
}
/* plist_member isn't used much in the Emacs sources, so just provide
a shim so that the function name follows the same pattern as
plist_get/plist_put. */
Lisp_Object
plist_member (Lisp_Object plist, Lisp_Object prop)
{
return Fplist_member (plist, prop, Qnil);
}
DEFUN ("widget-put", Fwidget_put, Swidget_put, 3, 3, 0,
doc: /* In WIDGET, set PROPERTY to VALUE.
The value can later be retrieved with `widget-get'. */)
(Lisp_Object widget, Lisp_Object property, Lisp_Object value)
{
CHECK_CONS (widget);
XSETCDR (widget, Fplist_put (XCDR (widget), property, value));
XSETCDR (widget, plist_put (XCDR (widget), property, value));
return value;
}
@ -3231,7 +3238,7 @@ later with `widget-put'. */)
if (NILP (widget))
return Qnil;
CHECK_CONS (widget);
tmp = Fplist_member (XCDR (widget), property);
tmp = plist_member (XCDR (widget), property);
if (CONSP (tmp))
{
tmp = XCDR (tmp);
@ -6064,8 +6071,6 @@ The same variable also affects the function `read-answer'. */);
defsubr (&Sget);
defsubr (&Splist_put);
defsubr (&Sput);
defsubr (&Slax_plist_get);
defsubr (&Slax_plist_put);
defsubr (&Seql);
defsubr (&Sequal);
defsubr (&Sequal_including_properties);

View file

@ -1635,10 +1635,10 @@ gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist)
char *c_hostname;
if (NILP (proplist))
proplist = Fcdr (Fplist_get (p->childp, QCtls_parameters));
proplist = Fcdr (plist_get (p->childp, QCtls_parameters));
verify_error = Fplist_get (proplist, QCverify_error);
hostname = Fplist_get (proplist, QChostname);
verify_error = plist_get (proplist, QCverify_error);
hostname = plist_get (proplist, QChostname);
if (EQ (verify_error, Qt))
verify_error_all = true;
@ -1668,7 +1668,7 @@ gnutls_verify_boot (Lisp_Object proc, Lisp_Object proplist)
p->gnutls_peer_verification = peer_verification;
warnings = Fplist_get (Fgnutls_peer_status (proc), intern (":warnings"));
warnings = plist_get (Fgnutls_peer_status (proc), intern (":warnings"));
if (!NILP (warnings))
{
for (Lisp_Object tail = warnings; CONSP (tail); tail = XCDR (tail))
@ -1870,13 +1870,13 @@ one trustfile (usually a CA bundle). */)
return Qnil;
}
hostname = Fplist_get (proplist, QChostname);
priority_string = Fplist_get (proplist, QCpriority);
trustfiles = Fplist_get (proplist, QCtrustfiles);
keylist = Fplist_get (proplist, QCkeylist);
crlfiles = Fplist_get (proplist, QCcrlfiles);
loglevel = Fplist_get (proplist, QCloglevel);
prime_bits = Fplist_get (proplist, QCmin_prime_bits);
hostname = plist_get (proplist, QChostname);
priority_string = plist_get (proplist, QCpriority);
trustfiles = plist_get (proplist, QCtrustfiles);
keylist = plist_get (proplist, QCkeylist);
crlfiles = plist_get (proplist, QCcrlfiles);
loglevel = plist_get (proplist, QCloglevel);
prime_bits = plist_get (proplist, QCmin_prime_bits);
if (!STRINGP (hostname))
{
@ -1929,7 +1929,7 @@ one trustfile (usually a CA bundle). */)
check_memory_full (gnutls_certificate_allocate_credentials (&x509_cred));
XPROCESS (proc)->gnutls_x509_cred = x509_cred;
verify_flags = Fplist_get (proplist, QCverify_flags);
verify_flags = plist_get (proplist, QCverify_flags);
if (TYPE_RANGED_FIXNUMP (unsigned int, verify_flags))
{
gnutls_verify_flags = XFIXNAT (verify_flags);
@ -2109,7 +2109,7 @@ one trustfile (usually a CA bundle). */)
}
XPROCESS (proc)->gnutls_complete_negotiation_p =
!NILP (Fplist_get (proplist, QCcomplete_negotiation));
!NILP (plist_get (proplist, QCcomplete_negotiation));
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
ret = emacs_gnutls_handshake (XPROCESS (proc));
if (ret < GNUTLS_E_SUCCESS)
@ -2348,7 +2348,7 @@ gnutls_symmetric (bool encrypting, Lisp_Object cipher,
if (!NILP (info) && CONSP (info))
{
Lisp_Object v = Fplist_get (info, QCcipher_id);
Lisp_Object v = plist_get (info, QCcipher_id);
if (TYPE_RANGED_FIXNUMP (gnutls_cipher_algorithm_t, v))
gca = XFIXNUM (v);
}
@ -2625,7 +2625,7 @@ itself. */)
if (!NILP (info) && CONSP (info))
{
Lisp_Object v = Fplist_get (info, QCmac_algorithm_id);
Lisp_Object v = plist_get (info, QCmac_algorithm_id);
if (TYPE_RANGED_FIXNUMP (gnutls_mac_algorithm_t, v))
gma = XFIXNUM (v);
}
@ -2715,7 +2715,7 @@ the number itself. */)
if (!NILP (info) && CONSP (info))
{
Lisp_Object v = Fplist_get (info, QCdigest_algorithm_id);
Lisp_Object v = plist_get (info, QCdigest_algorithm_id);
if (TYPE_RANGED_FIXNUMP (gnutls_digest_algorithm_t, v))
gda = XFIXNUM (v);
}

View file

@ -2309,8 +2309,8 @@ postprocess_image (struct frame *f, struct image *img)
tem = XCDR (conversion);
if (CONSP (tem))
image_edge_detection (f, img,
Fplist_get (tem, QCmatrix),
Fplist_get (tem, QCcolor_adjustment));
plist_get (tem, QCmatrix),
plist_get (tem, QCcolor_adjustment));
}
}
}

View file

@ -484,15 +484,15 @@ check_display_width (ptrdiff_t pos, ptrdiff_t col, ptrdiff_t *endpos)
: MOST_POSITIVE_FIXNUM);
plist = XCDR (val);
if ((prop = Fplist_get (plist, QCwidth),
if ((prop = plist_get (plist, QCwidth),
RANGED_FIXNUMP (0, prop, INT_MAX))
|| (prop = Fplist_get (plist, QCrelative_width),
|| (prop = plist_get (plist, QCrelative_width),
RANGED_FIXNUMP (0, prop, INT_MAX)))
width = XFIXNUM (prop);
else if (FLOATP (prop) && 0 <= XFLOAT_DATA (prop)
&& XFLOAT_DATA (prop) <= INT_MAX)
width = (int)(XFLOAT_DATA (prop) + 0.5);
else if ((prop = Fplist_get (plist, QCalign_to),
else if ((prop = plist_get (plist, QCalign_to),
RANGED_FIXNUMP (col, prop, align_to_max)))
width = XFIXNUM (prop) - col;
else if (FLOATP (prop) && col <= XFLOAT_DATA (prop)
@ -514,7 +514,7 @@ check_display_width (ptrdiff_t pos, ptrdiff_t col, ptrdiff_t *endpos)
/* For :relative-width, we need to multiply by the column
width of the character at POS, if it is greater than 1. */
if (!NILP (plist)
&& !NILP (Fplist_get (plist, QCrelative_width))
&& !NILP (plist_get (plist, QCrelative_width))
&& !NILP (BVAR (current_buffer, enable_multibyte_characters)))
{
int b, wd;

View file

@ -1737,11 +1737,11 @@ lookup_char_property (Lisp_Object plist, Lisp_Object prop, bool textprop)
{
tail = XCDR (tail);
for (; NILP (fallback) && CONSP (tail); tail = XCDR (tail))
fallback = Fplist_get (plist, XCAR (tail));
fallback = plist_get (plist, XCAR (tail));
}
if (textprop && NILP (fallback) && CONSP (Vdefault_text_properties))
fallback = Fplist_get (Vdefault_text_properties, prop);
fallback = plist_get (Vdefault_text_properties, prop);
return fallback;
}

View file

@ -5601,7 +5601,7 @@ make_lispy_position (struct frame *f, Lisp_Object x, Lisp_Object y,
if (IMAGEP (object))
{
Lisp_Object image_map, hotspot;
if ((image_map = Fplist_get (XCDR (object), QCmap),
if ((image_map = plist_get (XCDR (object), QCmap),
!NILP (image_map))
&& (hotspot = find_hot_spot (image_map, dx, dy),
CONSP (hotspot))

View file

@ -4034,6 +4034,10 @@ extern ptrdiff_t string_char_to_byte (Lisp_Object, ptrdiff_t);
extern ptrdiff_t string_byte_to_char (Lisp_Object, ptrdiff_t);
extern Lisp_Object string_to_multibyte (Lisp_Object);
extern Lisp_Object string_make_unibyte (Lisp_Object);
extern Lisp_Object plist_get (Lisp_Object plist, Lisp_Object prop);
extern Lisp_Object plist_put (Lisp_Object plist, Lisp_Object prop,
Lisp_Object val);
extern Lisp_Object plist_member (Lisp_Object plist, Lisp_Object prop);
extern void syms_of_fns (void);
/* Defined in sort.c */

View file

@ -3175,7 +3175,7 @@ hash_table_from_plist (Lisp_Object plist)
/* This is repetitive but fast and simple. */
#define ADDPARAM(name) \
do { \
Lisp_Object val = Fplist_get (plist, Q ## name); \
Lisp_Object val = plist_get (plist, Q ## name); \
if (!NILP (val)) \
{ \
*par++ = QC ## name; \
@ -3190,7 +3190,7 @@ hash_table_from_plist (Lisp_Object plist)
ADDPARAM (rehash_threshold);
ADDPARAM (purecopy);
Lisp_Object data = Fplist_get (plist, Qdata);
Lisp_Object data = plist_get (plist, Qdata);
/* Now use params to make a new hash table and fill it. */
Lisp_Object ht = Fmake_hash_table (par - params, params);

View file

@ -1281,7 +1281,7 @@ Return BUFFER. */)
update_process_mark (p);
}
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
pset_childp (p, Fplist_put (p->childp, QCbuffer, buffer));
pset_childp (p, plist_put (p->childp, QCbuffer, buffer));
setup_process_coding_systems (process);
return buffer;
}
@ -1360,7 +1360,7 @@ The string argument is normally a multibyte string, except:
pset_filter (p, filter);
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
pset_childp (p, Fplist_put (p->childp, QCfilter, filter));
pset_childp (p, plist_put (p->childp, QCfilter, filter));
setup_process_coding_systems (process);
return filter;
}
@ -1392,7 +1392,7 @@ It gets two arguments: the process, and a string describing the change. */)
pset_sentinel (p, sentinel);
if (NETCONN1_P (p) || SERIALCONN1_P (p) || PIPECONN1_P (p))
pset_childp (p, Fplist_put (p->childp, QCsentinel, sentinel));
pset_childp (p, plist_put (p->childp, QCsentinel, sentinel));
return sentinel;
}
@ -1553,25 +1553,25 @@ waiting for the process to be fully set up.*/)
if (DATAGRAM_CONN_P (process)
&& (EQ (key, Qt) || EQ (key, QCremote)))
contact = Fplist_put (contact, QCremote,
Fprocess_datagram_address (process));
contact = plist_put (contact, QCremote,
Fprocess_datagram_address (process));
#endif
if ((!NETCONN_P (process) && !SERIALCONN_P (process) && !PIPECONN_P (process))
|| EQ (key, Qt))
return contact;
if (NILP (key) && NETCONN_P (process))
return list2 (Fplist_get (contact, QChost),
Fplist_get (contact, QCservice));
return list2 (plist_get (contact, QChost),
plist_get (contact, QCservice));
if (NILP (key) && SERIALCONN_P (process))
return list2 (Fplist_get (contact, QCport),
Fplist_get (contact, QCspeed));
return list2 (plist_get (contact, QCport),
plist_get (contact, QCspeed));
/* FIXME: Return a meaningful value (e.g., the child end of the pipe)
if the pipe process is useful for purposes other than receiving
stderr. */
if (NILP (key) && PIPECONN_P (process))
return Qt;
return Fplist_get (contact, key);
return plist_get (contact, key);
}
DEFUN ("process-plist", Fprocess_plist, Sprocess_plist,
@ -1773,7 +1773,7 @@ usage: (make-process &rest ARGS) */)
/* Save arguments for process-contact and clone-process. */
contact = Flist (nargs, args);
if (!NILP (Fplist_get (contact, QCfile_handler)))
if (!NILP (plist_get (contact, QCfile_handler)))
{
Lisp_Object file_handler
= Ffind_file_name_handler (BVAR (current_buffer, directory),
@ -1782,7 +1782,7 @@ usage: (make-process &rest ARGS) */)
return CALLN (Fapply, file_handler, Qmake_process, contact);
}
buffer = Fplist_get (contact, QCbuffer);
buffer = plist_get (contact, QCbuffer);
if (!NILP (buffer))
buffer = Fget_buffer_create (buffer, Qnil);
@ -1792,10 +1792,10 @@ usage: (make-process &rest ARGS) */)
chdir, since it's in a vfork. */
current_dir = get_current_directory (true);
name = Fplist_get (contact, QCname);
name = plist_get (contact, QCname);
CHECK_STRING (name);
command = Fplist_get (contact, QCcommand);
command = plist_get (contact, QCcommand);
if (CONSP (command))
program = XCAR (command);
else
@ -1804,10 +1804,10 @@ usage: (make-process &rest ARGS) */)
if (!NILP (program))
CHECK_STRING (program);
bool query_on_exit = NILP (Fplist_get (contact, QCnoquery));
bool query_on_exit = NILP (plist_get (contact, QCnoquery));
stderrproc = Qnil;
xstderr = Fplist_get (contact, QCstderr);
xstderr = plist_get (contact, QCstderr);
if (PROCESSP (xstderr))
{
if (!PIPECONN_P (xstderr))
@ -1833,18 +1833,18 @@ usage: (make-process &rest ARGS) */)
eassert (NILP (XPROCESS (proc)->plist));
pset_type (XPROCESS (proc), Qreal);
pset_buffer (XPROCESS (proc), buffer);
pset_sentinel (XPROCESS (proc), Fplist_get (contact, QCsentinel));
pset_filter (XPROCESS (proc), Fplist_get (contact, QCfilter));
pset_sentinel (XPROCESS (proc), plist_get (contact, QCsentinel));
pset_filter (XPROCESS (proc), plist_get (contact, QCfilter));
pset_command (XPROCESS (proc), Fcopy_sequence (command));
if (!query_on_exit)
XPROCESS (proc)->kill_without_query = 1;
tem = Fplist_get (contact, QCstop);
tem = plist_get (contact, QCstop);
/* Normal processes can't be started in a stopped state, see
Bug#30460. */
CHECK_TYPE (NILP (tem), Qnull, tem);
tem = Fplist_get (contact, QCconnection_type);
tem = plist_get (contact, QCconnection_type);
if (EQ (tem, Qpty))
XPROCESS (proc)->pty_flag = true;
else if (EQ (tem, Qpipe))
@ -1886,7 +1886,7 @@ usage: (make-process &rest ARGS) */)
Lisp_Object coding_systems = Qt;
Lisp_Object val, *args2;
tem = Fplist_get (contact, QCcoding);
tem = plist_get (contact, QCcoding);
if (!NILP (tem))
{
val = tem;
@ -2364,7 +2364,7 @@ usage: (make-pipe-process &rest ARGS) */)
contact = Flist (nargs, args);
name = Fplist_get (contact, QCname);
name = plist_get (contact, QCname);
CHECK_STRING (name);
proc = make_process (name);
specpdl_ref specpdl_count = SPECPDL_INDEX ();
@ -2396,21 +2396,21 @@ usage: (make-pipe-process &rest ARGS) */)
if (inchannel > max_desc)
max_desc = inchannel;
buffer = Fplist_get (contact, QCbuffer);
buffer = plist_get (contact, QCbuffer);
if (NILP (buffer))
buffer = name;
buffer = Fget_buffer_create (buffer, Qnil);
pset_buffer (p, buffer);
pset_childp (p, contact);
pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
pset_plist (p, Fcopy_sequence (plist_get (contact, QCplist)));
pset_type (p, Qpipe);
pset_sentinel (p, Fplist_get (contact, QCsentinel));
pset_filter (p, Fplist_get (contact, QCfilter));
pset_sentinel (p, plist_get (contact, QCsentinel));
pset_filter (p, plist_get (contact, QCfilter));
eassert (NILP (p->log));
if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
if (tem = plist_get (contact, QCnoquery), !NILP (tem))
p->kill_without_query = 1;
if (tem = Fplist_get (contact, QCstop), !NILP (tem))
if (tem = plist_get (contact, QCstop), !NILP (tem))
pset_command (p, Qt);
eassert (! p->pty_flag);
@ -2431,7 +2431,7 @@ usage: (make-pipe-process &rest ARGS) */)
Lisp_Object coding_systems = Qt;
Lisp_Object val;
tem = Fplist_get (contact, QCcoding);
tem = plist_get (contact, QCcoding);
val = Qnil;
if (!NILP (tem))
{
@ -2918,7 +2918,7 @@ set up yet, this function will block until socket setup has completed. */)
if (set_socket_option (s, option, value))
{
pset_childp (p, Fplist_put (p->childp, option, value));
pset_childp (p, plist_put (p->childp, option, value));
return Qt;
}
@ -2996,19 +2996,19 @@ usage: (serial-process-configure &rest ARGS) */)
contact = Flist (nargs, args);
proc = Fplist_get (contact, QCprocess);
proc = plist_get (contact, QCprocess);
if (NILP (proc))
proc = Fplist_get (contact, QCname);
proc = plist_get (contact, QCname);
if (NILP (proc))
proc = Fplist_get (contact, QCbuffer);
proc = plist_get (contact, QCbuffer);
if (NILP (proc))
proc = Fplist_get (contact, QCport);
proc = plist_get (contact, QCport);
proc = get_process (proc);
p = XPROCESS (proc);
if (!EQ (p->type, Qserial))
error ("Not a serial process");
if (NILP (Fplist_get (p->childp, QCspeed)))
if (NILP (plist_get (p->childp, QCspeed)))
return Qnil;
serial_configure (p, contact);
@ -3101,17 +3101,17 @@ usage: (make-serial-process &rest ARGS) */)
contact = Flist (nargs, args);
port = Fplist_get (contact, QCport);
port = plist_get (contact, QCport);
if (NILP (port))
error ("No port specified");
CHECK_STRING (port);
if (NILP (Fplist_member (contact, QCspeed)))
if (NILP (plist_member (contact, QCspeed)))
error (":speed not specified");
if (!NILP (Fplist_get (contact, QCspeed)))
CHECK_FIXNUM (Fplist_get (contact, QCspeed));
if (!NILP (plist_get (contact, QCspeed)))
CHECK_FIXNUM (plist_get (contact, QCspeed));
name = Fplist_get (contact, QCname);
name = plist_get (contact, QCname);
if (NILP (name))
name = port;
CHECK_STRING (name);
@ -3131,21 +3131,21 @@ usage: (make-serial-process &rest ARGS) */)
eassert (0 <= fd && fd < FD_SETSIZE);
chan_process[fd] = proc;
buffer = Fplist_get (contact, QCbuffer);
buffer = plist_get (contact, QCbuffer);
if (NILP (buffer))
buffer = name;
buffer = Fget_buffer_create (buffer, Qnil);
pset_buffer (p, buffer);
pset_childp (p, contact);
pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
pset_plist (p, Fcopy_sequence (plist_get (contact, QCplist)));
pset_type (p, Qserial);
pset_sentinel (p, Fplist_get (contact, QCsentinel));
pset_filter (p, Fplist_get (contact, QCfilter));
pset_sentinel (p, plist_get (contact, QCsentinel));
pset_filter (p, plist_get (contact, QCfilter));
eassert (NILP (p->log));
if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
if (tem = plist_get (contact, QCnoquery), !NILP (tem))
p->kill_without_query = 1;
if (tem = Fplist_get (contact, QCstop), !NILP (tem))
if (tem = plist_get (contact, QCstop), !NILP (tem))
pset_command (p, Qt);
eassert (! p->pty_flag);
@ -3155,7 +3155,7 @@ usage: (make-serial-process &rest ARGS) */)
update_process_mark (p);
tem = Fplist_get (contact, QCcoding);
tem = plist_get (contact, QCcoding);
val = Qnil;
if (!NILP (tem))
@ -3209,7 +3209,7 @@ set_network_socket_coding_system (Lisp_Object proc, Lisp_Object host,
Lisp_Object coding_systems = Qt;
Lisp_Object val;
tem = Fplist_get (contact, QCcoding);
tem = plist_get (contact, QCcoding);
/* Setup coding systems for communicating with the network stream. */
/* Qt denotes we have not yet called Ffind_operation_coding_system. */
@ -3297,8 +3297,8 @@ finish_after_tls_connection (Lisp_Object proc)
if (!NILP (Ffboundp (Qnsm_verify_connection)))
result = call3 (Qnsm_verify_connection,
proc,
Fplist_get (contact, QChost),
Fplist_get (contact, QCservice));
plist_get (contact, QChost),
plist_get (contact, QCservice));
eassert (p->outfd < FD_SETSIZE);
if (NILP (result))
@ -3479,7 +3479,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
if (getsockname (s, psa1, &len1) == 0)
{
Lisp_Object service = make_fixnum (ntohs (sa1.sin_port));
contact = Fplist_put (contact, QCservice, service);
contact = plist_put (contact, QCservice, service);
/* Save the port number so that we can stash it in
the process object later. */
DECLARE_POINTER_ALIAS (psa, struct sockaddr_in, sa);
@ -3570,7 +3570,7 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
{
Lisp_Object remote;
memset (datagram_address[s].sa, 0, addrlen);
if (remote = Fplist_get (contact, QCremote), !NILP (remote))
if (remote = plist_get (contact, QCremote), !NILP (remote))
{
int rfamily;
ptrdiff_t rlen = get_lisp_to_sockaddr_size (remote, &rfamily);
@ -3585,8 +3585,8 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
}
#endif
contact = Fplist_put (contact, p->is_server? QClocal: QCremote,
conv_sockaddr_to_lisp (sa, addrlen));
contact = plist_put (contact, p->is_server? QClocal: QCremote,
conv_sockaddr_to_lisp (sa, addrlen));
#ifdef HAVE_GETSOCKNAME
if (!p->is_server)
{
@ -3594,8 +3594,8 @@ connect_network_socket (Lisp_Object proc, Lisp_Object addrinfos,
socklen_t len1 = sizeof (sa1);
DECLARE_POINTER_ALIAS (psa1, struct sockaddr, &sa1);
if (getsockname (s, psa1, &len1) == 0)
contact = Fplist_put (contact, QClocal,
conv_sockaddr_to_lisp (psa1, len1));
contact = plist_put (contact, QClocal,
conv_sockaddr_to_lisp (psa1, len1));
}
#endif
}
@ -3908,7 +3908,7 @@ usage: (make-network-process &rest ARGS) */)
#endif
/* :type TYPE (nil: stream, datagram */
tem = Fplist_get (contact, QCtype);
tem = plist_get (contact, QCtype);
if (NILP (tem))
socktype = SOCK_STREAM;
#ifdef DATAGRAM_SOCKETS
@ -3922,13 +3922,13 @@ usage: (make-network-process &rest ARGS) */)
else
error ("Unsupported connection type");
name = Fplist_get (contact, QCname);
buffer = Fplist_get (contact, QCbuffer);
filter = Fplist_get (contact, QCfilter);
sentinel = Fplist_get (contact, QCsentinel);
use_external_socket_p = Fplist_get (contact, QCuse_external_socket);
Lisp_Object server = Fplist_get (contact, QCserver);
bool nowait = !NILP (Fplist_get (contact, QCnowait));
name = plist_get (contact, QCname);
buffer = plist_get (contact, QCbuffer);
filter = plist_get (contact, QCfilter);
sentinel = plist_get (contact, QCsentinel);
use_external_socket_p = plist_get (contact, QCuse_external_socket);
Lisp_Object server = plist_get (contact, QCserver);
bool nowait = !NILP (plist_get (contact, QCnowait));
if (!NILP (server) && nowait)
error ("`:server' is incompatible with `:nowait'");
@ -3936,9 +3936,9 @@ usage: (make-network-process &rest ARGS) */)
/* :local ADDRESS or :remote ADDRESS */
if (NILP (server))
address = Fplist_get (contact, QCremote);
address = plist_get (contact, QCremote);
else
address = Fplist_get (contact, QClocal);
address = plist_get (contact, QClocal);
if (!NILP (address))
{
host = service = Qnil;
@ -3951,7 +3951,7 @@ usage: (make-network-process &rest ARGS) */)
}
/* :family FAMILY -- nil (for Inet), local, or integer. */
tem = Fplist_get (contact, QCfamily);
tem = plist_get (contact, QCfamily);
if (NILP (tem))
{
#ifdef AF_INET6
@ -3976,10 +3976,10 @@ usage: (make-network-process &rest ARGS) */)
error ("Unknown address family");
/* :service SERVICE -- string, integer (port number), or t (random port). */
service = Fplist_get (contact, QCservice);
service = plist_get (contact, QCservice);
/* :host HOST -- hostname, ip address, or 'local for localhost. */
host = Fplist_get (contact, QChost);
host = plist_get (contact, QChost);
if (NILP (host))
{
/* The "connection" function gets it bind info from the address we're
@ -4018,7 +4018,7 @@ usage: (make-network-process &rest ARGS) */)
if (!NILP (host))
{
message (":family local ignores the :host property");
contact = Fplist_put (contact, QChost, Qnil);
contact = plist_put (contact, QChost, Qnil);
host = Qnil;
}
CHECK_STRING (service);
@ -4172,16 +4172,16 @@ usage: (make-network-process &rest ARGS) */)
record_unwind_protect (remove_process, proc);
p = XPROCESS (proc);
pset_childp (p, contact);
pset_plist (p, Fcopy_sequence (Fplist_get (contact, QCplist)));
pset_plist (p, Fcopy_sequence (plist_get (contact, QCplist)));
pset_type (p, Qnetwork);
pset_buffer (p, buffer);
pset_sentinel (p, sentinel);
pset_filter (p, filter);
pset_log (p, Fplist_get (contact, QClog));
if (tem = Fplist_get (contact, QCnoquery), !NILP (tem))
pset_log (p, plist_get (contact, QClog));
if (tem = plist_get (contact, QCnoquery), !NILP (tem))
p->kill_without_query = 1;
if ((tem = Fplist_get (contact, QCstop), !NILP (tem)))
if ((tem = plist_get (contact, QCstop), !NILP (tem)))
pset_command (p, Qt);
eassert (p->pid == 0);
p->backlog = 5;
@ -4193,7 +4193,7 @@ usage: (make-network-process &rest ARGS) */)
eassert (! p->dns_request);
#endif
#ifdef HAVE_GNUTLS
tem = Fplist_get (contact, QCtls_parameters);
tem = plist_get (contact, QCtls_parameters);
CHECK_LIST (tem);
p->gnutls_boot_parameters = tem;
#endif
@ -4969,17 +4969,17 @@ server_accept_connection (Lisp_Object server, int channel)
/* Build new contact information for this setup. */
contact = Fcopy_sequence (ps->childp);
contact = Fplist_put (contact, QCserver, Qnil);
contact = Fplist_put (contact, QChost, host);
contact = plist_put (contact, QCserver, Qnil);
contact = plist_put (contact, QChost, host);
if (!NILP (service))
contact = Fplist_put (contact, QCservice, service);
contact = Fplist_put (contact, QCremote,
conv_sockaddr_to_lisp (&saddr.sa, len));
contact = plist_put (contact, QCservice, service);
contact = plist_put (contact, QCremote,
conv_sockaddr_to_lisp (&saddr.sa, len));
#ifdef HAVE_GETSOCKNAME
len = sizeof saddr;
if (getsockname (s, &saddr.sa, &len) == 0)
contact = Fplist_put (contact, QClocal,
conv_sockaddr_to_lisp (&saddr.sa, len));
contact = plist_put (contact, QClocal,
conv_sockaddr_to_lisp (&saddr.sa, len));
#endif
pset_childp (p, contact);

View file

@ -361,10 +361,10 @@ parse_sound (Lisp_Object sound, Lisp_Object *attrs)
return 0;
sound = XCDR (sound);
attrs[SOUND_FILE] = Fplist_get (sound, QCfile);
attrs[SOUND_DATA] = Fplist_get (sound, QCdata);
attrs[SOUND_DEVICE] = Fplist_get (sound, QCdevice);
attrs[SOUND_VOLUME] = Fplist_get (sound, QCvolume);
attrs[SOUND_FILE] = plist_get (sound, QCfile);
attrs[SOUND_DATA] = plist_get (sound, QCdata);
attrs[SOUND_DEVICE] = plist_get (sound, QCdevice);
attrs[SOUND_VOLUME] = plist_get (sound, QCvolume);
#ifndef WINDOWSNT
/* File name or data must be specified. */

View file

@ -2939,21 +2939,21 @@ serial_configure (struct Lisp_Process *p,
#endif
/* Configure speed. */
if (!NILP (Fplist_member (contact, QCspeed)))
tem = Fplist_get (contact, QCspeed);
if (!NILP (plist_member (contact, QCspeed)))
tem = plist_get (contact, QCspeed);
else
tem = Fplist_get (p->childp, QCspeed);
tem = plist_get (p->childp, QCspeed);
CHECK_FIXNUM (tem);
err = cfsetspeed (&attr, convert_speed (XFIXNUM (tem)));
if (err != 0)
report_file_error ("Failed cfsetspeed", tem);
childp2 = Fplist_put (childp2, QCspeed, tem);
childp2 = plist_put (childp2, QCspeed, tem);
/* Configure bytesize. */
if (!NILP (Fplist_member (contact, QCbytesize)))
tem = Fplist_get (contact, QCbytesize);
if (!NILP (plist_member (contact, QCbytesize)))
tem = plist_get (contact, QCbytesize);
else
tem = Fplist_get (p->childp, QCbytesize);
tem = plist_get (p->childp, QCbytesize);
if (NILP (tem))
tem = make_fixnum (8);
CHECK_FIXNUM (tem);
@ -2968,13 +2968,13 @@ serial_configure (struct Lisp_Process *p,
if (XFIXNUM (tem) != 8)
error ("Bytesize cannot be changed");
#endif
childp2 = Fplist_put (childp2, QCbytesize, tem);
childp2 = plist_put (childp2, QCbytesize, tem);
/* Configure parity. */
if (!NILP (Fplist_member (contact, QCparity)))
tem = Fplist_get (contact, QCparity);
if (!NILP (plist_member (contact, QCparity)))
tem = plist_get (contact, QCparity);
else
tem = Fplist_get (p->childp, QCparity);
tem = plist_get (p->childp, QCparity);
if (!NILP (tem) && !EQ (tem, Qeven) && !EQ (tem, Qodd))
error (":parity must be nil (no parity), `even', or `odd'");
#if defined (PARENB) && defined (PARODD) && defined (IGNPAR) && defined (INPCK)
@ -3001,13 +3001,13 @@ serial_configure (struct Lisp_Process *p,
if (!NILP (tem))
error ("Parity cannot be configured");
#endif
childp2 = Fplist_put (childp2, QCparity, tem);
childp2 = plist_put (childp2, QCparity, tem);
/* Configure stopbits. */
if (!NILP (Fplist_member (contact, QCstopbits)))
tem = Fplist_get (contact, QCstopbits);
if (!NILP (plist_member (contact, QCstopbits)))
tem = plist_get (contact, QCstopbits);
else
tem = Fplist_get (p->childp, QCstopbits);
tem = plist_get (p->childp, QCstopbits);
if (NILP (tem))
tem = make_fixnum (1);
CHECK_FIXNUM (tem);
@ -3023,13 +3023,13 @@ serial_configure (struct Lisp_Process *p,
if (XFIXNUM (tem) != 1)
error ("Stopbits cannot be configured");
#endif
childp2 = Fplist_put (childp2, QCstopbits, tem);
childp2 = plist_put (childp2, QCstopbits, tem);
/* Configure flowcontrol. */
if (!NILP (Fplist_member (contact, QCflowcontrol)))
tem = Fplist_get (contact, QCflowcontrol);
if (!NILP (plist_member (contact, QCflowcontrol)))
tem = plist_get (contact, QCflowcontrol);
else
tem = Fplist_get (p->childp, QCflowcontrol);
tem = plist_get (p->childp, QCflowcontrol);
if (!NILP (tem) && !EQ (tem, Qhw) && !EQ (tem, Qsw))
error (":flowcontrol must be nil (no flowcontrol), `hw', or `sw'");
#if defined (CRTSCTS)
@ -3063,14 +3063,14 @@ serial_configure (struct Lisp_Process *p,
error ("Software flowcontrol (XON/XOFF) not supported");
#endif
}
childp2 = Fplist_put (childp2, QCflowcontrol, tem);
childp2 = plist_put (childp2, QCflowcontrol, tem);
/* Activate configuration. */
err = tcsetattr (p->outfd, TCSANOW, &attr);
if (err != 0)
report_file_error ("Failed tcsetattr", Qnil);
childp2 = Fplist_put (childp2, QCsummary, build_string (summary));
childp2 = plist_put (childp2, QCsummary, build_string (summary));
pset_childp (p, childp2);
}
#endif /* not DOS_NT */

View file

@ -2249,7 +2249,7 @@ verify_interval_modification (struct buffer *buf,
tem = textget (i->plist, Qfront_sticky);
if (TMEM (Qread_only, tem)
|| (NILP (Fplist_get (i->plist, Qread_only))
|| (NILP (plist_get (i->plist, Qread_only))
&& TMEM (Qcategory, tem)))
text_read_only (after);
}
@ -2269,7 +2269,7 @@ verify_interval_modification (struct buffer *buf,
tem = textget (prev->plist, Qrear_nonsticky);
if (! TMEM (Qread_only, tem)
&& (! NILP (Fplist_get (prev->plist,Qread_only))
&& (! NILP (plist_get (prev->plist,Qread_only))
|| ! TMEM (Qcategory, tem)))
text_read_only (before);
}
@ -2288,13 +2288,13 @@ verify_interval_modification (struct buffer *buf,
tem = textget (i->plist, Qfront_sticky);
if (TMEM (Qread_only, tem)
|| (NILP (Fplist_get (i->plist, Qread_only))
|| (NILP (plist_get (i->plist, Qread_only))
&& TMEM (Qcategory, tem)))
text_read_only (after);
tem = textget (prev->plist, Qrear_nonsticky);
if (! TMEM (Qread_only, tem)
&& (! NILP (Fplist_get (prev->plist, Qread_only))
&& (! NILP (plist_get (prev->plist, Qread_only))
|| ! TMEM (Qcategory, tem)))
text_read_only (after);
}

View file

@ -10953,19 +10953,19 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact)
dcb.EvtChar = 0;
/* Configure speed. */
if (!NILP (Fplist_member (contact, QCspeed)))
tem = Fplist_get (contact, QCspeed);
if (!NILP (plist_member (contact, QCspeed)))
tem = plist_get (contact, QCspeed);
else
tem = Fplist_get (p->childp, QCspeed);
tem = plist_get (p->childp, QCspeed);
CHECK_FIXNUM (tem);
dcb.BaudRate = XFIXNUM (tem);
childp2 = Fplist_put (childp2, QCspeed, tem);
/* Configure bytesize. */
if (!NILP (Fplist_member (contact, QCbytesize)))
tem = Fplist_get (contact, QCbytesize);
if (!NILP (plist_member (contact, QCbytesize)))
tem = plist_get (contact, QCbytesize);
else
tem = Fplist_get (p->childp, QCbytesize);
tem = plist_get (p->childp, QCbytesize);
if (NILP (tem))
tem = make_fixnum (8);
CHECK_FIXNUM (tem);
@ -10976,10 +10976,10 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact)
childp2 = Fplist_put (childp2, QCbytesize, tem);
/* Configure parity. */
if (!NILP (Fplist_member (contact, QCparity)))
tem = Fplist_get (contact, QCparity);
if (!NILP (plist_member (contact, QCparity)))
tem = plist_get (contact, QCparity);
else
tem = Fplist_get (p->childp, QCparity);
tem = plist_get (p->childp, QCparity);
if (!NILP (tem) && !EQ (tem, Qeven) && !EQ (tem, Qodd))
error (":parity must be nil (no parity), `even', or `odd'");
dcb.fParity = FALSE;
@ -11006,10 +11006,10 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact)
childp2 = Fplist_put (childp2, QCparity, tem);
/* Configure stopbits. */
if (!NILP (Fplist_member (contact, QCstopbits)))
tem = Fplist_get (contact, QCstopbits);
if (!NILP (plist_member (contact, QCstopbits)))
tem = plist_get (contact, QCstopbits);
else
tem = Fplist_get (p->childp, QCstopbits);
tem = plist_get (p->childp, QCstopbits);
if (NILP (tem))
tem = make_fixnum (1);
CHECK_FIXNUM (tem);
@ -11023,10 +11023,10 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact)
childp2 = Fplist_put (childp2, QCstopbits, tem);
/* Configure flowcontrol. */
if (!NILP (Fplist_member (contact, QCflowcontrol)))
tem = Fplist_get (contact, QCflowcontrol);
if (!NILP (plist_member (contact, QCflowcontrol)))
tem = plist_get (contact, QCflowcontrol);
else
tem = Fplist_get (p->childp, QCflowcontrol);
tem = plist_get (p->childp, QCflowcontrol);
if (!NILP (tem) && !EQ (tem, Qhw) && !EQ (tem, Qsw))
error (":flowcontrol must be nil (no flowcontrol), `hw', or `sw'");
dcb.fOutxCtsFlow = FALSE;

View file

@ -10212,21 +10212,21 @@ usage: (w32-notification-notify &rest PARAMS) */)
arg_plist = Flist (nargs, args);
/* Icon. */
lres = Fplist_get (arg_plist, QCicon);
lres = plist_get (arg_plist, QCicon);
if (STRINGP (lres))
icon = SSDATA (ENCODE_FILE (Fexpand_file_name (lres, Qnil)));
else
icon = (char *)"";
/* Tip. */
lres = Fplist_get (arg_plist, QCtip);
lres = plist_get (arg_plist, QCtip);
if (STRINGP (lres))
tip = SSDATA (code_convert_string_norecord (lres, Qutf_8, 1));
else
tip = (char *)"Emacs notification";
/* Severity. */
lres = Fplist_get (arg_plist, QClevel);
lres = plist_get (arg_plist, QClevel);
if (NILP (lres))
severity = Ni_None;
else if (EQ (lres, Qinfo))
@ -10239,14 +10239,14 @@ usage: (w32-notification-notify &rest PARAMS) */)
severity = Ni_Info;
/* Title. */
lres = Fplist_get (arg_plist, QCtitle);
lres = plist_get (arg_plist, QCtitle);
if (STRINGP (lres))
title = SSDATA (code_convert_string_norecord (lres, Qutf_8, 1));
else
title = (char *)"";
/* Notification body text. */
lres = Fplist_get (arg_plist, QCbody);
lres = plist_get (arg_plist, QCbody);
if (STRINGP (lres))
msg = SSDATA (code_convert_string_norecord (lres, Qutf_8, 1));
else

View file

@ -382,7 +382,7 @@ w32_select_active_frame (GpBitmap *pBitmap, int frame, int *nframes,
static ARGB
w32_image_bg_color (struct frame *f, struct image *img)
{
Lisp_Object specified_bg = Fplist_get (XCDR (img->spec), QCbackground);
Lisp_Object specified_bg = plist_get (XCDR (img->spec), QCbackground);
Emacs_Color color;
/* If the user specified a color, try to use it; if not, use the
@ -435,7 +435,7 @@ w32_load_image (struct frame *f, struct image *img,
if (status == Ok)
{
/* In multiframe pictures, select the first frame. */
Lisp_Object lisp_index = Fplist_get (XCDR (img->spec), QCindex);
Lisp_Object lisp_index = plist_get (XCDR (img->spec), QCindex);
int index = FIXNATP (lisp_index) ? XFIXNAT (lisp_index) : 0;
int nframes;
double delay;

View file

@ -14694,7 +14694,7 @@ build_desired_tool_bar_string (struct frame *f)
selected. */
if (selected_p)
{
plist = Fplist_put (plist, QCrelief, make_fixnum (-relief));
plist = plist_put (plist, QCrelief, make_fixnum (-relief));
hmargin -= relief;
vmargin -= relief;
}
@ -14704,10 +14704,10 @@ build_desired_tool_bar_string (struct frame *f)
/* If image is selected, display it pressed, i.e. with a
negative relief. If it's not selected, display it with a
raised relief. */
plist = Fplist_put (plist, QCrelief,
(selected_p
? make_fixnum (-relief)
: make_fixnum (relief)));
plist = plist_put (plist, QCrelief,
(selected_p
? make_fixnum (-relief)
: make_fixnum (relief)));
hmargin -= relief;
vmargin -= relief;
}
@ -14716,18 +14716,18 @@ build_desired_tool_bar_string (struct frame *f)
if (hmargin || vmargin)
{
if (hmargin == vmargin)
plist = Fplist_put (plist, QCmargin, make_fixnum (hmargin));
plist = plist_put (plist, QCmargin, make_fixnum (hmargin));
else
plist = Fplist_put (plist, QCmargin,
Fcons (make_fixnum (hmargin),
make_fixnum (vmargin)));
plist = plist_put (plist, QCmargin,
Fcons (make_fixnum (hmargin),
make_fixnum (vmargin)));
}
/* If button is not enabled, and we don't have special images
for the disabled state, make the image appear disabled by
applying an appropriate algorithm to it. */
if (!enabled_p && idx < 0)
plist = Fplist_put (plist, QCconversion, Qdisabled);
plist = plist_put (plist, QCconversion, Qdisabled);
/* Put a `display' text property on the string for the image to
display. Put a `menu-item' property on the string that gives
@ -26510,8 +26510,8 @@ display_mode_element (struct it *it, int depth, int field_width, int precision,
tem = props;
while (CONSP (tem))
{
oprops = Fplist_put (oprops, XCAR (tem),
XCAR (XCDR (tem)));
oprops = plist_put (oprops, XCAR (tem),
XCAR (XCDR (tem)));
tem = XCDR (XCDR (tem));
}
props = oprops;
@ -26962,13 +26962,13 @@ store_mode_line_string (const char *string, Lisp_Object lisp_string,
props = mode_line_string_face_prop;
else if (!NILP (mode_line_string_face))
{
Lisp_Object face = Fplist_get (props, Qface);
Lisp_Object face = plist_get (props, Qface);
props = Fcopy_sequence (props);
if (NILP (face))
face = mode_line_string_face;
else
face = list2 (face, mode_line_string_face);
props = Fplist_put (props, Qface, face);
props = plist_put (props, Qface, face);
}
Fadd_text_properties (make_fixnum (0), make_fixnum (len),
props, lisp_string);
@ -26987,7 +26987,7 @@ store_mode_line_string (const char *string, Lisp_Object lisp_string,
Lisp_Object face;
if (NILP (props))
props = Ftext_properties_at (make_fixnum (0), lisp_string);
face = Fplist_get (props, Qface);
face = plist_get (props, Qface);
if (NILP (face))
face = mode_line_string_face;
else
@ -28037,7 +28037,7 @@ display_string (const char *string, Lisp_Object lisp_string, Lisp_Object face_st
face_string);
if (!NILP (display))
{
Lisp_Object min_width = Fplist_get (display, Qmin_width);
Lisp_Object min_width = plist_get (display, Qmin_width);
if (!NILP (min_width))
display_min_width (it, 0, face_string, min_width);
}
@ -30730,14 +30730,14 @@ produce_stretch_glyph (struct it *it)
plist = XCDR (it->object);
/* Compute the width of the stretch. */
if ((prop = Fplist_get (plist, QCwidth), !NILP (prop))
if ((prop = plist_get (plist, QCwidth), !NILP (prop))
&& calc_pixel_width_or_height (&tem, it, prop, font, true, NULL))
{
/* Absolute width `:width WIDTH' specified and valid. */
zero_width_ok_p = true;
width = (int)tem;
}
else if (prop = Fplist_get (plist, QCrelative_width), NUMVAL (prop) > 0)
else if (prop = plist_get (plist, QCrelative_width), NUMVAL (prop) > 0)
{
/* Relative width `:relative-width FACTOR' specified and valid.
Compute the width of the characters having this `display'
@ -30774,7 +30774,7 @@ produce_stretch_glyph (struct it *it)
PRODUCE_GLYPHS (&it2);
width = NUMVAL (prop) * it2.pixel_width;
}
else if ((prop = Fplist_get (plist, QCalign_to), !NILP (prop))
else if ((prop = plist_get (plist, QCalign_to), !NILP (prop))
&& calc_pixel_width_or_height (&tem, it, prop, font, true,
&align_to))
{
@ -30800,13 +30800,13 @@ produce_stretch_glyph (struct it *it)
{
int default_height = normal_char_height (font, ' ');
if ((prop = Fplist_get (plist, QCheight), !NILP (prop))
if ((prop = plist_get (plist, QCheight), !NILP (prop))
&& calc_pixel_width_or_height (&tem, it, prop, font, false, NULL))
{
height = (int)tem;
zero_height_ok_p = true;
}
else if (prop = Fplist_get (plist, QCrelative_height),
else if (prop = plist_get (plist, QCrelative_height),
NUMVAL (prop) > 0)
height = default_height * NUMVAL (prop);
else
@ -30818,7 +30818,7 @@ produce_stretch_glyph (struct it *it)
/* Compute percentage of height used for ascent. If
`:ascent ASCENT' is present and valid, use that. Otherwise,
derive the ascent from the font in use. */
if (prop = Fplist_get (plist, QCascent),
if (prop = plist_get (plist, QCascent),
NUMVAL (prop) > 0 && NUMVAL (prop) <= 100)
ascent = height * NUMVAL (prop) / 100.0;
else if (!NILP (prop)
@ -34165,7 +34165,7 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y,
if (IMAGEP (object))
{
Lisp_Object image_map, hotspot;
if ((image_map = Fplist_get (XCDR (object), QCmap),
if ((image_map = plist_get (XCDR (object), QCmap),
!NILP (image_map))
&& (hotspot = find_hot_spot (image_map, dx, dy),
CONSP (hotspot))
@ -34180,10 +34180,10 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y,
if (CONSP (hotspot)
&& (plist = XCAR (hotspot), CONSP (plist)))
{
pointer = Fplist_get (plist, Qpointer);
pointer = plist_get (plist, Qpointer);
if (NILP (pointer))
pointer = Qhand;
help = Fplist_get (plist, Qhelp_echo);
help = plist_get (plist, Qhelp_echo);
if (!NILP (help))
{
help_echo_string = help;
@ -34194,7 +34194,7 @@ note_mode_line_or_margin_highlight (Lisp_Object window, int x, int y,
}
}
if (NILP (pointer))
pointer = Fplist_get (XCDR (object), QCpointer);
pointer = plist_get (XCDR (object), QCpointer);
}
#endif /* HAVE_WINDOW_SYSTEM */
@ -34680,7 +34680,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
if (img != NULL && IMAGEP (img->spec))
{
Lisp_Object image_map, hotspot;
if ((image_map = Fplist_get (XCDR (img->spec), QCmap),
if ((image_map = plist_get (XCDR (img->spec), QCmap),
!NILP (image_map))
&& (hotspot = find_hot_spot (image_map,
glyph->slice.img.x + dx,
@ -34698,10 +34698,10 @@ note_mouse_highlight (struct frame *f, int x, int y)
if (CONSP (hotspot)
&& (plist = XCAR (hotspot), CONSP (plist)))
{
pointer = Fplist_get (plist, Qpointer);
pointer = plist_get (plist, Qpointer);
if (NILP (pointer))
pointer = Qhand;
help_echo_string = Fplist_get (plist, Qhelp_echo);
help_echo_string = plist_get (plist, Qhelp_echo);
if (!NILP (help_echo_string))
{
help_echo_window = window;
@ -34711,7 +34711,7 @@ note_mouse_highlight (struct frame *f, int x, int y)
}
}
if (NILP (pointer))
pointer = Fplist_get (XCDR (img->spec), QCpointer);
pointer = plist_get (XCDR (img->spec), QCpointer);
}
}
#endif /* HAVE_WINDOW_SYSTEM */

View file

@ -510,8 +510,8 @@ Point is moved to beginning of the buffer."
(let ((json-key-type 'string))
(setq obj (json-add-to-object obj "g" 7))
(setq obj (json-add-to-object obj "h" 8))
(should (= (lax-plist-get obj "g") 7))
(should (= (lax-plist-get obj "h") 8)))))
(should (= (plist-get obj "g" #'equal) 7))
(should (= (plist-get obj "h" #'equal) 8)))))
(ert-deftest test-json-add-to-hash-table ()
(let* ((json-object-type 'hash-table)

View file

@ -852,24 +852,6 @@
(should-not (plist-get d1 3))
(should-not (plist-get d2 3))))
(ert-deftest test-cycle-lax-plist-get ()
(let ((c1 (cyc1 1))
(c2 (cyc2 1 2))
(d1 (dot1 1))
(d2 (dot2 1 2)))
(should (lax-plist-get c1 1))
(should (lax-plist-get c2 1))
(should (lax-plist-get d1 1))
(should (lax-plist-get d2 1))
(should-error (lax-plist-get c1 2) :type 'circular-list)
(should (lax-plist-get c2 2))
(should-error (lax-plist-get d1 2) :type 'wrong-type-argument)
(should (lax-plist-get d2 2))
(should-error (lax-plist-get c1 3) :type 'circular-list)
(should-error (lax-plist-get c2 3) :type 'circular-list)
(should-error (lax-plist-get d1 3) :type 'wrong-type-argument)
(should-error (lax-plist-get d2 3) :type 'wrong-type-argument)))
(ert-deftest test-cycle-plist-member ()
(let ((c1 (cyc1 1))
(c2 (cyc2 1 2))
@ -906,24 +888,6 @@
(should-error (plist-put d1 3 3) :type 'wrong-type-argument)
(should-error (plist-put d2 3 3) :type 'wrong-type-argument)))
(ert-deftest test-cycle-lax-plist-put ()
(let ((c1 (cyc1 1))
(c2 (cyc2 1 2))
(d1 (dot1 1))
(d2 (dot2 1 2)))
(should (lax-plist-put c1 1 1))
(should (lax-plist-put c2 1 1))
(should (lax-plist-put d1 1 1))
(should (lax-plist-put d2 1 1))
(should-error (lax-plist-put c1 2 2) :type 'circular-list)
(should (lax-plist-put c2 2 2))
(should-error (lax-plist-put d1 2 2) :type 'wrong-type-argument)
(should (lax-plist-put d2 2 2))
(should-error (lax-plist-put c1 3 3) :type 'circular-list)
(should-error (lax-plist-put c2 3 3) :type 'circular-list)
(should-error (lax-plist-put d1 3 3) :type 'wrong-type-argument)
(should-error (lax-plist-put d2 3 3) :type 'wrong-type-argument)))
(ert-deftest test-cycle-equal ()
(should-error (equal (cyc1 1) (cyc1 1)))
(should-error (equal (cyc2 1 2) (cyc2 1 2))))
@ -936,24 +900,12 @@
"Test that `plist-get' doesn't signal an error on degenerate plists."
(should-not (plist-get '(:foo 1 :bar) :bar)))
(ert-deftest lax-plist-get/odd-number-of-elements ()
"Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726."
(should (equal (should-error (lax-plist-get '(:foo 1 :bar) :bar)
:type 'wrong-type-argument)
'(wrong-type-argument plistp (:foo 1 :bar)))))
(ert-deftest plist-put/odd-number-of-elements ()
"Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726."
(should (equal (should-error (plist-put '(:foo 1 :bar) :zot 2)
:type 'wrong-type-argument)
'(wrong-type-argument plistp (:foo 1 :bar)))))
(ert-deftest lax-plist-put/odd-number-of-elements ()
"Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726."
(should (equal (should-error (lax-plist-put '(:foo 1 :bar) :zot 2)
:type 'wrong-type-argument)
'(wrong-type-argument plistp (:foo 1 :bar)))))
(ert-deftest plist-member/improper-list ()
"Check for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=27726."
(should (equal (should-error (plist-member '(:foo 1 . :bar) :qux)
@ -1375,4 +1327,21 @@
(should-error (append loop '(end))
:type 'circular-list)))
(ert-deftest test-plist ()
(let ((plist '(:a "b")))
(setq plist (plist-put plist :b "c"))
(should (equal (plist-get plist :b) "c"))
(should (equal (plist-member plist :b) '(:b "c"))))
(let ((plist '("1" "2" "a" "b")))
(setq plist (plist-put plist (copy-sequence "a") "c"))
(should-not (equal (plist-get plist (copy-sequence "a")) "c"))
(should-not (equal (plist-member plist (copy-sequence "a")) '("a" "c"))))
(let ((plist '("1" "2" "a" "b")))
(setq plist (plist-put plist (copy-sequence "a") "c" #'equal))
(should (equal (plist-get plist (copy-sequence "a") #'equal) "c"))
(should (equal (plist-member plist (copy-sequence "a") #'equal)
'("a" "c")))))
;;; fns-tests.el ends here