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)) (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 ;; Pass 3: Interpreter passes
(define member-schema-interpreters (define member-schema-interpreters
`((pass-markers `((pass-markers
,(lambda (mr output key value) ,(lambda (mr output key value)
(case key (if (member key start-stop-markers)
((studentstart studentstop suspendstart suspendstop) (let ((marker (caddr (assq key start-stop-markers-lookup)))
(let ((marker (if (member key '(studentstart suspendstart)) (kind (cadr (assq key start-stop-markers-lookup))))
'start (foldl (lambda (mr value)
'stop)) (let* ((mspec (string-first+rest (car value)))
(kind (if (member key '(studentstart studentstop)) (month (string->month (car mspec)))
'student (comment (cdr mspec)))
'suspend))) (if month
(foldl (lambda (mr value) (member-record-sub-prepend
(let* ((mspec (string-first+rest (car value))) mr output kind
(month (string->month (car mspec))) (list marker month (cdr value) comment))
(comment (cdr mspec))) (member-record-add-highlight
(if month mr (cdr value) "Invalid month specification" 3 'error))))
(member-record-sub-prepend mr value))
mr output kind (member-record-sub-set mr output key value))))
(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)))))
(info (info
,(lambda (mr output key value) ,(lambda (mr output key value)
(case key (case key