Configurable start stop markers.

This commit is contained in:
Dominik Pantůček 2023-03-29 15:00:10 +02:00
parent cbaf49183b
commit 99b86ff9c2

View file

@ -52,18 +52,26 @@
(define known-keys (append mandatory-keys optional-keys))
;; Dynamic start/stop markers
(define start-stop-markers-lookup
'(
(studentstart student start)
(studentstop student stop)
(suspendstart suspend start)
(suspendstop suspend stop)
;;(joined member start)
;;(destroyed member stop)
))
(define start-stop-markers (map car start-stop-markers-lookup))
;; Pass 3: Interpreter passes
(define member-schema-interpreters
`((pass-markers
,(lambda (mr output key value)
(case key
((studentstart studentstop suspendstart suspendstop)
(let ((marker (if (member key '(studentstart suspendstart))
'start
'stop))
(kind (if (member key '(studentstart studentstop))
'student
'suspend)))
(if (member key start-stop-markers)
(let ((marker (caddr (assq key start-stop-markers-lookup)))
(kind (cadr (assq key start-stop-markers-lookup))))
(foldl (lambda (mr value)
(let* ((mspec (string-first+rest (car value)))
(month (string->month (car mspec)))
@ -74,9 +82,8 @@
(list marker month (cdr value) comment))
(member-record-add-highlight
mr (cdr value) "Invalid month specification" 3 'error))))
mr value)))
(else
(member-record-sub-set mr output key value)))))
mr value))
(member-record-sub-set mr output key value))))
(info
,(lambda (mr output key value)
(case key