repos / smoke / annotate_shade
summary | shortlog | log | tree | commit | commitdiff | headdiff | annotate | headblob | headfilediff | filehistory
normal | plain | shade | zebra
Fix undefine init_smoke* C function & cleanup finalizers when a image is saved.
Annotate for file src/smoke.lisp
2010-01-10 tobias 1 ;;; Copyright (C) 2009 Tobias Rautenkranz <tobias@rautenkranz.ch>
2009-04-14 tobias 2 ;;;
14:23:24 ' 3 ;;; This program is free software: you can redistribute it and/or modify
' 4 ;;; it under the terms of the GNU General Public License as published by
' 5 ;;; the Free Software Foundation, either version 3 of the License, or
' 6 ;;; (at your option) any later version.
' 7 ;;;
' 8 ;;; This program is distributed in the hope that it will be useful,
' 9 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
' 10 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
' 11 ;;; GNU General Public License for more details.
' 12 ;;;
' 13 ;;; You should have received a copy of the GNU General Public License
' 14 ;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
' 15 ;;;
' 16 ;;; As a special exception, the copyright holders of this library give you
' 17 ;;; permission to link this library with independent modules to produce an
' 18 ;;; executable, regardless of the license terms of these independent
' 19 ;;; modules, and to copy and distribute the resulting executable under
' 20 ;;; terms of your choice, provided that you also meet, for each linked
' 21 ;;; independent module, the terms and conditions of the license of that
' 22 ;;; module. An independent module is a module which is not derived from or
' 23 ;;; based on this library. If you modify this library, you may extend this
' 24 ;;; exception to your version of the library, but you are not obligated to
' 25 ;;; do so. If you do not wish to do so, delete this exception statement
' 26 ;;; from your version.
2009-04-05 tobias 27
2009-04-14 tobias 28 (in-package #:smoke)
2009-04-05 tobias 29
2009-06-30 tobias 30 (declaim (inline call-s-method))
2009-06-22 tobias 31 (defun call-s-method (method object-pointer stack-pointer)
12:18:08 ' 32 (foreign-funcall-pointer
2009-07-08 tobias 33 (foreign-slot-value (pointer (get-class method))
2009-08-02 tobias 34 'smoke-class
10:12:41 ' 35 'class-function)
2009-06-22 tobias 36 ()
12:18:08 ' 37 smoke-index (foreign-slot-value (smoke-method-pointer method)
2009-08-02 tobias 38 'smoke-method
10:12:41 ' 39 'method)
2009-06-22 tobias 40 :pointer object-pointer
12:18:08 ' 41 smoke-stack stack-pointer
' 42 :void))
' 43
' 44 (defun s-call (method object-pointer &optional (args nil))
2009-04-05 tobias 45 (with-stack (stack args (arguments method) )
2009-07-08 tobias 46 (call-s-method method object-pointer (pointer stack))
20:41:19 ' 47 (type-to-lisp (pointer stack) (return-type method))))
2009-04-05 tobias 48
2009-06-22 tobias 49 (defun pointer-call (method object-pointer &optional (args nil))
2009-04-05 tobias 50 (with-stack (stack args (arguments method) )
2009-07-08 tobias 51 (call-s-method method object-pointer (pointer stack))
20:41:19 ' 52 (foreign-slot-value (pointer stack) 'smoke-stack-item 'class)))
2009-04-05 tobias 53
2009-08-02 tobias 54
2009-04-05 tobias 55 (defun smoke-call (class pointer method-name &optional (args nil))
2009-08-02 tobias 56 (s-call
10:12:41 ' 57 (make-smoke-method-from-name class method-name)
' 58 pointer args))
2009-04-05 tobias 59
2010-01-17 tobias 60 (defun static-call (smoke class-name method-name &rest args)
2009-08-02 tobias 61 (s-call
10:12:41 ' 62 (make-smoke-method-from-name (make-smoke-class smoke class-name)
' 63 method-name)
' 64 (null-pointer) args))
2010-01-17 tobias 65
2009-04-05 tobias 66 (defun enum-call (method)
15:36:29 ' 67 "Return the enum value for METHOD."
' 68 ;; FIXME:
' 69 ;; we could use static call, but QGraphicsEllipseItem::Type has
' 70 ;; wrongly QGraphicsGridLayout as return type. Smoke ignores case
2009-08-02 tobias 71 ;; and confuses it with the member function type() ??
10:12:41 ' 72 ;; (27.2.09)
2009-04-05 tobias 73 ;;
15:36:29 ' 74 (assert (enum-p method))
' 75 (with-stack (stack nil nil)
2009-07-08 tobias 76 (call-s-method method (null-pointer) (pointer stack))
20:41:19 ' 77 (foreign-slot-value (pointer stack) 'smoke-stack-item 'long)))
2009-04-05 tobias 78
15:36:29 ' 79 (defun delete-pointer (pointer class)
' 80 "Destructs the object at POINTER of type CLASS.
2009-07-01 tobias 81 Calls the destructor and frees the memory."
2009-06-30 tobias 82 (declare (optimize (speed 3)))
2009-07-22 tobias 83 (let ((method-name (concatenate 'string "~" (name class))))
2009-08-02 tobias 84 (s-call
10:12:41 ' 85 (make-smoke-method-from-name class method-name)
2009-07-22 tobias 86 pointer))
22:26:05 ' 87 (setf pointer (null-pointer)))
2009-04-05 tobias 88
15:36:29 ' 89 (defun delete-object (object)
2010-02-19 tobias 90 (let ((method-name (concatenate 'string "~" (name (class-of object)))))
21:22:50 ' 91 (s-call
2009-08-02 tobias 92 (make-smoke-method-from-name (class-of object) method-name)
10:12:41 ' 93 (pointer object)))
2009-04-05 tobias 94 (setf (slot-value object 'pointer) (null-pointer)))
15:36:29 ' 95
2009-06-22 tobias 96 (defun set-binding (object)
12:18:08 ' 97 "Sets the Smoke binding for OBJECT, that receives its callbacks."
' 98 (declare (optimize (speed 3)))
2010-02-18 tobias 99 (with-foreign-object (stack 'smoke-stack-item 2)
2009-08-02 tobias 100 (setf (foreign-slot-value (mem-aref stack
10:12:41 ' 101 'smoke-stack-item
' 102 1)
' 103 'smoke-stack-item
' 104 'voidp)
2010-02-18 tobias 105 (smoke-module-binding (smoke (class-of object))))
19:57:00 ' 106 (foreign-funcall-pointer
2009-07-08 tobias 107 (foreign-slot-value (pointer (class-of object))
2009-08-02 tobias 108 'smoke-class
10:12:41 ' 109 'class-function)
2010-02-18 tobias 110 ()
19:57:00 ' 111 smoke-index 0 ;; set binding method index
2009-08-02 tobias 112 :pointer (pointer object) smoke-stack stack
2010-02-18 tobias 113 :void)))
2009-04-05 tobias 114
2009-06-22 tobias 115 (defun init (smoke module)
2009-04-05 tobias 116 "Returns the a new Smoke binding for the Smoke module SMOKE."
2010-01-10 tobias 117 (use-foreign-library libsmoke-c)
2009-08-02 tobias 118 (let* ((binding (smoke-init smoke
10:12:41 ' 119 (callback destructed)
2010-02-18 tobias 120 (callback dispatch-method))))
2010-01-10 tobias 121 (setf (binding smoke) binding
08:49:36 ' 122 (smoke-module-pointer module) smoke
2010-02-19 tobias 123 (smoke-module-binding module) binding)
21:10:24 ' 124 (init-smoke-module module)
' 125 (setf (gethash (pointer-address smoke) *smoke-modules*) module)
' 126 module))
2009-04-05 tobias 127
2009-05-12 tobias 128 (let ((pointer-symbol-map (make-hash-table)))
13:54:46 ' 129 (defun register-smoke-module-var (symbol)
' 130 "Registers SYMBOL of a variable containing a pointer to a Smoke module."
2009-08-02 tobias 131 (setf (gethash (pointer-address (smoke-module-pointer (eval symbol))) pointer-symbol-map)
2009-05-12 tobias 132 symbol))
13:54:46 ' 133 (defun get-smoke-variable-for-pointer (pointer)
' 134 "Returns the SYMBOL of the variable whose value is POINTER."
' 135 (gethash (pointer-address pointer) pointer-symbol-map)))
' 136
2009-04-05 tobias 137 (defun call (object method-name &rest args)
2009-08-02 tobias 138 (smoke-call (class-of object)
10:12:41 ' 139 (pointer object)
' 140 method-name
' 141 args))
2009-04-05 tobias 142
2009-04-12 tobias 143 (defmethod documentation ((class smoke-standard-class) (doc-type (eql 't)))
20:25:47 ' 144 (declare (optimize (speed 3)))
2009-04-05 tobias 145 (format nil "~@[~A~%~]C++ name: ~A" (call-next-method) (name class)))
15:36:29 ' 146
2009-07-22 tobias 147 ;; No eql T since all-methods is to slow to be used in conjunction with
22:26:05 ' 148 ;; mb:document
' 149 (defmethod documentation ((gf smoke-gf) (doc-type (eql 'cxx-function)))
2009-04-12 tobias 150 (declare (optimize (speed 3)))
2009-04-05 tobias 151 (let ((methods (all-methods (name gf))))
15:36:29 ' 152 (format nil "~@[~A~%~]~{~T~A~%~}"
' 153 (call-next-method)
' 154 (sort (mapcar #'method-declaration methods) #'string<=))))
' 155
' 156 (defun all-methods (name)
' 157 "Returns a list of all methods named NAME."
2010-01-10 tobias 158 ;;FIXME speed this up, needed by (mb:document :smoke).
2009-07-22 tobias 159 (declare (string name)
22:26:05 ' 160 (optimize (speed 3)))
2009-04-05 tobias 161 (let ((methods))
2009-06-22 tobias 162 (maphash
2009-07-22 tobias 163 #'(lambda (address value)
22:26:05 ' 164 (declare (ignore value))
' 165 (let ((smoke (make-pointer address)))
' 166 (map-methods #'(lambda (method)
' 167 (when (and (string= name (name method))
' 168 (not (enum-p method)))
' 169 (push (make-instance 'smoke-method
' 170 :id (smoke-method-id method)
' 171 :smoke (smoke method))
' 172 methods)))
' 173 smoke)))
' 174 *smoke-id-class-map*)
' 175 methods))
2009-04-05 tobias 176
15:36:29 ' 177 (defun fgrep-methods (smoke str)
' 178 (map-methods #'(lambda (method)
2009-06-22 tobias 179 (when (search str (name method))
12:18:08 ' 180 (princ (method-declaration method))
' 181 (terpri)))
2009-04-05 tobias 182 smoke))
15:36:29 ' 183
2009-06-11 tobias 184 (defmacro define-smoke-module (package library
14:35:40 ' 185 (variable variable-name)
2009-05-14 tobias 186 (init-function function-name))
12:07:00 ' 187 "Define a Smoke module."
2009-06-22 tobias 188 (let ((smoke-module (intern "*SMOKE-MODULE*")))
12:18:08 ' 189 `(progn
2009-07-22 tobias 190 (eval-when (:compile-toplevel :load-toplevel :execute)
22:26:05 ' 191 (define-foreign-library ,library
' 192 (:unix ,(format nil "~(~A~).so.2" library))
2009-07-02 tobias 193 (t (:default ,(format nil "~(~A~)" library)))))
19:08:40 ' 194 (eval-startup (:compile-toplevel :execute)
' 195 (load-foreign-library ',library))
' 196 (eval-startup (:compile-toplevel :execute)
' 197 ; (eval-when (:compile-toplevel :load-toplevel :execute)
' 198 ; (define-foreign-library ,library
' 199 ; (:unix ,(format nil "~(~A~).so.2" library))
' 200 ; (t (:default ,(format nil "~(~A~)" library))))
' 201 ; (load-foreign-library ',library))
' 202 (defcvar (,variable ,variable-name
' 203 :read-only t
' 204 :library ,library) :pointer)
2009-12-13 tobias 205 (defcfun (,init-function ,(format nil "_Z~A~Av"
10:17:08 ' 206 (length function-name)
2009-07-02 tobias 207 function-name)
19:08:40 ' 208 :library ,library)
2009-06-30 tobias 209 :void))
2009-06-12 tobias 210 (eval-when (:compile-toplevel :load-toplevel :execute)
2009-06-22 tobias 211 (defparameter ,smoke-module (make-smoke-module)))
12:18:08 ' 212 (eval-startup (:compile-toplevel :execute)
2009-06-30 tobias 213 (,init-function)
22:47:39 ' 214 (init ,variable ,smoke-module)
' 215 (register-smoke-module-var ',smoke-module))
2009-06-22 tobias 216 (define-classes-and-gfs ,package ,smoke-module))))
2009-05-14 tobias 217
2009-08-02 tobias 218
2009-04-05 tobias 219 (defun fgrep-classes (smoke str)
15:36:29 ' 220 (map-classes #'(lambda (class)
' 221 (when (search str (name class))
' 222 (format t "~A~%" (name class))))
' 223 smoke))
2009-05-28 tobias 224 (defmacro define-takes-ownership (method lambda-list object)
2009-06-08 tobias 225 "Declares METHOD transfers the ownership of OBJECT to the
09:20:54 ' 226 first argument of LAMBDA-LIST."
2009-05-31 tobias 227 `(defmethod ,method :before ,lambda-list
2009-06-30 tobias 228 (declare (ignorable ,@(loop for arg in (rest lambda-list) collect
22:47:39 ' 229 (if (consp arg)
' 230 (first arg)
' 231 arg))))
2009-06-08 tobias 232 (transfer-ownership-to ,object ,(if (consp (first lambda-list))
09:20:54 ' 233 (first (first lambda-list))
' 234 (first lambda-list)))))
2009-05-28 tobias 235
Crece desde el pueblo el futuro / crece desde el pie