You can run the examples with:
(asdf:oos 'asdf:load-op :cl-smoke.qt.examples)
(qt.examples:launcher
)
Example 3.4. Repl
Use a qt:string-list-model
with a qt:list-view
to show evaluated lisp expressions.
;;; Copyright 2009 Tobias Rautenkranz ;;; License: X11 license (in-package :qt.examples) (defclass repl (qt:widget) ((model :reader model :initform (make-instance 'qt:string-list-model)) (output :reader output :initform (make-instance 'qt:list-view)) (input :reader input :initform (make-instance 'qt:line-edit))) (:metaclass cxx:class)) (defun append-list-model (list-model string) "Appends STRING to LIST-MODEL." (let ((index (cxx:row-count list-model))) (unless (cxx:insert-row list-model index) (error "insert-row ~A for ~A failed." index list-model)) (unless (cxx:set-data list-model (cxx:index list-model index) string) (error "set-data failed.")))) (defmethod initialize-instance :after ((repl repl) &rest args) (declare (ignore args)) (setf (cxx:model (output repl)) (model repl)) (qt:connect (qt:get-signal (input repl) "returnPressed()") #'(lambda () (append-list-model ;; Input (model repl) (format nil "> ~A" (cxx:text (input repl)))) (append-list-model ;; return value (model repl) (write-to-string (handler-case (eval (read-from-string (cxx:text (input repl)))) (error (condition) condition)))) (cxx:clear (input repl)))) (let ((layout (make-instance 'qt:vbox-layout))) (cxx:add-widget layout (output repl)) (cxx:add-widget layout (input repl)) (setf (cxx:layout repl) layout)) (cxx:set-focus (input repl))) (defun repl () "Lisp REPL" (qt:with-app () (let ((repl (make-instance 'repl))) (cxx:show repl) (qt:exec))))
Example 3.5. Class Browser
Qt Classes browser using :cl-smoke.qt.webkit to display the
API doc and a custom qt:list-model
for the qt:list-view
of the available classes.
;;; Copyright 2009 Tobias Rautenkranz ;;; License: X11 license (in-package :qt.examples) (defclass classes-model (qt:abstract-list-model) ((items :reader items :initarg :items :initform (make-array 0 :adjustable t :fill-pointer t))) (:metaclass cxx:class)) (defmethod cxx:row-count ((list classes-model) parent) (length (items list))) (defmethod cxx:data ((list classes-model) index role) (if (and (cxx:is-valid index) (< (cxx:row index) (length (items list))) (= role (value qt:+display-role+))) (string-downcase (class-name (aref (items list) (cxx:row index)))) (qt:make-variant))) (defun class-at (model-index) (aref (items (cxx:model model-index)) (cxx:row model-index))) (defclass class-browser (qt:splitter) ((classes :accessor classes :initform (make-instance 'classes-model)) (classes-list :reader classes-list :initform (make-instance 'qt:list-view)) (info :reader class-info :initform (make-instance 'qt:label)) (web-view :reader web-view :initform (make-instance 'qt:web-view))) (:metaclass cxx:class)) (defun setup-class-list (classes) (do-external-symbols (symbol :qt) (let ((class (find-class symbol nil))) (when (and (not (null class)) (typep class (find-class 'smoke::smoke-standard-class))) (vector-push-extend class (items classes))))) (sort (items classes) #'(lambda (class1 class2) (string< (class-name class1) (class-name class2))))) (defmethod initialize-instance :after ((browser class-browser) &rest args) (declare (ignore args)) (let* ((w (make-instance 'qt:widget)) (layout (make-instance 'qt:vbox-layout))) (cxx:add-widget layout (classes-list browser)) (let ((search (make-instance 'qt:line-edit))) (cxx:add-widget layout search) (qt:connect (qt:get-signal search "textChanged(QString)") #'(lambda (text) ;; FIXME since the class list is sorted we could do better (cxx:keyboard-search (classes-list browser) text)))) (let ((scroll (make-instance 'qt:scroll-area))) (setf (cxx:widget scroll) (class-info browser) (cxx:widget-resizable scroll) t) (cxx:add-widget layout scroll)) (setf (cxx:layout w) layout) (cxx:add-widget browser w)) (cxx:add-widget browser (web-view browser)) (qt:do-delayed-initialize (setup-class-list (classes browser)) (setf (cxx:uniform-item-sizes (classes-list browser)) t (cxx:selection-mode (classes-list browser)) qt:abstract-item-view.+single-selection+ (cxx:model (classes-list browser)) (classes browser) (cxx:word-wrap (class-info browser)) t (cxx:window-title browser) "CL Qt Classes") (qt:connect (qt:get-signal (cxx:selection-model (classes-list browser)) "currentChanged(QModelIndex, QModelIndex)") #'(lambda (current previous) (declare (ignore previous)) (set-info (class-info browser) (web-view browser) current))))) (defun set-info (info web-view model-index) (let* ((class (class-at model-index))) (cxx:load web-view (format nil "http://qt.nokia.com/doc/~A/~(~A~).html" (subseq (qt:q-version) 0 3) (remove #\: (smoke:name class) :count 1))) (cxx:set-text info (format nil "<h1>qt:~A</h1> <p>~A</p> <h2>Direct Superclasses</h2> <ul> ~{ <li>~A</li> ~} </ul> <h2>Direct Subclasses</h2> <ul> ~{ <li>~A</li>~} </ul> " (string-downcase (class-name class)) (smoke:name class) (mapcar #'(lambda (c) (string-downcase (class-name c))) (closer-mop:class-direct-superclasses class)) (mapcar #'(lambda (c) (string-downcase (class-name c))) (closer-mop:class-direct-subclasses class)))))) (defun class-browser () "Qt Class Browser" (qt:with-app () (let ((browser (make-instance 'class-browser))) (cxx:show browser) (qt:exec))))