Implemented read-pbxproj.
[com-informatimago:com-informatimago.git] / xcode / pbxproj.lisp
1 ;;;; -*- mode:lisp;coding:utf-8 -*-
2 ;;;;**************************************************************************
3 ;;;;FILE:               pbxproj.lisp
4 ;;;;LANGUAGE:           Common-Lisp
5 ;;;;SYSTEM:             Common-Lisp
6 ;;;;USER-INTERFACE:     NONE
7 ;;;;DESCRIPTION
8 ;;;;    
9 ;;;;    A program to read Xcode .pbxproj files.
10 ;;;;    
11 ;;;;AUTHORS
12 ;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
13 ;;;;MODIFICATIONS
14 ;;;;    2012-12-10 <PJB> Created.
15 ;;;;BUGS
16 ;;;;LEGAL
17 ;;;;    AGPL3
18 ;;;;    
19 ;;;;    Copyright Pascal J. Bourguignon 2012 - 2012
20 ;;;;    
21 ;;;;    This program is free software: you can redistribute it and/or modify
22 ;;;;    it under the terms of the GNU Affero General Public License as published by
23 ;;;;    the Free Software Foundation, either version 3 of the License, or
24 ;;;;    (at your option) any later version.
25 ;;;;    
26 ;;;;    This program is distributed in the hope that it will be useful,
27 ;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
28 ;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
29 ;;;;    GNU Affero General Public License for more details.
30 ;;;;    
31 ;;;;    You should have received a copy of the GNU Affero General Public License
32 ;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>.
33 ;;;;**************************************************************************
34
35 (defpackage "COM.INFORMATIMAGO.XCODE"
36   (:use "COMMON-LISP"
37         "COM.INFORMATIMAGO.RDP"
38         "COM.INFORMATIMAGO.COMMON-LISP.PARSER.SCANNER")
39   (:export "READ-PBXPROJ"
40            "WRITE-PBXPROJ"))
41 (in-package "COM.INFORMATIMAGO.XCODE")
42
43
44
45 ;;----------------------------------------------------------------------
46 ;; pbxproj scanner
47 ;;----------------------------------------------------------------------
48
49 (defclass pbxproj-scanner (rdp-scanner)
50   ((bom :initform nil :accessor pbxproj-bom)))
51
52
53 (defun eofp (object) (null object))
54 (defvar *eof* nil)
55
56 (defun unquoted-string-char-p (ch)
57    (or (alphanumericp ch) (find ch ".$_/")))
58
59 (defmethod scan-next-token ((scanner pbxproj-scanner) &optional parser-data)
60   (declare (ignore parser-data))
61   (when (zerop (scanner-line scanner))
62     (setf (pbxproj-bom scanner) (readline scanner)))
63   (setf (scanner-current-token scanner)
64         (flet ((scan-unquoted-string (scanner)
65                  (loop
66                    :with string = (make-array 8
67                                               :element-type 'character
68                                               :initial-element #\space
69                                               :adjustable t :fill-pointer 0)
70                    :for ch = (getchar scanner)
71                    :while (unquoted-string-char-p ch)
72                    :do (vector-push-extend ch string (length string))
73                    :finally (progn
74                               (ungetchar scanner ch)
75                               (return (make-instance 'token  :kind 'string :text string
76                                                      :column (scanner-column scanner)
77                                                      :line (scanner-line scanner)))))))
78           (let ((ch (nextchar scanner)))
79             (case ch
80               ((nil)
81                *eof*)
82               ((#\{)
83                (getchar scanner)
84                (make-instance 'token :kind 'left-brace :text "{"
85                               :column (scanner-column scanner)
86                               :line (scanner-line scanner)))
87               ((#\;)
88                (getchar scanner)
89                (make-instance 'token :kind 'semi-colon :text ";"
90                               :column (scanner-column scanner)
91                               :line (scanner-line scanner)))
92               ((#\})
93                (getchar scanner)
94                (make-instance 'token :kind 'right-brace :text "}"
95                               :column (scanner-column scanner)
96                               :line (scanner-line scanner)))
97               ((#\()
98                (getchar scanner)
99                (make-instance 'token :kind 'left-paren :text "("
100                               :column (scanner-column scanner)
101                               :line (scanner-line scanner)))
102               ((#\,)
103                (getchar scanner)
104                (make-instance 'token :kind 'comma :text ","
105                               :column (scanner-column scanner)
106                               :line (scanner-line scanner)))
107               ((#\))
108                (getchar scanner)
109                (make-instance 'token :kind 'right-paren :text ")"
110                               :column (scanner-column scanner)
111                               :line (scanner-line scanner)))
112               ((#\=)
113                (getchar scanner)
114                (make-instance 'token :kind 'equal :text "="
115                               :column (scanner-column scanner)
116                               :line (scanner-line scanner)))
117               ((#\")
118                (getchar scanner)
119                (loop
120                  :named :eat-string
121                  :with column = (scanner-column scanner)
122                  :with line   = (scanner-line   scanner)
123                  :with string = (make-array 8
124                                             :element-type 'character
125                                             :initial-element #\space
126                                             :adjustable t :fill-pointer 0)
127                  :for ch = (getchar scanner)
128                  :while (and ch (char/= ch #\"))
129                  :do (vector-push-extend (if (char= #\\ ch)
130                                              (let ((ch (getchar scanner)))
131                                                (case ch
132                                                  ((#\n) #\newline)
133                                                  ((#\t) #\tab)
134                                                  ((#\v) #\vt)
135                                                  ((#\b) #\bell)
136                                                  ((#\r) #\return)
137                                                  ;; TODO: Perhaps scan octal character codes?
138                                                  (otherwise ch)))
139                                              ch)
140                                          string (length string))
141                  :finally (let ((token (make-instance 'token :kind 'string :text string
142                                                       :column column :line line)))
143                             (unless ch
144                               (error 'scanner-error
145                                      :line line :column column
146                                      :current-token token
147                                      :scanner scanner
148                                      :format-control "End of file while reading a string."))
149                             (return-from :eat-string token))))
150               ((#\/)
151                (getchar scanner)
152                (if (char= #\* (nextchar scanner))
153                    (progn ; comment
154                      (getchar scanner) 
155                      (loop
156                        :named :eat-comment
157                        :with column = (scanner-column scanner)
158                        :with line   = (scanner-line   scanner)
159                        :for ch = (getchar scanner)
160                        :while (and ch (not (and (eql #\* ch) (eql #\/ (nextchar scanner)))))
161                        :finally (progn
162                                   (unless ch
163                                     (error 'scanner-error
164                                            :line line :column column
165                                            :scanner scanner
166                                            :format-control "End of file while reading a comment."))
167                                   (getchar scanner)
168                                   (return-from :eat-comment (scan-next-token scanner)))))
169                    (progn
170                      (ungetchar scanner #\/)
171                      (scan-unquoted-string scanner))))
172               ((#\space #\newline #\vt #\tab)
173                (getchar scanner)
174                (scan-next-token scanner))
175               (otherwise
176                (if (unquoted-string-char-p ch)
177                    (scan-unquoted-string scanner)
178                    (progn
179                      (getchar scanner) ; let's eat it so that error recovery skips it.
180                      (error 'scanner-error
181                             :line (scanner-line scanner)
182                             :column (scanner-column scanner)
183                             :scanner scanner
184                             :format-control "Unexpected character '~C' (code ~D)."
185                             :format-arguments (list ch (char-code ch))))))))))
186   (setf (scanner-current-text scanner) (token-text (scanner-current-token scanner)))
187   (scanner-current-token scanner))
188
189
190 (defmethod advance-line  ((scanner pbxproj-scanner))
191   (scan-next-token scanner))
192
193
194 (defmethod scanner-end-of-source-p ((scanner pbxproj-scanner))
195   (eofp (scanner-current-token scanner)))
196
197 (defmethod word-equal ((a symbol) (b token)) (eql a (token-kind b)))
198 (defmethod word-equal ((a token) (b symbol)) (eql (token-kind a) b))
199
200 (when (find-method (function scanner-current-token) '()  '(rdp-scanner) nil)
201   (remove-method (function scanner-current-token) (find-method (function scanner-current-token) '()  '(rdp-scanner))))
202
203 (defmethod accept ((scanner rdp-scanner) expected)
204   (let ((token (scanner-current-token scanner)))
205    (if (word-equal expected token)
206        (prog1 (list (token-kind token)
207                     (token-text token)
208                     (token-column token))
209          (scan-next-token scanner))
210        (call-next-method))))
211
212
213 (defun test/scan-stream (src)
214   (loop
215     :with scanner = (make-instance 'pbxproj-scanner :source src :state 0)
216     ;; :initially (progn
217     ;;              (advance-line scanner)
218     ;;              (format t "~2%;; ~A~%;; ~A~%"
219     ;;                      (scanner-buffer scanner)
220     ;;                      (scanner-current-token scanner)))
221     :do (progn
222           (scan-next-token scanner)
223           (format t "~&~3A ~20A ~20S ~3A ~3A ~20A ~A~%"
224                   (scanner-state scanner)
225                   (token-kind (scanner-current-token scanner))
226                   (token-text (scanner-current-token scanner))
227                   (eofp (scanner-current-token scanner))
228                   (eofp (scanner-current-token scanner))
229                   "-" ;; (scanner-previous-token-kind scanner) 
230                   (type-of (scanner-current-token scanner)))
231           (finish-output))
232     :while (scanner-current-token scanner)))
233
234 (defun test/scan-file (path)
235   (with-open-file (src path)
236     (test/scan-stream src)))
237
238 (defun test/scan-string (source)
239   (with-input-from-string (src source)
240     (test/scan-stream src)))
241
242
243
244 ;;----------------------------------------------------------------------
245 ;; pbxproj parser
246 ;;----------------------------------------------------------------------
247
248 (when (and (find-package "COM.INFORMATIMAGO.RDP")
249            (find-symbol "*BOILERPLATE-GENERATED*" "COM.INFORMATIMAGO.RDP")
250            (boundp (find-symbol "*BOILERPLATE-GENERATED*" "COM.INFORMATIMAGO.RDP")))
251   (setf (symbol-value (find-symbol "*BOILERPLATE-GENERATED*" "COM.INFORMATIMAGO.RDP")) nil))
252
253
254 (defgrammar pbxproj
255     :scanner pbxproj-scanner
256     :terminals ((string "…")
257                 (equal "=")
258                 (left-brace "{")
259                 (semi-colon ";")
260                 (right-brace "}")
261                 (left-paren "(")
262                 (comma ",")
263                 (right-paren ")"))
264     :start file
265     :rules ((--> file    object)
266             (--> object  left-brace slots right-brace
267                  :action $2)
268             (--> slots   (rep slot semi-colon :action $1)
269                  :action (cons 'object $1))
270             (--> slot    string equal data
271                  :action (list (second $1) (second $3)))
272             (--> data    (alt (seq string :action (second $1))
273                               (seq object :action $1)
274                               (seq list   :action $1)))
275             (--> list    left-paren (rep data comma :action (second $1)) right-paren
276                  :action (cons 'list $2))))
277
278
279
280
281 (defun test/parse-stream (src)
282   (let ((scanner (make-instance 'pbxproj-scanner :source src :state 0)))
283     (parse-pbxproj scanner)))
284
285
286 (defun test/parse-string (source)
287   (with-input-from-string (src source)
288     (test/parse-stream src)))
289
290 ;; (test/scan-file  #P"~/works/abalone-macosx/Abalone-10.7/Abalone.xcodeproj/project.pbxproj")
291
292 (defun read-pbxproj (path)
293   (with-open-file (stream path)
294     (parse-pbxproj  stream)))
295
296 ;; (read-pbxproj #P"~/works/abalone-macosx/Abalone-10.7/Abalone.xcodeproj/project.pbxproj")
297