blob: 818e13146942b3122e98c1de3c9eecfde1194f93 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
;;; keywords.scm -- Convenience procedures for keyword-argument handling.
;;;
;;; Copyright 2003, 2004 Manuel Serrano
;;; Copyright 2006 Ludovic Court�s <ludovic.courtes@laas.fr>
;;;
;;;
;;; This file is part of Skribilo.
;;;
;;; Skribilo is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.
;;;
;;; Skribilo is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with Skribilo. If not, see <http://www.gnu.org/licenses/>.
(define-module (skribilo utils keywords)
#:export (the-body the-options list-split))
;;; Author: Manuel Serrano, Ludovic Court�s
;;;
;;; Commentary:
;;;
;;; This module provides convenience functions to handle keyword arguments.
;;; These are typically used by markup functions.
;;;
;;; Code:
(define (the-body opt+)
;; Filter out the keyword arguments from OPT+.
(let loop ((opt* opt+)
(res '()))
(cond
((null? opt*)
(reverse! res))
((not (pair? opt*))
(error "invalid body" opt*))
((keyword? (car opt*))
(if (null? (cdr opt*))
(error "invalid option" (car opt*))
(loop (cddr opt*) res)))
(else
(loop (cdr opt*) (cons (car opt*) res))))))
(define (the-options opt+ . out)
;; Return a list made of keyword arguments (i.e., each time, a keyword
;; followed by its associated value). The OUT argument should be a list
;; containing keyword argument names to be filtered out (e.g.,
;; `(#:ident)').
(let loop ((opt* opt+)
(res '()))
(cond
((null? opt*)
(reverse! res))
((not (pair? opt*))
(error "invalid options" opt*))
((keyword? (car opt*))
(cond
((null? (cdr opt*))
(error "invalid option" (car opt*)))
((memq (car opt*) out)
(loop (cdr opt*) res))
(else
(loop (cdr opt*)
(cons (list (car opt*) (cadr opt*)) res)))))
(else
(loop (cdr opt*) res)))))
(define (list-split l num . fill)
(let loop ((l l)
(i 0)
(acc '())
(res '()))
(cond
((null? l)
(reverse! (cons (if (or (null? fill) (= i num))
(reverse! acc)
(append! (reverse! acc)
(make-list (- num i) (car fill))))
res)))
((= i num)
(loop l
0
'()
(cons (reverse! acc) res)))
(else
(loop (cdr l)
(+ i 1)
(cons (car l) acc)
res)))))
;;; arch-tag: 3e9066d5-6d7d-4da5-922b-cc3d4ba8476e
;;; keywords.scm ends here
|
