Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 226 lines (174 sloc) 6.966 kb
f649a59 @davazp File description.
authored
1 ;; types.lisp ---
2 ;;
3 ;; This file implements the iCalendar data types described in the
4 ;; RFC5545 and provide a plataform in order to add new data types.
8cf9aca @davazp Changes to time functions.
authored
5 ;;
6 ;; Copyrigth (C) 2009, 2010 Mario Castelán Castro <marioxcc>
7 ;; Copyrigth (C) 2009, 2010 David Vázquez
8 ;;
9 ;; This file is part of cl-icalendar.
10 ;;
11 ;; cl-icalendar is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
15 ;;
16 ;; cl-icalendar is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
20 ;;
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with cl-icalendar. If not, see <http://www.gnu.org/licenses/>.
23
24 (in-package :cl-icalendar)
25
55bb124 @davazp - Move date to type-date.lisp.
authored
26 ;;; This file contains code which implements the values that iCalendar
27 ;;; properties can take. We provide a data type specifier,
28 ;;; constructor, accessors, and utilities functions for each one of
29 ;;; them. Indeed, we provide 3 common functions in order to turn these
30 ;;; objects to strings and vice versa.
31
82ed816 @davazp format-values and some documentation.
authored
32 (deftype ical-value ()
77a0b35 Add geo type.
Mario Castelan Castro authored
33 '(or boolean integer float text binary uri geo cal-address utc-offset
e6dcf80 @davazp format-value accepts a TYPE argument
authored
34 date time datetime duration period recur x-ical-value))
82ed816 @davazp format-values and some documentation.
authored
35
a06431c @davazp UTC-OFFSET data type implemented.
authored
36 ;;; Like `check-type' but it signals an error with %parse-error.
37 (defmacro check-ical-type (place type)
38 (with-gensyms (vplace)
39 `(let ((,vplace ,place))
40 (unless (typep ,vplace ',type)
41 (%parse-error "The ~a is not a ~a type." ',place ',type)))))
42
f233324 @davazp Recover bidirectional translation
authored
43 ;;; Register a iCalendar data type in the standard vendor.
44 (defmacro register-ical-value (symbol &key (name (string symbol)))
45 (check-type symbol symbol)
46 (check-type name string)
47 `(register-translation ',symbol ,name :type))
48
49
55bb124 @davazp - Move date to type-date.lisp.
authored
50 ;;; Generic functions
e6dcf80 @davazp format-value accepts a TYPE argument
authored
51 (defgeneric format-value (value type &optional params))
73c15cf @davazp New parameters.lisp file. This is use to avoid string->symbol
authored
52 (defgeneric parse-value (value type &optional params))
6b811cc @davazp base64 parameter implemented.
authored
53
54 ;;; Multiple-value versions
55
73c15cf @davazp New parameters.lisp file. This is use to avoid string->symbol
authored
56 (defun parse-values (string type &optional params)
57 (declare (symbol type))
7343ebc @davazp Changes to date type.
authored
58 (labels (;; Find the position of the separator character (,) from
21ee0b4 @davazp Indentation.
authored
59 ;; the character at START position.
b9576bf @davazp Fix parse-values bug.
authored
60 (position-separator (start)
61 (let ((position (position #\, string :start start)))
62 (if (and (integerp position)
63 (< 0 position)
64 (char= #\\ (char string (1- position))))
65 (position-separator (1+ position))
66 position))))
67 ;; Collect values
68 (loop for start = 0 then (1+ end)
69 for end = (position-separator start)
70 for sub = (subseq string start end)
73c15cf @davazp New parameters.lisp file. This is use to avoid string->symbol
authored
71 collect (parse-value sub type params)
b9576bf @davazp Fix parse-values bug.
authored
72 while end)))
bc5d77a @davazp Use format-value and parse-value generic functions.
authored
73
e6dcf80 @davazp format-value accepts a TYPE argument
authored
74 (defun format-values (objects type &optional params)
f9f3970 @davazp Patch bug in types.lisp
authored
75 (flet ((format-value* (type x) (format-value x type params)))
e6dcf80 @davazp format-value accepts a TYPE argument
authored
76 (join-strings (map1 #'format-value* type objects) #\,)))
6b811cc @davazp base64 parameter implemented.
authored
77
78
8e82f80 @davazp parse-boolean
authored
79 ;;;; Boolean
80
03e619d @davazp Delete value-typeof generic function
authored
81 (register-ical-value boolean)
7d7ce50 @davazp Recur advances and boolean unit tests added.
authored
82 (define-predicate-type boolean)
83
e6dcf80 @davazp format-value accepts a TYPE argument
authored
84 (defmethod format-value (value (type (eql 'boolean)) &optional params)
2b1feda @davazp Use params variable in format and parse methods.
authored
85 (declare (ignore params))
e6dcf80 @davazp format-value accepts a TYPE argument
authored
86 (if value "TRUE" "FALSE"))
bc5d77a @davazp Use format-value and parse-value generic functions.
authored
87
73c15cf @davazp New parameters.lisp file. This is use to avoid string->symbol
authored
88 (defmethod parse-value (string (type (eql 'boolean)) &optional params)
2b1feda @davazp Use params variable in format and parse methods.
authored
89 (declare (ignore params))
8e82f80 @davazp parse-boolean
authored
90 (cond
5e1f7fe @davazp Boolean values are case-insensitive.
authored
91 ((string-ci= string "TRUE") t)
92 ((string-ci= string "FALSE") nil)
e6dcf80 @davazp format-value accepts a TYPE argument
authored
93 (t (%parse-error "~a is not a boolean data type." string))))
8e82f80 @davazp parse-boolean
authored
94
95
bc5d77a @davazp Use format-value and parse-value generic functions.
authored
96 ;;;; Integer
97
070999c @davazp save-vcalendar function added for testing and routine to get the
authored
98 (register-ical-value integer)
5e2b57d @davazp register-ical-value registers a type in the translation table. Add
authored
99
e6dcf80 @davazp format-value accepts a TYPE argument
authored
100 (defmethod format-value (n (type (eql 'integer)) &optional params)
2b1feda @davazp Use params variable in format and parse methods.
authored
101 (declare (ignore params))
e6dcf80 @davazp format-value accepts a TYPE argument
authored
102 (format nil "~d" n))
bc5d77a @davazp Use format-value and parse-value generic functions.
authored
103
73c15cf @davazp New parameters.lisp file. This is use to avoid string->symbol
authored
104 (defmethod parse-value (string (type (eql 'integer)) &optional params)
2b1feda @davazp Use params variable in format and parse methods.
authored
105 (declare (ignore params))
bc5d77a @davazp Use format-value and parse-value generic functions.
authored
106 (values (parse-integer string)))
107
108
eca5c97 @davazp Rewrite of `parse-float'.
authored
109 ;;;; Float
110
070999c @davazp save-vcalendar function added for testing and routine to get the
authored
111 (register-ical-value float)
5e2b57d @davazp register-ical-value registers a type in the translation table. Add
authored
112
e6dcf80 @davazp format-value accepts a TYPE argument
authored
113 (defmethod format-value (value (type (eql 'float)) &optional params)
2330367 @davazp Bug fixed in datetime+ function.
authored
114 (declare (ignore params))
e6dcf80 @davazp format-value accepts a TYPE argument
authored
115 (format nil "~f" value))
8568c7f @davazp Format functions for boolean and float. Text data type added.
authored
116
73c15cf @davazp New parameters.lisp file. This is use to avoid string->symbol
authored
117 (defmethod parse-value (string (type (eql 'float)) &optional params)
2b1feda @davazp Use params variable in format and parse methods.
authored
118 (declare (ignore params))
eca5c97 @davazp Rewrite of `parse-float'.
authored
119 (let ((sign 1) ; the sign
120 (x 0) ; integer part
121 (y 0)) ; fractional part
122 (with-input-from-string (in string)
123 ;; Read sign
124 (case (peek-char nil in)
125 (#\+
55bb124 @davazp - Move date to type-date.lisp.
authored
126 (read-char in))
eca5c97 @davazp Rewrite of `parse-float'.
authored
127 (#\-
55bb124 @davazp - Move date to type-date.lisp.
authored
128 (setf sign -1)
129 (read-char in)))
eca5c97 @davazp Rewrite of `parse-float'.
authored
130 ;; Read integer part
6f9655c @davazp Rename READ-UNTIL to PARSE
authored
131 (let ((istring (parse in (complement #'digit-char-p) nil nil)))
eca5c97 @davazp Rewrite of `parse-float'.
authored
132 (setf x (parse-integer istring)))
133 ;; Read fractinal part (if any)
134 (let ((dot (read-char in nil)))
135 (unless (null dot)
136 (unless (char= dot #\.)
fb678c8 @davazp Rename parse-error to %parse-error temporarily.
authored
137 (%parse-error "Bad formed float."))
6f9655c @davazp Rename READ-UNTIL to PARSE
authored
138 (let ((fstring (parse in (complement #'digit-char-p) nil nil)))
eca5c97 @davazp Rewrite of `parse-float'.
authored
139 (setf y (/ (float (parse-integer fstring))
d63997b @davazp Fix bug in float parsing
authored
140 (expt 10 (length fstring)))))
141 (unless (null (read-char in nil))
142 (%parse-error "Junk is not allowed after a float value")))))
eca5c97 @davazp Rewrite of `parse-float'.
authored
143 (* sign (+ x y))))
144
145
3cd4c87 Implement URI and CAL-ADDRESS trivial types.
Mario Castelan Castro authored
146 ;;;; URI
147
e6dcf80 @davazp format-value accepts a TYPE argument
authored
148 (deftype uri () 'string)
03e619d @davazp Delete value-typeof generic function
authored
149 (register-ical-value uri)
3cd4c87 Implement URI and CAL-ADDRESS trivial types.
Mario Castelan Castro authored
150
e6dcf80 @davazp format-value accepts a TYPE argument
authored
151 (defmethod format-value (value (type (eql 'uri)) &optional params)
73c15cf @davazp New parameters.lisp file. This is use to avoid string->symbol
authored
152 (declare (ignore params))
e6dcf80 @davazp format-value accepts a TYPE argument
authored
153 value)
73c15cf @davazp New parameters.lisp file. This is use to avoid string->symbol
authored
154
155 (defmethod parse-value (string (type (eql 'uri)) &optional params)
156 (declare (ignore params))
e6dcf80 @davazp format-value accepts a TYPE argument
authored
157 string)
3cd4c87 Implement URI and CAL-ADDRESS trivial types.
Mario Castelan Castro authored
158
9b04951 @davazp unknown-value class defined to treat with unknown iCalendar data types.
authored
159
77a0b35 Add geo type.
Mario Castelan Castro authored
160 ;;;; Geo
161
162 (defclass geo ()
163 ((latitude
164 :type float
165 :initarg :latitude
166 :reader latitude)
167 (longitude
168 :type float
169 :initarg :longitude
170 :reader longitude)))
171
172 (define-predicate-type geo)
173
174 (defun make-geo (latitude longitude)
175 (make-instance 'geo :latitude latitude :longitude longitude))
176
177 (defprinter (x geo)
178 (format t "~d;~d" (latitude x) (longitude x)))
179
e6dcf80 @davazp format-value accepts a TYPE argument
authored
180 (defmethod format-value ((x geo) (type (eql 'geo)) &optional params)
77a0b35 Add geo type.
Mario Castelan Castro authored
181 (declare (ignore params))
182 (format nil "~d;~d" (latitude x) (longitude x)))
183
184 (defmethod parse-value (string (type (eql 'geo)) &optional params)
185 (declare (ignore params))
186 (let* ((parts (split-string string #\;))
187 (length (length parts)))
188 (unless (= 2 length)
189 (%parse-error "Bad formed geo. 2 parts expected ~d found." length))
190 (make-geo (parse-value (first parts) 'float)
191 (parse-value (second parts) 'float))))
192
55bb124 @davazp - Move date to type-date.lisp.
authored
193 ;;;; Cal-address
194
e6dcf80 @davazp format-value accepts a TYPE argument
authored
195 (deftype cal-address ()
196 'string)
55bb124 @davazp - Move date to type-date.lisp.
authored
197
03e619d @davazp Delete value-typeof generic function
authored
198 (register-ical-value cal-address)
55bb124 @davazp - Move date to type-date.lisp.
authored
199
e6dcf80 @davazp format-value accepts a TYPE argument
authored
200 (defmethod format-value (string (type (eql 'cal-address)) &optional params)
201 (declare (ignore params))
202 string)
f279996 @davazp Declarations added.
authored
203
73c15cf @davazp New parameters.lisp file. This is use to avoid string->symbol
authored
204 (defmethod parse-value (string (type (eql 'cal-address)) &optional params)
205 (declare (ignore params))
e6dcf80 @davazp format-value accepts a TYPE argument
authored
206 string)
73c15cf @davazp New parameters.lisp file. This is use to avoid string->symbol
authored
207
f279996 @davazp Declarations added.
authored
208
209
da1e21b @davazp Fix null ical-value specifier in format-value
authored
210 ;;; Format-value and parse-value methods for unknown data types.
c9318d7 @davazp Revert "translate.lisp provides a translation-table type, which is re…
authored
211
d63997b @davazp Fix bug in float parsing
authored
212 (defmethod format-value ((string string) (type (eql 'nil)) &optional params)
c9318d7 @davazp Revert "translate.lisp provides a translation-table type, which is re…
authored
213 (declare (ignore params))
e6dcf80 @davazp format-value accepts a TYPE argument
authored
214 string)
c9318d7 @davazp Revert "translate.lisp provides a translation-table type, which is re…
authored
215
d63997b @davazp Fix bug in float parsing
authored
216 (defmethod parse-value ((string string) (type (eql 'nil)) &optional params)
e6dcf80 @davazp format-value accepts a TYPE argument
authored
217 (declare (ignore params))
218 string)
c9318d7 @davazp Revert "translate.lisp provides a translation-table type, which is re…
authored
219
9b04951 @davazp unknown-value class defined to treat with unknown iCalendar data types.
authored
220 ;; User-defined iCalendar data types
3d147c4 @davazp Use svref indeed of aref.
authored
221 (defclass x-ical-value ()
222 nil)
f279996 @davazp Declarations added.
authored
223
e6dcf80 @davazp format-value accepts a TYPE argument
authored
224
88d95d3 @davazp Rename datatime.lisp to types.lisp
authored
225 ;;; types.lisp ends here
Something went wrong with that request. Please try again.