From 3c5b923c6d761ff656e71b05f6306d0b08c2b489 Mon Sep 17 00:00:00 2001 From: Daniel Ziltener Date: Mon, 14 Feb 2022 11:22:40 +0100 Subject: [PATCH] Added a bunch of documentation --- qml.core.scm | 1114 +++++++++++++++++++++++--------------------- scripts/gen-doc.sh | 2 + 2 files changed, 581 insertions(+), 535 deletions(-) create mode 100755 scripts/gen-doc.sh diff --git a/qml.core.scm b/qml.core.scm index 0575b79..1209277 100644 --- a/qml.core.scm +++ b/qml.core.scm @@ -11,610 +11,654 @@ (import (qml lowlevel)) (import (scheme base)) (import coops coops-primitive-objects coops-extras coops-utils srfi-1 srfi-69 object-evict) - @("This should appear as library doc.") + @("A library to simplify usage of QML user interfaces from Chicken.") (export application-dir-path - process-events - process-events-timed + process-events + process-events-timed - gui-application-create - gui-application-exec - gui-application-quit - gui-application-delete + gui-application-create + gui-application-exec + gui-application-quit + gui-application-delete - qapplication-create - qapplication-exec - qapplication-quit - qapplication-delete + qapplication-create + qapplication-exec + qapplication-quit + qapplication-delete - qquickstyle-set-style - qquickstyle-set-fallback-style + qquickstyle-set-style + qquickstyle-set-fallback-style - initialize-instance - set - to - is-null? - assign - copy - delete-pointer - delete-pointer-later + initialize-instance + set + to + is-null? + assign + copy + delete-pointer + delete-pointer-later - - - qevent-loop-process-event-flag + + + qevent-loop-process-event-flag - - qt-connection-type + + qt-connection-type - - qquick-view-resize-mode + + qquick-view-resize-mode - - qitem-data-role + + qitem-data-role - - qt-orientation + + qt-orientation - - add-ptrentry - remove-ptrentry + + add-ptrentry + remove-ptrentry - + - - new-Parameter + + new-Parameter - - new-Signal - - new-Signals + + new-Signal + + new-Signals - - new-Slot - - new-Slots + + new-Slot + + new-Slots - - new-Property - - new-Properties + + new-Property + + new-Properties - - delete-pointer + + delete-pointer - - signal-emit - object-name - set-object-name - property - set-property - find-child - connect - disconnect + + signal-emit + object-name + set-object-name + property + set-property + find-child + connect + disconnect - - qvariant + + qvariant - - base-url - set-property + + base-url + set-property - - new-QUrl - to-string - valid? + + new-QUrl + to-string + valid? - - new-QPixmap - load - load-from-data - fill - assign + + new-QPixmap + load + load-from-data + fill + assign - - new-QQuickImageProvider + + new-QQuickImageProvider - - load - load-url - load-data - add-import-path - context - root - add-image-provider + + load + load-url + load-data + add-import-path + context + root + add-image-provider - - show - source - set-source-url - set-source - set-resize-mode - root-context + + show + source + set-source-url + set-source + set-resize-mode + root-context - - new-QMetaObject - invoke-method + + new-QMetaObject + invoke-method - - row - column - valid? - data - parent - child - sibling - assign + + row + column + valid? + data + parent + child + sibling + assign - - new-QAbstractItemModel - set-data - flags - header-data + + new-QAbstractItemModel + set-data + flags + header-data - - new-QAbstractListModel - index - parent - column-count + + new-QAbstractListModel + index + parent + column-count - - new-QAbstractTableModel - index - parent - ) + + new-QAbstractTableModel + index + parent + ) (begin - ;; Enums - (define-class () - ((val accessor: val))) - (define-class ()) - (define (qevent-loop-process-event-flag val) @("Event flags") - (case val - ((process-all-events:) - (make 'val DosQEventLoopProcessEventFlagProcessAllEvents)) - ((exclude-user-input-events:) - (make 'val DosQEventLoopProcessEventFlagExcludeUserInputEvents)) - ((process-exclude-socket-notifiers:) - (make 'val DosQEventLoopProcessEventFlagProcessExcludeSocketNotifiers)) - ((process-all-events-wait-for-more-events:) - (make 'val DosQEventLoopProcessEventFlagProcessAllEventsWaitForMoreEvents)))) - (define-class ()) - (define (qt-connection-type val) - (case val - ((auto:) - (make 'val DosQtConnectionTypeAutoConnection)) - ((direct:) - (make 'val DosQtConnectionTypeDirectConnection)) - ((queued:) - (make 'val DosQtConnectionTypeQueuedConnection)) - ((blocking:) - (make 'val DosQtConnectionTypeBlockingConnection)) - ((unique:) - (make 'val DosQtConnectionTypeUniqueConnection)))) + ;; Enums + @(== "Enums") + @(=== "Usage") + @("When a method requires an enum value, it can be handed to it using the enum's procedure plus the enum value keyword. Example:") + @(script "(qt-connection-type auto:)") - (define-class ()) - (define (qquick-view-resize-mode val) - (case val - ((size-view-to-root-object:) (make 'val #x0)) - ((size-root-object-to-view:) (make 'val #x1)))) + (define-class () + ((val accessor: val))) - (define-class ()) - (define (qitem-data-role val) - (case val - ((display:) (make 'val 0)) - ((decoration:) (make 'val 1)) - ((edit:) (make 'val 2)) - ((tool-tip:) (make 'val 3)) - ((status-tip:) (make 'val 4)) - ((whats-this:) (make 'val 5)) - ((font:) (make 'val 6)) - ((text-alignment:) (make 'val 7)) - ((background:) (make 'val 8)) - ((foreground:) (make 'val 9)) - ((check-state:) (make 'val 10)) - ((accessible-text:) (make 'val 11)) - ((accessible-description:) (make 'val 12)) - ((size-hint:) (make 'val 13)) - ((initial-sort-order:) (make 'val 14)))) + (define-class ()) + (define (qevent-loop-process-event-flag val) @("QEventLoopProcessEventFlag flags. Available values: process-all-events:, exclude-user-input-events:, process-exclude-socket-notifiers:, and process-all-events-wait-for-more-events:.") + (case val + ((process-all-events:) + (make 'val DosQEventLoopProcessEventFlagProcessAllEvents)) + ((exclude-user-input-events:) + (make 'val DosQEventLoopProcessEventFlagExcludeUserInputEvents)) + ((process-exclude-socket-notifiers:) + (make 'val DosQEventLoopProcessEventFlagProcessExcludeSocketNotifiers)) + ((process-all-events-wait-for-more-events:) + (make 'val DosQEventLoopProcessEventFlagProcessAllEventsWaitForMoreEvents)))) - (define-class ()) - (define (qt-orientation val) - (case val - ((horizontal:) (make 'val #x01)) - ((vertical:) (make 'val #x02)))) + (define-class ()) + (define (qt-connection-type val) @("QConnectionType flags. Available values: auto:, direct:, queued:, blocking:, and unique:.") + (case val + ((auto:) + (make 'val DosQtConnectionTypeAutoConnection)) + ((direct:) + (make 'val DosQtConnectionTypeDirectConnection)) + ((queued:) + (make 'val DosQtConnectionTypeQueuedConnection)) + ((blocking:) + (make 'val DosQtConnectionTypeBlockingConnection)) + ((unique:) + (make 'val DosQtConnectionTypeUniqueConnection)))) - ;; Helpers - (define (application-dir-path) - (dos_qcoreapplication_application_dir_path)) - (define-method (process-events (flag )) - (dos_qcoreapplication_process_events (val flag))) - (define-method (process-events-timed (flag ) (timed )) - (dos_qcoreapplication_process_events_timed (val flag) timed)) + (define-class ()) + (define (qquick-view-resize-mode val) @("QQuickViewResizeMode flags. Available values: side-view-to-root-object:, and size-root-object-to-view:.") + (case val + ((size-view-to-root-object:) (make 'val #x0)) + ((size-root-object-to-view:) (make 'val #x1)))) - (define (gui-application-create) - (dos_qguiapplication_create)) - (define (gui-application-exec) - (dos_qguiapplication_exec)) - (define (gui-application-quit) - (dos_qguiapplication_quit)) - (define (gui-application-delete) - (dos_qguiapplication_delete)) + (define-class ()) + (define (qitem-data-role val) @("QItemDataRole flags. Available values: display:, decoration:, edit:, tool-tip:, status-tip:, whats-this:, font:, text-alignment:, background:, foreground:, check-state:, accessible-text:, accessible-description:, size-hint:, and initial-sort-order:.") + (case val + ((display:) (make 'val 0)) + ((decoration:) (make 'val 1)) + ((edit:) (make 'val 2)) + ((tool-tip:) (make 'val 3)) + ((status-tip:) (make 'val 4)) + ((whats-this:) (make 'val 5)) + ((font:) (make 'val 6)) + ((text-alignment:) (make 'val 7)) + ((background:) (make 'val 8)) + ((foreground:) (make 'val 9)) + ((check-state:) (make 'val 10)) + ((accessible-text:) (make 'val 11)) + ((accessible-description:) (make 'val 12)) + ((size-hint:) (make 'val 13)) + ((initial-sort-order:) (make 'val 14)))) - (define (qapplication-create) - (dos_qapplication_create)) - (define (qapplication-exec) - (dos_qapplication_exec)) - (define (qapplication-quit) - (dos_qapplication_quit)) - (define (qapplication-delete) - (dos_qapplication_delete)) + (define-class ()) + (define (qt-orientation val) @("QOrientation flags. Available values: horizontal:, and vertical:.") + (case val + ((horizontal:) (make 'val #x01)) + ((vertical:) (make 'val #x02)))) - (define (qquickstyle-set-style style) - (dos_qquickstyle_set_style style)) - (define (qquickstyle-set-fallback-style style) - (dos_qquickstyle_set_fallback_style style)) + ;; Helpers + @(== "Helpers") + (define (application-dir-path) @((@to "the application dir path")) + (dos_qcoreapplication_application_dir_path)) + (define-method (process-events (flag )) @("Runs the QML event processing once until all queued events are processed.") + (dos_qcoreapplication_process_events (val flag))) + (define-method (process-events-timed (flag ) (timed )) @("Runs the QML event processing until all queued events are processed or the timeout has run out.") + (dos_qcoreapplication_process_events_timed (val flag) timed)) - ;; Objects - (define callback-registry - (make-hash-table)) + (define (gui-application-create) @("Initializes the QGuiApplication.") + (dos_qguiapplication_create)) + (define (gui-application-exec) @("Executes the QGuiApplication. WARNING: This will block the Chicken process!") + (dos_qguiapplication_exec)) + (define (gui-application-quit) @("Quits the QGuiApplication.") + (dos_qguiapplication_quit)) + (define (gui-application-delete) @("Deletes the QGuiApplication.") + (dos_qguiapplication_delete)) - (define-method (refcount (alist )) - (cdr (find (lambda (a) (eq? refcount: (car a))) alist))) - (define-method (refcount (ht ) (ptr )) - (if (hash-table-exists? callback-registry ptr) - (refcount (hash-table-ref ht ptr)) - 0)) + (define (qapplication-create) @("Initializes the QApplication.") + (dos_qapplication_create)) + (define (qapplication-exec) @("Executes the QApplication. WARNING: This will block the Chicken process!") + (dos_qapplication_exec)) + (define (qapplication-quit) @("Quits the QApplication.") + (dos_qapplication_quit)) + (define (qapplication-delete) @("Deletes the QApplication.") + (dos_qapplication_delete)) - (define-class () - ((ptr accessor: ptr initform: #f))) - (define-method (delete-pointer (qbase )) - (abort (make-property-condition 'exn 'Message "Please implement the delete method for your subtype."))) - (define-method (add-ptrentry (qbase )) - (hash-table-update! callback-registry (ptr qbase) - (lambda (alist) - (let* ((refc (refcount alist)) - (alist (alist-delete refcount: alist))) - (alist-cons refcount: (+ 1 refc) alist))) - (lambda () - (alist-cons refcount: 1 '())))) - (define-method (remove-ptrentry (qbase )) - (if (eq? 1 (refcount callback-registry (ptr qbase))) - (hash-table-delete! callback-registry (ptr qbase)) - (hash-table-update! callback-registry (ptr qbase) - (lambda (alist) - (let* ((refc (refcount alist)) - (alist (alist-delete refcount: alist))) - (alist-cons refcount: (- refc 1) alist))) ))) - (define-method (initialize-instance (qbase )) - (call-next-method) - (add-ptrentry qbase) - (set-finalizer! qbase (lambda (obj) - (remove-ptrentry qbase) - (when (= 0 (refcount callback-registry (ptr qbase))) - (delete-pointer qbase))))) + (define (qquickstyle-set-style style) @("Sets the QQuickStyle, see https://doc.qt.io/qt-5/qquickstyle.html#setStyle for details.") + (dos_qquickstyle_set_style style)) + (define (qquickstyle-set-fallback-style style) @("Sets the fallback style with QQuickStyle, see https://doc.qt.io/qt-5/qquickstyle.html#setFallbackStyle for details.") + (dos_qquickstyle_set_fallback_style style)) - (define-class ()) + ;; Objects + @(== "Classes") + (define callback-registry + (make-hash-table)) - (define-class () - ((ptr accessor: ptr))) - (define (new-QVariant) - (make 'ptr (dos_qvariant_create))) - (define-method (qvariant (val )) - (make 'ptr (dos_qvariant_create_int val))) - (define-method (qvariant (val )) - (make 'ptr (dos_qvariant_create_bool val))) - (define-method (qvariant (val )) - (make 'ptr (dos_qvariant_create_string val))) - (define-method (qvariant (val )) - (make 'ptr (dos_qvariant_create_qobject (ptr val)))) - (define-method (qvariant (val )) - (make 'ptr (dos_qvariant_create_float val))) - (define-method (set (qv ) (val )) - (dos_qvariant_setInt (ptr qv) val)) - (define-method (set (qv ) (val )) - (dos_qvariant_setBool (ptr qv) val)) - (define-method (set (qv ) (val )) - (dos_qvariant_setFloat (ptr qv) val)) - (define-method (set (qv ) (val )) - (dos_qvariant_setString (ptr qv) val)) - (define-method (set (qv ) (val )) - (dos_qvariant_setQObject (ptr qv) (ptr val))) - (define-method (to (qv ) (target )) - (case target - ((integer:) (dos_qvariant_toInt (ptr qv))) - ((boolean:) (dos_qvariant_toBool (ptr qv))) - ((string:) (dos_qvariant_toString (ptr qv))) - ((flonum:) (dos_qvariant_toFloat (ptr qv))) - ((qobject:) (dos_qvariant_toQObject (ptr qv))))) - (define-method (is-null? (qv )) - (dos_qvariant_isnull (ptr qv))) - (define-method (assign (qv ) (other )) - (dos_qvariant_assign (ptr qv) (ptr other))) - (define-method (copy (qv )) - (make 'ptr (dos_qvariant_create_qvariant (ptr qv)))) - (define-method (delete-pointer (qv )) - (dos_qvariant_delete (ptr qv))) + (define-method (refcount (alist )) + (cdr (find (lambda (a) (eq? refcount: (car a))) alist))) + (define-method (refcount (ht ) (ptr )) + (if (hash-table-exists? callback-registry ptr) + (refcount (hash-table-ref ht ptr)) + 0)) - (define-method (signal-emit (qo ) (name ) (paramcount ) (parameters )) - (dos_qobject_signal_emit (ptr qo) name paramcount parameters)) - (define-method (object-name (qo )) - (dos_qobject_objectName (slot-value qo 'ptr))) - (define-method (set-object-name (qo ) (name )) - (dos_qobject_setObjectName (slot-value qo) name)) - (define-method (property (qo ) (propertyName )) - (make 'ptr (dos_qobject_property (slot-value qo 'ptr) propertyName))) - (define-method (set-property (qo ) (propertyName ) (value )) - (dos_qobject_setProperty (slot-value qo 'ptr) propertyName (slot-value value 'ptr))) - (define-method (find-child (qo ) (child-name )) - (make 'ptr (qml_qobject_findChild (ptr qo) child-name))) + @(=== "") + @("A base class you can't directly use yourself, but it provides facilities like a refcounter to delete the companion pointer once it is not needed anymore.") + (define-class () + ((ptr accessor: ptr initform: #f))) + (define-method (delete-pointer (qbase )) + (abort (make-property-condition 'exn 'Message "Please implement the delete method for your subtype."))) + (define-method (add-ptrentry (qbase )) + (hash-table-update! callback-registry (ptr qbase) + (lambda (alist) + (let* ((refc (refcount alist)) + (alist (alist-delete refcount: alist))) + (alist-cons refcount: (+ 1 refc) alist))) + (lambda () + (alist-cons refcount: 1 '())))) + (define-method (remove-ptrentry (qbase )) + (if (eq? 1 (refcount callback-registry (ptr qbase))) + (hash-table-delete! callback-registry (ptr qbase)) + (hash-table-update! callback-registry (ptr qbase) + (lambda (alist) + (let* ((refc (refcount alist)) + (alist (alist-delete refcount: alist))) + (alist-cons refcount: (- refc 1) alist))) ))) + (define-method (initialize-instance (qbase )) + (call-next-method) + (add-ptrentry qbase) + (set-finalizer! qbase (lambda (obj) + (remove-ptrentry qbase) + (when (= 0 (refcount callback-registry (ptr qbase))) + (delete-pointer qbase))))) - ;; Signal connectors and helpers - ;; We keep a hash table with the actual callback data passed. That way we don't have to deal with (un-)evicting it. - ;; As actual callback data we pass the generated key. One single callback helper handles all the callbacks and - ;; looks up where to pass on the sent data using that hash table. - (define lambda-static-callbacks (make-hash-table)) + (define-class ()) - (define-class () - ((ptr accessor: ptr) - (callback-key accessor: callback-key))) + @(=== "") + @("This class is used to pass and return value types to and from Qt, and offers a decent range of possible types.") + (define-class () + ((ptr accessor: ptr))) + (define (new-QVariant) @("Creates a blank QVariant with no content." + (@to "")) + (make 'ptr (dos_qvariant_create))) + (define-method (qvariant (val )) @("Creates a QVariant with an integer." + (val "The integer to store") + (@to "")) + (make 'ptr (dos_qvariant_create_int val))) + (define-method (qvariant (val )) @("Creates a QVariant with a boolean." + (val "The boolean to store") + (@to "")) + (make 'ptr (dos_qvariant_create_bool val))) + (define-method (qvariant (val )) @("Creates a QVariant with a string." + (val "The string to store") + (@to "")) + (make 'ptr (dos_qvariant_create_string val))) + (define-method (qvariant (val )) @("Creates a QVariant with a QObject." + (val "The QObject to store") + (@to "")) + (make 'ptr (dos_qvariant_create_qobject (ptr val)))) + (define-method (qvariant (val )) @("Creates a QVariant with a float." + (val "The float to store") + (@to "")) + (make 'ptr (dos_qvariant_create_float val))) + (define-method (set (qv ) (val )) @("Sets the QVariant value to the specified integer." + (qv "The QVariant to modify") + (val "The integer to store") + (@to "void")) + (dos_qvariant_setInt (ptr qv) val)) + (define-method (set (qv ) (val )) @("Sets the QVariant value to the specified boolean." + (qv "The QVariant to modify") + (val "The booleant o store") + (@to "void")) + (dos_qvariant_setBool (ptr qv) val)) + (define-method (set (qv ) (val )) @("Sets the QVariant value to the specified float." + (qv "The QVariant to modify") + (val "The float to store") + (@to "void")) + (dos_qvariant_setFloat (ptr qv) val)) + (define-method (set (qv ) (val )) @("Sets the QVariant value to the specified string." + (qv "The QVariant to modify") + (val "The string to store") + (@to "void")) + (dos_qvariant_setString (ptr qv) val)) + (define-method (set (qv ) (val )) @("Sets the QVariant value to the specified QObject." + (qv "The QVariant to modify") + (val "The QObject to store") + (@to "void")) + (dos_qvariant_setQObject (ptr qv) (ptr val))) + (define-method (to (qv ) (target )) @("Extracts the QVariant's value." + (qv "The QVariant to read") + (target "The target format; available are integer:, boolean:, string:, flonum:, and qobject:") + (@to "target format")) + (case target + ((integer:) (dos_qvariant_toInt (ptr qv))) + ((boolean:) (dos_qvariant_toBool (ptr qv))) + ((string:) (dos_qvariant_toString (ptr qv))) + ((flonum:) (dos_qvariant_toFloat (ptr qv))) + ((qobject:) (dos_qvariant_toQObject (ptr qv))))) + (define-method (is-null? (qv )) @("Checks if the QVariant's value is null." + (qv "The QVariant to check") + (@to "boolean")) + (dos_qvariant_isnull (ptr qv))) + (define-method (assign (qv ) (other )) + (dos_qvariant_assign (ptr qv) (ptr other))) + (define-method (copy (qv )) + (make 'ptr (dos_qvariant_create_qvariant (ptr qv)))) + (define-method (delete-pointer (qv )) + (dos_qvariant_delete (ptr qv))) - (define-external (connectLambdaStaticCallbackHelper (c-pointer cbdata) (int argc) ((c-pointer c-pointer) argv)) void - (let* ((callback-key (object-unevict (pointer->object cbdata))) - (callback-info (hash-table-ref lambda-static-callbacks callback-key)) - (callback-proc (alist-ref proc: callback-info)) - (callback-data (alist-ref data: callback-info)) - (signal-data (map (lambda (item) - (make 'ptr item)) - (c_array_convert argv argc)))) - (callback-proc callback-data signal-data))) + (define-method (signal-emit (qo ) (name ) (paramcount ) (parameters )) + (dos_qobject_signal_emit (ptr qo) name paramcount parameters)) + (define-method (object-name (qo )) + (dos_qobject_objectName (slot-value qo 'ptr))) + (define-method (set-object-name (qo ) (name )) + (dos_qobject_setObjectName (slot-value qo) name)) + (define-method (property (qo ) (propertyName )) + (make 'ptr (dos_qobject_property (slot-value qo 'ptr) propertyName))) + (define-method (set-property (qo ) (propertyName ) (value )) + (dos_qobject_setProperty (slot-value qo 'ptr) propertyName (slot-value value 'ptr))) + (define-method (find-child (qo ) (child-name )) + (make 'ptr (qml_qobject_findChild (ptr qo) child-name))) - ;; Connect with lambda, static - (define-method (connect (sender ) (signal ) - (callback ) (callback-data ) - (connection-type )) - (let* ((callback-key (string-append (->string sender) "->" signal "->" (->string callback))) - (intern-callback-data (object->pointer (object-evict callback-key)))) - (hash-table-set! lambda-static-callbacks callback-key `((proc: . ,callback) - (data: . ,callback-data) - (intern-data-pointer: . ,intern-callback-data))) - (make - 'callback-key callback-key - 'ptr - (dos_qobject_connect_lambda_static (ptr sender) signal - (location connectLambdaStaticCallbackHelper) - intern-callback-data - (val connection-type))))) + ;; Signal connectors and helpers + ;; We keep a hash table with the actual callback data passed. That way we don't have to deal with (un-)evicting it. + ;; As actual callback data we pass the generated key. One single callback helper handles all the callbacks and + ;; looks up where to pass on the sent data using that hash table. + (define lambda-static-callbacks (make-hash-table)) - ;; Connect with lambda and context, static - (define-method (connect (sender ) (signal ) - (context ) (callback ) - (callback-data ) - (connection-type )) - (let* ((callback-key (string-append (->string sender) "->" signal "->" (->string callback))) - (intern-callback-data (object->pointer (object-evict callback-key)))) - (hash-table-set! lambda-static-callbacks callback-key `((proc: . ,callback) - (data: . ,callback-data) - (intern-data-pointer: . ,intern-callback-data))) - (make - 'callback-key callback-key - 'ptr - (dos_qobject_connect_lambda_with_context_static - (ptr sender) signal (ptr context) (location connectLambdaStaticCallbackHelper) - intern-callback-data - (val connection-type))))) + (define-class () + ((ptr accessor: ptr) + (callback-key accessor: callback-key))) - ;; Connect static - (define-method (connect (sender ) (signal ) - (receiver ) (slot ) (connection-type )) - (make 'ptr - (dos_qobject_connect_static (slot-value sender 'ptr) signal - (slot-value receiver 'ptr) slot (qt-connection-type connection-type)))) + (define-external (connectLambdaStaticCallbackHelper (c-pointer cbdata) (int argc) ((c-pointer c-pointer) argv)) void + (let* ((callback-key (object-unevict (pointer->object cbdata))) + (callback-info (hash-table-ref lambda-static-callbacks callback-key)) + (callback-proc (alist-ref proc: callback-info)) + (callback-data (alist-ref data: callback-info)) + (signal-data (map (lambda (item) + (make 'ptr item)) + (c_array_convert argv argc)))) + (callback-proc callback-data signal-data))) - (define-method (disconnect (sender ) (signal ) (receiver ) (slot )) - (dos_qobject_disconnect_static (slot-value sender 'ptr) signal (slot-value receiver 'ptr) slot)) - (define-method (disconnect (qmoc )) - (dos_qobject_disconnect_with_connection_static (slot-value qmoc 'ptr))) + ;; Connect with lambda, static + (define-method (connect (sender ) (signal ) + (callback ) (callback-data ) + (connection-type )) + (let* ((callback-key (string-append (->string sender) "->" signal "->" (->string callback))) + (intern-callback-data (object->pointer (object-evict callback-key)))) + (hash-table-set! lambda-static-callbacks callback-key `((proc: . ,callback) + (data: . ,callback-data) + (intern-data-pointer: . ,intern-callback-data))) + (make + 'callback-key callback-key + 'ptr + (dos_qobject_connect_lambda_static (ptr sender) signal + (location connectLambdaStaticCallbackHelper) + intern-callback-data + (val connection-type))))) - (define-method (delete-pointer (qmoc )) - (handle-exceptions exn #t - (disconnect qmoc)) - (object-release (pointer->object (alist-ref intern-data-pointer: (hash-table-ref lambda-static-callbacks (callback-key qmoc))))) - (hash-table-delete! lambda-static-callbacks (callback-key qmoc)) - (dos_qmetaobject_connection_delete (slot-value qmoc 'ptr))) + ;; Connect with lambda and context, static + (define-method (connect (sender ) (signal ) + (context ) (callback ) + (callback-data ) + (connection-type )) + (let* ((callback-key (string-append (->string sender) "->" signal "->" (->string callback))) + (intern-callback-data (object->pointer (object-evict callback-key)))) + (hash-table-set! lambda-static-callbacks callback-key `((proc: . ,callback) + (data: . ,callback-data) + (intern-data-pointer: . ,intern-callback-data))) + (make + 'callback-key callback-key + 'ptr + (dos_qobject_connect_lambda_with_context_static + (ptr sender) signal (ptr context) (location connectLambdaStaticCallbackHelper) + intern-callback-data + (val connection-type))))) - (define-method (delete-pointer (qo )) - (dos_qobject_delete (ptr qo))) - (define-method (delete-pointer-later (qo )) - (dos_qobject_deleteLater (ptr qo))) + ;; Connect static + (define-method (connect (sender ) (signal ) + (receiver ) (slot ) (connection-type )) + (make 'ptr + (dos_qobject_connect_static (slot-value sender 'ptr) signal + (slot-value receiver 'ptr) slot (qt-connection-type connection-type)))) - ;; Scheme Objects - (define-class () - ((obj accessor: obj))) + (define-method (disconnect (sender ) (signal ) (receiver ) (slot )) + (dos_qobject_disconnect_static (slot-value sender 'ptr) signal (slot-value receiver 'ptr) slot)) + (define-method (disconnect (qmoc )) + (dos_qobject_disconnect_with_connection_static (slot-value qmoc 'ptr))) - (define-class ()) - (define-method (new-Parameter (name ) (meta-type )) - (make 'obj (dos_parameterdefinition_create name meta-type))) + (define-method (delete-pointer (qmoc )) + (handle-exceptions exn #t + (disconnect qmoc)) + (object-release (pointer->object (alist-ref intern-data-pointer: (hash-table-ref lambda-static-callbacks (callback-key qmoc))))) + (hash-table-delete! lambda-static-callbacks (callback-key qmoc)) + (dos_qmetaobject_connection_delete (slot-value qmoc 'ptr))) - ;; - Signals - (define-class ()) - (define-method (new-Signal (name ) (parameters )) - (make 'obj (dos_signaldefinition_create name (length parameters) (map obj parameters)))) - (define-class ()) - (define-method (new-Signals (defs )) - (make 'ptr (dos_signaldefinitions_create (length defs) (map ptr defs)))) - (define-method (delete-pointer (sd )) - (dos_signaldefinitions_delete (ptr sd))) + (define-method (delete-pointer (qo )) + (dos_qobject_delete (ptr qo))) + (define-method (delete-pointer-later (qo )) + (dos_qobject_deleteLater (ptr qo))) - ;; - Slots - (define-class ()) - (define-method (new-Slot (name ) (returnMetaType ) (parameters )) - (make 'obj (dos_slotdefinition_create name returnMetaType (length parameters) (map obj parameters)))) - (define-class ()) - (define-method (new-Slots (defs )) - (make 'ptr (dos_slotdefinitions_create (length defs) (map obj defs)))) - (define-method (delete-pointer (sd )) - (dos_slotdefinitions_delete (ptr sd))) + ;; Scheme Objects + (define-class () + ((obj accessor: obj))) - ;; - Properties - (define-class ()) - (define-method (new-Property (name ) (propertyMetaType ) (readSlot ) (writeSlot ) (notifySignal )) - (make 'obj (dos_propertydefinition_create name propertyMetaType readSlot writeSlot notifySignal))) - (define-class ()) - (define-method (new-Properties (defs )) - (make 'ptr (dos_propertydefinitions_create (length defs) (map obj defs)))) - (define-method (delete-pointer (pd )) - (dos_propertydefinitions_delete (ptr pd))) + (define-class ()) + (define-method (new-Parameter (name ) (meta-type )) + (make 'obj (dos_parameterdefinition_create name meta-type))) - (define-class ()) - (define-method (base-url (context )) - (dos_qqmlcontext_baseUrl (ptr context))) - (define-method (set-property (context ) (name ) (qvalue )) - (dos_qqmlcontext_setcontextproperty (ptr context) name (ptr qvalue))) + ;; - Signals + (define-class ()) + (define-method (new-Signal (name ) (parameters )) + (make 'obj (dos_signaldefinition_create name (length parameters) (map obj parameters)))) + (define-class ()) + (define-method (new-Signals (defs )) + (make 'ptr (dos_signaldefinitions_create (length defs) (map ptr defs)))) + (define-method (delete-pointer (sd )) + (dos_signaldefinitions_delete (ptr sd))) - (define-class ()) - (define (new-QUrl url) - (let ((qurl (make 'ptr (dos_qurl_create url 0)))) - qurl)) - (define-method (to-string (qurl )) - (dos_qurl_to_string (ptr qurl))) - (define-method (valid? (qurl )) - (dos_qurl_isValid (ptr qurl))) - (define-method (delete-pointer (qurl )) - (dos_qurl_delete (ptr qurl))) + ;; - Slots + (define-class ()) + (define-method (new-Slot (name ) (returnMetaType ) (parameters )) + (make 'obj (dos_slotdefinition_create name returnMetaType (length parameters) (map obj parameters)))) + (define-class ()) + (define-method (new-Slots (defs )) + (make 'ptr (dos_slotdefinitions_create (length defs) (map obj defs)))) + (define-method (delete-pointer (sd )) + (dos_slotdefinitions_delete (ptr sd))) - (define-class ()) - (define-method (initialize-instance (qpx )) - (set! (slot-value qpx 'ptr) (dos_qpixmap_create)) - (call-next-method)) - (define (new-QPixmap width height) - (make 'ptr (dos_qpixmap_create_width_and_height width height))) - (define-method (copy (qpix )) - (make 'ptr (dos_qpixmap_create_qpixmap (ptr qpix)))) - (define-method (load (qpix ) (filepath ) (format )) - (dos_qpixmap_load (ptr qpix) filepath format)) - (define-method (load-from-data (qpix ) (data ) (len )) - (dos_qpixmap_loadFromData (ptr qpix) data len)) - (define-method (fill (qpix ) (r ) (g ) (b ) (a )) - (dos_qpixmap_fill (ptr qpix) r g b a)) - (define-method (assign (qpix ) (other )) - (dos_qpixmap_assign (ptr qpix) (ptr other))) - (define-method (is-null? (qpix )) - (dos_qpixmap_isNull (ptr qpix))) - (define-method (delete-pointer (qpix )) - (dos_qpixmap_delete (ptr qpix))) + ;; - Properties + (define-class ()) + (define-method (new-Property (name ) (propertyMetaType ) (readSlot ) (writeSlot ) (notifySignal )) + (make 'obj (dos_propertydefinition_create name propertyMetaType readSlot writeSlot notifySignal))) + (define-class ()) + (define-method (new-Properties (defs )) + (make 'ptr (dos_propertydefinitions_create (length defs) (map obj defs)))) + (define-method (delete-pointer (pd )) + (dos_propertydefinitions_delete (ptr pd))) - (define-class ()) - (define-method (new-QQuickImageProvider callback) - (make 'ptr (dos_qquickimageprovider_create callback))) - (define-method (delete-pointer (qip )) - (dos_qquickimageprovider_delete (ptr qip))) + (define-class ()) + (define-method (base-url (context )) + (dos_qqmlcontext_baseUrl (ptr context))) + (define-method (set-property (context ) (name ) (qvalue )) + (dos_qqmlcontext_setcontextproperty (ptr context) name (ptr qvalue))) - (define-class ()) - (define-method (initialize-instance (qae )) - (set! (ptr qae) (dos_qqmlapplicationengine_create)) - (call-next-method)) - (define-method (load (appengine ) (filePath )) - (dos_qqmlapplicationengine_load (ptr appengine) filePath)) - (define-method (load-url (appengine ) (qurl )) - (dos_qqmlapplicationengine_load_url (ptr appengine) (ptr qurl))) - (define-method (load-data (appengine ) (data )) - (dos_qqmlapplicationengine_load_data (ptr appengine) data)) - (define-method (add-import-path (appengine ) (import-path )) - (dos_qqmlapplicationengine_add_import_path (ptr appengine) import-path)) - (define-method (context (appengine )) - (make 'ptr (dos_qqmlapplicationengine_context (ptr appengine)))) - (define-method (root (appengine )) - (make 'ptr (qml_qqmlapplicationengine_root (ptr appengine)))) - (define-method (add-image-provider (appengine ) (provider-id ) (provider )) - (dos_qqmlapplicationengine_addImageProvider (ptr appengine) provider-id (ptr provider))) - (define-method (delete-pointer (appengine )) - (dos_qqmlapplicationengine_delete (ptr appengine))) + (define-class ()) + (define (new-QUrl url) + (let ((qurl (make 'ptr (dos_qurl_create url 0)))) + qurl)) + (define-method (to-string (qurl )) + (dos_qurl_to_string (ptr qurl))) + (define-method (valid? (qurl )) + (dos_qurl_isValid (ptr qurl))) + (define-method (delete-pointer (qurl )) + (dos_qurl_delete (ptr qurl))) - (define-class ()) - (define-method (initialize-instance (qqv )) - (set! (slot-value qqv 'ptr) (dos_qquickview_create)) - (call-next-method)) - (define-method (show (qqv )) - (dos_qquickview_show (ptr qqv))) - (define-method (source (qqv )) - (dos_qquickview_source (ptr qqv))) - (define-method (set-source-url (qqv ) (qurl )) - (dos_qquickview_set_source_url (ptr qqv) (ptr qurl))) - (define-method (set-source (qqv ) (filename )) - (dos_qquickview_set_source (ptr qqv) filename)) - (define-method (set-resize-mode (qqv ) (mode )) - (dos_qquickview_set_resize_mode (ptr qqv) (val mode))) - (define-method (root-context (qqv )) - (make 'ptr (dos_qquickview_rootContext (ptr qqv)))) - (define-method (delete-pointer (qqv )) - (dos_qquickview_delete (ptr qqv))) + (define-class ()) + (define-method (initialize-instance (qpx )) + (set! (slot-value qpx 'ptr) (dos_qpixmap_create)) + (call-next-method)) + (define (new-QPixmap width height) + (make 'ptr (dos_qpixmap_create_width_and_height width height))) + (define-method (copy (qpix )) + (make 'ptr (dos_qpixmap_create_qpixmap (ptr qpix)))) + (define-method (load (qpix ) (filepath ) (format )) + (dos_qpixmap_load (ptr qpix) filepath format)) + (define-method (load-from-data (qpix ) (data ) (len )) + (dos_qpixmap_loadFromData (ptr qpix) data len)) + (define-method (fill (qpix ) (r ) (g ) (b ) (a )) + (dos_qpixmap_fill (ptr qpix) r g b a)) + (define-method (assign (qpix ) (other )) + (dos_qpixmap_assign (ptr qpix) (ptr other))) + (define-method (is-null? (qpix )) + (dos_qpixmap_isNull (ptr qpix))) + (define-method (delete-pointer (qpix )) + (dos_qpixmap_delete (ptr qpix))) - (define-class ()) - (define (new-QMetaObject superclass classname signal-definitions slot-definitions property-definitions) - (make 'ptr (dos_qmetaobject_create (ptr superclass) classname signal-definitions - slot-definitions property-definitions))) - (define-method (invoke-method (qmo ) (callback ) (data ) (connection-type )) - (dos_qmetaobject_invoke_method (ptr qmo) callback data (val connection-type))) - (define-method (delete-pointer (qmo )) - (dos_qmetaobject_delete (ptr qmo))) - (define (qmetaobject kind) - (case kind - ((qobject:) (make 'ptr (dos_qobject_qmetaobject))) - ((qabstractitemmodel:) (make 'ptr (dos_qabstractitemmodel_qmetaobject))) - ((qabstracttablemodel:) (make 'ptr (dos_qabstracttablemodel_qmetaobject))) - ((qabstractlistmodel:) (make 'ptr (dos_qabstractlistmodel_qmetaobject))))) + (define-class ()) + (define-method (new-QQuickImageProvider callback) + (make 'ptr (dos_qquickimageprovider_create callback))) + (define-method (delete-pointer (qip )) + (dos_qquickimageprovider_delete (ptr qip))) - (define-class ()) - (define-method (initialize-instance (qmi )) - (set! (ptr qmi) (dos_qmodelindex_create)) - (call-next-method)) - (define-method (copy (qmi )) - (make 'ptr (dos_qmodelindex_create_qmodelindex (ptr qmi)))) - (define-method (row (qmi )) - (dos_qmodelindex_row (ptr qmi))) - (define-method (column (qmi )) - (dos_qmodelindex_column (ptr qmi))) - (define-method (valid? (qmi )) - (dos_qmodelindex_isValid (ptr qmi))) - (define-method (data (qmi ) (role )) - (dos_qmodelindex_data (ptr qmi) (val role))) - (define-method (parent (qmi )) - (make 'ptr (dos_qmodelindex_parent (ptr qmi)))) - (define-method (child (qmi ) (row ) (column )) - (make 'ptr (dos_qmodelindex_child (ptr qmi) row column))) - (define-method (sibling (qmi ) (row ) (column )) - (make 'ptr (dos_qmodelindex_sibling (ptr qmi) row column))) - (define-method (assign (qmi ) (other )) - (dos_qmodelindex_assign (ptr qmi) (ptr other))) - (define-method (delete-pointer (qmi )) - (dos_qmodelindex_delete (ptr qmi))) + (define-class ()) + (define-method (initialize-instance (qae )) + (set! (ptr qae) (dos_qqmlapplicationengine_create)) + (call-next-method)) + (define-method (load (appengine ) (filePath )) + (dos_qqmlapplicationengine_load (ptr appengine) filePath)) + (define-method (load-url (appengine ) (qurl )) + (dos_qqmlapplicationengine_load_url (ptr appengine) (ptr qurl))) + (define-method (load-data (appengine ) (data )) + (dos_qqmlapplicationengine_load_data (ptr appengine) data)) + (define-method (add-import-path (appengine ) (import-path )) + (dos_qqmlapplicationengine_add_import_path (ptr appengine) import-path)) + (define-method (context (appengine )) + (make 'ptr (dos_qqmlapplicationengine_context (ptr appengine)))) + (define-method (root (appengine )) + (make 'ptr (qml_qqmlapplicationengine_root (ptr appengine)))) + (define-method (add-image-provider (appengine ) (provider-id ) (provider )) + (dos_qqmlapplicationengine_addImageProvider (ptr appengine) provider-id (ptr provider))) + (define-method (delete-pointer (appengine )) + (dos_qqmlapplicationengine_delete (ptr appengine))) - (define-class ()) - (define (new-QAbstractItemModel callback meta-object dcallback callbacks) - (make 'ptr (dos_qabstractitemmodel_create callback (ptr meta-object) dcallback (ptr callbacks)))) - (define-method (set-data (qaim ) (qmi ) (qv ) (role )) - (dos_qabstractitemmodel_setData (ptr qaim) (ptr qmi) (ptr qv) (val role))) - (define-method (flags (qaim ) (qmi )) - (dos_qabstractitemmodel_flags (ptr qaim) (ptr qmi))) - (define-method (header-data (qaim ) (section ) (orientation ) (role )) - (dos_qabstractitemmodel_headerData (ptr qaim) section (val orientation) role)) + (define-class ()) + (define-method (initialize-instance (qqv )) + (set! (slot-value qqv 'ptr) (dos_qquickview_create)) + (call-next-method)) + (define-method (show (qqv )) + (dos_qquickview_show (ptr qqv))) + (define-method (source (qqv )) + (dos_qquickview_source (ptr qqv))) + (define-method (set-source-url (qqv ) (qurl )) + (dos_qquickview_set_source_url (ptr qqv) (ptr qurl))) + (define-method (set-source (qqv ) (filename )) + (dos_qquickview_set_source (ptr qqv) filename)) + (define-method (set-resize-mode (qqv ) (mode )) + (dos_qquickview_set_resize_mode (ptr qqv) (val mode))) + (define-method (root-context (qqv )) + (make 'ptr (dos_qquickview_rootContext (ptr qqv)))) + (define-method (delete-pointer (qqv )) + (dos_qquickview_delete (ptr qqv))) - (define-class ()) - (define (new-QAbstractListModel callback qalm dcallback callbacks) - (dos_qabstractlistmodel_create callback (ptr qalm) dcallback (ptr callbacks))) - (define-method (index (qalm ) (row ) (column ) (parent )) - (dos_qabstractlistmodel_index (ptr qalm) row column (ptr parent))) - (define-method (parent (qalm ) (child )) - (dos_qabstractlistmodel_parent (ptr qalm) (ptr child))) - (define-method (column-count (qalm ) (parent )) - (dos_qabstractlistmodel_columnCount (ptr qalm) (ptr parent))) + (define-class ()) + (define (new-QMetaObject superclass classname signal-definitions slot-definitions property-definitions) + (make 'ptr (dos_qmetaobject_create (ptr superclass) classname signal-definitions + slot-definitions property-definitions))) + (define-method (invoke-method (qmo ) (callback ) (data ) (connection-type )) + (dos_qmetaobject_invoke_method (ptr qmo) callback data (val connection-type))) + (define-method (delete-pointer (qmo )) + (dos_qmetaobject_delete (ptr qmo))) + (define (qmetaobject kind) + (case kind + ((qobject:) (make 'ptr (dos_qobject_qmetaobject))) + ((qabstractitemmodel:) (make 'ptr (dos_qabstractitemmodel_qmetaobject))) + ((qabstracttablemodel:) (make 'ptr (dos_qabstracttablemodel_qmetaobject))) + ((qabstractlistmodel:) (make 'ptr (dos_qabstractlistmodel_qmetaobject))))) - (define-class ()) - (define (new-QAbstractTableModel callback meta-object dcallback callbacks) - (dos_qabstracttablemodel_create callback (ptr meta-object) dcallback (ptr callbacks))) - (define-method (index (qatm ) (row ) (column ) (parent )) - (dos_qabstracttablemodel_index (ptr qatm) row column (ptr parent))) - (define-method (parent (qatm ) (child )) - (dos_qabstracttablemodel_parent (ptr qatm) (ptr child))) + (define-class ()) + (define-method (initialize-instance (qmi )) + (set! (ptr qmi) (dos_qmodelindex_create)) + (call-next-method)) + (define-method (copy (qmi )) + (make 'ptr (dos_qmodelindex_create_qmodelindex (ptr qmi)))) + (define-method (row (qmi )) + (dos_qmodelindex_row (ptr qmi))) + (define-method (column (qmi )) + (dos_qmodelindex_column (ptr qmi))) + (define-method (valid? (qmi )) + (dos_qmodelindex_isValid (ptr qmi))) + (define-method (data (qmi ) (role )) + (dos_qmodelindex_data (ptr qmi) (val role))) + (define-method (parent (qmi )) + (make 'ptr (dos_qmodelindex_parent (ptr qmi)))) + (define-method (child (qmi ) (row ) (column )) + (make 'ptr (dos_qmodelindex_child (ptr qmi) row column))) + (define-method (sibling (qmi ) (row ) (column )) + (make 'ptr (dos_qmodelindex_sibling (ptr qmi) row column))) + (define-method (assign (qmi ) (other )) + (dos_qmodelindex_assign (ptr qmi) (ptr other))) + (define-method (delete-pointer (qmi )) + (dos_qmodelindex_delete (ptr qmi))) + + (define-class ()) + (define (new-QAbstractItemModel callback meta-object dcallback callbacks) + (make 'ptr (dos_qabstractitemmodel_create callback (ptr meta-object) dcallback (ptr callbacks)))) + (define-method (set-data (qaim ) (qmi ) (qv ) (role )) + (dos_qabstractitemmodel_setData (ptr qaim) (ptr qmi) (ptr qv) (val role))) + (define-method (flags (qaim ) (qmi )) + (dos_qabstractitemmodel_flags (ptr qaim) (ptr qmi))) + (define-method (header-data (qaim ) (section ) (orientation ) (role )) + (dos_qabstractitemmodel_headerData (ptr qaim) section (val orientation) role)) + + (define-class ()) + (define (new-QAbstractListModel callback qalm dcallback callbacks) + (dos_qabstractlistmodel_create callback (ptr qalm) dcallback (ptr callbacks))) + (define-method (index (qalm ) (row ) (column ) (parent )) + (dos_qabstractlistmodel_index (ptr qalm) row column (ptr parent))) + (define-method (parent (qalm ) (child )) + (dos_qabstractlistmodel_parent (ptr qalm) (ptr child))) + (define-method (column-count (qalm ) (parent )) + (dos_qabstractlistmodel_columnCount (ptr qalm) (ptr parent))) + + (define-class ()) + (define (new-QAbstractTableModel callback meta-object dcallback callbacks) + (dos_qabstracttablemodel_create callback (ptr meta-object) dcallback (ptr callbacks))) + (define-method (index (qatm ) (row ) (column ) (parent )) + (dos_qabstracttablemodel_index (ptr qatm) row column (ptr parent))) + (define-method (parent (qatm ) (child )) + (dos_qabstracttablemodel_parent (ptr qatm) (ptr child))) + ) ) -) diff --git a/scripts/gen-doc.sh b/scripts/gen-doc.sh new file mode 100755 index 0000000..7a8e23b --- /dev/null +++ b/scripts/gen-doc.sh @@ -0,0 +1,2 @@ +#!/bin/sh +chalk -m ./qml.core.scm > readme.wiki