doc/introspection.lisp

   1 (defpackage :gtk-doc-introspection
   2   #+(or clozure-common-lisp openmcl) (:shadowing-import-from :closer-mop #:defgeneric #:ensure-generic-function #:standard-generic-function)
   3   (:use :cl :gtk :gobject :gdk :iter :closer-mop)
   4   (:export #:get-gobject-classes
   5            #:generate-doc-for-class
   6            #:generate-texinfo-for-class
   7            #:generate-texinfo-for-package
   8            #:get-enums
   9            #:generate-texinfo-for-enum
  10            #:generate-texinfo-for-packages))
  11
  12 (in-package :gtk-doc-introspection)
  13
  14 (defun get-gobject-classes (package)
  15   (when (symbolp package) (setf package (find-package package)))
  16   (unless package (error "Package is NIL"))
  17   (iter (for symbol in-package package :external-only t)
  18         (for class = (find-class symbol nil))
  19         (when (and class (subtypep class 'gobject:g-object))
  20           (collect class))))
  21
  22 (defun get-enums (package)
  23   (when (symbolp package) (setf package (find-package package)))
  24   (iter (for (g-type-name type) in-hashtable gobject::*registered-enum-types*)
  25         (when (eq (symbol-package type) package)
  26           (collect type))))
  27
  28 (defun get-flags (package)
  29   (when (symbolp package) (setf package (find-package package)))
  30   (iter (for (g-type-name type) in-hashtable gobject::*registered-flags-types*)
  31         (when (eq (symbol-package type) package)
  32           (collect type))))
  33
  34 (defvar *doc-packages* nil)
  35
  36 (defun generate-texinfo-for-packages (directory packages)
  37   (setf packages (mapcar (lambda (x)
  38                            (if (symbolp x)
  39                                (find-package x)
  40                                x))
  41                          packages))
  42   (ensure-directories-exist directory)
  43   (let ((*doc-packages* packages))
  44     (iter (for package in packages)
  45           (for file-name = (format nil "~A.ref.texi" (string-downcase (package-name package))))
  46           (for file-path = (merge-pathnames file-name directory))
  47           (generate-texinfo-for-package file-path package))))
  48
  49 (defun generate-texinfo-for-package (file package)
  50   (when (symbolp package) (setf package (find-package package)))
  51   (with-open-file (stream file :direction :output :if-exists :supersede)
  52     (let ((classes (sort (copy-list (get-gobject-classes package)) #'string< :key #'class-name))
  53           (enums (sort (copy-list (get-enums package)) #'string<))
  54           (flags (sort (copy-list (get-flags package)) #'string<)))
  55       (format stream "@menu~%")
  56       (format stream "* ~A Classes::~%" (string-downcase (package-name package)))
  57       (format stream "* ~A Enums::~%" (string-downcase (package-name package)))
  58       (format stream "* ~A Flags::~%" (string-downcase (package-name package)))
  59       (format stream "@end menu~%~%")
  60       (format stream "@node ~A Classes~%" (string-downcase (package-name package)))
  61       (format stream "@section ~A Classes~%~%" (string-downcase (package-name package)))
  62       (format stream "@menu~%")
  63       (iter (for class in classes)
  64             (format stream "* ~A::~%" (string-downcase (symbol-name (class-name class)))))
  65       (format stream "@end menu~%~%")
  66       (format stream "Reference of classes in package ~A~%~%" (package-name package))
  67       (iter (for class in classes)
  68             (generate-texinfo-for-class class stream)
  69             (format stream "~%"))
  70
  71       (format stream "@node ~A Enums~%" (string-downcase (package-name package)))
  72       (format stream "@section ~A Enums~%~%" (string-downcase (package-name package)))
  73       (format stream "@menu~%")
  74       (iter (for enum in enums)
  75             (format stream "* ~A::~%" (string-downcase (symbol-name enum))))
  76       (format stream "@end menu~%~%")
  77       (format stream "Reference of enums in package ~A~%~%" (package-name package))
  78       (iter (for enum in enums)
  79             (generate-texinfo-for-enum enum stream)
  80             (format stream "~%"))
  81
  82       (format stream "@node ~A Flags~%" (string-downcase (package-name package)))
  83       (format stream "@section ~A Flags~%~%" (string-downcase (package-name package)))
  84       (format stream "@menu~%")
  85       (iter (for flags-type in flags)
  86             (format stream "* ~A::~%" (string-downcase (symbol-name flags-type))))
  87       (format stream "@end menu~%~%")
  88       (format stream "Reference of flags in package ~A~%~%" (package-name package))
  89       (iter (for flags-type in flags)
  90             (generate-texinfo-for-flags flags-type stream)
  91             (format stream "~%"))
  92
  93       )))
  94
  95 (defun get-class-signals (class)
  96   (when (typep class 'gobject-class)
  97     (let* ((g-type-name (gobject::gobject-class-g-type-name class))
  98            (signals (type-signals g-type-name :include-inherited nil)))
  99       signals)))
 100
 101 (defun generate-doc-for-signal (signal)
 102   signal)
 103
 104 (defgeneric texi-ref (object))
 105
 106 (defmethod texi-ref ((class class))
 107   (symbol-texi-ref (class-name class)))
 108
 109 (defun symbol-texi-ref (symbol)
 110   (if (member (symbol-package symbol) *doc-packages*)
 111       (format nil "@ref{~A}" (string-downcase (symbol-name symbol)))
 112       (symbol-texi symbol)))
 113
 114 (defun symbol-texi (symbol)
 115   (format nil "@code{~A}" (string-downcase (symbol-name symbol))))
 116
 117 (defun g-type-texi (type)
 118   (cond
 119     ((g-type= "gchararray" type) "@code{string}")
 120     ((g-type= "GStrv" type) "@code{(list string)}")
 121     ((or (g-type= +g-type-int+ type)
 122          (g-type= +g-type-int64+ type)
 123          (g-type= +g-type-long+ type)) "@code{integer}")
 124     ((or (g-type= +g-type-uint+ type)
 125          (g-type= +g-type-uint64+ type)
 126          (g-type= +g-type-ulong+ type)) "@code{(integer 0)}")
 127     ((g-type= +g-type-float+ type) "@code{single-float}")
 128     ((g-type= +g-type-double+ type) "@code{double-float}")
 129     ((g-type= +g-type-void+ type) "@code{null}")
 130     ((g-type= +g-type-param+ type) "@code{class-property-info}")
 131     ((g-type= +g-type-string+ type) "@code{string}")
 132     ((g-type= +g-type-boolean+ type) "@code{boolean}")
 133     ((g-type= +g-type-pointer+ type) "@code{foreign-pointer}")
 134     ((and (g-type= (g-type-fundamental type) "GEnum")
 135           (gethash (g-type-string type) gobject::*registered-enum-types*))
 136      (symbol-texi-ref (gethash (g-type-string type) gobject::*registered-enum-types*)))
 137     ((and (g-type= (g-type-fundamental type) "GFlags")
 138           (gethash (g-type-string type) gobject::*registered-flags-types*))
 139      (symbol-texi-ref (gethash (g-type-string type) gobject::*registered-flags-types*)))
 140     ((and (or (g-type= (g-type-fundamental type) "GObject")
 141               (g-type= (g-type-fundamental type) "GInterface"))
 142           (gethash (g-type-string type) gobject::*registered-object-types*))
 143      (symbol-texi-ref (gethash (g-type-string type) gobject::*registered-object-types*)))
 144     (t (g-type-string type))))
 145
 146 (defun generate-texinfo-for-class (class stream)
 147   (when (symbolp class) (setf class (find-class class)))
 148   (format stream "@node ~A~%" (string-downcase (symbol-name (class-name class))))
 149   (format stream "@subsection ~A~%"(string-downcase (symbol-name (class-name class))))
 150   (format stream "@Class ~A~%~%" (string-downcase (symbol-name (class-name class))))
 151   (format stream "Superclasses: ~{~A~^, ~}~%~%" (mapcar #'texi-ref (class-direct-superclasses class)))
 152   (format stream "Slots:~%")
 153   (let ((slots (sort (copy-list (class-direct-slots class)) #'string< :key #'slot-definition-name)))
 154     (if (null slots)
 155         (format stream "None~%~%")
 156         (progn
 157           (format stream "@itemize~%")
 158           (iter (for slot in slots)
 159                 (generate-texinfo-for-slot class slot stream))
 160           (format stream "@end itemize~%"))))
 161   (format stream "Signals:~%")
 162   (let ((signals (sort (copy-list (get-class-signals class)) #'string< :key #'signal-info-name)))
 163     (if (null signals)
 164         (format stream "None~%~%")
 165         (progn
 166           (format stream "@itemize~%")
 167           (iter (for signal in signals)
 168                 (generate-texinfo-for-signal class signal stream))
 169           (format stream "@end itemize~%")))))
 170
 171 (defun generate-texinfo-for-slot (class slot stream)
 172   (format stream "@item ~A" (string-downcase (slot-definition-name slot)))
 173   (ignore-errors
 174     (when (typep slot 'gobject::gobject-property-direct-slot-definition)
 175       (let* ((class-g-type (gobject::gobject-class-g-type-name class))
 176              (property-name (gobject::gobject-property-direct-slot-definition-g-property-name slot))
 177              (property (if (g-type= (g-type-fundamental class-g-type) "GInterface")
 178                            (find property-name (interface-properties class-g-type)
 179                                  :key #'g-class-property-definition-name
 180                                  :test #'string=)
 181                            (class-property-info class-g-type property-name))))
 182         (format stream ". Type: ~A (flags:~@[~* readable~]~@[~* writable~]~@[~* constructor~]~@[~* constructor-only~])~%~%"
 183                 (g-type-texi (g-class-property-definition-type property))
 184                 (g-class-property-definition-readable property)
 185                 (g-class-property-definition-writable property)
 186                 (g-class-property-definition-constructor property)
 187                 (g-class-property-definition-constructor-only property)))))
 188   (format stream "~%~%"))
 189
 190 (defun generate-texinfo-for-signal (class signal stream)
 191   (declare (ignore class))
 192   (format stream "@item ~A. (~{~A~^, ~}) -> ~A ~@[ [~{~A~^, ~}]~]~%~%"
 193           (signal-info-name signal)
 194           (mapcar #'g-type-texi (signal-info-param-types signal))
 195           (g-type-texi (signal-info-return-type signal))
 196           (mapcar (lambda (x) (string-downcase (symbol-name x)))
 197                   (signal-info-flags signal))))
 198
 199 (defun generate-texinfo-for-enum (enum stream)
 200   (format stream "@node ~A~%" (string-downcase enum))
 201   (format stream "@subsection ~A~%" (string-downcase enum))
 202   (format stream "@Enum ~A~%" (string-downcase enum))
 203   (format stream "Values:~%")
 204   (format stream "@itemize~%")
 205   (iter (for v in (cffi::foreign-enum-keyword-list enum))
 206         (format stream "@item ~A~%" (string-downcase (format nil "~S" v))))
 207   (format stream "@end itemize~%~%"))
 208
 209 (defun generate-texinfo-for-flags (flags stream)
 210   (format stream "@node ~A~%" (string-downcase flags))
 211   (format stream "@subsection ~A~%" (string-downcase flags))
 212   (format stream "@Flags ~A~%" (string-downcase flags))
 213   (format stream "Values:~%")
 214   (format stream "@itemize~%")
 215   (iter (for v in (cffi::foreign-bitfield-symbol-list flags))
 216         (format stream "@item ~A~%" (string-downcase (format nil "~S" v))))
 217   (format stream "@end itemize~%~%"))