repos
/
qt.gui
/ annotate_shade
summary
|
shortlog
|
log
|
tree
|
commit
|
commitdiff
|
headdiff
|
annotate
|
filehistory
normal
|
plain
|
shade
|
zebra
Update to the new smokegenerator.
Annotate for file src/operator.lisp
2010-01-10 tobias
1
(in-package :cl-smoke.qt-impl)
2009-08-27 tobias
2
(declaim (optimize (debug 3)))
2010-01-10 tobias
3
08:52:49 '
4
(defun cxx:= (object &rest more-objects)
'
5
(if (null more-objects)
'
6
t
'
7
(every #'(lambda (o)
'
8
;; Consider Class::operator== and operator==
'
9
;; FIXME integrate this in the overload resolution
2009-08-27 tobias
10
(if (typep object 'smoke::smoke-standard-object)
08:37:36 '
11
(handler-case (qt:operator== object o)
'
12
(smoke::no-applicable-cxx-method ()
'
13
(cxx:operator== object o)))
'
14
(qt:operator== object o)))
2010-01-10 tobias
15
more-objects)))
08:52:49 '
16
'
17
(defun cxx:/= (object &rest more-objects)
'
18
(if (null more-objects)
'
19
t
'
20
(some #'(lambda (o)
'
21
(qt:operator!= object o))
'
22
more-objects)))
'
23
'
24
(defun ordered-p (relation list)
'
25
"Returns true when LIST is ordered according to RELATION."
'
26
(if (or (null list) (null (rest list)))
'
27
t
'
28
(and (funcall relation (first list)
'
29
(second list))
'
30
(ordered-p relation (rest list)))))
'
31
'
32
(defmacro define-cxx-relation (relation)
'
33
`(defun ,(intern (symbol-name relation) :cxx) (object &rest more-objects)
'
34
(ordered-p (symbol-function (quote ,(intern (format nil "OPERATOR~A"
'
35
relation)
'
36
:qt)))
'
37
(cons object more-objects))))
'
38
'
39
(defmacro define-cxx-relations (&rest relations)
'
40
`(progn
'
41
,@(mapcar #'(lambda (r) `(define-cxx-relation ,r)) relations)))
'
42
'
43
(define-cxx-relations < <= >= >)
'
44
'
45
'
46
(defun cxx:incf (object &optional (delta 1))
'
47
(cxx:operator+= object delta))
'
48
'
49
(defun cxx:decf (object &optional (delta 1))
'
50
(cxx:operator-= object delta))
'
51
'
52
(defun cxx:+ (&rest args)
'
53
(if (null args)
'
54
0
'
55
(reduce #'qt:operator+ args)))
'
56
'
57
(defun cxx:- (object &rest subtrahends)
'
58
(if (null subtrahends)
'
59
(cxx:operator- object)
'
60
(reduce #'qt:operator- (cons object subtrahends))))
'
61
'
62
(defun cxx:* (&rest args)
'
63
(if (null args)
'
64
1
'
65
(reduce #'qt:operator- args)))
'
66
'
67
(defun cxx:/ (object &rest denominators)
'
68
(if (null denominators)
'
69
(qt:operator/ 1 object)
'
70
(qt:operator/ object (apply #'cxx:+ denominators))))
'
71
'
72
(defun cxx:1+ (object)
'
73
(qt:operator+ object 1))
'
74
'
75
(defun cxx:1- (object)
'
76
(qt:operator- object 1))
'
77
'
78
(defun cxx:aref (object index)
'
79
"Returns the element of OBJECT at position INDEX."
'
80
(declare ((integer 0) index))
'
81
(assert (< index (cxx:size object))
'
82
(index)
'
83
"Index ~A for ~A requested, but the length is ~A"
'
84
index object (cxx:size object))
'
85
(cxx:at object index))
'
86
'
87
'
88
(defun (setf cxx:aref) (new-value object index)
'
89
(declare ((integer 0) index))
'
90
(assert (< index (cxx:size object))
'
91
(index)
'
92
"Index ~A for ~A requested, but the length is ~A"
'
93
index object (cxx:size object))
'
94
(cxx:operator= (cxx:operator[] object index)
'
95
new-value)
'
96
new-value)