* 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).
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,
@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,
@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
\f
* 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.
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
;; `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
(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))
(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"
(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
(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'."
(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."
((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))))))
(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))
\f
(provide 'simple)
}
ASET (attrs, coding_attr_plist,
- Fplist_put (CODING_ATTR_PLIST (attrs), prop, val));
+ plist_put (CODING_ATTR_PLIST (attrs), prop, val));
return val;
}
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. */
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))
\f
/* 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 (EQ (prop, XCAR (tail)))
+ 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)
+ {
+ if (! CONSP (XCDR (tail)))
+ break;
+ if (EQ (prop, XCAR (tail)))
+ return XCAR (XCDR (tail));
+ tail = XCDR (tail);
+ }
+ return Qnil;
+}
+
DEFUN ("get", Fget, Sget, 2, 2, 0,
doc: /* Return the value of SYMBOL's PROPNAME property.
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 (EQ (prop, XCAR (tail)))
+ if (!NILP (call2 (predicate, prop, XCAR (tail))))
{
Fsetcar (XCDR (tail), val);
return plist;
return plist;
}
-DEFUN ("put", Fput, Sput, 3, 3, 0,
- doc: /* Store SYMBOL's PROPNAME property with value VALUE.
-It can be retrieved with `(get SYMBOL PROPNAME)'. */)
- (Lisp_Object symbol, Lisp_Object propname, Lisp_Object value)
-{
- CHECK_SYMBOL (symbol);
- set_symbol_plist
- (symbol, Fplist_put (XSYMBOL (symbol)->u.s.plist, propname, value));
- return value;
-}
-\f
-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
+plist_put (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))))
+ if (EQ (prop, XCAR (tail)))
{
Fsetcar (XCDR (tail), val);
return plist;
tail = XCDR (tail);
}
CHECK_TYPE (NILP (tail), Qplistp, plist);
- Lisp_Object newcell = list2 (prop, val);
+ Lisp_Object newcell
+ = Fcons (prop, Fcons (val, NILP (prev) ? plist : XCDR (XCDR (prev))));
if (NILP (prev))
return newcell;
Fsetcdr (XCDR (prev), newcell);
return plist;
}
+
+DEFUN ("put", Fput, Sput, 3, 3, 0,
+ doc: /* Store SYMBOL's PROPNAME property with value VALUE.
+It can be retrieved with `(get SYMBOL PROPNAME)'. */)
+ (Lisp_Object symbol, Lisp_Object propname, Lisp_Object value)
+{
+ CHECK_SYMBOL (symbol);
+ set_symbol_plist
+ (symbol, plist_put (XSYMBOL (symbol)->u.s.plist, propname, value));
+ return value;
+}
\f
DEFUN ("eql", Feql, Seql, 2, 2, 0,
doc: /* Return t if the two args are `eq' or are indistinguishable numbers.
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))
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;
}
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);
defsubr (&Sget);
defsubr (&Splist_put);
defsubr (&Sput);
- defsubr (&Slax_plist_get);
- defsubr (&Slax_plist_put);
defsubr (&Seql);
defsubr (&Sequal);
defsubr (&Sequal_including_properties);
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;
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))
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))
{
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);
}
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)
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);
}
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);
}
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);
}
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));
}
}
}
: 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)
/* 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;
{
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;
}
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))
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 */
/* 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; \
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);
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;
}
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;
}
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;
}
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,
/* 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),
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);
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
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))
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))
Lisp_Object coding_systems = Qt;
Lisp_Object val, *args2;
- tem = Fplist_get (contact, QCcoding);
+ tem = plist_get (contact, QCcoding);
if (!NILP (tem))
{
val = tem;
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 ();
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);
Lisp_Object coding_systems = Qt;
Lisp_Object val;
- tem = Fplist_get (contact, QCcoding);
+ tem = plist_get (contact, QCcoding);
val = Qnil;
if (!NILP (tem))
{
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;
}
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);
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);
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);
update_process_mark (p);
- tem = Fplist_get (contact, QCcoding);
+ tem = plist_get (contact, QCcoding);
val = Qnil;
if (!NILP (tem))
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. */
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))
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);
{
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);
}
#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)
{
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
}
#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
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'");
/* :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;
}
/* :family FAMILY -- nil (for Inet), local, or integer. */
- tem = Fplist_get (contact, QCfamily);
+ tem = plist_get (contact, QCfamily);
if (NILP (tem))
{
#ifdef AF_INET6
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
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);
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;
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
/* 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);
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. */
#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);
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)
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);
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)
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 */
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 (before);
}
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);
}
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);
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;
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);
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;
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))
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
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
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;
selected. */
if (selected_p)
{
- plist = Fplist_put (plist, QCrelief, make_fixnum (-relief));
+ plist = plist_put (plist, QCrelief, make_fixnum (-relief));
hmargin -= relief;
vmargin -= relief;
}
/* 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;
}
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
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;
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);
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
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);
}
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'
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))
{
{
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
/* 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)
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))
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;
}
}
if (NILP (pointer))
- pointer = Fplist_get (XCDR (object), QCpointer);
+ pointer = plist_get (XCDR (object), QCpointer);
}
#endif /* HAVE_WINDOW_SYSTEM */
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,
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;
}
}
if (NILP (pointer))
- pointer = Fplist_get (XCDR (img->spec), QCpointer);
+ pointer = plist_get (XCDR (img->spec), QCpointer);
}
}
#endif /* HAVE_WINDOW_SYSTEM */
(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)
(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))
(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))))
"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)
(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
projects / emacs.git / commitdiff