Added finalizing of all gtk+ classes at the end of compilation
[cl-gtk2.git] / doc / skeleton.lisp
blob0699720de251e0c477c38316577f0b0a78be179c
1 (defpackage :doc-skeleton
2 (:use :cl :gtk :gdk :gobject :iter :c2mop :glib)
3 (:export :widget-skeleton
4 :widgets-chapter-skeleton
5 :enum-skeleton
6 :flags-skeleton
7 :all-enums
8 :all-flags
9 :enum-chapter-skeleton
10 :flags-chapter-skeleton
11 :struct-skeleton
12 #:all-structs
13 #:struct-chapter-skeleton
14 #:interface-chapter-skeleton
15 #:all-interfaces
16 #:interface-skeleton
17 #:all-widgets
18 #:all-classes
19 #:all-gtk-skeletons))
21 (in-package :doc-skeleton)
23 (defun widgets-chapter-skeleton (output widgets &key (use-refs t) (section "section"))
24 (cond
25 ((or (pathnamep output)
26 (stringp output))
27 (with-open-file (stream output :direction :output :if-exists :supersede)
28 (widgets-chapter-skeleton stream widgets :use-refs use-refs :section section)))
29 ((null output) (with-output-to-string (stream)
30 (widgets-chapter-skeleton stream widgets :use-refs use-refs :section section)))
31 ((or (eq t output) (streamp output))
32 (format output "@menu~%")
33 (iter (for w in widgets)
34 (format output "* ~A::~%" (string-downcase (symbol-name w))))
35 (format output "@end menu~%~%")
36 (iter (for w in widgets)
37 (write-string (widget-skeleton w :section section :use-refs use-refs) output)
38 (format output "~%~%")))))
40 (defparameter *exclusions* '(gdk:display gdk:screen))
42 (defparameter *ref-exclusions* '(gtk-demo::custom-window gtkglext:gl-drawing-area gtkglext:gdk-gl-window gtkglext:gdk-gl-pixmap))
44 (defun all-widgets (package)
45 (sort (iter (for symbol in-package (find-package package) :external-only t)
46 (unless (member symbol *exclusions*)
47 (for class = (find-class symbol nil))
48 (when (and class (subclassp class (find-class 'gtk:widget)))
49 (collect symbol))))
50 #'string<))
52 (defun all-classes (package)
53 (sort (iter (for symbol in-package (find-package package) :external-only t)
54 (unless (member symbol *exclusions*)
55 (for class = (find-class symbol nil))
56 (when (and class
57 (not (subclassp class (find-class 'condition)))
58 (not (subclassp class (find-class 'gtk:widget)))
59 (or (not (typep class 'gobject::gobject-class))
60 (not (gobject::gobject-class-interface-p class)))
61 (not (typep class 'structure-class)))
62 (collect symbol))))
63 #'string<))
65 ;; (widget-skeleton widget &key (sectioning-command "section"))
66 ;; returns the texinfo string for widget (a symbol or class)
67 ;; Template:
68 ;;
69 ;; @node $WIDGET
70 ;; @$SECTIONING-COMMAND $WIDGET
72 ;; @Class $WIDGET
73 ;;
74 ;; Superclass: $(direct-superclass WIDGET)
76 ;; Interfaces: $(direct-interface widget)
78 ;; Slots:
79 ;; @itemize
80 ;; $(for each slot)
81 ;; @item @anchor{slot.$widget.$slot}$slot. Type: $(slot-type slot). Accessor: $(slot-accessor slot). $(when (constructor-only slot) "Contructor-only slot.")
82 ;; $(end for)
83 ;; @end itemize
85 ;; Signals:
86 ;; @itemize
87 ;; $(for each signal)
88 ;; @item @anchor{signal.$widget.$signal}"$signal". Signature: Type1 Arg1, .., Typen Argn => return-type. Options: $(signal-options)
89 ;; $(end for)
90 ;; @end itemize
92 (defvar *use-refs* t)
94 (defun widget-skeleton (widget &key (section "section") (use-refs t))
95 (unless (typep widget 'class) (setf widget (find-class widget)))
96 (with-output-to-string (stream)
97 (let ((*print-case* :downcase)
98 (*package* (symbol-package (class-name widget)))
99 (*print-circle* nil)
100 (*use-refs* use-refs))
101 (format stream "@node ~A~%" (class-name widget))
102 (format stream "@~A ~A~%" section (class-name widget))
103 (format stream "@Class ~A~%" (class-name widget))
104 (format stream "Superclass:")
105 (iter (for super in (class-direct-superclasses widget))
106 (format stream " ~A" (format-ref (class-name super))))
107 (when (class-direct-subclasses widget)
108 (format stream "~%~%")
109 (format stream "Subclasses:")
110 (iter (for sub in (class-direct-subclasses widget))
111 (unless (member (class-name sub) *ref-exclusions*)
112 (format stream " ~A" (format-ref (class-name sub))))))
113 (format stream "~%~%")
114 (widget-slots stream widget)
115 (format stream "~%~%")
116 (widget-signals stream widget)
117 (format stream "~%~%")
118 (widget-child-properties stream widget))))
120 (defun widget-slots (stream widget)
121 (format stream "Slots:~%")
122 (format stream "@itemize~%")
123 (iter (for slot in (sort (copy-list (class-direct-slots widget)) #'string< :key #'slot-definition-name))
124 (when (typep slot 'gobject::gobject-direct-slot-definition)
125 (format stream "@item @anchor{slot.~A.~A}~A. Type: ~A. Accessor: ~A."
126 (class-name widget) (slot-definition-name slot)
127 (slot-definition-name slot)
128 (slot-type slot)
129 (slot-accessor slot))
130 (case (classify-slot-readability widget slot)
131 (:write-only (format stream " Write-only."))
132 (:read-only (format stream " Read-only.")))
133 (format stream "~%")))
134 (format stream "@end itemize~%"))
136 (defun widget-signals (stream widget)
137 (when (typep widget 'gobject::gobject-class)
138 (let ((g-type (gobject::gobject-class-direct-g-type-name widget)))
139 (when g-type
140 (format stream "Signals:~%")
141 (format stream "@itemize~%")
142 ;; @item @anchor{signal.$widget.$signal}"$signal". Signature: Type1 Arg1, .., Typen Argn => return-type. Options: $(signal-options)
143 (iter (for signal in (sort (copy-list (type-signals g-type)) #'string< :key #'signal-info-name))
144 (format stream "@item @anchor{signal.~A.~A}\"~A\". Signature: ~A. Options: ~A."
145 (class-name widget)
146 (signal-info-name signal)
147 (signal-info-name signal)
148 (signal-signature signal)
149 (signal-options signal))
150 (format stream "~%"))
151 (format stream "@end itemize~%")))))
153 (defun widget-child-properties (stream widget)
154 (when (typep stream 'gobject::gobject-class)
155 (let ((g-type (gobject::gobject-class-g-type-name widget)))
156 (when (g-type-is-a g-type "GtkContainer")
157 (unless (string= g-type (gobject::gobject-class-g-type-name (first (class-direct-superclasses widget))))
158 (let ((props (gtk::container-class-child-properties g-type)))
159 (when props
160 (format stream "Child properties:~%")
161 (format stream "@itemize~%")
162 ;; @item @anchor{signal.$widget.$signal}"$signal". Signature: Type1 Arg1, .., Typen Argn => return-type. Options: $(signal-options)
163 (iter (for prop in (sort (copy-list props) #'string< :key #'g-class-property-definition-name))
164 (for accessor = (format nil "~A-child-~A"
165 (string-downcase (symbol-name (class-name widget)))
166 (g-class-property-definition-name prop)))
167 (format stream "@item @anchor{childprop.~A.~A}~A. Type: ~A. Accessor: ~A."
168 (string-downcase (symbol-name (class-name widget)))
169 (g-class-property-definition-name prop)
170 (g-class-property-definition-name prop)
171 (type-string (g-class-property-definition-type prop))
172 accessor)
173 (format stream "~%"))
174 (format stream "@end itemize~%"))))))))
176 (defun signal-signature (s)
177 (with-output-to-string (stream)
178 (format stream "(instance ~A)" (type-string (signal-info-owner-type s)))
179 (iter (for type in (signal-info-param-types s))
180 (for counter from 1)
181 (format stream ", (arg-~A ~A)" counter (type-string type)))
182 (format stream " @result{} ~A" (type-string (signal-info-return-type s)))))
184 (defun signal-options (s)
185 (format nil "~{~A~^, ~}"(signal-info-flags s)))
187 (defun slot-type (slot)
188 (let ((type (gobject::gobject-direct-slot-definition-g-property-type slot)))
189 (type-string type)))
191 (defun type-string (type)
192 (typecase type
193 (string (type-string-s type))
194 (t (type-string-f type))))
196 (defun ensure-list (x) (if (listp x) x (list x)))
198 (defun type-string-f (type)
199 (let ((l (ensure-list type)))
200 (case (first l)
201 (glib:gstrv "list of @code{string}")
202 ((:string glib:g-string) "@code{string}")
203 ((:int :uint :long :ulong :char :uchar :int64 :uint64) "@code{integer}")
204 ((:boolean :bool) "@code{boolean}")
205 (g-object (if (second l)
206 (format-ref (second l))
207 "@ref{g-object}"))
208 (g-boxed-foreign (format-ref (second l)))
209 ((nil) "????")
210 ((glist gslist) (format nil "list of ~A" (type-string-f (second l))))
211 (t (if (symbolp type)
212 (format-ref type)
213 (format-ref l))))))
215 (defun type-string-s (type)
216 (cond
217 ((g-type= type "GStrv") "list of @code{string}")
218 ((g-type= type +g-type-string+) "@code{string}")
219 ((g-type= type +g-type-boolean+) "@code{boolean}")
220 ((g-type= type +g-type-float+) "@code{single-float}")
221 ((g-type= type +g-type-double+) "@code{double-float}")
222 ((or (g-type= type +g-type-int+)
223 (g-type= type +g-type-uint+)
224 (g-type= type +g-type-char+)
225 (g-type= type +g-type-uchar+)
226 (g-type= type +g-type-long+)
227 (g-type= type +g-type-ulong+)
228 (g-type= type +g-type-int64+)
229 (g-type= type +g-type-uint64+)
230 (g-type= type +g-type-uint64+)) "@code{integer}")
231 ((g-type= type +g-type-float+) "@code{single-float}")
232 ((g-type-is-a type +g-type-enum+) (enum-string type))
233 ((g-type-is-a type +g-type-flags+) (flags-string type))
234 ((g-type-is-a type +g-type-object+) (object-string type))
235 ((g-type-is-a type +g-type-boxed+) (boxed-string type))
236 (t type)))
238 (defun format-ref (s)
239 (if (and *use-refs* (if (symbolp s)
240 (not (eq (symbol-package s) (find-package :cl)))
242 (format nil "@ref{~A}" s)
243 (format nil "@code{~A}" s)))
245 (defun flags-string (type)
246 (let ((flags (gobject::registered-flags-type (g-type-string type))))
247 (if flags
248 (format-ref flags)
249 (format nil "@code{~A}" (g-type-string type)))))
251 (defun enum-string (type)
252 (let ((enum (gobject::registered-enum-type (g-type-string type))))
253 (if enum
254 (format-ref enum)
255 (format nil "@code{~A}" (g-type-string type)))))
257 (defun object-string (type)
258 (let ((class (gobject::registered-object-type-by-name (g-type-string type))))
259 (if class
260 (format-ref class)
261 (format nil "@code{~A}" (g-type-string type)))))
263 (defun boxed-string (type)
264 (let ((boxed (ignore-errors (gobject::get-g-boxed-foreign-info-for-gtype (g-type-string type)))))
265 (if boxed
266 (format-ref (gobject::g-boxed-info-name boxed))
267 (format nil "@code{~A}" (g-type-string type)))))
269 (defmethod classify-slot-readability (class (slot gobject::gobject-property-direct-slot-definition))
270 (let* ((g-type (gobject::gobject-class-g-type-name class))
271 (property-name (gobject::gobject-property-direct-slot-definition-g-property-name slot))
272 (prop (if (g-type-is-a g-type +g-type-interface+)
273 (find property-name (interface-properties g-type)
274 :test #'string=
275 :key #'g-class-property-definition-name)
276 (class-property-info g-type property-name)))
277 (readable (g-class-property-definition-readable prop))
278 (writable (g-class-property-definition-writable prop)))
279 (cond
280 ((and readable writable) :normal)
281 ((not readable) :write-only)
282 ((not writable) :read-only)
283 (t :bad))))
285 (defmethod classify-slot-readability (class (slot gobject::gobject-fn-direct-slot-definition))
286 (let ((readable (gobject::gobject-fn-direct-slot-definition-g-getter-name slot))
287 (writable (gobject::gobject-fn-direct-slot-definition-g-setter-name slot)))
288 (cond
289 ((and readable writable) :normal)
290 ((not readable) :write-only)
291 ((not writable) :read-only)
292 (t :bad))))
294 (defun slot-accessor (slot)
295 (let* ((readers (slot-definition-readers slot))
296 (writers (mapcar #'second (slot-definition-writers slot)))
297 (combined (union readers writers))
298 (accessor (first combined)))
299 (if accessor
300 (format nil "@anchor{fn.~A}@code{~A}" accessor accessor)
301 (format nil "None"))))
303 ;; Enum skeleton
304 ;; (enum-skeleton enum &key (section "section"))
305 ;; @node $enum
306 ;; @section $enum
307 ;; Values:
308 ;; @itemize
309 ;; $(enum-values enum)
310 ;; @end itemize
312 (defun enum-skeleton (enum &key (section "section"))
313 (with-output-to-string (stream)
314 (format stream "@node ~A~%" (string-downcase enum))
315 (format stream "@~A ~A~%" section (string-downcase enum))
316 (format stream "@Enum ~A~%" (string-downcase enum))
317 (format stream "Values: ~%")
318 (format stream "@itemize~%")
319 (iter (for item in (sort (copy-list (cffi:foreign-enum-keyword-list enum)) #'string<))
320 (format stream "@item @anchor{enum.~A.~A}:~A~%"
321 (string-downcase enum)
322 (string-downcase (symbol-name item))
323 (string-downcase (symbol-name item))))
324 (format stream "@end itemize~%")))
326 (defun flags-skeleton (flags &key (section "section"))
327 (with-output-to-string (stream)
328 (format stream "@node ~A~%" (string-downcase flags))
329 (format stream "@~A ~A~%" section (string-downcase flags))
330 (format stream "@Flags ~A~%" (string-downcase flags))
331 (format stream "Values: ~%")
332 (format stream "@itemize~%")
333 (iter (for item in (sort (copy-list (cffi:foreign-bitfield-symbol-list flags)) #'string<))
334 (format stream "@item @anchor{flags.~A.~A}:~A~%"
335 (string-downcase flags)
336 (string-downcase (symbol-name item))
337 (string-downcase (symbol-name item))))
338 (format stream "@end itemize~%")))
340 (defun all-enums (package)
341 (sort (iter (for symbol in-package package :external-only t)
342 (unless (member symbol *exclusions*)
343 (when (ignore-errors (cffi:foreign-enum-keyword-list symbol))
344 (collect symbol))))
345 #'string<))
347 (defun all-flags (package)
348 (sort (iter (for symbol in-package package :external-only t)
349 (unless (member symbol *exclusions*)
350 (when (ignore-errors (cffi:foreign-bitfield-symbol-list symbol))
351 (collect symbol))))
352 #'string<))
354 (defun enum-chapter-skeleton (output enums &key (section "section"))
355 (cond
356 ((or (pathnamep output) (stringp output))
357 (with-open-file (stream output :direction :output :if-exists :supersede)
358 (enum-chapter-skeleton stream enums :section section)))
359 ((null output) (with-output-to-string (stream)
360 (enum-chapter-skeleton stream enums :section section)))
361 ((or (eq t output) (streamp output))
362 (format output "@menu~%")
363 (iter (for e in enums)
364 (format output "* ~A::~%" (string-downcase (symbol-name e))))
365 (format output "@end menu~%~%")
366 (iter (for e in enums)
367 (write-string (enum-skeleton e :section section) output)
368 (format output "~%~%")))))
370 (defun flags-chapter-skeleton (output flagss &key (section "section"))
371 (cond
372 ((or (pathnamep output) (stringp output))
373 (with-open-file (stream output :direction :output :if-exists :supersede)
374 (flags-chapter-skeleton stream flagss :section section)))
375 ((null output) (with-output-to-string (stream)
376 (flags-chapter-skeleton stream flagss :section section)))
377 ((or (eq t output) (streamp output))
378 (format output "@menu~%")
379 (iter (for e in flagss)
380 (format output "* ~A::~%" (string-downcase (symbol-name e))))
381 (format output "@end menu~%~%")
382 (iter (for e in flagss)
383 (write-string (flags-skeleton e :section section) output)
384 (format output "~%~%")))))
386 ;; Struct skeleton
387 ;; (struct-skeleton struct &key (section "section") (use-refs t))
388 ;; @node $struct
389 ;; @$section $struct
390 ;; @Struct @struct
391 ;; Slots:
392 ;; @itemize
393 ;; $(for each slot
394 ;; @item $slot
395 ;; )
396 ;; @end itemize
398 (defun struct-skeleton (struct &key (section "section") (use-refs t))
399 (unless (typep struct 'class) (setf struct (find-class struct)))
400 (with-output-to-string (stream)
401 (let ((*print-case* :downcase)
402 (*package* (symbol-package (class-name struct)))
403 (*print-circle* nil)
404 (*use-refs* use-refs))
405 (format stream "@node ~A~%" (class-name struct))
406 (format stream "@~A ~A~%" section (class-name struct))
407 (format stream "@Struct ~A~%" (class-name struct))
408 (format stream "Superclass:")
409 (iter (for super in (class-direct-superclasses struct))
410 (format stream " ~A" (format-ref (class-name super))))
411 (when (class-direct-subclasses struct)
412 (format stream "~%~%")
413 (format stream "Subclasses:")
414 (iter (for sub in (class-direct-subclasses struct))
415 (unless (member (class-name sub) *ref-exclusions*)
416 (format stream " ~A" (format-ref (class-name sub))))))
417 (format stream "~%~%")
418 (struct-slots stream struct))))
420 (defun struct-slots (stream struct)
421 (format stream "Slots:~%")
422 (format stream "@itemize~%")
423 (iter (for slot in (sort (copy-list (class-direct-slots struct)) #'string< :key #'slot-definition-name))
424 (format stream "@item @anchor{slot.~A.~A}~A. Accessor: ~A."
425 (class-name struct) (string-downcase (slot-definition-name slot))
426 (string-downcase (slot-definition-name slot))
427 (format nil "~A-~A" (class-name struct) (slot-definition-name slot)))
428 (format stream "~%"))
429 (format stream "@end itemize~%"))
431 (defun all-structs (package)
432 (sort (iter (for symbol in-package package :external-only t)
433 (unless (member symbol *exclusions*)
434 (for class = (find-class symbol nil))
435 (when (and class (typep class (find-class 'structure-class)))
436 (collect symbol))))
437 #'string<))
439 (defun struct-chapter-skeleton (output structs &key (section "section") (use-refs t))
440 (cond
441 ((or (stringp output) (pathnamep output))
442 (with-open-file (stream output :direction :output :if-exists :supersede)
443 (struct-chapter-skeleton stream structs :section section :use-refs use-refs)))
444 ((null output) (with-output-to-string (stream)
445 (struct-chapter-skeleton stream structs :section section :use-refs use-refs)))
446 ((or (eq t output) (streamp output))
447 (format output "@menu~%")
448 (iter (for e in structs)
449 (format output "* ~A::~%" (string-downcase (symbol-name e))))
450 (format output "@end menu~%~%")
451 (iter (for e in structs)
452 (write-string (struct-skeleton e :section section :use-refs use-refs) output)
453 (format output "~%~%")))))
455 (defun interface-chapter-skeleton (output interfaces &key (use-refs t) (section "section"))
456 (cond
457 ((or (stringp output) (pathnamep output))
458 (with-open-file (stream output :direction :output :if-exists :supersede)
459 (interface-chapter-skeleton stream interfaces :use-refs use-refs :section section)))
460 ((null output) (with-output-to-string (stream)
461 (interface-chapter-skeleton stream interfaces :use-refs use-refs :section section)))
462 ((or (eq t output) (streamp output))
463 (format output "@menu~%")
464 (iter (for w in interfaces)
465 (format output "* ~A::~%" (string-downcase (symbol-name w))))
466 (format output "@end menu~%~%")
467 (iter (for w in interfaces)
468 (write-string (interface-skeleton w :section section :use-refs use-refs) output)
469 (format output "~%~%")))))
471 (defun all-interfaces (package)
472 (sort (iter (for symbol in-package package :external-only t)
473 (unless (member symbol *exclusions*)
474 (for class = (find-class symbol nil))
475 (when (and class
476 (typep class 'gobject:gobject-class)
477 (gobject::gobject-class-interface-p class))
478 (collect symbol))))
479 #'string<))
481 ;; (interface-skeleton interface &key (sectioning-command "section"))
482 ;; returns the texinfo string for interface (a symbol or class)
483 ;; Template:
485 ;; @node $INTERFACE
486 ;; @$SECTIONING-COMMAND $INTERFACE
488 ;; @Class $INTERFACE
490 ;; Interfaces: $(direct-interface interface)
492 ;; Slots:
493 ;; @itemize
494 ;; $(for each slot)
495 ;; @item @anchor{slot.$interface.$slot}$slot. Type: $(slot-type slot). Accessor: $(slot-accessor slot). $(when (constructor-only slot) "Contructor-only slot.")
496 ;; $(end for)
497 ;; @end itemize
499 ;; Signals:
500 ;; @itemize
501 ;; $(for each signal)
502 ;; @item @anchor{signal.$interface.$signal}"$signal". Signature: Type1 Arg1, .., Typen Argn => return-type. Options: $(signal-options)
503 ;; $(end for)
504 ;; @end itemize
506 (defun interface-skeleton (interface &key (section "section") (use-refs t))
507 (unless (typep interface 'class) (setf interface (find-class interface)))
508 (with-output-to-string (stream)
509 (let ((*print-case* :downcase)
510 (*package* (symbol-package (class-name interface)))
511 (*print-circle* nil)
512 (*use-refs* use-refs))
513 (format stream "@node ~A~%" (class-name interface))
514 (format stream "@~A ~A~%" section (class-name interface))
515 (format stream "@Class ~A~%" (class-name interface))
516 (when (class-direct-subclasses interface)
517 (format stream "~%~%")
518 (format stream "Subclasses:")
519 (iter (for sub in (class-direct-subclasses interface))
520 (unless (member (class-name sub) *ref-exclusions*)
521 (format stream " ~A" (format-ref (class-name sub))))))
522 (format stream "~%~%")
523 (widget-slots stream interface)
524 (format stream "~%~%")
525 (widget-signals stream interface))))
527 (defun all-gtk-skeletons (dir)
528 (widgets-chapter-skeleton (merge-pathnames "gdk.objects.texi" dir) (all-classes :gdk))
529 (widgets-chapter-skeleton (merge-pathnames "gtk.objects.texi" dir) (all-classes :gtk))
530 (struct-chapter-skeleton (merge-pathnames "gtk.structs.texi" dir) (all-structs :gtk))
531 (struct-chapter-skeleton (merge-pathnames "gdk.structs.texi" dir) (all-structs :gdk))
532 (widgets-chapter-skeleton (merge-pathnames "gtk.widgets.texi" dir) (all-widgets :gtk))
533 (interface-chapter-skeleton (merge-pathnames "gtk.interfaces.texi" dir) (all-interfaces :gtk))
534 (enum-chapter-skeleton (merge-pathnames "gtk.enums.texi" dir) (all-enums :gtk))
535 (enum-chapter-skeleton (merge-pathnames "gdk.enums.texi" dir) (all-enums :gdk))
536 (flags-chapter-skeleton (merge-pathnames "gtk.flags.texi" dir) (all-flags :gtk))
537 (flags-chapter-skeleton (merge-pathnames "gdk.flags.texi" dir) (all-flags :gdk)))