brmlab/hackerbase
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Configurable start stop markers.

Browse source
This commit is contained in:
Dominik Pantůček 2023-03-29 15:00:10 +02:00
parent cbaf49183b
commit 99b86ff9c2
1 changed files with 28 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

49
member-parser.scm
View file

@ -52,31 +52,38 @@
(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)))
(foldl (lambda (mr value)
(let* ((mspec (string-first+rest (car value)))
(month (string->month (car mspec)))
(comment (cdr mspec)))
(if month
(member-record-sub-prepend
mr output kind
(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)))))
(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)))
(comment (cdr mspec)))
(if month
(member-record-sub-prepend
mr output kind
(list marker month (cdr value) comment))
(member-record-add-highlight
mr (cdr value) "Invalid month specification" 3 'error))))
mr value))
(member-record-sub-set mr output key value))))
(info
,(lambda (mr output key value)
(case key