/[gtk-cffi]/gtk-cffi/gtk/window.lisp
ViewVC logotype

Contents of /gtk-cffi/gtk/window.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.7 - (show annotations)
Sun Aug 12 17:42:30 2012 UTC (20 months ago) by rklochkov
Branch: MAIN
CVS Tags: HEAD
Changes since 1.6: +1 -1 lines
Synced with current version of CFFI
1 ;;;
2 ;;; window.lisp --- GtkWindow
3 ;;;
4 ;;; Copyright (C) 2007, Roman Klochkov <kalimehtar@mail.ru>
5 ;;;
6 ;;; Some conventions
7 ;;; gtk_window_set_position -> (setf (position-type ...))
8 ;;; gtk_window_get_position/gtk_window_move -> window-position (setf'able)
9 ;;; gtk_window_get_default_widget/gtk_window_set_default -> default-widget
10
11 (in-package :gtk-cffi)
12
13 (defcenum window-type
14 :top-level :popup)
15
16 (defclass window (bin)
17 ())
18
19 (defcfun gtk-window-new :pointer (type window-type))
20
21 (defmethod gconstructor ((window window)
22 &key (type :top-level) &allow-other-keys)
23 (gtk-window-new type))
24
25 (defslots window
26 title :string
27 role :string
28 resizable :boolean
29 modal :boolean
30 gravity gravity
31 transient-for pobject
32 destroy-with-parent :boolean
33 focus pobject
34 decorated :boolean
35 deletable :boolean
36 mnemonic-modifier modifier-type
37 type-hint window-type-hint
38 skip-taskbar-hint :boolean
39 skip-pager-hint :boolean
40 urgency-hint :boolean
41 accept-focus :boolean
42 focus-on-map :boolean
43 ; default-icon-list g-list-object
44 ; default-icon-name :string
45 icon pobject
46 icon-list g-list-object
47 icon-name :string
48 opacity :double
49 mnemonics-visible :boolean
50 #+gtk3.2 focus-visible #+gtk3.2 :boolean
51 has-resize-grip :boolean
52 application pobject
53 screen pobject)
54
55 (defcfun gtk-window-set-icon-from-file :boolean
56 (window pobject) (filename cffi-pathname) (g-error object))
57
58 (defmethod (setf icon) ((value pathname) (window window))
59 (setf (icon window) (namestring value)))
60
61 (defmethod (setf icon) ((value string) (window window))
62 (with-g-error g-error
63 (unless
64 (gtk-window-set-icon-from-file window value g-error)
65 (cerror "Continue" "Window icon load error: ~a" g-error))))
66
67
68
69 (defcfun gtk-window-set-default-size
70 :void (window pobject) (w :int) (h :int))
71
72 (defcfun gtk-window-get-default-size
73 :void (window pobject) (w :pointer) (h :pointer))
74
75 (defcfun gtk-window-set-default-geometry
76 :void (window pobject) (w :int) (h :int))
77
78 (defgeneric (setf default-size) (coords window &key geometry &allow-other-keys)
79 (:method (coords (window window) &key geometry &allow-other-keys)
80 (destructuring-bind (width height) coords
81 (if geometry
82 (gtk-window-set-default-geometry window (round width) (round height))
83 (gtk-window-set-default-size window (round width) (round height))))))
84
85 (defgeneric default-size (window)
86 (:method ((window window))
87 (with-foreign-outs-list ((width :int) (height :int)) :ignore
88 (gtk-window-get-default-size window width height))))
89
90
91 (defcenum position
92 :none
93 :center
94 :mouse
95 :center-always
96 :center-on-parent)
97
98 (deffuns window
99 (:set (position-type . position) position)
100 (add-accel-group :void (accel-group pobject))
101 (remove-accel-group :void (accel-group pobject))
102 (activate-focus :boolean)
103 (activate-default :boolean)
104 (set-geometry-hints :void (widget pobject) (geometry (struct geometry))
105 (mask window-hints))
106 (is-active :boolean)
107 (has-toplevel-focus :boolean)
108 (list-toplevels (g-list :free-from-foreign nil))
109 (add-mnemonic :void (keyval key) (target pobject))
110 (remove-mnemonic :void (keyval key) (target pobject))
111 (mnemonic-activate :boolean &key (keyval key) (modifier modifier-type))
112 (activate-key :boolean (event event))
113 (propagate-key-event :boolean (event event))
114 (:get default-widget pobject)
115 (:set (default-widget . default) pobject)
116 (present :void)
117 (present-with-time :void (timestamp :uint32))
118 (iconify :void)
119 (deiconify :void)
120 (stick :void)
121 (unstick :void)
122 (maximize :void)
123 (unmaximize :void)
124 (fullscreen :void)
125 (unfullscreen :void)
126 (:set keep-above :boolean)
127 (:set keep-below :boolean)
128 (begin-resize-drag :void (edge window-edge) (button :int) (root-x :int)
129 (root-y :int) (timestamp :uint32))
130 (begin-move-drag :void (button :int) (root-x :int)
131 (root-y :int) (timestamp :uint32))
132 (:get window-type window-type &key)
133 (parse-geometry :boolean (geometry :string))
134 (reshow-with-initial-size :void)
135 (:set auto-startup-notification :boolean)
136 (resize-grip-is-visible :boolean)
137 (:get group pobject)
138 (has-group :boolean)
139 (:set startup-id :string))
140
141 (defcfun gtk-window-get-resize-grip-area :boolean
142 (window pobject) (rect (struct rectangle :out t)))
143
144 (defgeneric resize-grip-area (window)
145 (:method ((window window))
146 (let ((dest (make-instance 'rectangle)))
147 (when (gtk-window-get-resize-grip-area window dest)
148 dest))))
149
150 (defcfun gtk-window-get-position :void (window pobject)
151 (x :pointer) (y :pointer))
152
153 (defgeneric window-position (window)
154 (:method ((window window))
155 (with-foreign-outs-list ((x :int) (y :int)) :ignore
156 (gtk-window-get-position window x y))))
157
158 (defcfun gtk-window-move :void (window pobject) (x :int) (y :int))
159
160 (defgeneric (setf window-position) (coords window)
161 (:method (coords (window window))
162 (destructuring-bind (x y) coords
163 (gtk-window-move window x y))))
164
165 (defcfun gtk-window-get-size :void (window pobject)
166 (width :pointer) (height :pointer))
167
168 (defcfun gtk-window-resize :void (window pobject)
169 (width :int) (height :int))
170
171 (defcfun gtk-window-resize-to-geometry :void (window pobject)
172 (width :int) (height :int))
173
174 (defgeneric (setf window-size) (coords window &key geometry &allow-other-keys)
175 (:method (coords (window window) &key geometry &allow-other-keys)
176 (destructuring-bind (width height) coords
177 (if geometry
178 (gtk-window-resize-to-geometry window (round width) (round height))
179 (gtk-window-resize window (round width) (round height))))))
180
181 (defgeneric window-size (window)
182 (:method ((window window))
183 (with-foreign-outs-list ((width :int) (height :int)) :ignore
184 (gtk-window-get-size window width height))))
185
186 (defcfun gtk-window-set-default-icon :void (icon pobject))
187 (defcfun gtk-window-set-default-icon-from-file :boolean
188 (filename cffi-pathname) (g-error object))
189 (defgeneric (setf default-icon) (icon)
190 (:method ((icon string))
191 (with-g-error g-error
192 (unless (gtk-window-set-default-icon-from-file icon g-error)
193 (cerror "Continue" "Default icon load error: ~a" g-error))))
194 (:method ((icon pathname))
195 (setf (default-icon) (namestring icon)))
196 (:method (icon)
197 (gtk-window-set-default-icon icon)))
198
199 (defcfun (default-icon-list "gtk_window_get_default_icon_list") g-list-object)
200 (defcfun gtk-window-set-default-icon-list :void (icons g-list-object))
201 (defun (setf default-icon-list) (value)
202 (gtk-window-set-default-icon-list value))
203
204 (defcfun (default-icon-name "gtk_window_get_default_icon_name") :string)
205 (defcfun gtk-window-set-default-icon-name :void (name :string))
206 (defun (setf default-icon-name) (name)
207 (gtk-window-set-default-icon-name name))
208
209
210 (init-slots window ((width -1) (height -1) geometry resize)
211 (when (or (/= width -1) (/= height -1))
212 (let ((sizes (list width height)))
213 (if resize
214 (setf (window-size window :geometry geometry) sizes)
215 (setf (default-size window :geometry geometry) sizes)))))
216

  ViewVC Help
Powered by ViewVC 1.1.5