X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=doc%2Fskeleton.lisp;h=0699720de251e0c477c38316577f0b0a78be179c;hb=d2b671c59e17cbee173f4e118e7c40120128d91d;hp=c7e45d3dd8d6fdbcfe916aa64232fa859af68163;hpb=5afe221f097d4e8ba212d4b6e35978aa3afd510c;p=cl-gtk2.git

diff --git a/doc/skeleton.lisp b/doc/skeleton.lisp
index c7e45d3..0699720 100644
--- a/doc/skeleton.lisp
+++ b/doc/skeleton.lisp
@@ -1,18 +1,33 @@
 (defpackage :doc-skeleton
   (:use :cl :gtk :gdk :gobject :iter :c2mop :glib)
   (:export :widget-skeleton
-           :chapter-skeleton
-           :*gtk-widgets*
-           :all-gtk-widgets))
+           :widgets-chapter-skeleton
+           :enum-skeleton
+           :flags-skeleton
+           :all-enums
+           :all-flags
+           :enum-chapter-skeleton
+           :flags-chapter-skeleton
+           :struct-skeleton
+           #:all-structs
+           #:struct-chapter-skeleton
+           #:interface-chapter-skeleton
+           #:all-interfaces
+           #:interface-skeleton
+           #:all-widgets
+           #:all-classes
+           #:all-gtk-skeletons))
 
 (in-package :doc-skeleton)
 
-(defun chapter-skeleton (output widgets &key use-refs (section "section"))
+(defun widgets-chapter-skeleton (output widgets &key (use-refs t) (section "section"))
   (cond
-    ((stringp output) (with-open-file (stream output :direction :output :if-exists :supersede)
-                        (chapter-skeleton stream widgets :use-refs use-refs)))
+    ((or (pathnamep output)
+         (stringp output))
+     (with-open-file (stream output :direction :output :if-exists :supersede)
+       (widgets-chapter-skeleton stream widgets :use-refs use-refs :section section)))
     ((null output) (with-output-to-string (stream)
-                     (chapter-skeleton stream widgets :use-refs use-refs)))
+                     (widgets-chapter-skeleton stream widgets :use-refs use-refs :section section)))
     ((or (eq t output) (streamp output))
      (format output "@menu~%")
      (iter (for w in widgets)
@@ -22,32 +37,29 @@
            (write-string (widget-skeleton w :section section :use-refs use-refs) output)
            (format output "~%~%")))))
 
-(defparameter *gtk-widgets* '(about-dialog accel-label alignment arrow
-  aspect-frame assistant bin box button button-box calendar cell-view
-  check-button check-menu-item color-button color-selection
-  color-selection-dialog combo-box combo-box-entry container curve
-  dialog drawing-area entry event-box expander file-chooser-button
-  file-chooser-dialog file-chooser-widget fixed font-button
-  font-selection font-selection-dialog frame gamma-curve gtk-window
-  h-box h-button-box h-paned h-ruler h-s-v h-scale h-scrollbar
-  h-separator handle-box icon-view image image-menu-item input-dialog
-  invisible item label layout link-button menu menu-bar menu-item
-  menu-shell menu-tool-button message-dialog misc notebook
-  old-editable paned plug progress progress-bar radio-button
-  radio-menu-item radio-tool-button range recent-chooser-dialog
-  recent-chooser-menu recent-chooser-widget ruler scale scale-button
-  scrollbar scrolled-window separator separator-menu-item
-  separator-tool-item socket spin-button statusbar table
-  tearoff-menu-item text text-view toggle-button toggle-tool-button
-  tool-button tool-item toolbar tree tree-item tree-view v-box
-  v-button-box v-paned v-ruler v-scale v-scrollbar v-separator
-  viewport volume-button widget))
-
-(defun all-gtk-widgets ()
-  (sort (iter (for symbol in-package (find-package :gtk) :external-only t)
-              (for class = (find-class symbol nil))
-              (when (and class (subclassp class (find-class 'gtk:widget)))
-                (collect symbol)))
+(defparameter *exclusions* '(gdk:display gdk:screen))
+
+(defparameter *ref-exclusions* '(gtk-demo::custom-window gtkglext:gl-drawing-area gtkglext:gdk-gl-window gtkglext:gdk-gl-pixmap))
+
+(defun all-widgets (package)
+  (sort (iter (for symbol in-package (find-package package) :external-only t)
+              (unless (member symbol *exclusions*)
+                (for class = (find-class symbol nil))
+                (when (and class (subclassp class (find-class 'gtk:widget)))
+                  (collect symbol))))
+        #'string<))
+
+(defun all-classes (package)
+  (sort (iter (for symbol in-package (find-package package) :external-only t)
+              (unless (member symbol *exclusions*)
+                (for class = (find-class symbol nil))
+                (when (and class
+                           (not (subclassp class (find-class 'condition)))
+                           (not (subclassp class (find-class 'gtk:widget)))
+                           (or (not (typep class 'gobject::gobject-class))
+                               (not (gobject::gobject-class-interface-p class)))
+                           (not (typep class 'structure-class)))
+                  (collect symbol))))
         #'string<))
 
 ;; (widget-skeleton widget &key (sectioning-command "section"))
@@ -79,7 +91,7 @@
 
 (defvar *use-refs* t)
 
-(defun widget-skeleton (widget &key (section "section") (use-refs nil))
+(defun widget-skeleton (widget &key (section "section") (use-refs t))
   (unless (typep widget 'class) (setf widget (find-class widget)))
   (with-output-to-string (stream)
     (let ((*print-case* :downcase)
@@ -91,8 +103,13 @@
       (format stream "@Class ~A~%" (class-name widget))
       (format stream "Superclass:")
       (iter (for super in (class-direct-superclasses widget))
-            (unless (and (typep super 'gobject-class) (gobject::gobject-class-interface-p super))
-              (format stream " @code{~A}" (class-name super))))
+            (format stream " ~A" (format-ref (class-name super))))
+      (when (class-direct-subclasses widget)
+        (format stream "~%~%")
+        (format stream "Subclasses:")
+        (iter (for sub in (class-direct-subclasses widget))
+              (unless (member (class-name sub) *ref-exclusions*)
+                (format stream " ~A" (format-ref (class-name sub))))))
       (format stream "~%~%")
       (widget-slots stream widget)
       (format stream "~%~%")
@@ -103,7 +120,7 @@
 (defun widget-slots (stream widget)
   (format stream "Slots:~%")
   (format stream "@itemize~%")
-  (iter (for slot in (class-direct-slots widget))
+  (iter (for slot in (sort (copy-list (class-direct-slots widget)) #'string< :key #'slot-definition-name))
         (when (typep slot 'gobject::gobject-direct-slot-definition)
           (format stream "@item @anchor{slot.~A.~A}~A. Type: ~A. Accessor: ~A."
                   (class-name widget) (slot-definition-name slot)
@@ -117,42 +134,44 @@
   (format stream "@end itemize~%"))
 
 (defun widget-signals (stream widget)
-  (let ((g-type (gobject::gobject-class-g-type-name widget)))
-    (unless (string= g-type (gobject::gobject-class-g-type-name (first (class-direct-superclasses widget))))
-      (format stream "Signals:~%")
-      (format stream "@itemize~%")
-  ;; @item @anchor{signal.$widget.$signal}"$signal". Signature: Type1 Arg1, .., Typen Argn => return-type. Options: $(signal-options)
-      (iter (for signal in (type-signals g-type))
-            (format stream "@item @anchor{signal.~A.~A}\"~A\". Signature: ~A. Options: ~A."
-                    (class-name widget)
-                    (signal-info-name signal)
-                    (signal-info-name signal)
-                    (signal-signature signal)
-                    (signal-options signal))
-            (format stream "~%"))
-      (format stream "@end itemize~%"))))
+  (when (typep widget 'gobject::gobject-class)
+    (let ((g-type (gobject::gobject-class-direct-g-type-name widget)))
+      (when g-type
+        (format stream "Signals:~%")
+        (format stream "@itemize~%")
+        ;; @item @anchor{signal.$widget.$signal}"$signal". Signature: Type1 Arg1, .., Typen Argn => return-type. Options: $(signal-options)
+        (iter (for signal in (sort (copy-list (type-signals g-type)) #'string< :key #'signal-info-name))
+              (format stream "@item @anchor{signal.~A.~A}\"~A\". Signature: ~A. Options: ~A."
+                      (class-name widget)
+                      (signal-info-name signal)
+                      (signal-info-name signal)
+                      (signal-signature signal)
+                      (signal-options signal))
+              (format stream "~%"))
+        (format stream "@end itemize~%")))))
 
 (defun widget-child-properties (stream widget)
-  (let ((g-type (gobject::gobject-class-g-type-name widget)))
-    (when (g-type-is-a g-type "GtkContainer")
-      (unless (string= g-type (gobject::gobject-class-g-type-name (first (class-direct-superclasses widget))))
-        (let ((props (gtk::container-class-child-properties g-type)))
-          (when props
-            (format stream "Child properties:~%")
-            (format stream "@itemize~%")
-            ;; @item @anchor{signal.$widget.$signal}"$signal". Signature: Type1 Arg1, .., Typen Argn => return-type. Options: $(signal-options)
-            (iter (for prop in props)
-                  (for accessor = (format nil "~A-child-~A"
-                                      (string-downcase (symbol-name (class-name widget)))
-                                      (g-class-property-definition-name prop)))
-                  (format stream "@item @anchor{childprop.~A.~A}~A. Type: ~A. Accessor: ~A."
-                          (string-downcase (symbol-name (class-name widget)))
-                          (g-class-property-definition-name prop)
-                          (g-class-property-definition-name prop)
-                          (type-string (g-class-property-definition-type prop))
-                          accessor)
-                  (format stream "~%"))
-            (format stream "@end itemize~%")))))))
+  (when (typep stream 'gobject::gobject-class)
+    (let ((g-type (gobject::gobject-class-g-type-name widget)))
+      (when (g-type-is-a g-type "GtkContainer")
+        (unless (string= g-type (gobject::gobject-class-g-type-name (first (class-direct-superclasses widget))))
+          (let ((props (gtk::container-class-child-properties g-type)))
+            (when props
+              (format stream "Child properties:~%")
+              (format stream "@itemize~%")
+              ;; @item @anchor{signal.$widget.$signal}"$signal". Signature: Type1 Arg1, .., Typen Argn => return-type. Options: $(signal-options)
+              (iter (for prop in (sort (copy-list props) #'string< :key #'g-class-property-definition-name))
+                    (for accessor = (format nil "~A-child-~A"
+                                            (string-downcase (symbol-name (class-name widget)))
+                                            (g-class-property-definition-name prop)))
+                    (format stream "@item @anchor{childprop.~A.~A}~A. Type: ~A. Accessor: ~A."
+                            (string-downcase (symbol-name (class-name widget)))
+                            (g-class-property-definition-name prop)
+                            (g-class-property-definition-name prop)
+                            (type-string (g-class-property-definition-type prop))
+                            accessor)
+                    (format stream "~%"))
+              (format stream "@end itemize~%"))))))))
 
 (defun signal-signature (s)
   (with-output-to-string (stream)
@@ -179,13 +198,14 @@
 (defun type-string-f (type)
   (let ((l (ensure-list type)))
     (case (first l)
+      (glib:gstrv "list of @code{string}")
       ((:string glib:g-string) "@code{string}")
       ((:int :uint :long :ulong :char :uchar :int64 :uint64) "@code{integer}")
       ((:boolean :bool) "@code{boolean}")
       (g-object (if (second l)
-                    (format-ref (string-downcase (symbol-name (second l))))
+                    (format-ref (second l))
                     "@ref{g-object}"))
-      (g-boxed-foreign (format-ref (string-downcase (symbol-name (second l)))))
+      (g-boxed-foreign (format-ref (second l)))
       ((nil) "????")
       ((glist gslist) (format nil "list of ~A" (type-string-f (second l))))
       (t (if (symbolp type)
@@ -194,6 +214,7 @@
 
 (defun type-string-s (type)
   (cond
+    ((g-type= type "GStrv") "list of @code{string}")
     ((g-type= type +g-type-string+) "@code{string}")
     ((g-type= type +g-type-boolean+) "@code{boolean}")
     ((g-type= type +g-type-float+) "@code{single-float}")
@@ -215,7 +236,9 @@
     (t type)))
 
 (defun format-ref (s)
-  (if *use-refs*
+  (if (and *use-refs* (if (symbolp s)
+                          (not (eq (symbol-package s) (find-package :cl)))
+                          t))
       (format nil "@ref{~A}" s)
       (format nil "@code{~A}" s)))
 
@@ -246,7 +269,11 @@
 (defmethod classify-slot-readability (class (slot gobject::gobject-property-direct-slot-definition))
   (let* ((g-type (gobject::gobject-class-g-type-name class))
          (property-name (gobject::gobject-property-direct-slot-definition-g-property-name slot))
-         (prop (class-property-info g-type property-name))
+         (prop (if (g-type-is-a g-type +g-type-interface+)
+                   (find property-name (interface-properties g-type)
+                         :test #'string=
+                         :key #'g-class-property-definition-name)
+                   (class-property-info g-type property-name)))
          (readable (g-class-property-definition-readable prop))
          (writable (g-class-property-definition-writable prop)))
     (cond
@@ -270,5 +297,241 @@
          (combined (union readers writers))
          (accessor (first combined)))
     (if accessor
-        (format nil "@anchor{~A}@code{~A}" accessor accessor)
+        (format nil "@anchor{fn.~A}@code{~A}" accessor accessor)
         (format nil "None"))))
+
+;; Enum skeleton
+;; (enum-skeleton enum &key (section "section"))
+;; @node $enum
+;; @section $enum
+;; Values:
+;; @itemize
+;; $(enum-values enum)
+;; @end itemize
+
+(defun enum-skeleton (enum &key (section "section"))
+  (with-output-to-string (stream)
+    (format stream "@node ~A~%" (string-downcase enum))
+    (format stream "@~A ~A~%" section (string-downcase enum))
+    (format stream "@Enum ~A~%" (string-downcase enum))
+    (format stream "Values: ~%")
+    (format stream "@itemize~%")
+    (iter (for item in (sort (copy-list (cffi:foreign-enum-keyword-list enum)) #'string<))
+          (format stream "@item @anchor{enum.~A.~A}:~A~%"
+                  (string-downcase enum)
+                  (string-downcase (symbol-name item))
+                  (string-downcase (symbol-name item))))
+    (format stream "@end itemize~%")))
+
+(defun flags-skeleton (flags &key (section "section"))
+  (with-output-to-string (stream)
+    (format stream "@node ~A~%" (string-downcase flags))
+    (format stream "@~A ~A~%" section (string-downcase flags))
+    (format stream "@Flags ~A~%" (string-downcase flags))
+    (format stream "Values: ~%")
+    (format stream "@itemize~%")
+    (iter (for item in (sort (copy-list (cffi:foreign-bitfield-symbol-list flags)) #'string<))
+          (format stream "@item @anchor{flags.~A.~A}:~A~%"
+                  (string-downcase flags)
+                  (string-downcase (symbol-name item))
+                  (string-downcase (symbol-name item))))
+    (format stream "@end itemize~%")))
+
+(defun all-enums (package)
+  (sort (iter (for symbol in-package package :external-only t)
+              (unless (member symbol *exclusions*)
+                (when (ignore-errors (cffi:foreign-enum-keyword-list symbol))
+                  (collect symbol))))
+        #'string<))
+
+(defun all-flags (package)
+  (sort (iter (for symbol in-package package :external-only t)
+              (unless (member symbol *exclusions*)
+                (when (ignore-errors (cffi:foreign-bitfield-symbol-list symbol))
+                  (collect symbol))))
+        #'string<))
+
+(defun enum-chapter-skeleton (output enums &key (section "section"))
+  (cond
+    ((or (pathnamep output) (stringp output))
+     (with-open-file (stream output :direction :output :if-exists :supersede)
+       (enum-chapter-skeleton stream enums :section section)))
+    ((null output) (with-output-to-string (stream)
+                     (enum-chapter-skeleton stream enums :section section)))
+    ((or (eq t output) (streamp output))
+     (format output "@menu~%")
+     (iter (for e in enums)
+           (format output "* ~A::~%" (string-downcase (symbol-name e))))
+     (format output "@end menu~%~%")
+     (iter (for e in enums)
+           (write-string (enum-skeleton e :section section) output)
+           (format output "~%~%")))))
+
+(defun flags-chapter-skeleton (output flagss &key (section "section"))
+  (cond
+    ((or (pathnamep output) (stringp output))
+     (with-open-file (stream output :direction :output :if-exists :supersede)
+       (flags-chapter-skeleton stream flagss :section section)))
+    ((null output) (with-output-to-string (stream)
+                     (flags-chapter-skeleton stream flagss :section section)))
+    ((or (eq t output) (streamp output))
+     (format output "@menu~%")
+     (iter (for e in flagss)
+           (format output "* ~A::~%" (string-downcase (symbol-name e))))
+     (format output "@end menu~%~%")
+     (iter (for e in flagss)
+           (write-string (flags-skeleton e :section section) output)
+           (format output "~%~%")))))
+
+;; Struct skeleton
+;; (struct-skeleton struct &key (section "section") (use-refs t))
+;; @node $struct
+;; @$section $struct
+;; @Struct @struct
+;; Slots:
+;; @itemize
+;; $(for each slot
+;; @item $slot
+;; )
+;; @end itemize
+
+(defun struct-skeleton (struct &key (section "section") (use-refs t))
+  (unless (typep struct 'class) (setf struct (find-class struct)))
+  (with-output-to-string (stream)
+    (let ((*print-case* :downcase)
+          (*package* (symbol-package (class-name struct)))
+          (*print-circle* nil)
+          (*use-refs* use-refs))
+      (format stream "@node ~A~%" (class-name struct))
+      (format stream "@~A ~A~%" section (class-name struct))
+      (format stream "@Struct ~A~%" (class-name struct))
+      (format stream "Superclass:")
+      (iter (for super in (class-direct-superclasses struct))
+            (format stream " ~A" (format-ref (class-name super))))
+      (when (class-direct-subclasses struct)
+        (format stream "~%~%")
+        (format stream "Subclasses:")
+        (iter (for sub in (class-direct-subclasses struct))
+              (unless (member (class-name sub) *ref-exclusions*)
+                (format stream " ~A" (format-ref (class-name sub))))))
+      (format stream "~%~%")
+      (struct-slots stream struct))))
+
+(defun struct-slots (stream struct)
+  (format stream "Slots:~%")
+  (format stream "@itemize~%")
+  (iter (for slot in (sort (copy-list (class-direct-slots struct)) #'string< :key #'slot-definition-name))
+        (format stream "@item @anchor{slot.~A.~A}~A. Accessor: ~A."
+                (class-name struct) (string-downcase (slot-definition-name slot))
+                (string-downcase (slot-definition-name slot))
+                (format nil "~A-~A" (class-name struct) (slot-definition-name slot)))
+        (format stream "~%"))
+  (format stream "@end itemize~%"))
+
+(defun all-structs (package)
+  (sort (iter (for symbol in-package package :external-only t)
+              (unless (member symbol *exclusions*)
+                (for class = (find-class symbol nil))
+                (when (and class (typep class (find-class 'structure-class)))
+                  (collect symbol))))
+        #'string<))
+
+(defun struct-chapter-skeleton (output structs &key (section "section") (use-refs t))
+  (cond
+    ((or (stringp output) (pathnamep output))
+     (with-open-file (stream output :direction :output :if-exists :supersede)
+       (struct-chapter-skeleton stream structs :section section :use-refs use-refs)))
+    ((null output) (with-output-to-string (stream)
+                     (struct-chapter-skeleton stream structs :section section :use-refs use-refs)))
+    ((or (eq t output) (streamp output))
+     (format output "@menu~%")
+     (iter (for e in structs)
+           (format output "* ~A::~%" (string-downcase (symbol-name e))))
+     (format output "@end menu~%~%")
+     (iter (for e in structs)
+           (write-string (struct-skeleton e :section section :use-refs use-refs) output)
+           (format output "~%~%")))))
+
+(defun interface-chapter-skeleton (output interfaces &key (use-refs t) (section "section"))
+  (cond
+    ((or (stringp output) (pathnamep output))
+     (with-open-file (stream output :direction :output :if-exists :supersede)
+       (interface-chapter-skeleton stream interfaces :use-refs use-refs :section section)))
+    ((null output) (with-output-to-string (stream)
+                     (interface-chapter-skeleton stream interfaces :use-refs use-refs :section section)))
+    ((or (eq t output) (streamp output))
+     (format output "@menu~%")
+     (iter (for w in interfaces)
+           (format output "* ~A::~%" (string-downcase (symbol-name w))))
+     (format output "@end menu~%~%")
+     (iter (for w in interfaces)
+           (write-string (interface-skeleton w :section section :use-refs use-refs) output)
+           (format output "~%~%")))))
+
+(defun all-interfaces (package)
+  (sort (iter (for symbol in-package package :external-only t)
+              (unless (member symbol *exclusions*)
+                (for class = (find-class symbol nil))
+                (when (and class
+                           (typep class 'gobject:gobject-class)
+                           (gobject::gobject-class-interface-p class))
+                  (collect symbol))))
+        #'string<))
+
+;; (interface-skeleton interface &key (sectioning-command "section"))
+;; returns the texinfo string for interface (a symbol or class)
+;; Template:
+;; 
+;; @node $INTERFACE
+;; @$SECTIONING-COMMAND $INTERFACE
+;;
+;; @Class $INTERFACE
+;; 
+;; Interfaces: $(direct-interface interface)
+;;
+;; Slots:
+;; @itemize
+;; $(for each slot)
+;; @item @anchor{slot.$interface.$slot}$slot. Type: $(slot-type slot). Accessor: $(slot-accessor slot). $(when (constructor-only slot) "Contructor-only slot.")
+;; $(end for)
+;; @end itemize
+;;
+;; Signals:
+;; @itemize
+;; $(for each signal)
+;; @item @anchor{signal.$interface.$signal}"$signal". Signature: Type1 Arg1, .., Typen Argn => return-type. Options: $(signal-options)
+;; $(end for)
+;; @end itemize
+
+(defun interface-skeleton (interface &key (section "section") (use-refs t))
+  (unless (typep interface 'class) (setf interface (find-class interface)))
+  (with-output-to-string (stream)
+    (let ((*print-case* :downcase)
+          (*package* (symbol-package (class-name interface)))
+          (*print-circle* nil)
+          (*use-refs* use-refs))
+      (format stream "@node ~A~%" (class-name interface))
+      (format stream "@~A ~A~%" section (class-name interface))
+      (format stream "@Class ~A~%" (class-name interface))
+      (when (class-direct-subclasses interface)
+        (format stream "~%~%")
+        (format stream "Subclasses:")
+        (iter (for sub in (class-direct-subclasses interface))
+              (unless (member (class-name sub) *ref-exclusions*)
+                (format stream " ~A" (format-ref (class-name sub))))))
+      (format stream "~%~%")
+      (widget-slots stream interface)
+      (format stream "~%~%")
+      (widget-signals stream interface))))
+
+(defun all-gtk-skeletons (dir)
+  (widgets-chapter-skeleton (merge-pathnames "gdk.objects.texi" dir) (all-classes :gdk))
+  (widgets-chapter-skeleton (merge-pathnames "gtk.objects.texi" dir) (all-classes :gtk))
+  (struct-chapter-skeleton (merge-pathnames "gtk.structs.texi" dir) (all-structs :gtk))
+  (struct-chapter-skeleton (merge-pathnames "gdk.structs.texi" dir) (all-structs :gdk))
+  (widgets-chapter-skeleton (merge-pathnames "gtk.widgets.texi" dir) (all-widgets :gtk))
+  (interface-chapter-skeleton (merge-pathnames "gtk.interfaces.texi" dir) (all-interfaces :gtk))
+  (enum-chapter-skeleton (merge-pathnames "gtk.enums.texi" dir) (all-enums :gtk))
+  (enum-chapter-skeleton (merge-pathnames "gdk.enums.texi" dir) (all-enums :gdk))
+  (flags-chapter-skeleton (merge-pathnames "gtk.flags.texi" dir) (all-flags :gtk))
+  (flags-chapter-skeleton (merge-pathnames "gdk.flags.texi" dir) (all-flags :gdk)))
\ No newline at end of file