mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-06-14 04:21:24 +00:00
η-reduce icr:make-bysetpos-filter
This commit is contained in:
parent
9a092fd74e
commit
b223f825f6
2 changed files with 23 additions and 26 deletions
|
|
@ -953,8 +953,8 @@ BYSECOND=... clause; see `icalendar-recur' for the possible values."
|
||||||
(BYMINUTE (icr:refine-byminute interval values vtimezone))
|
(BYMINUTE (icr:refine-byminute interval values vtimezone))
|
||||||
(BYSECOND (icr:refine-bysecond interval values vtimezone))))
|
(BYSECOND (icr:refine-bysecond interval values vtimezone))))
|
||||||
|
|
||||||
(defun icr:make-bysetpos-filter (setpos)
|
(defun icr:bysetpos-filter (setpos recurrences)
|
||||||
"Return a filter on values for the indices in SETPOS.
|
"Filter RECURRENCES on values for the indices in SETPOS.
|
||||||
|
|
||||||
SETPOS should be a list of positive or negative integers between -366
|
SETPOS should be a list of positive or negative integers between -366
|
||||||
and 366, indicating a fixed index in a set of recurrences for *one
|
and 366, indicating a fixed index in a set of recurrences for *one
|
||||||
|
|
@ -963,25 +963,24 @@ an `icalendar-recur'. For example, in a YEARLY recurrence rule with an
|
||||||
INTERVAL of 1, the SETPOS represent indices in the recurrence instances
|
INTERVAL of 1, the SETPOS represent indices in the recurrence instances
|
||||||
generated for a single year.
|
generated for a single year.
|
||||||
|
|
||||||
The returned value is a closure which can be called on the list of
|
The returned value is RECURRENCES filtered by index."
|
||||||
recurrences for one interval to filter it by index."
|
(let* ((len (length recurrences))
|
||||||
(lambda (dts)
|
(keep-indices (mapcar
|
||||||
(let* ((len (length dts))
|
(lambda (pos)
|
||||||
(keep-indices (mapcar
|
;; sequence indices are 0-based, POS's are 1-based:
|
||||||
(lambda (pos)
|
(if (< pos 0)
|
||||||
;; sequence indices are 0-based, POS's are 1-based:
|
(+ pos len)
|
||||||
(if (< pos 0)
|
(1- pos)))
|
||||||
(+ pos len)
|
setpos))
|
||||||
(1- pos)))
|
(r nil)
|
||||||
setpos))
|
(i 0)
|
||||||
(r nil)
|
(dts recurrences))
|
||||||
(i 0))
|
(while dts
|
||||||
(while dts
|
(when (memq i keep-indices)
|
||||||
(when (memq i keep-indices)
|
(push (car dts) r))
|
||||||
(push (car dts) r))
|
(incf i)
|
||||||
(incf i)
|
(pop dts))
|
||||||
(pop dts))
|
(nreverse r)))
|
||||||
(nreverse r))))
|
|
||||||
|
|
||||||
(defun icr:refine-from-clauses (interval recur-value dtstart
|
(defun icr:refine-from-clauses (interval recur-value dtstart
|
||||||
&optional vtimezone)
|
&optional vtimezone)
|
||||||
|
|
@ -1225,8 +1224,7 @@ retrieved on subsequent calls with the same arguments."
|
||||||
(keep-indices (ical:recur-by* 'BYSETPOS recur-value))
|
(keep-indices (ical:recur-by* 'BYSETPOS recur-value))
|
||||||
(pos-recs
|
(pos-recs
|
||||||
(if keep-indices
|
(if keep-indices
|
||||||
(funcall (icr:make-bysetpos-filter keep-indices)
|
(icr:bysetpos-filter keep-indices sub-recs)
|
||||||
sub-recs)
|
|
||||||
sub-recs))
|
sub-recs))
|
||||||
;; Remove any recurrences before DTSTART or after UNTIL
|
;; Remove any recurrences before DTSTART or after UNTIL
|
||||||
;; (both of which are inclusive bounds):
|
;; (both of which are inclusive bounds):
|
||||||
|
|
|
||||||
|
|
@ -117,13 +117,12 @@ END:VTIMEZONE
|
||||||
;; Tests for basic functions:
|
;; Tests for basic functions:
|
||||||
|
|
||||||
(ert-deftest ict:recur-bysetpos-filter ()
|
(ert-deftest ict:recur-bysetpos-filter ()
|
||||||
"Test that `icr:make-bysetpos-filter' filters correctly by position"
|
"Test that `icr:bysetpos-filter' filters correctly by position"
|
||||||
(let* ((t1 (list 1 1 2024))
|
(let* ((t1 (list 1 1 2024))
|
||||||
(t2 (list 2 1 2024))
|
(t2 (list 2 1 2024))
|
||||||
(t3 (list 12 30 2024))
|
(t3 (list 12 30 2024))
|
||||||
(dts (list t1 t2 t3))
|
(dts (list t1 t2 t3))
|
||||||
(filter (icr:make-bysetpos-filter (list 1 -1)))
|
(filtered (icr:bysetpos-filter (list 1 -1) dts)))
|
||||||
(filtered (funcall filter dts)))
|
|
||||||
(should (member t1 filtered))
|
(should (member t1 filtered))
|
||||||
(should (member t3 filtered))
|
(should (member t3 filtered))
|
||||||
(should-not (member t2 filtered))))
|
(should-not (member t2 filtered))))
|
||||||
|
|
|
||||||
Loading…
Reference in a new issue