/[gtk-cffi]/gtk-cffi/gtk/tree-view.lisp
ViewVC logotype

Contents of /gtk-cffi/gtk/tree-view.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.8 - (show annotations)
Sat Mar 23 13:14:23 2013 UTC (12 months, 4 weeks ago) by rklochkov
Branch: MAIN
CVS Tags: HEAD
Changes since 1.7: +136 -7 lines
1
1 ;;; GtkTreeView
2 ;;;
3 ;;; (foreach tree-view ...) = gtk-tree-view-map-expanded-rows
4 ;;; (path-at-pos ... :is-blank t) = gtk-tree-view-is-blank-at-pos
5 ;;; (convert-bin-window-to-widget tree-view x y) -> (list wx wy) =
6 ;;; gtk-tree-view-convert-bin-window-to-widget-coords
7 ;;; (convert-{smth} ...) = gtk-tree-view-convert-{smth}-coords
8
9 (in-package :gtk-cffi)
10
11 (defclass tree-view (container)
12 ())
13
14 (defcenum tree-view-grid-lines
15 :none :horizontal :vertical :both)
16
17 (defcfun gtk-tree-view-new :pointer)
18 (defcfun gtk-tree-view-new-with-model :pointer (model pobject))
19
20 (defmethod gconstructor ((tree-view tree-view)
21 &key model &allow-other-keys)
22 (initialize tree-view 'model)
23 (if model
24 (gtk-tree-view-new-with-model model)
25 (gtk-tree-view-new)))
26
27 (defcenum tree-view-grid-lines :nobe :horizontal :vertical :both)
28
29 (defslots tree-view
30 level-indentation :int
31 show-expanders :boolean
32 model pobject
33 hadjustment pobject
34 vadjustment pobject
35 headers-visible :boolean
36 headers-clickable :boolean
37 rules-hint :boolean
38 hover-selection :boolean
39 hover-expand :boolean
40 rubber-banding :boolean
41 search-column :int
42 expander-column pobject
43 reorderable :boolean
44 enable-search :boolean
45 search-entry pobject
46 fixed-height-mode :boolean
47 enable-tree-lines :boolean
48 grid-lines tree-view-grid-lines
49 tooltip-column :int)
50
51
52 (defcenum tree-view-drop-position
53 :before :after :into-or-before :into-or-after)
54
55 (deffuns tree-view
56 (remove-column :int (column pobject))
57 (append-column :int (column pobject))
58 (insert-column :int (column pobject) (position :int) &key)
59 (:get selection pobject)
60 (:get columns g-list-object)
61 (:get column pobject (n :int))
62 (:get n-columns :int)
63 (move-column-after :void (column pobject) (base-column pobject))
64 (scroll-to-point :void (x :int) (y :int))
65 (row-activated :void (path tree-path) (comumn pobject))
66 (expand-all :void)
67 (collapse-all :void)
68 (expand-to-path :void (path tree-path))
69 (expand-row :void (path tree-path) (open-all :boolean))
70 (collapse-row :void (path tree-path))
71 (row-expanded :boolean (path tree-path))
72 (:get bin-window pobject)
73 (unset-rows-drag-source :void)
74 (unset-rows-drag-dest :void)
75 (create-row-drag-icon :pointer (path tree-path))
76 (:get search-equal-func :pointer)
77 (:get search-position-func :pointer)
78 (:get row-separator-func :pointer)
79 (is-rubber-banding-active :boolean))
80
81
82 (defcfun gtk-tree-view-scroll-to-cell :void
83 (tree-view pobject) (path tree-path) (column pobject) (use-align :boolean)
84 (row-align :float) (col-align :float))
85
86 (defgeneric scroll-to-cell (tree-view path column &key row-align col-align)
87 (:method ((tree-view tree-view) path column
88 &key (row-align 0.0 row-align-p) (col-align 0.0 col-align-p))
89 (gtk-tree-view-scroll-to-cell tree-view path column
90 (or row-align-p col-align-p)
91 row-align col-align)))
92
93
94 (defmethod (setf columns) (columns (tree-view tree-view))
95 (dolist (column (columns tree-view))
96 (remove-column tree-view column))
97 (labels
98 ((mk-column (column num)
99 (typecase column
100 (string (make-instance 'tree-view-column
101 :title column
102 :cell (make-instance 'cell-renderer-text)
103 :attributes `(:text ,num)))
104 (cons (apply #'make-instance
105 'tree-view-column column))
106 (t column))))
107 (reduce (lambda (num column)
108 (append-column tree-view (mk-column column num)))
109 columns :initial-value 0)))
110 (save-setter tree-view columns)
111
112
113 (defcfun gtk-tree-view-get-cursor :void
114 (view pobject) (path :pointer) (column :pointer))
115
116 (defgeneric cursor (tree-view)
117 (:method ((tree-view tree-view))
118 (with-foreign-outs-list ((path 'tree-path) (column 'pobject)) :ignore
119 (gtk-tree-view-get-cursor tree-view path column))))
120
121 (defcfun gtk-tree-view-set-cursor :void
122 (tree-view pobject) (path tree-path) (focus-column pobject)
123 (start-editing :boolean))
124
125 (defcfun gtk-tree-view-set-cursor-on-cell :void
126 (tree-view pobject) (path tree-path) (focus-column pobject)
127 (focus-cell pobject) (start-editing :boolean))
128
129 (defgeneric (setf cursor) (path+column tree-view &key start-editing cell)
130 (:method (path+column (tree-view tree-view) &key start-editing cell)
131 (destructuring-bind (path column) path+column
132 (if cell
133 (gtk-tree-view-set-cursor-on-cell tree-view path column
134 cell start-editing)
135 (gtk-tree-view-set-cursor tree-view path column start-editing)))
136 path+column))
137
138
139 (defcfun gtk-tree-view-insert-column-with-data-func :int
140 (tree-view pobject) (position :int) (title :string) (cell pobject)
141 (data-func pfunction) (data pdata) (destroy pfunction))
142
143 (defmethod insert-column ((tree-view tree-view) (cell cell-renderer) position
144 &key title func data destroy-notify)
145 (set-callback tree-view gtk-tree-view-insert-column-with-data-func
146 cb-cell-data-func func data destroy-notify
147 position title cell))
148
149 (defcfun gtk-tree-view-set-column-drag-function :void
150 (tree-view pobject) (func pfunction) (user-data pdata) (destroy pfunction))
151
152 (defcallback cb-column-drop-function :boolean
153 ((tree-view pobject) (column pobject) (prev-column pobject)
154 (next-column pobject) (data pdata))
155 (funcall data tree-view column prev-column next-column))
156
157 (defgeneric (setf column-drag-function) (func tree-view
158 &key data destroy-notify)
159 (:documentation "gtk_tree_view_set_column_drag_function")
160 (:method (func (tree-view tree-view) &key data destroy-notify)
161 (set-callback tree-view gtk-tree-view-set-column-drag-function
162 cb-column-drop-function func data destroy-notify)))
163
164 (make-foreach (tree-view gtk-tree-view-map-expanded-rows)
165 (path ptree-path) (data pdata))
166
167 (defcfun gtk-tree-view-is-blank-at-pos :boolean
168 (tree-view pobject) (x :int) (y :int)
169 (path :pointer) (column :pointer) (cell-x :pointer) (cell-y :pointer))
170
171 (defcfun gtk-tree-view-get-path-at-pos :boolean
172 (tree-view pobject) (x :int) (y :int)
173 (path :pointer) (column :pointer) (cell-x :pointer) (cell-y :pointer))
174
175 (defgeneric path-at-pos (tree-view x y &key is-blank)
176 (:documentation "if is-blank gtk-tree-view-is-blank-at-pos called, else
177 gtk-tree-view-path-at-pos")
178 (:method ((tree-view tree-view) x y &key is-blank)
179 (with-foreign-outs ((path 'tree-path) (column 'pobject)
180 (cell-x :int) (cell-y :int)) :return
181 (funcall (if is-blank #'gtk-tree-view-is-blank-at-pos
182 #'gtk-tree-view-get-path-at-pos)
183 tree-view x y path column cell-x cell-y))))
184
185 (macrolet ((get-area (area-type)
186 (let ((cname (symbolicate 'gtk-tree-view-get- area-type '-area))
187 (lname (symbolicate area-type '-area)))
188 `(progn
189 (defcfun ,cname :void
190 (tree-view pobject) (path tree-path) (column pobject)
191 (rect (struct rectangle :out t)))
192 (defgeneric ,lname
193 (tree-view path column)
194 (:method ((tree-view tree-view) path column)
195 (let ((res (make-instance 'rectangle)))
196 (,cname tree-view path column res)
197 res)))))))
198 (get-area background)
199 (get-area cell))
200
201 (defcfun gtk-tree-view-get-visible-rect :void
202 (tree-view pobject) (visible-rect (struct rectangle :out t)))
203
204 (defgeneric visible-rect (tree-view)
205 (:method ((tree-view tree-view))
206 (let ((res (make-instance 'rectangle)))
207 (gtk-tree-view-get-visible-rect tree-view res)
208 res)))
209
210 (defcfun gtk-tree-view-get-visible-range :void
211 (tree-view pobject) (start-path :pointer) (end-path :pointer))
212
213 (defgeneric visible-range (tree-view)
214 (:method ((tree-view tree-view))
215 (with-foreign-outs-list ((start-path 'tree-path) (end-path 'tree-path))
216 :ignore
217 (gtk-tree-view-get-visible-range tree-view start-path end-path))))
218
219 (macrolet ((def-coords (from to)
220 (flet ((name-coord (sym1 sym2)
221 (symbolicate (aref (symbol-name sym1) 0) sym2)))
222 (let ((cfun (symbolicate 'gtk-tree-view-convert- from
223 '-to- to '-coords))
224 (lfun (symbolicate 'convert- from '-to- to))
225 (from-x (name-coord from 'x))
226 (from-y (name-coord from 'y))
227 (to-x (name-coord to 'x))
228 (to-y (name-coord to 'y)))
229 `(progn
230 (defcfun ,cfun :void
231 (tree-view pobject)
232 (,from-x :int) (,from-y :int)
233 (,to-x :pointer) (,to-y :pointer))
234 (defgeneric ,lfun (tree-view x y)
235 (:method ((tree-view tree-view) x y)
236 (with-foreign-outs-list ((,to-x :int) (,to-y :int))
237 :ignore
238 (,cfun tree-view x y ,to-x ,to-y)))))))))
239 (def-coords bin-window tree)
240 (def-coords bin-window widget)
241 (def-coords tree bin-window)
242 (def-coords tree widget)
243 (def-coords widget bin-window)
244 (def-coords widget tree))
245
246 (defcfun gtk-tree-view-enable-model-drag-dest :void
247 (tree-view pobject) (targets (carray (struct target-entry)))
248 (n-targets :int) (action drag-action))
249
250 (defgeneric enable-model-drag-dest (tree-view targets action)
251 (:method ((tree-view tree-view) targets action)
252 (gtk-tree-view-enable-model-drag-dest tree-view targets
253 (length targets) action)))
254
255 (defcfun gtk-tree-view-enable-model-drag-source :void
256 (tree-view pobject) (start-button-mask modifier-type)
257 (targets (carray (struct target-entry)))
258 (n-targets :int) (action drag-action))
259
260 (defgeneric enable-model-drag-source (tree-view start-button-mask
261 targets action)
262 (:method ((tree-view tree-view) start-button-mask targets action)
263 (gtk-tree-view-enable-model-drag-source tree-view start-button-mask targets
264 (length targets) action)))
265
266 (defcfun gtk-tree-view-get-drag-dest-row :void (tree-view pobject)
267 (tree-path :pointer) (pos :pointer))
268
269 (defgeneric drag-dest-row (tree-view)
270 (:method ((tree-view tree-view))
271 (with-foreign-outs-list ((path 'tree-path) (pos 'tree-view-drop-position))
272 :ignore
273 (gtk-tree-view-get-drag-dest-row tree-view path pos))))
274
275 (defcfun gtk-tree-view-set-drag-dest-row :void (tree-view pobject)
276 (tree-path tree-path) (pos tree-view-drop-position))
277
278 (defgeneric (setf drag-dest-row) (value tree-view)
279 (:method (value (tree-view tree-view))
280 (destructuring-bind (path pos) value
281 (gtk-tree-view-set-drag-dest-row tree-view path pos))))
282
283 (defcfun gtk-tree-view-get-dest-row-at-pos :void (tree-view pobject)
284 (x :int) (y :int)
285 (tree-path :pointer) (pos :pointer))
286
287 (defgeneric dest-row-at-post (tree-view x y)
288 (:method ((tree-view tree-view) x y)
289 (with-foreign-outs-list ((path 'tree-path) (pos 'tree-view-drop-position))
290 :ignore
291 (gtk-tree-view-get-dest-row-at-pos tree-view x y path pos))))
292
293 (defcfun gtk-tree-view-set-search-equal-func :int
294 (tree-view pobject)
295 (func pfunction) (data pdata) (destroy pfunction))
296
297 (defcallback cb-search-equal-func :boolean
298 ((tree-view pobject) (column :int) (key :string)
299 (tree-iter (struct tree-iter)) (data pdata))
300 (funcall data tree-view column key tree-iter))
301
302 (defgeneric (setf search-equal-func) (func tree-view &key data destroy-notify)
303 (:method (func (tree-view tree-view) &key data destroy-notify)
304 (set-callback tree-view gtk-tree-view-set-search-equal-func
305 cb-search-equal-func func data destroy-notify)))
306
307 (defcfun gtk-tree-view-set-search-position-func :int
308 (tree-view pobject)
309 (func pfunction) (data pdata) (destroy pfunction))
310
311 (defcallback cb-search-position-func :boolean
312 ((tree-view pobject) (search-dialog pobject) (data pdata))
313 (funcall data tree-view search-dialog))
314
315 (defgeneric (setf search-position-func) (func tree-view &key data destroy-notify)
316 (:method (func (tree-view tree-view) &key data destroy-notify)
317 (set-callback tree-view gtk-tree-view-set-search-position-func
318 cb-search-position-func func data destroy-notify)))
319
320 (defcfun gtk-tree-view-set-row-separator-func :int
321 (tree-view pobject)
322 (func pfunction) (data pdata) (destroy pfunction))
323
324 (defcallback cb-row-separator-func :boolean
325 ((tree-view pobject) (tree-iter (struct tree-iter)) (data pdata))
326 (funcall data tree-view tree-iter))
327
328 (defgeneric (setf row-separator-func) (func tree-view &key data destroy-notify)
329 (:method (func (tree-view tree-view) &key data destroy-notify)
330 (set-callback tree-view gtk-tree-view-set-row-separator-func
331 cb-row-separator-func func data destroy-notify)))
332
333 (defcfun gtk-tree-view-set-tooltip-row :void
334 (tree-view pobject) (tooltip pobject) (tree-path tree-path))
335
336 (defgeneric (setf tooltip-row) (value tree-view tooltip)
337 (:method (value (tree-view tree-view) tooltip)
338 (gtk-tree-view-set-tooltip-row tree-view tooltip value)))
339
340 (defcfun gtk-tree-view-set-tooltip-cell :void
341 (tree-view pobject) (tooltip pobject) (tree-path tree-path) (column pobject)
342 (cell pobject))
343
344 (defgeneric (setf tooltip-cell) (value tree-view tooltip)
345 (:method (value (tree-view tree-view) tooltip)
346 (destructuring-bind (path column cell) value
347 (gtk-tree-view-set-tooltip-cell tree-view tooltip path column cell))))
348
349 (defcfun gtk-tree-view-get-tooltip-context :boolean
350 (tree-view pobject) (ptr-x :pointer) (ptr-y :pointer) (keyboard-tip :boolean)
351 (model :pointer) (path :pointer) (tree-iter (struct tree-iter :out t)))
352
353 (defgeneric tooltip-context (tree-view ptr-x ptr-y keyboard-tip)
354 (:method ((tree-view tree-view) ptr-x ptr-y keyboard-tip)
355 (let ((tree-iter (make-instance 'tree-iter)))
356 (multiple-value-bind (res model path)
357 (with-foreign-outs ((model 'pobject) (path 'pobject)) :return
358 (gtk-tree-view-get-tooltip-context
359 tree-view ptr-x ptr-y keyboard-tip model path tree-iter))
360 (when res (list model path tree-iter))))))
361
362 (init-slots tree-view (on-select)
363 (when on-select
364 (setf (gsignal (selection tree-view) :changed)
365 (lambda (selection)
366 (destructuring-bind (rows model) (selected-rows selection)
367 (when rows
368 (apply on-select model rows)))))))

  ViewVC Help
Powered by ViewVC 1.1.5