Sun Apr 5 17:36:16 CEST 2009 Tobias Rautenkranz * initial import diff -rN -u old-kde.ui/TODO new-kde.ui/TODO --- old-kde.ui/TODO 1970-01-01 01:00:00.000000000 +0100 +++ new-kde.ui/TODO 2014-10-30 07:23:41.000000000 +0100 @@ -0,0 +1 @@ +* fix segfault on exit after kde:application has run diff -rN -u old-kde.ui/kde.mbd new-kde.ui/kde.mbd --- old-kde.ui/kde.mbd 1970-01-01 01:00:00.000000000 +0100 +++ new-kde.ui/kde.mbd 2014-10-30 07:23:41.000000000 +0100 @@ -0,0 +1,18 @@ +;;;; -*- Mode: lisp; indent-tabs-mode: nil -*- + +(in-package :sysdef-user) + +(define-system :kde () + (:version 0 0 1) + (:documentation "Smoke KDE bindings.") + (:keywords "GUI" "KDE") + (:author "Tobias Rautenkranz") + (:needs :qt) + (:components + ("src" module + (:components + "package" + ("dr-konqi" (:needs "package")) + ("kde" (:needs "package" "dr-konqi")) + ("application" (:needs "package" "kde")) + ("standard-action" (:needs "package" "kde")))))) diff -rN -u old-kde.ui/src/application.lisp new-kde.ui/src/application.lisp --- old-kde.ui/src/application.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-kde.ui/src/application.lisp 2014-10-30 07:23:41.000000000 +0100 @@ -0,0 +1,59 @@ +(in-package :kde) + +(declaim (optimize (debug 3))) + +(defun app () + (assert (app-p)) + (qt:app)) + +(defun app-p () + (and (qt:app-p) + (typep (qt:app) (find-class 'application)))) + +(defun make-aboutdata (app-name program-name version) + (let ((app-name (make-instance 'qt:byte-array :args (list app-name))) + (catalog-name (make-instance 'qt:byte-array)) + (program-name (kde:ki18n program-name)) + (version (make-instance 'qt:byte-array :args (list version)))) + (make-instance 'about-data :args (list app-name catalog-name + program-name version)))) + +(let ((argv)) + (defun ensure-app (about-data &optional (application 'application) + (args #+sbcl sb-ext:*posix-argv* + #-sbcl (list "lisp"))) + (if (qt:app-p) + (progn + (assert (typep (qt:app) (find-class application)) + () + "The existing application object ~A is +not of type ~A." (qt:app) (find-class application)) + (values (qt:app) nil)) + (let ((args (append (list (first args)) + '("--nocrashhandler") (rest args)))) + (unless (null argv) + (foreign-free argv) + (setf argv (null-pointer))) + + (setf argv (foreign-alloc :string :initial-contents args)) + (kde:cmd-line-args.init (length args) argv about-data) + (values (make-instance 'application) t)))) + (defun kill-app () + (qt:application.close-all-windows) + (setf qt::*widgets* nil) + ;; FIXME make it work without mem-faults + (cxx:delete-later (app)) + (trivial-garbage:cancel-finalization (app)) + (smoke::delete-pointer (smoke::pointer (app)) (class-of (app))) + (setf (slot-value (app) 'pointer) (null-pointer)))) + +(defmacro with-app (about-data &body body) + `(qt::with-application ((ensure-app ,about-data) + (kill-app)) + ,@body)) + +(defmacro with-kde ((app-name program-name version) &body body) + (let ((about-data (gensym))) + `(let ((,about-data (make-aboutdata ,app-name ,program-name ,version))) + (with-app ,about-data + ,@body)))) diff -rN -u old-kde.ui/src/dr-konqi.lisp new-kde.ui/src/dr-konqi.lisp --- old-kde.ui/src/dr-konqi.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-kde.ui/src/dr-konqi.lisp 2014-10-30 07:23:41.000000000 +0100 @@ -0,0 +1,6 @@ +(in-package :kde) + +(defun disable-dr-konqi () + "Disables the Dr Konqi crash manager since it traps signals." + #+sbcl (sb-posix:putenv "KDE_DEBUG=true") + #-sbcl (warn "Can not disable Dr. Konqi.")) diff -rN -u old-kde.ui/src/kde.lisp new-kde.ui/src/kde.lisp --- old-kde.ui/src/kde.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-kde.ui/src/kde.lisp 2014-10-30 07:23:41.000000000 +0100 @@ -0,0 +1,28 @@ +(in-package :kde) + +(eval-when (:load-toplevel :compile-toplevel) + (define-foreign-library libsmokekde + (:unix "libsmokekde.so.2") + (t (:default "libsmokekde"))) + + (use-foreign-library libsmokekde) + + (defcvar "kde_Smoke" :pointer + "The Smoke KDE binding") + + (defcfun (init-kde-smoke "_Z14init_kde_Smokev") :void) + + (defvar *kde-binding* (null-pointer)) + + (init-kde-smoke) + (disable-dr-konqi) + (when (null-pointer-p *kde-binding*) + (setf *kde-binding* (init *kde-smoke*)))) + +(define-methods *kde-smoke*) + +(defun new (class-name method-name &rest args) + (apply #'new-object *kde-binding* class-name method-name args)) + +(defun static-call (class-name method-name &rest args) + (apply #'smoke::static-call *kde-smoke* class-name method-name args)) diff -rN -u old-kde.ui/src/package.lisp new-kde.ui/src/package.lisp --- old-kde.ui/src/package.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-kde.ui/src/package.lisp 2014-10-30 07:23:41.000000000 +0100 @@ -0,0 +1,11 @@ +(defpackage :kde + (:use :cl :asdf :smoke :cffi :cxx-support) + (:export #:new + #:call + #:static-call + + #:make-aboutdata + #:make-standard-action + #:init-app + #:with-kde + #:with-app)) diff -rN -u old-kde.ui/src/standard-action.lisp new-kde.ui/src/standard-action.lisp --- old-kde.ui/src/standard-action.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-kde.ui/src/standard-action.lisp 2014-10-30 07:23:41.000000000 +0100 @@ -0,0 +1,13 @@ +(in-package :kde) + +(defun make-standard-action (action action-collection &optional slot) + "Adds the standard-action ACTION to ACTION-COLLECTION and connects +the \"triggered()\" signal to SLOT when specified." + (let ((std-action (static-call "KStandardAction" "create$#$#" action + (null-pointer) + (null-pointer) + action-collection))) + (when slot + (qt:connect (qt:get-signal std-action "triggered()") + slot)) + std-action)) diff -rN -u old-kde.ui/tests/test.lisp new-kde.ui/tests/test.lisp --- old-kde.ui/tests/test.lisp 1970-01-01 01:00:00.000000000 +0100 +++ new-kde.ui/tests/test.lisp 2014-10-30 07:23:41.000000000 +0100 @@ -0,0 +1 @@ +(mb:test :kde.tests)