aboutsummaryrefslogtreecommitdiffstats
path: root/src/xfdf.lisp
blob: a3ada7b5363262ab20c4dbdb752458416f87bde4 (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
100
101
(in-package :xfdf)

(defun write-xfdf (output-stream fields)
  "Write an XFDF document to `output-stream` using cons cells in the `fields`
list."
  (format output-stream "~
<?xml version=\"1.0\" encoding=\"UTF-8\"?>
<xfdf xmlns=\"http://ns.adobe.com/xfdf/\" xml:space=\"preserve\">
	<fields>
")

;   (loop for (name . value) in fields
;         do
;         (let ((value (cond ((eq value t) "Yes")
;                            ((eq value nil) "Off")
;                            (t value))))
;           (format output-stream "		<field name=\"~A\">
; 			<value>~A</value>
; 		</field>
; "
; name
; value)))

  (loop for (name . value) in fields
        do
        (format output-stream "~A" (field-xfdf name value)))

  (format output-stream "	</fields>
</xfdf>")

  output-stream)

(defconstant +field-base-indentation+ 2)

(defun field-xfdf (name value)
  "Build an XFDF XML string for a field."
  (field-xfdf* name value 0))

(defun field-xfdf* (name value nesting-level)
  "Build an XFDF XML string for a field. The `nesting-level` specifies the
amount of indentation to use relative to the +field-base-indentation+."
  (let ((indent (+ +field-base-indentation+ nesting-level)))
    ;; TODO: Add checkbox default values.
    (if (consp value)
        ;; TODO: We need to do something with value
        ;; TODO: How to concat results from dolist?
        (let ((inner-fields
                (loop for field in value
                      collect
                      (let ((subname (if (listp field)
                                         (first field)
                                         field))
                            (subfield (if (listp field)
                                          (rest field)
                                          field)))
                        (field-xfdf* subname subfield (1+ nesting-level))))))
          (build-xfdf-outer-field name inner-fields indent))

        ;; TODO: Put checkbox stuff here.
        (let ((value (pdf-checkbox-value value)))
          (build-xfdf-field name value indent)))))
;; * (format t "~v{~A~:*~}<>~A" 5 '("Hello") "Next")

(defun pdf-checkbox-value (value)
  "If `value` is T or NIL, convert it to the default PDF checkbox values
'Yes' and 'Off' respectively.

If `value` is anything else, return its identity."

  (cond ((eq value t) "Yes")
        ((eq value nil) "Off")
        (t value)))

(defun build-xfdf-outer-field (name inner-fields-string indent)
  "Build the XFDF XML for a field containing other fields."
  (format nil "~
~v{~A~:*~}<field name=\"~A\">
~{~A~}~v{~A~:*~}</field>
"
indent
'("	")
name
inner-fields-string
indent
'("	")))

(defun build-xfdf-field (name value indent)
  "Build the XFDF XML for a single field."
  (format nil "~
~v{~A~:*~}<field name=\"~A\">
~v{~A~:*~}	<value>~A</value>
~v{~A~:*~}</field>
"
indent
'("	")
name
indent
'("	")
value
indent
'("	")))