GNU bug report logs - #27584
26.0.50; alist-get: Add optional arg TESTFN

Previous Next

Full log

Message #8 received at 27584 <at> debbugs.gnu.org (full text, mbox):

From: Tino Calancha <tino.calancha <at> gmail.com>
To: 27584 <at> debbugs.gnu.org
Cc: nicolas petton <nicolas <at> petton.fr>,
 stefan monnier <monnier <at> iro.umontreal.ca>
Subject: Re: bug#27584: 26.0.50; alist-get: Add optional arg TESTFN
Date: Wed, 05 Jul 2017 17:53:29 +0900

>  
> -(defun assoc-default (key alist &optional test default)
> +(defun assoc-default (key alist &optional test default full)
>    "Find object KEY in a pseudo-alist ALIST.
>  ALIST is a list of conses or objects.  Each element
>   (or the element's car, if it is a cons) is compared with KEY by
>   calling TEST, with two arguments: (i) the element or its car,
>   and (ii) KEY.
>  If that is non-nil, the element matches; then `assoc-default'
> - returns the element's cdr, if it is a cons, or DEFAULT if the
> - element is not a cons.
> + returns the element, if it is a cons and FULL is non-nil,
> + or the element's cdr, if it is a cons and FULL is nil,
> + or DEFAULT if the element is not a cons.
>  
>  If no element matches, the value is nil.
>  If TEST is omitted or nil, `equal' is used."
>    (let (found (tail alist) value)
>      (while (and tail (not found))
>        (let ((elt (car tail)))
> -	(when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key)
> -	  (setq found t value (if (consp elt) (cdr elt) default))))
> +        (when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key)
> +          (setq found t
> +                value (cond ((consp elt)
> +                             (if full elt (cdr elt)))
> +                            (t default)))))
>        (setq tail (cdr tail)))
>      value))

If we go in this direction, then i think it has sense to add
something with less parameters, like this:

(defsubst assoc-predicate (key alist test)
  "Like `assoc' but compare keys with TEST."
  (assoc-default key alist test nil 'full))

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.