0d07716f |
1 | ;; Common Lisp bindings for GTK+ v2.0 |
2 | ;; Copyright (C) 1999-2000 Espen S. Johnsen <espejohn@online.no> |
3 | ;; |
4 | ;; This library is free software; you can redistribute it and/or |
5 | ;; modify it under the terms of the GNU Lesser General Public |
6 | ;; License as published by the Free Software Foundation; either |
7 | ;; version 2 of the License, or (at your option) any later version. |
8 | ;; |
9 | ;; This library is distributed in the hope that it will be useful, |
10 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
11 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
12 | ;; Lesser General Public License for more details. |
13 | ;; |
14 | ;; You should have received a copy of the GNU Lesser General Public |
15 | ;; License along with this library; if not, write to the Free Software |
16 | ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA |
17 | |
ecb4e7dc |
18 | ;; $Id: gtk.lisp,v 1.1.1.1 2000/08/14 16:44:51 espen Exp $ |
0d07716f |
19 | |
20 | |
21 | (in-package "GTK") |
22 | |
23 | ;;; Gtk version |
24 | |
25 | (define-foreign check-version () string |
26 | (required-major unsigned-int) |
27 | (required-minor unsigned-int) |
28 | (required-micro unsigned-int)) |
29 | |
30 | (define-foreign query-version () nil |
31 | (major unsigned-int :out) |
32 | (minor unsigned-int :out) |
33 | (micro unsigned-int :out)) |
34 | |
35 | (defun gtk-version () |
36 | (multiple-value-bind (major minor micro) |
37 | (query-version) |
38 | (if (zerop micro) |
39 | (format nil "Gtk+ v~A.~A" major minor) |
40 | (format nil "Gtk+ v~A.~A.~A" major minor micro)))) |
41 | |
42 | (export '*clg-version*) |
43 | |
44 | |
45 | |
46 | ;;; InitializationInitialization, exit, mainloop and miscellaneous routines |
47 | |
48 | |
49 | (define-foreign grab-add () nil |
50 | (widget widget)) |
51 | |
52 | (define-foreign grab-get-current () widget) |
53 | |
54 | (define-foreign grab-remove () nil |
55 | (widget widget)) |
56 | |
57 | (define-foreign ("gtk_timeout_add_full" timeout-add) |
58 | (interval function) unsigned-int |
59 | (interval (unsigned 32)) |
60 | (0 unsigned-long) |
61 | (*callback-marshal* pointer) |
62 | ((register-callback-function function) unsigned-long) |
63 | (*destroy-marshal* pointer)) |
64 | |
65 | (define-foreign timeout-remove () nil |
66 | (timeout-handler-id unsigned-int)) |
67 | |
68 | (define-foreign ("gtk_idle_add_full" idle-add) |
69 | (function &optional (priority 200)) unsigned-int |
70 | (priority int) |
71 | (0 unsigned-long) |
72 | (*callback-marshal* pointer) |
73 | ((register-callback-function function) unsigned-long) |
74 | (*destroy-marshal* pointer)) |
75 | |
76 | (define-foreign idle-remove () nil |
77 | (idle-handler-id unsigned-int)) |
78 | |
79 | (define-foreign get-current-event () gdk:event) |
80 | |
81 | (define-foreign get-event-widget () widget |
82 | (event gdk:event)) |
83 | |
84 | |
85 | ;;; should be moved to gobject |
86 | |
87 | ; (define-foreign ("gtk_object_set_data_full" object-set-data) |
88 | ; (object key data &optional destroy-function) nil |
89 | ; (object object) |
90 | ; ((string key) string) |
91 | ; ((register-user-data data destroy-function) unsigned-long) |
92 | ; (*destroy-marshal* pointer)) |
93 | |
94 | ; (defun (setf object-data) (data object key) |
95 | ; (object-set-data object key data) |
96 | ; data) |
97 | |
98 | ; (define-foreign %object-get-data (object key) unsigned-long |
99 | ; (object object) |
100 | ; ((string key) string)) |
101 | |
102 | ; (defun object-data (object key) |
103 | ; (find-user-data (%object-get-data object key))) |
104 | |
105 | ; (define-foreign object-remove-data (object key) nil |
106 | ; (object object) |
107 | ; ((string key) string)) |
108 | |
109 | ; (defun object-user-data (object) |
110 | ; (object-data object :user-data)) |
111 | |
112 | ; (defun (setf object-user-data) (data object) |
113 | ; (setf (object-data object :user-data) data)) |
114 | |
115 | |
116 | ;;; Label |
117 | |
118 | (define-foreign label-new () label |
119 | (text string)) |
120 | |
121 | (define-foreign label-parse-uline () unsigned-int |
122 | (label label) |
123 | (string string)) |
124 | |
125 | |
126 | |
127 | ;;; Acccel label |
128 | |
129 | (define-foreign accel-label-new () accel-label |
130 | (text string)) |
131 | |
132 | (define-foreign accel-label-refetch () boolean |
133 | (accel-label accel-label)) |
134 | |
135 | |
136 | |
137 | ;;; Tips query |
138 | |
139 | (define-foreign tips-query-new () tips-query) |
140 | |
141 | (define-foreign tips-query-start-query () nil |
142 | (tips-query tips-query)) |
143 | |
144 | (define-foreign tips-query-stop-query () nil |
145 | (tips-query tips-query)) |
146 | |
147 | |
148 | |
149 | ;;; Arrow |
150 | |
151 | (define-foreign arrow-new () arrow |
152 | (arrow-type arrow-type) |
153 | (shadow-type shadow-type)) |
154 | |
155 | |
156 | |
157 | ;;; Pixmap |
158 | |
159 | ; (defun %pixmap-create (source) |
160 | ; (cond |
161 | ; ((not source) nil) |
162 | ; ((typep source gdk:pixmap) source) |
163 | ; ((and (consp source) (typep (first source) gdk:pixmap)) (values-list source)) |
164 | ; (t (gdk:pixmap-create source)))) |
165 | |
166 | (define-foreign %pixmap-new () pixmap |
167 | (pixmap gdk:pixmap) |
168 | (mask (or null gdk:bitmap))) |
169 | |
170 | (defun pixmap-new (source) |
171 | (multiple-value-bind (pixmap mask) |
172 | (%pixmap-create source) |
173 | (%pixmap-new pixmap mask))) |
174 | |
175 | (define-foreign %pixmap-set () nil |
176 | (pixmap pixmap) |
177 | (gdk:pixmap gdk:pixmap) |
178 | (mask (or null gdk:bitmap))) |
179 | |
180 | (defun (setf pixmap-pixmap) (source pixmap) |
181 | (multiple-value-bind (gdk:pixmap mask) |
182 | (%pixmap-create source) |
183 | (%pixmap-set pixmap gdk:pixmap mask) |
184 | (values gdk:pixmap mask))) |
185 | |
186 | (define-foreign ("gtk_pixmap_get" pixmap-pixmap) () nil |
187 | (pixmap pixmap) |
188 | (val gdk:pixmap :out) |
189 | (mask gdk:bitmap :out)) |
190 | |
191 | |
192 | |
193 | ;;; Bin |
194 | |
195 | (defun bin-child (bin) |
196 | (first (container-children bin))) |
197 | |
198 | (defun (setf bin-child) (child bin) |
199 | (let ((old-child (bin-child bin))) |
200 | (when old-child |
201 | (container-remove bin old-child))) |
202 | (container-add bin child) |
203 | child) |
204 | |
205 | |
206 | ;;; Alignment |
207 | |
208 | (define-foreign alignment-new () alignment |
209 | (xalign single-float) |
210 | (ylign single-float) |
211 | (xscale single-float) |
212 | (yscale single-float)) |
213 | |
214 | |
215 | |
216 | ;;; Frame |
217 | |
218 | (define-foreign frame-new (&optional label) frame |
219 | (label string)) |
220 | |
221 | |
222 | |
223 | ;;; Aspect frame |
224 | |
225 | (define-foreign aspect-frame-new () alignment |
226 | (xalign single-float) |
227 | (ylign single-float) |
228 | (ratio single-float) |
229 | (obey-child boolean)) |
230 | |
231 | |
232 | |
233 | ;;; Button |
234 | |
235 | (define-foreign %button-new () button) |
236 | |
237 | (define-foreign %button-new-with-label () button |
238 | (label string)) |
239 | |
240 | (defun button-new (&optional label) |
241 | (if label |
242 | (%button-new-with-label label) |
243 | (%button-new))) |
244 | |
245 | (define-foreign button-pressed () nil |
246 | (button button)) |
247 | |
248 | (define-foreign button-released () nil |
249 | (button button)) |
250 | |
251 | (define-foreign button-clicked () nil |
252 | (button button)) |
253 | |
254 | (define-foreign button-enter () nil |
255 | (button button)) |
256 | |
257 | (define-foreign button-leave () nil |
258 | (button button)) |
259 | |
260 | |
261 | |
262 | ;;; Toggle button |
263 | |
264 | (define-foreign %toggle-button-new () toggle-button) |
265 | |
266 | (define-foreign %toggle-button-new-with-label () toggle-button |
267 | (label string)) |
268 | |
269 | (defun toggle-button-new (&optional label) |
270 | (if label |
271 | (%toggle-button-new-with-label label) |
272 | (%toggle-button-new))) |
273 | |
274 | (define-foreign toggle-button-toggled () nil |
275 | (toggle-button toggle-button)) |
276 | |
277 | |
278 | |
279 | ;;; Check button |
280 | |
281 | (define-foreign %check-button-new () check-button) |
282 | |
283 | (define-foreign %check-button-new-with-label () check-button |
284 | (label string)) |
285 | |
286 | (defun check-button-new (&optional label) |
287 | (if label |
288 | (%check-button-new-with-label label) |
289 | (%check-button-new))) |
290 | |
291 | |
292 | |
293 | ;;; Radio button |
294 | |
295 | (define-foreign %radio-button-new () radio-button |
296 | (group (or null radio-button-group))) |
297 | |
298 | (define-foreign %radio-button-new-with-label-from-widget () radio-button |
299 | (widget (or null widget)) |
300 | (label string)) |
301 | |
302 | (define-foreign %radio-button-new-from-widget () radio-button |
303 | (widget (or null widget))) |
304 | |
305 | (define-foreign %radio-button-new-with-label () radio-button |
306 | (group (or null radio-button-group)) |
307 | (label string)) |
308 | |
309 | (defun radio-button-new (group &key label from-widget) |
310 | (cond |
311 | ((and from-widget label) |
312 | (%radio-button-new-with-label-from-widget group label)) |
313 | (from-widget |
314 | (%radio-button-new-from-widget group)) |
315 | (label |
316 | (%radio-button-new-with-label group label)) |
317 | (t |
318 | (%radio-button-new group)))) |
319 | |
320 | (define-foreign radio-button-group () radio-button-group |
321 | (radio-button radio-button)) |
322 | |
323 | |
324 | |
325 | ;;; Option menu |
326 | |
327 | ; (define-foreign option-menu-new () option-menu) |
328 | |
329 | ; (define-foreign %option-menu-set-menu () nil |
330 | ; (option-menu option-menu) |
331 | ; (menu widget)) |
332 | |
333 | ; (define-foreign %option-menu-remove-menu () nil |
334 | ; (option-menu option-menu)) |
335 | |
336 | ; (defun (setf option-menu-menu) (menu option-menu) |
337 | ; (if (not menu) |
338 | ; (%option-menu-remove-menu option-menu) |
339 | ; (%option-menu-set-menu option-menu menu)) |
340 | ; menu) |
341 | |
342 | |
343 | |
344 | ;;; Item |
345 | |
346 | (define-foreign item-select () nil |
347 | (item item)) |
348 | |
349 | (define-foreign item-deselect () nil |
350 | (item item)) |
351 | |
352 | (define-foreign item-toggle () nil |
353 | (item item)) |
354 | |
355 | |
356 | |
357 | ;;; Menu item |
358 | |
359 | ; (define-foreign %menu-item-new () menu-item) |
360 | |
361 | ; (define-foreign %menu-item-new-with-label () menu-item |
362 | ; (label string)) |
363 | |
364 | ; (defun menu-item-new (&optional label) |
365 | ; (if label |
366 | ; (%menu-item-new-with-label label) |
367 | ; (%menu-item-new))) |
368 | |
369 | ; (defun (setf menu-item-label) (label menu-item) |
370 | ; (let ((accel-label (accel-label-new label))) |
371 | ; (setf (misc-xalign accel-label) 0.0) |
372 | ; (setf (misc-yalign accel-label) 0.5) |
373 | |
374 | ; (container-add menu-item accel-label) |
375 | ; (setf (accel-label-accel-widget accel-label) menu-item) |
376 | ; (widget-show accel-label)) |
377 | ; label) |
378 | |
379 | ; (define-foreign %menu-item-set-submenu () nil |
380 | ; (menu-item menu-item) |
381 | ; (submenu menu)) |
382 | |
383 | ; (define-foreign %menu-item-remove-submenu () nil |
384 | ; (menu-item menu-item)) |
385 | |
386 | ; (defun (setf menu-item-submenu) (submenu menu-item) |
387 | ; (if (not submenu) |
388 | ; (%menu-item-remove-submenu menu-item) |
389 | ; (%menu-item-set-submenu menu-item submenu)) |
390 | ; submenu) |
391 | |
392 | ; (define-foreign %menu-item-configure () nil |
393 | ; (menu-item menu-item) |
394 | ; (show-toggle-indicator boolean) |
395 | ; (show-submenu-indicator boolean)) |
396 | |
397 | ; (defun (setf menu-item-toggle-indicator-p) (show menu-item) |
398 | ; (%menu-item-configure |
399 | ; menu-item |
400 | ; show |
401 | ; (menu-item-submenu-indicator-p menu-item)) |
402 | ; show) |
403 | |
404 | ; (defun (setf menu-item-submenu-indicator-p) (show menu-item) |
405 | ; (%menu-item-configure |
406 | ; menu-item |
407 | ; (menu-item-toggle-indicator-p menu-item) |
408 | ; show)) |
409 | |
410 | ; (define-foreign menu-item-select () nil |
411 | ; (menu-item menu-item)) |
412 | |
413 | ; (define-foreign menu-item-deselect () nil |
414 | ; (menu-item menu-item)) |
415 | |
416 | ; (define-foreign menu-item-activate () nil |
417 | ; (menu-item menu-item)) |
418 | |
419 | ; (define-foreign menu-item-right-justify () nil |
420 | ; (menu-item menu-item)) |
421 | |
422 | |
423 | |
424 | ; ;;; Check menu item |
425 | |
426 | ; (define-foreign %check-menu-item-new |
427 | ; () check-menu-item) |
428 | |
429 | ; (define-foreign %check-menu-item-new-with-label () check-menu-item |
430 | ; (label string)) |
431 | |
432 | ; (defun check-menu-item-new (&optional label) |
433 | ; (if label |
434 | ; (%check-menu-item-new-with-label label) |
435 | ; (%check-menu-item-new))) |
436 | |
437 | ; (define-foreign check-menu-item-toggled () nil |
438 | ; (check-menu-item check-menu-item)) |
439 | |
440 | |
441 | |
442 | ; ;;; Radio menu item |
443 | |
444 | ; (define-foreign %radio-menu-item-new |
445 | ; () radio-menu-item |
446 | ; (group (or null radio-menu-item-group))) |
447 | |
448 | ; (define-foreign %radio-menu-item-new-with-label () radio-menu-item |
449 | ; (group (or null radio-menu-item-group)) |
450 | ; (label string)) |
451 | |
452 | ; (defun radio-menu-item-new (group &optional label) |
453 | ; (if label |
454 | ; (%radio-menu-item-new-with-label group label) |
455 | ; (%radio-menu-item-new group))) |
456 | |
457 | |
458 | |
459 | ; ;;; Tearoff menu item |
460 | |
461 | ; (define-foreign tearoff-menu-item-new () tearoff-menu-item) |
462 | |
463 | |
464 | |
465 | ;;; List item |
466 | |
467 | (define-foreign %list-item-new () list-item) |
468 | |
469 | (define-foreign %list-item-new-with-label () list-item |
470 | (label string)) |
471 | |
472 | (defun list-item-new (&optional label) |
473 | (if label |
474 | (%list-item-new-with-label label) |
475 | (%list-item-new))) |
476 | |
477 | (define-foreign list-item-select () nil |
478 | (list-item list-item)) |
479 | |
480 | (define-foreign list-item-deselect () nil |
481 | (list-item list-item)) |
482 | |
483 | |
484 | |
485 | ;;; Tree item |
486 | |
487 | (define-foreign %tree-item-new () tree-item) |
488 | |
489 | (define-foreign %tree-item-new-with-label () tree-item |
490 | (label string)) |
491 | |
492 | (defun tree-item-new (&optional label) |
493 | (if label |
494 | (%tree-item-new-with-label label) |
495 | (%tree-item-new))) |
496 | |
497 | (define-foreign %tree-item-set-subtree () nil |
498 | (tree-item tree-item) |
499 | (subtree tree)) |
500 | |
501 | (define-foreign %tree-item-remove-subtree () nil |
502 | (tree-item tree-item)) |
503 | |
504 | (defun (setf tree-item-subtree) (subtree tree-item) |
505 | (if subtree |
506 | (%tree-item-set-subtree tree-item subtree) |
507 | (%tree-item-remove-subtree tree-item)) |
508 | subtree) |
509 | |
510 | (define-foreign tree-item-select () nil |
511 | (tree-item tree-item)) |
512 | |
513 | (define-foreign tree-item-deselect () nil |
514 | (tree-item tree-item)) |
515 | |
516 | (define-foreign tree-item-expand () nil |
517 | (tree-item tree-item)) |
518 | |
519 | (define-foreign tree-item-collapse () nil |
520 | (tree-item tree-item)) |
521 | |
522 | |
523 | |
524 | ;;; Window |
525 | |
526 | (define-foreign window-new () window |
527 | (type window-type)) |
528 | |
529 | (define-foreign %window-set-wmclass () nil |
530 | (window window) |
531 | (wmclass-name string) |
532 | (wmclass-class string)) |
533 | |
534 | (defun (setf window-wmclass) (wmclass window) |
535 | (%window-set-wmclass window (svref wmclass 0) (svref wmclass 1)) |
536 | (values (svref wmclass 0) (svref wmclass 1))) |
537 | |
538 | ;; cl-gtk.c |
539 | (define-foreign window-wmclass () nil |
540 | (window window) |
541 | (wmclass-name string :out) |
542 | (wmclass-class string :out)) |
543 | |
544 | (define-foreign window-add-accel-group () nil |
545 | (window window) |
546 | (accel-group accel-group)) |
547 | |
548 | (define-foreign window-remove-accel-group () nil |
549 | (window window) |
550 | (accel-group accel-group)) |
551 | |
552 | (define-foreign window-activate-focus () int |
553 | (window window)) |
554 | |
555 | (define-foreign window-activate-default () int |
556 | (window window)) |
557 | |
558 | (define-foreign window-set-transient-for () nil |
559 | (window window) |
560 | (parent window)) |
561 | |
562 | ;(define-foreign window-set-geometry-hints) |
563 | |
564 | |
565 | |
566 | ;;; Color selection dialog |
567 | |
568 | ; (define-foreign color-selection-dialog-new () color-selection-dialog |
569 | ; (title string)) |
570 | |
571 | |
572 | |
573 | ;;; Dialog |
574 | |
575 | ; (define-foreign dialog-new () dialog) |
576 | |
577 | |
578 | |
579 | ;;; Input dialog |
580 | |
581 | ; (define-foreign input-dialog-new () dialog) |
582 | |
583 | |
584 | |
585 | ;;; File selection |
586 | |
587 | ; (define-foreign file-selection-new () file-selection |
588 | ; (title string)) |
589 | |
590 | ; (define-foreign file-selection-complete () nil |
591 | ; (file-selection file-selection) |
592 | ; (pattern string)) |
593 | |
594 | ; (define-foreign file-selection-show-fileop-buttons () nil |
595 | ; (file-selection file-selection)) |
596 | |
597 | ; (define-foreign file-selection-hide-fileop-buttons () nil |
598 | ; (file-selection file-selection)) |
599 | |
600 | |
601 | |
602 | ; ;;; Handle box |
603 | |
604 | ; (define-foreign handle-box-new () handle-box) |
605 | |
606 | |
607 | |
608 | ; ;;; Scrolled window |
609 | |
610 | (define-foreign scrolled-window-new |
611 | (&optional hadjustment vadjustment) scrolled-window |
612 | (hadjustment (or null adjustment)) |
613 | (vadjustment (or null adjustment))) |
614 | |
615 | (defun (setf scrolled-window-scrollbar-policy) (policy window) |
616 | (setf (scrolled-window-hscrollbar-policy window) policy) |
617 | (setf (scrolled-window-vscrollbar-policy window) policy)) |
618 | |
619 | (define-foreign scrolled-window-add-with-viewport () nil |
620 | (scrolled-window scrolled-window) |
621 | (child widget)) |
622 | |
623 | |
624 | |
625 | ; ;;; Viewport |
626 | |
627 | ; (define-foreign viewport-new () viewport |
628 | ; (hadjustment adjustment) |
629 | ; (vadjustment adjustment)) |
630 | |
631 | |
632 | |
633 | ;;; Box |
634 | |
635 | (define-foreign box-pack-start () nil |
636 | (box box) |
637 | (child widget) |
638 | (expand boolean) |
639 | (fill boolean) |
640 | (padding unsigned-int)) |
641 | |
642 | (define-foreign box-pack-end () nil |
643 | (box box) |
644 | (child widget) |
645 | (expand boolean) |
646 | (fill boolean) |
647 | (padding unsigned-int)) |
648 | |
649 | (defun box-pack (box child &key (pack :start) (expand t) (fill t) (padding 0)) |
650 | (if (eq pack :start) |
651 | (box-pack-start box child expand fill padding) |
652 | (box-pack-end box child expand fill padding))) |
653 | |
654 | (define-foreign box-reorder-child () nil |
655 | (box box) |
656 | (child widget) |
657 | (position int)) |
658 | |
659 | (define-foreign box-query-child-packing () nil |
660 | (box box) |
661 | (child widget :out) |
662 | (expand boolean :out) |
663 | (fill boolean :out) |
664 | (padding unsigned-int :out) |
665 | (pack-type pack-type :out)) |
666 | |
667 | (define-foreign box-set-child-packing () nil |
668 | (box box) |
669 | (child widget) |
670 | (expand boolean) |
671 | (fill boolean) |
672 | (padding unsigned-int) |
673 | (pack-type pack-type)) |
674 | |
675 | |
676 | |
677 | ;;; Button box |
678 | |
679 | (define-foreign ("gtk_button_box_get_child_size_default" |
680 | button-box-default-child-size) () nil |
681 | (min-width int :out) |
682 | (min-height int :out)) |
683 | |
684 | (define-foreign ("gtk_button_box_get_child_ipadding_default" |
685 | button-box-default-child-ipadding) () nil |
686 | (ipad-x int :out) |
687 | (ipad-y int :out)) |
688 | |
689 | (define-foreign %button-box-set-child-size-default () nil |
690 | (min-width int) |
691 | (min-height int)) |
692 | |
693 | (defun (setf button-box-default-child-size) (size) |
694 | (%button-box-set-child-size-default (svref size 0) (svref size 1)) |
695 | (values (svref size 0) (svref size 1))) |
696 | |
697 | (define-foreign %button-box-set-child-ipadding-default () nil |
698 | (ipad-x int) |
699 | (ipad-y int)) |
700 | |
701 | (defun (setf button-box-default-child-ipadding) (ipad) |
702 | (%button-box-set-child-ipadding-default (svref ipad 0) (svref ipad 1)) |
703 | (values (svref ipad 0) (svref ipad 1))) |
704 | |
705 | (define-foreign |
706 | ("gtk_button_box_get_child_size" button-box-child-size) () nil |
707 | (button-box button-box) |
708 | (min-width int :out) |
709 | (min-height int :out)) |
710 | |
711 | (define-foreign |
712 | ("gtk_button_box_get_child_ipadding" button-box-child-ipadding) () nil |
713 | (button-box button-box) |
714 | (ipad-x int :out) |
715 | (ipad-y int :out)) |
716 | |
717 | (define-foreign %button-box-set-child-size () nil |
718 | (button-box button-box) |
719 | (min-width int) |
720 | (min-height int)) |
721 | |
722 | (defun (setf button-box-child-size) (size button-box) |
723 | (%button-box-set-child-size button-box (svref size 0) (svref size 1)) |
724 | (values (svref size 0) (svref size 1))) |
725 | |
726 | (define-foreign %button-box-set-child-ipadding () nil |
727 | (button-box button-box) |
728 | (ipad-x int) |
729 | (ipad-y int)) |
730 | |
731 | (defun (setf button-box-child-ipadding) (ipad button-box) |
732 | (%button-box-set-child-ipadding button-box (svref ipad 0) (svref ipad 1)) |
733 | (values (svref ipad 0) (svref ipad 1))) |
734 | |
735 | |
736 | |
737 | ;;; HButton box |
738 | |
739 | ;(define-foreign hbutton-box-new () hbutton-box) |
740 | |
741 | (define-foreign ("gtk_hbutton_box_get_spacing_default" |
742 | hbutton-box-default-spacing) () int) |
743 | |
744 | (define-foreign ("gtk_hbutton_box_set_spacing_default" |
745 | (setf hbutton-box-default-spacing)) () nil |
746 | (spacing int)) |
747 | |
748 | (define-foreign ("gtk_hbutton_box_get_layout_default" |
749 | hbutton-box-default-layout) () button-box-style) |
750 | |
751 | (define-foreign ("gtk_hbutton_box_set_layout_default" |
752 | (setf hbutton-box-default-layout)) () nil |
753 | (layout button-box-style)) |
754 | |
755 | |
756 | |
757 | ;;; VButton Box |
758 | |
759 | ;(define-foreign vbutton-box-new () vbutton-box) |
760 | |
761 | (define-foreign ("gtk_vbutton_box_get_spacing_default" |
762 | vbutton-box-default-spacing) () int) |
763 | |
764 | (define-foreign ("gtk_vbutton_box_set_spacing_default" |
765 | (setf vbutton-box-default-spacing)) () nil |
766 | (spacing int)) |
767 | |
768 | (define-foreign ("gtk_vbutton_box_get_layout_default" |
769 | vbutton-box-default-layout) () button-box-style) |
770 | |
771 | (define-foreign ("gtk_vbutton_box_set_layout_default" |
772 | (setf vbutton-box-default-layout)) () nil |
773 | (layout button-box-style)) |
774 | |
775 | |
776 | |
777 | ;;; VBox |
778 | |
779 | (define-foreign vbox-new () vbox |
780 | (homogeneous boolean) |
781 | (spacing int)) |
782 | |
783 | |
784 | |
785 | ;;; Color selection |
786 | |
787 | ; (define-foreign color-selection-new () color-selection) |
788 | |
789 | ; ;; cl-gtk.c |
790 | ; (define-foreign %color-selection-set-color-by-values () nil |
791 | ; (colorsel color-selection) |
792 | ; (red double-float) |
793 | ; (green double-float) |
794 | ; (blue double-float) |
795 | ; (opacity double-float)) |
796 | |
797 | ; (defun (setf color-selection-color) (color colorsel) |
798 | ; (%color-selection-set-color-by-values |
799 | ; colorsel |
800 | ; (svref color 0) (svref color 1) (svref color 2) |
801 | ; (if (> (length color) 3) |
802 | ; (svref color 3) |
803 | ; 1.0)) |
804 | ; color) |
805 | |
806 | ; ;; cl-gtk.c |
807 | ; (define-foreign %color-selection-get-color-as-values () nil |
808 | ; (colorsel color-selection) |
809 | ; (red double-float :out) |
810 | ; (green double-float :out) |
811 | ; (blue double-float :out) |
812 | ; (opacity double-float :out)) |
813 | |
814 | ; (defun color-selection-color (colorsel) |
815 | ; (multiple-value-bind (red green blue opacity) |
816 | ; (%color-selection-get-color-as-values colorsel) |
817 | ; (if (color-selection-use-opacity-p colorsel) |
818 | ; (vector red green blue opacity) |
819 | ; (vector red green blue)))) |
820 | |
821 | |
822 | |
823 | |
824 | ; ;;; Gamma curve |
825 | |
826 | ; (define-foreign gamma-curve-new () gamma-curve) |
827 | |
828 | |
829 | |
830 | ;;; HBox |
831 | |
832 | (define-foreign hbox-new () hbox |
833 | (homogeneous boolean) |
834 | (spacing int)) |
835 | |
836 | |
837 | |
838 | ;;; Combo |
839 | |
840 | ; (define-foreign combo-new () combo) |
841 | |
842 | ; (define-foreign combo-set-value-in-list () nil |
843 | ; (combo combo) |
844 | ; (val boolean) |
845 | ; (ok-if-empty boolean)) |
846 | |
847 | ; (define-foreign ("gtk_combo_set_item_string" (setf combo-item-string)) () nil |
848 | ; (combo combo) |
849 | ; (item item) |
850 | ; (item-value string)) |
851 | |
852 | ; (define-foreign ("gtk_combo_set_popdown_strings" |
853 | ; (setf combo-popdown-strings)) () nil |
854 | ; (combo combo) |
855 | ; (strings (double-list string))) |
856 | |
857 | ; (define-foreign combo-disable-activate () nil |
858 | ; (combo combo)) |
859 | |
860 | |
861 | |
862 | ; ;;; Statusbar |
863 | |
864 | ; (define-foreign statusbar-new () statusbar) |
865 | |
866 | ; (define-foreign |
867 | ; ("gtk_statusbar_get_context_id" statusbar-context-id) () unsigned-int |
868 | ; (statusbar statusbar) |
869 | ; (context-description string)) |
870 | |
871 | ; (define-foreign statusbar-push () unsigned-int |
872 | ; (statusbar statusbar) |
873 | ; (context-id unsigned-int) |
874 | ; (text string)) |
875 | |
876 | ; (define-foreign statusbar-pop () nil |
877 | ; (statusbar statusbar) |
878 | ; (context-id unsigned-int)) |
879 | |
880 | ; (define-foreign statusbar-remove () nil |
881 | ; (statusbar statusbar) |
882 | ; (context-id unsigned-int) |
883 | ; (message-id unsigned-int)) |
884 | |
885 | |
886 | |
887 | ;;; CList |
888 | |
889 | ; (define-foreign %clist-new () clist |
890 | ; (columns int)) |
891 | |
892 | ; (define-foreign %clist-new-with-titles () clist |
893 | ; (columns int) |
894 | ; (titles pointer)) |
895 | |
896 | ; (defun clist-new (columns) |
897 | ; (if (atom columns) |
898 | ; (%clist-new columns) |
899 | ; (with-array (titles :initial-contents columns :free-contents t) |
900 | ; (%clist-new-with-titles (length columns) titles)))) |
901 | |
902 | ; (define-foreign ("gtk_clist_set_button_actions" |
903 | ; (setf clist-button-actions)) () nil |
904 | ; (clist clist) |
905 | ; (button unsigned-int) |
906 | ; (button-actions button-actions)) |
907 | |
908 | ; (define-foreign clist-freeze () nil |
909 | ; (clist clist)) |
910 | |
911 | ; (define-foreign clist-thaw () nil |
912 | ; (clist clist)) |
913 | |
914 | ; (define-foreign clist-column-titles-show () nil |
915 | ; (clist clist)) |
916 | |
917 | ; (define-foreign clist-column-titles-hide () nil |
918 | ; (clist clist)) |
919 | |
920 | ; (defun (setf clist-titles-visible-p) (visible clist) |
921 | ; (if visible |
922 | ; (clist-column-titles-hide clist) |
923 | ; (clist-column-titles-show clist))) |
924 | |
925 | ; (define-foreign clist-column-title-active () nil |
926 | ; (clist clist) |
927 | ; (column int)) |
928 | |
929 | ; (define-foreign clist-column-title-passive () nil |
930 | ; (clist clist) |
931 | ; (column int)) |
932 | |
933 | ; (define-foreign clist-column-titles-active () nil |
934 | ; (clist clist)) |
935 | |
936 | ; (define-foreign clist-column-titles-passive () nil |
937 | ; (clist clist)) |
938 | |
939 | ; (define-foreign ("gtk_clist_set_column_title" |
940 | ; (setf clist-column-title)) () nil |
941 | ; (clist clist) |
942 | ; (column int) |
943 | ; (title string)) |
944 | |
945 | ; (define-foreign ("gtk_clist_get_column_title" clist-column-title) () string |
946 | ; (clist clist) |
947 | ; (column int)) |
948 | |
949 | ; (define-foreign ("gtk_clist_set_column_widget" |
950 | ; (setf clist-column-widget)) () nil |
951 | ; (clist clist) |
952 | ; (column int) |
953 | ; (widget widget)) |
954 | |
955 | ; (define-foreign ("gtk_clist_get_column_widget" clist-column-widget) () widget |
956 | ; (clist clist) |
957 | ; (column int)) |
958 | |
959 | ; (define-foreign ("gtk_clist_set_column_justification" |
960 | ; (setf clist-column-justification)) () nil |
961 | ; (clist clist) |
962 | ; (column int) |
963 | ; (justification justification)) |
964 | |
965 | ; (define-foreign clist-column-justification (clist column) justification |
966 | ; (clist clist) |
967 | ; ((progn |
968 | ; (assert (and (>= column 0) (< column (clist-n-columns clist)))) |
969 | ; column) |
970 | ; int)) |
971 | |
972 | ; (define-foreign ("gtk_clist_set_column_visibility" |
973 | ; (setf clist-column-visible-p)) () nil |
974 | ; (clist clist) |
975 | ; (column int) |
976 | ; (visible boolean)) |
977 | |
978 | ; ;; cl-gtk.c |
979 | ; (define-foreign clist-column-visible-p (clist column) boolean |
980 | ; (clist clist) |
981 | ; ((progn |
982 | ; (assert (and (>= column 0) (< column (clist-n-columns clist)))) |
983 | ; column) |
984 | ; int)) |
985 | |
986 | ; (define-foreign ("gtk_clist_set_column_resizeable" |
987 | ; (setf clist-column-resizeable-p)) () nil |
988 | ; (clist clist) |
989 | ; (column int) |
990 | ; (resizeable boolean)) |
991 | |
992 | ; ;; cl-gtk.c |
993 | ; (define-foreign clist-column-resizeable-p (clist column) boolean |
994 | ; (clist clist) |
995 | ; ((progn |
996 | ; (assert (and (>= column 0) (< column (clist-n-columns clist)))) |
997 | ; column) |
998 | ; int)) |
999 | |
1000 | ; (define-foreign ("gtk_clist_set_column_auto_resize" |
1001 | ; (setf clist-column-auto-resize-p)) () nil |
1002 | ; (clist clist) |
1003 | ; (column int) |
1004 | ; (auto-resize boolean)) |
1005 | |
1006 | ; ;; cl-gtk.c |
1007 | ; (define-foreign clist-column-auto-resize-p (clist column) boolean |
1008 | ; (clist clist) |
1009 | ; ((progn |
1010 | ; (assert (and (>= column 0) (< column (clist-n-columns clist)))) |
1011 | ; column) |
1012 | ; int)) |
1013 | |
1014 | ; (define-foreign clist-columns-autosize () int |
1015 | ; (clist clist)) |
1016 | |
1017 | ; (define-foreign clist-optimal-column-width () int |
1018 | ; (clist clist) |
1019 | ; (column int)) |
1020 | |
1021 | ; (define-foreign ("gtk_clist_set_column_width" |
1022 | ; (setf clist-column-width)) () nil |
1023 | ; (clist clist) |
1024 | ; (column int) |
1025 | ; (width int)) |
1026 | |
1027 | ; ;; cl-gtk.c |
1028 | ; (define-foreign clist-column-width (clist column) int |
1029 | ; (clist clist) |
1030 | ; ((progn |
1031 | ; (assert (and (>= column 0) (< column (clist-n-columns clist)))) |
1032 | ; column) |
1033 | ; int)) |
1034 | |
1035 | ; (define-foreign ("gtk_clist_set_column_min_width" |
1036 | ; (setf clist-column-min-width)) (min-width clist column) nil |
1037 | ; (clist clist) |
1038 | ; (column int) |
1039 | ; ((or min-width -1) int)) |
1040 | |
1041 | ; (define-foreign ("gtk_clist_set_column_max_width" |
1042 | ; (setf clist-column-max-width)) (max-width clist column) nil |
1043 | ; (clist clist) |
1044 | ; (column int) |
1045 | ; ((or max-width -1) int)) |
1046 | |
1047 | ; (define-foreign clist-moveto () nil |
1048 | ; (clist clist) |
1049 | ; (row int) |
1050 | ; (column int) |
1051 | ; (row-align single-float) |
1052 | ; (columnt-align single-float)) |
1053 | |
1054 | ; (define-foreign |
1055 | ; ("gtk_clist_row_is_visible" clist-row-visiblie-p) () visibility |
1056 | ; (clist clist) |
1057 | ; (row int)) |
1058 | |
1059 | ; (define-foreign ("gtk_clist_get_cell_type" clist-cell-type) () cell-type |
1060 | ; (clist clist) |
1061 | ; (row int) |
1062 | ; (column int)) |
1063 | |
1064 | ; (define-foreign ("gtk_clist_set_text" (setf clist-cell-text)) () nil |
1065 | ; (clist clist) |
1066 | ; (row int) |
1067 | ; (column int) |
1068 | ; (text string)) |
1069 | |
1070 | ; (define-foreign %clist-set-pixmap () nil |
1071 | ; (clist clist) |
1072 | ; (row int) |
1073 | ; (column int) |
1074 | ; (gdk:pixmap gdk:pixmap) |
1075 | ; (mask (or null gdk:bitmap))) |
1076 | |
1077 | ; (defun (setf clist-cell-pixmap) (pixmap clist row column) |
1078 | ; (multiple-value-bind (gdk:pixmap mask) |
1079 | ; (%pixmap-create pixmap) |
1080 | ; (%clist-set-pixmap clist row column gdk:pixmap mask) |
1081 | ; (values pixmap mask))) |
1082 | |
1083 | ; (define-foreign %clist-set-pixtext () nil |
1084 | ; (clist clist) |
1085 | ; (row int) |
1086 | ; (column int) |
1087 | ; (text string) |
1088 | ; (spacing uint8) |
1089 | ; (pixmap gdk:pixmap) |
1090 | ; (mask (or null gdk:bitmap))) |
1091 | |
1092 | ; (defun clist-set-cell-pixtext (clist row column text spacing pixmap) |
1093 | ; (multiple-value-bind (gdk:pixmap mask) |
1094 | ; (%pixmap-create pixmap) |
1095 | ; (%clist-set-pixtext clist row column text spacing gdk:pixmap mask))) |
1096 | |
1097 | ; (define-foreign %clist-get-text () boolean |
1098 | ; (clist clist) |
1099 | ; (row int) |
1100 | ; (column int) |
1101 | ; (text string :out)) |
1102 | |
1103 | ; (defun clist-cell-text (clist row column) |
1104 | ; (multiple-value-bind (success text) |
1105 | ; (%clist-get-text clist row column) |
1106 | ; (unless success |
1107 | ; (error |
1108 | ; "Cell at row ~D column ~D in ~A is not of type :text" |
1109 | ; row column clist)) |
1110 | ; text)) |
1111 | |
1112 | ; (define-foreign ("gtk_clist_get_pixmap" %clist-get-pixmap) () boolean |
1113 | ; (clist clist) |
1114 | ; (row int) |
1115 | ; (column int) |
1116 | ; (pixmap gdk:pixmap :out) |
1117 | ; (mask gdk:bitmap :out)) |
1118 | |
1119 | ; (defun clist-cell-pixmap (clist row column) |
1120 | ; (multiple-value-bind (success pixmap mask) |
1121 | ; (%clist-get-pixmap clist row column) |
1122 | ; (unless success |
1123 | ; (error |
1124 | ; "Cell at row ~D column ~D in ~A is not of type :pixmap" |
1125 | ; row column clist)) |
1126 | ; (values pixmap mask))) |
1127 | |
1128 | ; (define-foreign %clist-get-pixtext () boolean |
1129 | ; (clist clist) |
1130 | ; (row int) |
1131 | ; (column int) |
1132 | ; (text string :out) |
1133 | ; (spacing unsigned-int :out) |
1134 | ; (pixmap gdk:pixmap :out) |
1135 | ; (mask gdk:bitmap :out)) |
1136 | |
1137 | ; (defun clist-cell-pixtext (clist row column) |
1138 | ; (multiple-value-bind (success text spacing pixmap mask) |
1139 | ; (%clist-get-pixtext clist row column) |
1140 | ; (unless success |
1141 | ; (error |
1142 | ; "Cell at row ~D column ~D in ~A is not of type :pixtext" |
1143 | ; row column clist)) |
1144 | ; (values text spacing pixmap mask))) |
1145 | |
1146 | ; (define-foreign %clist-set-foreground () nil |
1147 | ; (clist clist) |
1148 | ; (row int) |
1149 | ; (color gdk:color)) |
1150 | |
1151 | ; (defun (setf clist-foreground) (color clist row) |
1152 | ; (gdk:with-colors ((color color)) |
1153 | ; (%clist-set-foreground clist row color)) |
1154 | ; color) |
1155 | |
1156 | ; (define-foreign %clist-set-background () nil |
1157 | ; (clist clist) |
1158 | ; (row int) |
1159 | ; (color gdk:color)) |
1160 | |
1161 | ; (defun (setf clist-background) (color clist row) |
1162 | ; (gdk:with-colors ((color color)) |
1163 | ; (%clist-set-background clist row color)) |
1164 | ; color) |
1165 | |
1166 | ; (define-foreign ("gtk_clist_set_cell_style" |
1167 | ; (setf clist-cell-style)) () nil |
1168 | ; (clist clist) |
1169 | ; (row int) |
1170 | ; (column int) |
1171 | ; (style style)) |
1172 | |
1173 | ; (define-foreign ("gtk_clist_get_cell_style" clist-cell-style) () style |
1174 | ; (clist clist) |
1175 | ; (row int) |
1176 | ; (column int)) |
1177 | |
1178 | ; (define-foreign ("gtk_clist_set_row_style" |
1179 | ; (setf clist-row-style)) () nil |
1180 | ; (clist clist) |
1181 | ; (row int) |
1182 | ; (style style)) |
1183 | |
1184 | ; (define-foreign ("gtk_clist_get_row_style" clist-row-style) () style |
1185 | ; (clist clist) |
1186 | ; (row int)) |
1187 | |
1188 | ; (define-foreign clist-set-shift () nil |
1189 | ; (clist clist) |
1190 | ; (row int) |
1191 | ; (column int) |
1192 | ; (vertical int) |
1193 | ; (horizontal int)) |
1194 | |
1195 | ; (define-foreign ("gtk_clist_set_selectable" |
1196 | ; (setf clist-selectable-p)) () nil |
1197 | ; (clist clist) |
1198 | ; (row int) |
1199 | ; (selectable boolean)) |
1200 | |
1201 | ; (define-foreign ("gtk_clist_get_selectable" clist-selectable-p) () boolean |
1202 | ; (clist clist) |
1203 | ; (row int)) |
1204 | |
1205 | ; (define-foreign ("gtk_clist_insert" %clist-insert) () int |
1206 | ; (clist clist) |
1207 | ; (row int) |
1208 | ; (text pointer)) |
1209 | |
1210 | ; (defun clist-insert (clist row text) |
1211 | ; (unless (= (length text) (clist-n-columns clist)) |
1212 | ; (error "Wrong number of elements in ~A" text)) |
1213 | ; (with-array (data :initial-contents text :free-contents t) |
1214 | ; (%clist-insert clist row data))) |
1215 | |
1216 | ; (defun clist-prepend (clist text) |
1217 | ; (clist-insert clist 0 text)) |
1218 | |
1219 | ; (defun clist-append (clist text) |
1220 | ; (clist-insert clist -1 text)) |
1221 | |
1222 | ; (define-foreign clist-remove () nil |
1223 | ; (clist clist) |
1224 | ; (row int)) |
1225 | |
1226 | ; (define-foreign ("gtk_clist_set_row_data_full" clist-set-row-data) |
1227 | ; (clist row data &optional destroy-function) nil |
1228 | ; (clist clist) |
1229 | ; (row int) |
1230 | ; ((register-user-data data destroy-function) unsigned-long) |
1231 | ; (*destroy-marshal* pointer)) |
1232 | |
1233 | ; (defun (setf clist-row-data) (data clist row) |
1234 | ; (clist-set-row-data clist row data) |
1235 | ; data) |
1236 | |
1237 | ; (define-foreign %clist-get-row-data () unsigned-long |
1238 | ; (clist clist) |
1239 | ; (row int)) |
1240 | |
1241 | ; (defun clist-row-data (clist row) |
1242 | ; (find-user-data (%clist-get-row-data clist row))) |
1243 | |
1244 | ; (define-foreign %clist-find-row-from-data () int |
1245 | ; (clist clist) |
1246 | ; (id unsigned-long)) |
1247 | |
1248 | ; (define-foreign clist-select-row (clist row &optional (column -1)) nil |
1249 | ; (clist clist) |
1250 | ; (row int) |
1251 | ; (column int)) |
1252 | |
1253 | ; (define-foreign clist-unselect-row (clist row &optional (column -1)) nil |
1254 | ; (clist clist) |
1255 | ; (row int) |
1256 | ; (column int)) |
1257 | |
1258 | ; (define-foreign clist-undo-selection () nil |
1259 | ; (clist clist)) |
1260 | |
1261 | ; (define-foreign clist-clear () nil |
1262 | ; (clist clist)) |
1263 | |
1264 | ; (define-foreign ("gtk_clist_get_selection_info" clist-selection-info) () int |
1265 | ; (clist clist) |
1266 | ; (x int) |
1267 | ; (y int) |
1268 | ; (row int :out) |
1269 | ; (column int :out)) |
1270 | |
1271 | ; (define-foreign clist-select-all () nil |
1272 | ; (clist clist)) |
1273 | |
1274 | ; (define-foreign clist-unselect-all () nil |
1275 | ; (clist clist)) |
1276 | |
1277 | ; (define-foreign clist-swap-rows () nil |
1278 | ; (clist clist) |
1279 | ; (row1 int) |
1280 | ; (row2 int)) |
1281 | |
1282 | ; (define-foreign ("gtk_clist_row_move" clist-move-row) () nil |
1283 | ; (clist clist) |
1284 | ; (source-row int) |
1285 | ; (dest-row int)) |
1286 | |
1287 | ; ;(define-foreign clist-set-compare-func ...) |
1288 | |
1289 | ; (define-foreign clist-sort () nil |
1290 | ; (clist clist)) |
1291 | |
1292 | ; (define-foreign ("gtk_clist_set_auto_sort" |
1293 | ; (setf clist-auto-sort-p)) () nil |
1294 | ; (clist clist) |
1295 | ; (auto-sort boolean)) |
1296 | |
1297 | ; ;; cl-gtk.c |
1298 | ; (define-foreign clist-auto-sort-p () boolean |
1299 | ; (clist clist)) |
1300 | |
1301 | ; (defun clist-focus-row (clist) |
1302 | ; (let ((row (%clist-focus-row clist))) |
1303 | ; (when (>= row 0) |
1304 | ; row))) |
1305 | |
1306 | ; ;; cl-gtk.c |
1307 | ; (define-foreign clist-selection () (list int) |
1308 | ; (clist clist)) |
1309 | |
1310 | |
1311 | |
1312 | ; ;;; CTree |
1313 | |
1314 | ; (define-foreign %ctree-new () ctree |
1315 | ; (columns int) |
1316 | ; (tree-column int)) |
1317 | |
1318 | ; (define-foreign %ctree-new-with-titles () ctree |
1319 | ; (columns int) |
1320 | ; (tree-column int) |
1321 | ; (titles pointer)) |
1322 | |
1323 | ; (defun ctree-new (columns &optional (tree-column 0)) |
1324 | ; (if (atom columns) |
1325 | ; (%ctree-new columns tree-column) |
1326 | ; (with-array (titles :initial-contents columns :free-contents t) |
1327 | ; (%ctree-new-with-titles (length columns) tree-column titles)))) |
1328 | |
1329 | ; (define-foreign %ctree-insert-node () ctree-node |
1330 | ; (ctree ctree) |
1331 | ; (parent (or null ctree-node)) |
1332 | ; (sibling (or null ctree-node)) |
1333 | ; (text pointer) |
1334 | ; (spacing uint8) |
1335 | ; (pixmap-closed (or null gdk:pixmap)) |
1336 | ; (bitmap-closed (or null gdk:bitmap)) |
1337 | ; (pixmap-opened (or null gdk:pixmap)) |
1338 | ; (bitmap-opened (or null gdk:bitmap)) |
1339 | ; (leaf boolean) |
1340 | ; (expaned boolean)) |
1341 | |
1342 | ; (defun ctree-insert-node (ctree parent sibling text spacing |
1343 | ; &key pixmap closed opened leaf expanded) |
1344 | ; (multiple-value-bind (pixmap-closed mask-closed) |
1345 | ; (%pixmap-create (or closed pixmap)) |
1346 | ; (multiple-value-bind (pixmap-opened mask-opened) |
1347 | ; (%pixmap-create (or opened (and (not leaf) pixmap))) |
1348 | ; (with-array (data :clear t :initial-contents text :free-contents t) |
1349 | ; (%ctree-insert-node |
1350 | ; ctree parent sibling data spacing pixmap-closed mask-closed |
1351 | ; pixmap-opened mask-opened leaf expanded))))) |
1352 | |
1353 | ; (define-foreign ctree-remove-node () nil |
1354 | ; (ctree ctree) |
1355 | ; (node ctree-node)) |
1356 | |
1357 | ; (defun ctree-insert-from-list (ctree parent tree function) |
1358 | ; (clist-freeze ctree) |
1359 | ; (labels ((insert-node (node parent) |
1360 | ; (let ((ctree-node |
1361 | ; (ctree-insert-node |
1362 | ; ctree parent nil |
1363 | ; (make-list (clist-n-columns ctree) :initial-element "") |
1364 | ; 0 :leaf (not (rest node))))) |
1365 | ; (funcall function ctree-node (car node)) |
1366 | ; (dolist (child (rest node)) |
1367 | ; (insert-node child ctree-node))))) |
1368 | ; (if parent |
1369 | ; (insert-node tree parent) |
1370 | ; (dolist (node tree) |
1371 | ; (insert-node node nil)))) |
1372 | ; (clist-thaw ctree)) |
1373 | |
1374 | ; (defun ctree-map-to-list (ctree node function) |
1375 | ; (labels ((map-children (child) |
1376 | ; (when child |
1377 | ; (let ((sibling (ctree-node-sibling child))) |
1378 | ; (cons |
1379 | ; (ctree-map-to-list ctree child function) |
1380 | ; (map-children sibling)))))) |
1381 | ; (if node |
1382 | ; (cons |
1383 | ; (funcall function node) |
1384 | ; (map-children (ctree-node-child node))) |
1385 | ; (map-children (ctree-nth-node ctree 0))))) |
1386 | |
1387 | |
1388 | ; (defun %ctree-apply-recursive (ctree node pre function depth) |
1389 | ; (when (and pre node (or (not depth) (<= (ctree-node-level node) depth))) |
1390 | ; (funcall function node)) |
1391 | |
1392 | ; (let ((first-child (if node |
1393 | ; (ctree-node-child node) |
1394 | ; (ctree-nth-node ctree 0)))) |
1395 | ; (when (and |
1396 | ; first-child |
1397 | ; (or (not depth) (<= (ctree-node-level first-child) depth))) |
1398 | ; (labels ((foreach-child (child) |
1399 | ; (when child |
1400 | ; (let ((sibling (ctree-node-sibling child))) |
1401 | ; (%ctree-apply-recursive ctree child pre function depth) |
1402 | ; (foreach-child sibling))))) |
1403 | ; (foreach-child first-child)))) |
1404 | |
1405 | ; (when (and |
1406 | ; (not pre) node (or (not depth) (<= (ctree-node-level node) depth))) |
1407 | ; (funcall function node))) |
1408 | |
1409 | ; (defun ctree-apply-post-recursive (ctree node function &optional depth) |
1410 | ; (%ctree-apply-recursive ctree node nil function depth)) |
1411 | |
1412 | ; (defun ctree-apply-pre-recursive (ctree node function &optional depth) |
1413 | ; (%ctree-apply-recursive ctree node t function depth)) |
1414 | |
1415 | ; (define-foreign ("gtk_ctree_is_viewable" ctree-node-viewable-p) () boolean |
1416 | ; (ctree ctree) |
1417 | ; (node ctree-node)) |
1418 | |
1419 | ; (define-foreign ctree-last () ctree-node |
1420 | ; (ctree ctree)) |
1421 | |
1422 | ; (define-foreign ("gtk_ctree_node_nth" ctree-nth-node) () ctree-node |
1423 | ; (ctree ctree) |
1424 | ; (row int)) |
1425 | |
1426 | ; (define-foreign ctree-find () boolean |
1427 | ; (ctree ctree) |
1428 | ; (node ctree-node) |
1429 | ; (child ctree-node)) |
1430 | |
1431 | ; (define-foreign ("gtk_ctree_is_ancestor" ctree-ancestor-p) () boolean |
1432 | ; (ctree ctree) |
1433 | ; (node ctree-node) |
1434 | ; (child ctree-node)) |
1435 | |
1436 | ; (define-foreign %ctree-find-by-row-data () int |
1437 | ; (clist clist) |
1438 | ; (node ctree-node) |
1439 | ; (id unsigned-long)) |
1440 | |
1441 | ; (define-foreign ("gtk_ctree_is_hot_spot" ctree-hot-spot-p) () boolean |
1442 | ; (ctree ctree) |
1443 | ; (x int) |
1444 | ; (y int)) |
1445 | |
1446 | ; (define-foreign ctree-move () nil |
1447 | ; (ctree ctree) |
1448 | ; (node ctree-node) |
1449 | ; (new-parent ctree-node) |
1450 | ; (new-sibling ctree-node)) |
1451 | |
1452 | ; (define-foreign ctree-expand () nil |
1453 | ; (ctree ctree) |
1454 | ; (node ctree-node)) |
1455 | |
1456 | ; (define-foreign ctree-expand-recursive () nil |
1457 | ; (ctree ctree) |
1458 | ; (node (or null ctree-node))) |
1459 | |
1460 | ; (define-foreign ctree-expand-to-depth () nil |
1461 | ; (ctree ctree) |
1462 | ; (node (or null ctree-node)) |
1463 | ; (depth int)) |
1464 | |
1465 | ; (define-foreign ctree-collapse () nil |
1466 | ; (ctree ctree) |
1467 | ; (node ctree-node)) |
1468 | |
1469 | ; (define-foreign ctree-collapse-recursive () nil |
1470 | ; (ctree ctree) |
1471 | ; (node (or null ctree-node))) |
1472 | |
1473 | ; (define-foreign ctree-collapse-to-depth () nil |
1474 | ; (ctree ctree) |
1475 | ; (node (or null ctree-node)) |
1476 | ; (depth int)) |
1477 | |
1478 | ; (define-foreign ctree-toggle-expansion () nil |
1479 | ; (ctree ctree) |
1480 | ; (node ctree-node)) |
1481 | |
1482 | ; (define-foreign ctree-toggle-expansion-recursive () nil |
1483 | ; (ctree ctree) |
1484 | ; (node (or null ctree-node))) |
1485 | |
1486 | ; (define-foreign ctree-select () nil |
1487 | ; (ctree ctree) |
1488 | ; (node ctree-node)) |
1489 | |
1490 | ; (define-foreign ctree-unselect () nil |
1491 | ; (ctree ctree) |
1492 | ; (node ctree-node)) |
1493 | |
1494 | ; (define-foreign %ctree-real-select-recursive () nil |
1495 | ; (ctree ctree) |
1496 | ; (node (or null ctree-node)) |
1497 | ; (state boolean)) |
1498 | |
1499 | ; (defun ctree-select-recursive (ctree node) |
1500 | ; (%ctree-real-select-recursive ctree node t)) |
1501 | |
1502 | ; (defun ctree-unselect-recursive (ctree node) |
1503 | ; (%ctree-real-select-recursive ctree node nil)) |
1504 | |
1505 | ; (define-foreign ("gtk_ctree_node_set_text" (setf ctree-cell-text)) () nil |
1506 | ; (ctree ctree) |
1507 | ; (node ctree-node) |
1508 | ; (column int) |
1509 | ; (text string)) |
1510 | |
1511 | ; (define-foreign %ctree-node-set-pixmap () nil |
1512 | ; (ctree ctree) |
1513 | ; (node ctree-node) |
1514 | ; (column int) |
1515 | ; (gdk:pixmap gdk:pixmap) |
1516 | ; (mask (or null gdk:bitmap))) |
1517 | |
1518 | ; (defun (setf ctree-cell-pixmap) (source ctree node column) |
1519 | ; (multiple-value-bind (pixmap mask) |
1520 | ; (%pixmap-create source) |
1521 | ; (%ctree-node-set-pixmap ctree node column pixmap mask) |
1522 | ; (values pixmap mask))) |
1523 | |
1524 | ; (define-foreign %ctree-node-set-pixtext () nil |
1525 | ; (ctree ctree) |
1526 | ; (node ctree-node) |
1527 | ; (column int) |
1528 | ; (text string) |
1529 | ; (spacing uint8) |
1530 | ; (pixmap gdk:pixmap) |
1531 | ; (mask (or null gdk:bitmap))) |
1532 | |
1533 | ; (defun ctree-set-cell-pixtext (ctree node column text spacing source) |
1534 | ; (multiple-value-bind (pixmap mask) |
1535 | ; (%pixmap-create source) |
1536 | ; (%ctree-node-set-pixtext ctree node column text spacing pixmap mask))) |
1537 | |
1538 | ; (define-foreign %ctree-set-node-info () ctree-node |
1539 | ; (ctree ctree) |
1540 | ; (node (or null ctree-node)) |
1541 | ; (text string) |
1542 | ; (spacing uint8) |
1543 | ; (pixmap-closed (or null gdk:pixmap)) |
1544 | ; (bitmap-closed (or null gdk:bitmap)) |
1545 | ; (pixmap-opened (or null gdk:pixmap)) |
1546 | ; (bitmap-opened (or null gdk:bitmap)) |
1547 | ; (leaf boolean) |
1548 | ; (expaned boolean)) |
1549 | |
1550 | ; (defun ctree-set-node-info (ctree node text spacing |
1551 | ; &key pixmap closed opened leaf expanded) |
1552 | ; (multiple-value-bind (pixmap-closed mask-closed) |
1553 | ; (%pixmap-create (or closed pixmap)) |
1554 | ; (multiple-value-bind (pixmap-opened mask-opened) |
1555 | ; (%pixmap-create (or opened (and (not leaf) pixmap))) |
1556 | ; (%ctree-set-node-info |
1557 | ; ctree node text spacing pixmap-closed mask-closed |
1558 | ; pixmap-opened mask-opened leaf expanded)))) |
1559 | |
1560 | ; (define-foreign ("gtk_ctree_node_set_shift" ctree-set-shift) () nil |
1561 | ; (ctree ctree) |
1562 | ; (node ctree-node) |
1563 | ; (column int) |
1564 | ; (vertical int) |
1565 | ; (horizontal int)) |
1566 | |
1567 | ; (define-foreign ("gtk_ctree_node_set_selectable" |
1568 | ; (setf ctree-selectable-p)) () nil |
1569 | ; (ctree ctree) |
1570 | ; (node ctree-node) |
1571 | ; (selectable boolean)) |
1572 | |
1573 | ; (define-foreign ("gtk_ctree_node_get_selectable" |
1574 | ; ctree-selectable-p) () boolean |
1575 | ; (ctree ctree) |
1576 | ; (node ctree-node)) |
1577 | |
1578 | ; (define-foreign ("gtk_ctree_node_get_cell_type" ctree-cell-type) () cell-type |
1579 | ; (ctree ctree) |
1580 | ; (node ctree-node) |
1581 | ; (column int)) |
1582 | |
1583 | ; (define-foreign %ctree-node-get-text () boolean |
1584 | ; (ctree ctree) |
1585 | ; (node ctree-node) |
1586 | ; (column int) |
1587 | ; (text string :out)) |
1588 | |
1589 | ; (defun ctree-cell-text (ctree node column) |
1590 | ; (multiple-value-bind (success text) |
1591 | ; (%ctree-node-get-text ctree node column) |
1592 | ; (unless success |
1593 | ; (error |
1594 | ; "Cell in node ~A, column ~D in ~A is not of type :text" |
1595 | ; node column ctree)) |
1596 | ; text)) |
1597 | |
1598 | ; (define-foreign %ctree-node-get-pixmap () boolean |
1599 | ; (ctree ctree) |
1600 | ; (node ctree-node) |
1601 | ; (column int) |
1602 | ; (pixmap gdk:pixmap :out) |
1603 | ; (mask gdk:bitmap :out)) |
1604 | |
1605 | ; (defun ctree-cell-pixmap (ctree node column) |
1606 | ; (multiple-value-bind (success pixmap mask) |
1607 | ; (%ctree-node-get-pixmap ctree node column) |
1608 | ; (unless success |
1609 | ; (error |
1610 | ; "Cell in node ~A column ~D in ~A is not of type :text" |
1611 | ; node column ctree)) |
1612 | ; (values pixmap mask))) |
1613 | |
1614 | ; (define-foreign %ctree-node-get-pixtext () boolean |
1615 | ; (ctree ctree) |
1616 | ; (node ctree-node) |
1617 | ; (column int) |
1618 | ; (text string :out) |
1619 | ; (spacing unsigned-int :out) |
1620 | ; (pixmap gdk:pixmap :out) |
1621 | ; (mask gdk:bitmap :out)) |
1622 | |
1623 | ; (defun ctree-cell-pixtext (ctree node column) |
1624 | ; (multiple-value-bind (success text spacing pixmap mask) |
1625 | ; (%ctree-node-get-pixtext ctree node column) |
1626 | ; (unless success |
1627 | ; (error |
1628 | ; "Cell in node ~A column ~D in ~A is not of type :text" |
1629 | ; node column ctree)) |
1630 | ; (values text spacing pixmap mask))) |
1631 | |
1632 | ; (define-foreign ("gtk_ctree_get_node_info" ctree-node-info) () nil |
1633 | ; (ctree ctree) |
1634 | ; (node ctree-node) |
1635 | ; (text string :out) |
1636 | ; (spacing unsigned-int :out) |
1637 | ; (pixmap-closed gdk:pixmap :out) |
1638 | ; (mask-closed gdk:bitmap :out) |
1639 | ; (pixmap-opened gdk:pixmap :out) |
1640 | ; (mask-opened gdk:bitmap :out) |
1641 | ; (leaf boolean :out) |
1642 | ; (expanded boolean :out)) |
1643 | |
1644 | ; (define-foreign ("gtk_ctree_node_set_row_style" |
1645 | ; (setf ctree-row-style)) () nil |
1646 | ; (ctree ctree) |
1647 | ; (node ctree-node) |
1648 | ; (style (or null style))) |
1649 | |
1650 | ; (define-foreign ("gtk_ctree_node_get_row_style" ctree-row-style) () style |
1651 | ; (ctree ctree) |
1652 | ; (node ctree-node)) |
1653 | |
1654 | ; (define-foreign ("gtk_ctree_node_set_cell_style" |
1655 | ; (setf ctree-cell-style)) () nil |
1656 | ; (ctree ctree) |
1657 | ; (node ctree-node) |
1658 | ; (column int) |
1659 | ; (style (or null style))) |
1660 | |
1661 | ; (define-foreign ("gtk_ctree_node_get_cell_style" |
1662 | ; ctree-cell-style) () style |
1663 | ; (ctree ctree) |
1664 | ; (node ctree-node) |
1665 | ; (column int)) |
1666 | |
1667 | ; (define-foreign %ctree-node-set-foreground () nil |
1668 | ; (ctree ctree) |
1669 | ; (node ctree-node) |
1670 | ; (color gdk:color)) |
1671 | |
1672 | ; (defun (setf ctree-node-foreground) (color clist row) |
1673 | ; (gdk:with-colors ((color color)) |
1674 | ; (%ctree-node-set-foreground clist row color)) |
1675 | ; color) |
1676 | |
1677 | ; (define-foreign %ctree-node-set-background () nil |
1678 | ; (ctree ctree) |
1679 | ; (node ctree-node) |
1680 | ; (color gdk:color)) |
1681 | |
1682 | ; (defun (setf ctree-node-background) (color clist row) |
1683 | ; (gdk:with-colors ((color color)) |
1684 | ; (%ctree-node-set-background clist row color)) |
1685 | ; color) |
1686 | |
1687 | ; (define-foreign ("gtk_ctree_node_set_row_data_full" ctree-set-node-data) |
1688 | ; (ctree node data &optional destroy-function) nil |
1689 | ; (ctree ctree) |
1690 | ; (node ctree-node) |
1691 | ; ((register-user-data data destroy-function) unsigned-long) |
1692 | ; (*destroy-marshal* pointer)) |
1693 | |
1694 | ; (defun (setf ctree-node-data) (data ctree node) |
1695 | ; (ctree-set-node-data ctree node data) |
1696 | ; data) |
1697 | |
1698 | ; (define-foreign %ctree-node-get-row-data () unsigned-long |
1699 | ; (ctree ctree) |
1700 | ; (node ctree-node)) |
1701 | |
1702 | ; (defun ctree-node-data (ctree node) |
1703 | ; (find-user-data (%ctree-node-get-row-data ctree node))) |
1704 | |
1705 | ; (define-foreign ctree-node-moveto () nil |
1706 | ; (ctree ctree) |
1707 | ; (node ctree-node) |
1708 | ; (column int) |
1709 | ; (row-aling single-float) |
1710 | ; (column-aling single-float)) |
1711 | |
1712 | ; (define-foreign ("gtk_ctree_node_is_visible" |
1713 | ; ctree-node-visibility) () visibility |
1714 | ; (ctree ctree) |
1715 | ; (node ctree-node)) |
1716 | |
1717 | ; (define-foreign ctree-sort-node () nil |
1718 | ; (ctree ctree) |
1719 | ; (node ctree-node)) |
1720 | |
1721 | ; (define-foreign ctree-sort-recursive (ctree &optional node) nil |
1722 | ; (ctree ctree) |
1723 | ; (node (or null ctree-node))) |
1724 | |
1725 | ; ;; cl-gtk.c |
1726 | ; (define-foreign ("gtk_clist_selection" ctree-selection) () (list ctree-node) |
1727 | ; (ctree ctree)) |
1728 | |
1729 | ; ;; cl-gtk.c |
1730 | ; (define-foreign ctree-node-leaf-p () boolean |
1731 | ; (node ctree-node)) |
1732 | |
1733 | ; ;; cl-gtk.c |
1734 | ; (define-foreign ctree-node-parent () ctree-node |
1735 | ; (node ctree-node)) |
1736 | |
1737 | ; ;; cl-gtk.c |
1738 | ; (define-foreign ctree-node-child () ctree-node |
1739 | ; (node ctree-node)) |
1740 | |
1741 | ; ;; cl-gtk.c |
1742 | ; (define-foreign ctree-node-sibling () ctree-node |
1743 | ; (node ctree-node)) |
1744 | |
1745 | ; ;; cl-gtk.c |
1746 | ; (define-foreign ctree-node-level () int |
1747 | ; (node ctree-node)) |
1748 | |
1749 | |
1750 | ;;; Fixed |
1751 | |
1752 | ; (define-foreign fixed-new () fixed) |
1753 | |
1754 | ; (define-foreign fixed-put () nil |
1755 | ; (fixed fixed) |
1756 | ; (widget widget) |
1757 | ; (x int) (y int16)) |
1758 | |
1759 | ; (define-foreign fixed-move () nil |
1760 | ; (fixed fixed) |
1761 | ; (widget widget) |
1762 | ; (x int16) (y int16)) |
1763 | |
1764 | |
1765 | |
1766 | ; ;;; Notebook |
1767 | |
1768 | ; (define-foreign notebook-new () notebook) |
1769 | |
1770 | ; (define-foreign ("gtk_notebook_insert_page_menu" notebook-insert-page) |
1771 | ; (notebook position child tab-label &optional menu-label) nil |
1772 | ; (notebook notebook) |
1773 | ; (child widget) |
1774 | ; ((if (stringp tab-label) |
1775 | ; (label-new tab-label) |
1776 | ; tab-label) widget) |
1777 | ; ((if (stringp menu-label) |
1778 | ; (label-new menu-label) |
1779 | ; menu-label) (or null widget)) |
1780 | ; (position int)) |
1781 | |
1782 | ; (defun notebook-append-page (notebook child tab-label &optional menu-label) |
1783 | ; (notebook-insert-page notebook -1 child tab-label menu-label)) |
1784 | |
1785 | ; (defun notebook-prepend-page (notebook child tab-label &optional menu-label) |
1786 | ; (notebook-insert-page notebook 0 child tab-label menu-label)) |
1787 | |
1788 | ; (define-foreign notebook-remove-page () nil |
1789 | ; (notebook notebook) |
1790 | ; (page-num int)) |
1791 | |
1792 | ; (defun notebook-current-page-num (notebook) |
1793 | ; (let ((page-num (notebook-current-page notebook))) |
1794 | ; (if (= page-num -1) |
1795 | ; nil |
1796 | ; page-num))) |
1797 | |
1798 | ; (define-foreign ("gtk_notebook_get_nth_page" notebook-nth-page) () widget |
1799 | ; (notebook notebook) |
1800 | ; (page-num int)) |
1801 | |
1802 | ; (define-foreign %notebook-page-num () int |
1803 | ; (notebook notebook) |
1804 | ; (page-num int)) |
1805 | |
1806 | ; (defun notebook-child-page-num (notebook child) |
1807 | ; (let ((page-num (%notebook-page-num notebook child))) |
1808 | ; (if (= page-num -1) |
1809 | ; nil |
1810 | ; page-num))) |
1811 | |
1812 | ; (define-foreign notebook-next-page () nil |
1813 | ; (notebook notebook)) |
1814 | |
1815 | ; (define-foreign notebook-prev-page () nil |
1816 | ; (notebook notebook)) |
1817 | |
1818 | ; (define-foreign notebook-popup-enable () nil |
1819 | ; (notebook notebook)) |
1820 | |
1821 | ; (define-foreign notebook-popup-disable () nil |
1822 | ; (notebook notebook)) |
1823 | |
1824 | ; (define-foreign |
1825 | ; ("gtk_notebook_get_tab_label" notebook-tab-label) (notebook ref) widget |
1826 | ; (notebook notebook) |
1827 | ; ((if (widget-p ref) |
1828 | ; ref |
1829 | ; (notebook-nth-page notebook ref)) |
1830 | ; widget)) |
1831 | |
1832 | ; (define-foreign %notebook-set-tab-label () nil |
1833 | ; (notebook notebook) |
1834 | ; (reference widget) |
1835 | ; (tab-label widget)) |
1836 | |
1837 | ; (defun (setf notebook-tab-label) (tab-label notebook reference) |
1838 | ; (let ((tab-label-widget (if (stringp tab-label) |
1839 | ; (label-new tab-label) |
1840 | ; tab-label))) |
1841 | ; (%notebook-set-tab-label |
1842 | ; notebook |
1843 | ; (if (widget-p reference) |
1844 | ; reference |
1845 | ; (notebook-nth-page notebook reference)) |
1846 | ; tab-label-widget) |
1847 | ; (when (stringp tab-label) |
1848 | ; (widget-unref tab-label-widget)) |
1849 | ; tab-label-widget)) |
1850 | |
1851 | ; (define-foreign |
1852 | ; ("gtk_notebook_get_menu_label" notebook-menu-label) (notebook ref) widget |
1853 | ; (notebook notebook) |
1854 | ; ((if (widget-p ref) |
1855 | ; ref |
1856 | ; (notebook-nth-page notebook ref)) |
1857 | ; widget)) |
1858 | |
1859 | ; (define-foreign %notebook-set-menu-label () nil |
1860 | ; (notebook notebook) |
1861 | ; (reference widget) |
1862 | ; (menu-label widget)) |
1863 | |
1864 | ; (defun (setf notebook-menu-label) (menu-label notebook reference) |
1865 | ; (let ((menu-label-widget (if (stringp menu-label) |
1866 | ; (label-new menu-label) |
1867 | ; menu-label))) |
1868 | ; (%notebook-set-menu-label |
1869 | ; notebook |
1870 | ; (if (widget-p reference) |
1871 | ; reference |
1872 | ; (notebook-nth-page notebook reference)) |
1873 | ; menu-label-widget) |
1874 | ; (when (stringp menu-label) |
1875 | ; (widget-unref menu-label-widget)) |
1876 | ; menu-label-widget)) |
1877 | |
1878 | ; (define-foreign notebook-query-tab-label-packing (notebook ref) nil |
1879 | ; (notebook notebook) |
1880 | ; ((if (widget-p ref) |
1881 | ; ref |
1882 | ; (notebook-nth-page notebook ref)) |
1883 | ; widget) |
1884 | ; (expand boolean :out) |
1885 | ; (fill boolean :out) |
1886 | ; (pack-type pack-type :out)) |
1887 | |
1888 | ; (define-foreign |
1889 | ; notebook-set-tab-label-packing (notebook ref expand fill pack-type) nil |
1890 | ; (notebook notebook) |
1891 | ; ((if (widget-p ref) |
1892 | ; ref |
1893 | ; (notebook-nth-page notebook ref)) |
1894 | ; widget) |
1895 | ; (expand boolean) |
1896 | ; (fill boolean) |
1897 | ; (pack-type pack-type)) |
1898 | |
1899 | ; (define-foreign notebook-reorder-child () nil |
1900 | ; (notebook notebook) |
1901 | ; (child widget) |
1902 | ; (position int)) |
1903 | |
1904 | |
1905 | |
1906 | ; ;;; Font selection |
1907 | |
1908 | |
1909 | |
1910 | |
1911 | ; ;;; Paned |
1912 | |
1913 | ; (define-foreign paned-add1 () nil |
1914 | ; (paned paned) |
1915 | ; (child widget)) |
1916 | |
1917 | ; (define-foreign paned-add2 () nil |
1918 | ; (paned paned) |
1919 | ; (child widget)) |
1920 | |
1921 | ; (define-foreign paned-pack1 () nil |
1922 | ; (paned paned) |
1923 | ; (child widget) |
1924 | ; (resize boolean) |
1925 | ; (shrink boolean)) |
1926 | |
1927 | ; (define-foreign paned-pack2 () nil |
1928 | ; (paned paned) |
1929 | ; (child widget) |
1930 | ; (resize boolean) |
1931 | ; (shrink boolean)) |
1932 | |
1933 | ; ; (define-foreign ("gtk_paned_set_position" (setf paned-position)) () nil |
1934 | ; ; (paned paned) |
1935 | ; ; (position int)) |
1936 | |
1937 | ; ;; cl-gtk.c |
1938 | ; (define-foreign paned-child1 () widget |
1939 | ; (paned paned) |
1940 | ; (resize boolean :out) |
1941 | ; (shrink boolean :out)) |
1942 | |
1943 | ; ;; cl-gtk.c |
1944 | ; (define-foreign paned-child2 () widget |
1945 | ; (paned paned) |
1946 | ; (resize boolean :out) |
1947 | ; (shrink boolean :out)) |
1948 | |
1949 | ; (define-foreign vpaned-new () vpaned) |
1950 | |
1951 | ; (define-foreign hpaned-new () hpaned) |
1952 | |
1953 | |
1954 | |
1955 | ; ;;; Layout |
1956 | |
1957 | ; (define-foreign layout-new (&optional hadjustment vadjustment) layout |
1958 | ; (hadjustment (or null adjustment)) |
1959 | ; (vadjustment (or null adjustment))) |
1960 | |
1961 | ; (define-foreign layout-put () nil |
1962 | ; (layout layout) |
1963 | ; (widget widget) |
1964 | ; (x int) (y int)) |
1965 | |
1966 | ; (define-foreign layout-move () nil |
1967 | ; (layout layout) |
1968 | ; (widget widget) |
1969 | ; (x int) (y int)) |
1970 | |
1971 | ; (define-foreign %layout-set-size () nil |
1972 | ; (layout layout) |
1973 | ; (width int) |
1974 | ; (height int)) |
1975 | |
1976 | ; (defun (setf layout-size) (size layout) |
1977 | ; (%layout-set-size layout (svref size 0) (svref size 1)) |
1978 | ; (values (svref size 0) (svref size 1))) |
1979 | |
1980 | ; ;; cl-gtk.c |
1981 | ; (define-foreign layout-size () nil |
1982 | ; (layout layout) |
1983 | ; (width int :out) |
1984 | ; (height int :out)) |
1985 | |
1986 | ; (define-foreign layout-freeze () nil |
1987 | ; (layout layout)) |
1988 | |
1989 | ; (define-foreign layout-thaw () nil |
1990 | ; (layout layout)) |
1991 | |
1992 | ; (define-foreign layout-offset () nil |
1993 | ; (layout layout) |
1994 | ; (x int :out) |
1995 | ; (y int :out)) |
1996 | |
1997 | |
1998 | |
1999 | ;;; List |
2000 | |
2001 | ; (define-foreign list-new () list-widget) |
2002 | |
2003 | ; (define-foreign list-insert-items () nil |
2004 | ; (list list-widget) |
2005 | ; (items (list list-item)) |
2006 | ; (position int)) |
2007 | |
2008 | ; (define-foreign list-append-items () nil |
2009 | ; (list list-widget) |
2010 | ; (items (double-list list-item))) |
2011 | |
2012 | ; (define-foreign list-prepend-items () nil |
2013 | ; (list list-widget) |
2014 | ; (items (double-list list-item))) |
2015 | |
2016 | ; (define-foreign %list-remove-items () nil |
2017 | ; (list list-widget) |
2018 | ; (items (double-list list-item))) |
2019 | |
2020 | ; (define-foreign %list-remove-items-no-unref () nil |
2021 | ; (list list-widget) |
2022 | ; (items (double-list list-item))) |
2023 | |
2024 | ; (defun list-remove-items (list items &key no-unref) |
2025 | ; (if no-unref |
2026 | ; (%list-remove-items-no-unref list items) |
2027 | ; (%list-remove-items list items))) |
2028 | |
2029 | ; (define-foreign list-clear-items () nil |
2030 | ; (list list-widget) |
2031 | ; (start int) |
2032 | ; (end int)) |
2033 | |
2034 | ; (define-foreign list-select-item () nil |
2035 | ; (list list-widget) |
2036 | ; (item int)) |
2037 | |
2038 | ; (define-foreign list-unselect-item () nil |
2039 | ; (list list-widget) |
2040 | ; (item int)) |
2041 | |
2042 | ; (define-foreign list-select-child () nil |
2043 | ; (list list-widget) |
2044 | ; (child widget)) |
2045 | |
2046 | ; (define-foreign list-unselect-child () nil |
2047 | ; (list list-widget) |
2048 | ; (child widget)) |
2049 | |
2050 | ; (define-foreign list-child-position () int |
2051 | ; (list list-widget) |
2052 | ; (child widget)) |
2053 | |
2054 | ; (define-foreign list-extend-selection () nil |
2055 | ; (list list-widget) |
2056 | ; (scroll-type scroll-type) |
2057 | ; (position single-float) |
2058 | ; (auto-start-selection boolean)) |
2059 | |
2060 | ; (define-foreign list-start-selection () nil |
2061 | ; (list list-widget)) |
2062 | |
2063 | ; (define-foreign list-end-selection () nil |
2064 | ; (list list-widget)) |
2065 | |
2066 | ; (define-foreign list-select-all () nil |
2067 | ; (list list-widget)) |
2068 | |
2069 | ; (define-foreign list-unselect-all () nil |
2070 | ; (list list-widget)) |
2071 | |
2072 | ; (define-foreign list-scroll-horizontal () nil |
2073 | ; (list list-widget) |
2074 | ; (scroll-type scroll-type) |
2075 | ; (position single-float)) |
2076 | |
2077 | ; (define-foreign list-scroll-vertical () nil |
2078 | ; (list list-widget) |
2079 | ; (scroll-type scroll-type) |
2080 | ; (position single-float)) |
2081 | |
2082 | ; (define-foreign list-toggle-add-mode () nil |
2083 | ; (list list-widget)) |
2084 | |
2085 | ; (define-foreign list-toggle-focus-row () nil |
2086 | ; (list list-widget)) |
2087 | |
2088 | ; (define-foreign list-toggle-row () nil |
2089 | ; (list list-widget) |
2090 | ; (item list-item)) |
2091 | |
2092 | ; (define-foreign list-undo-selection () nil |
2093 | ; (list list-widget)) |
2094 | |
2095 | ; (define-foreign list-end-drag-selection () nil |
2096 | ; (list list-widget)) |
2097 | |
2098 | ; ;; cl-gtk.c |
2099 | ; (define-foreign list-selection () (double-list list-item) |
2100 | ; (list list-widget)) |
2101 | |
2102 | |
2103 | |
2104 | ;;; Menu shell |
2105 | |
2106 | ; (define-foreign menu-shell-insert () nil |
2107 | ; (menu-shell menu-shell) |
2108 | ; (menu-item menu-item) |
2109 | ; (position int)) |
2110 | |
2111 | ; (defun menu-shell-append (menu-shell menu-item) |
2112 | ; (menu-shell-insert menu-shell menu-item -1)) |
2113 | |
2114 | ; (defun menu-shell-prepend (menu-shell menu-item) |
2115 | ; (menu-shell-insert menu-shell menu-item 0)) |
2116 | |
2117 | ; (define-foreign menu-shell-deactivate () nil |
2118 | ; (menu-shell menu-shell)) |
2119 | |
2120 | ; (define-foreign menu-shell-select-item () nil |
2121 | ; (menu-shell menu-shell) |
2122 | ; (menu-item menu-item)) |
2123 | |
2124 | ; (define-foreign menu-shell-deselect () nil |
2125 | ; (menu-shell menu-shell)) |
2126 | |
2127 | ; (define-foreign menu-shell-activate-item () nil |
2128 | ; (menu-shell menu-shell) |
2129 | ; (menu-item menu-item) |
2130 | ; (fore-deactivate boolean)) |
2131 | |
2132 | |
2133 | |
2134 | ; ;;; Menu bar |
2135 | |
2136 | ; (define-foreign menu-bar-new () menu-bar) |
2137 | |
2138 | ; (define-foreign menu-bar-insert () nil |
2139 | ; (menu-bar menu-bar) |
2140 | ; (menu menu) |
2141 | ; (position int)) |
2142 | |
2143 | ; (defun menu-bar-append (menu-bar menu) |
2144 | ; (menu-bar-insert menu-bar menu -1)) |
2145 | |
2146 | ; (defun menu-bar-prepend (menu-bar menu) |
2147 | ; (menu-bar-insert menu-bar menu 0)) |
2148 | |
2149 | |
2150 | |
2151 | ; ;;; Menu |
2152 | |
2153 | ; (define-foreign menu-new () menu) |
2154 | |
2155 | ; (defun menu-insert (menu menu-item position) |
2156 | ; (menu-shell-insert menu menu-item position)) |
2157 | |
2158 | ; (defun menu-append (menu menu-item) |
2159 | ; (menu-shell-append menu menu-item)) |
2160 | |
2161 | ; (defun menu-prepend (menu menu-item) |
2162 | ; (menu-shell-prepend menu menu-item)) |
2163 | |
2164 | ; ;(defun menu-popup ...) |
2165 | |
2166 | ; (define-foreign menu-reposition () nil |
2167 | ; (menu menu)) |
2168 | |
2169 | ; (define-foreign menu-popdown () nil |
2170 | ; (menu menu)) |
2171 | |
2172 | ; (define-foreign ("gtk_menu_get_active" menu-active) () widget |
2173 | ; (menu menu)) |
2174 | |
2175 | ; (define-foreign ("gtk_menu_set_active" (setf menu-active)) () nil |
2176 | ; (menu menu) |
2177 | ; (index unsigned-int)) |
2178 | |
2179 | ; ;(defun menu-attach-to-widget ...) |
2180 | |
2181 | ; (define-foreign menu-detach () nil |
2182 | ; (menu menu)) |
2183 | |
2184 | ; (define-foreign ("gtk_menu_get_attach_widget" menu-attach-widget) () widget |
2185 | ; (menu menu)) |
2186 | |
2187 | ; (define-foreign menu-reorder-child () nil |
2188 | ; (menu menu) |
2189 | ; (menu-item menu-item) |
2190 | ; (position int)) |
2191 | |
2192 | |
2193 | |
2194 | ;;; Packer |
2195 | |
2196 | ; (define-foreign packer-new () packer) |
2197 | |
2198 | ; (define-foreign packer-add |
2199 | ; (packer child side anchor |
2200 | ; &key |
2201 | ; options |
2202 | ; (border-width (packer-default-border-width packer)) |
2203 | ; (pad-x (packer-default-pad-x packer)) |
2204 | ; (pad-y (packer-default-pad-y packer)) |
2205 | ; (ipad-x (packer-default-ipad-x packer)) |
2206 | ; (ipad-y (packer-default-ipad-y packer))) nil |
2207 | ; (packer packer) |
2208 | ; (child widget) |
2209 | ; (side side-type) |
2210 | ; (anchor anchor-type) |
2211 | ; (options packer-options) |
2212 | ; (border-width unsigned-int) |
2213 | ; (pad-x unsigned-int) |
2214 | ; (pad-y unsigned-int) |
2215 | ; (ipad-x unsigned-int) |
2216 | ; (ipad-y unsigned-int)) |
2217 | |
2218 | ; (define-foreign packer-set-child-packing () nil |
2219 | ; (packer packer) |
2220 | ; (child widget) |
2221 | ; (side side-type) |
2222 | ; (anchor anchor-type) |
2223 | ; (options packer-options) |
2224 | ; (border-width unsigned-int) |
2225 | ; (pad-x unsigned-int) |
2226 | ; (pad-y unsigned-int) |
2227 | ; (ipad-x unsigned-int) |
2228 | ; (ipad-y unsigned-int)) |
2229 | |
2230 | ; (define-foreign packer-reorder-child () nil |
2231 | ; (packer packer) |
2232 | ; (child widget) |
2233 | ; (position int)) |
2234 | |
2235 | |
2236 | |
2237 | ; ;;; Table |
2238 | |
2239 | ; (define-foreign table-new () table |
2240 | ; (rows unsigned-int) |
2241 | ; (columns unsigned-int) |
2242 | ; (homogeneous boolean)) |
2243 | |
2244 | ; (define-foreign table-resize () nil |
2245 | ; (table table) |
2246 | ; (rows unsigned-int) |
2247 | ; (columns unsigned-int)) |
2248 | |
2249 | ; (define-foreign table-attach (table child left right top bottom |
2250 | ; &key (x-options '(:expand :fill)) |
2251 | ; (y-options '(:expand :fill)) |
2252 | ; (x-padding 0) (y-padding 0)) nil |
2253 | ; (table table) |
2254 | ; (child widget) |
2255 | ; (left unsigned-int) |
2256 | ; (right unsigned-int) |
2257 | ; (top unsigned-int) |
2258 | ; (bottom unsigned-int) |
2259 | ; (x-options attach-options) |
2260 | ; (y-options attach-options) |
2261 | ; (x-padding unsigned-int) |
2262 | ; (y-padding unsigned-int)) |
2263 | |
2264 | ; (define-foreign ("gtk_table_set_row_spacing" (setf table-row-spacing)) () nil |
2265 | ; (table table) |
2266 | ; (row unsigned-int) |
2267 | ; (spacing unsigned-int)) |
2268 | |
2269 | ; ;; cl-gtk.c |
2270 | ; (define-foreign table-row-spacing (table row) unsigned-int |
2271 | ; (table table) |
2272 | ; ((progn |
2273 | ; (assert (and (>= row 0) (< row (table-rows table)))) |
2274 | ; row) unsigned-int)) |
2275 | |
2276 | ; (define-foreign ("gtk_table_set_col_spacing" |
2277 | ; (setf table-column-spacing)) () nil |
2278 | ; (table table) |
2279 | ; (col unsigned-int) |
2280 | ; (spacing unsigned-int)) |
2281 | |
2282 | ; ;; cl-gtk.c |
2283 | ; (define-foreign table-column-spacing (table col) unsigned-int |
2284 | ; (table table) |
2285 | ; ((progn |
2286 | ; (assert (and (>= col 0) (< col (table-columns table)))) |
2287 | ; col) unsigned-int)) |
2288 | |
2289 | |
2290 | ; (defun %set-table-child-option (object slot flag value) |
2291 | ; (let ((options (container-child-slot-value object slot))) |
2292 | ; (cond |
2293 | ; ((and value (not (member flag options))) |
2294 | ; (setf (container-child-slot-value object slot) (cons flag options))) |
2295 | ; ((and (not value) (member flag options)) |
2296 | ; (setf |
2297 | ; (container-child-slot-value object slot) (delete flag options)))))) |
2298 | |
2299 | |
2300 | ; (macrolet ((define-option-accessor (name slot flag) |
2301 | ; `(progn |
2302 | ; (defun ,name (object) |
2303 | ; (member ,flag (container-child-slot-value object ,slot))) |
2304 | ; (defun (setf ,name) (value object) |
2305 | ; (%set-table-child-option object ,slot ,flag value))))) |
2306 | ; (define-option-accessor table-child-x-expand-p :x-options :expand) |
2307 | ; (define-option-accessor table-child-y-expand-p :y-options :expand) |
2308 | ; (define-option-accessor table-child-x-shrink-p :x-options :shrink) |
2309 | ; (define-option-accessor table-child-y-shrink-p :y-options :shrink) |
2310 | ; (define-option-accessor table-child-x-fill-p :x-options :fill) |
2311 | ; (define-option-accessor table-child-y-fill-p :y-options :fill)) |
2312 | |
2313 | |
2314 | |
2315 | ; ;;; Toolbar |
2316 | |
2317 | ; (define-foreign toolbar-new () toolbar |
2318 | ; (orientation orientation) |
2319 | ; (style toolbar-style)) |
2320 | |
2321 | |
2322 | ; ;; cl-gtk.c |
2323 | ; (define-foreign toolbar-num-children () int |
2324 | ; (toolbar toolbar)) |
2325 | |
2326 | ; (defun %toolbar-position-num (toolbar position) |
2327 | ; (case position |
2328 | ; (:prepend 0) |
2329 | ; (:append (toolbar-num-children toolbar)) |
2330 | ; (t |
2331 | ; (assert (and (>= position 0) (< position (toolbar-num-children toolbar)))) |
2332 | ; position))) |
2333 | |
2334 | ; (define-foreign %toolbar-insert-element () widget |
2335 | ; (toolbar toolbar) |
2336 | ; (type toolbar-child-type) |
2337 | ; (widget (or null widget)) |
2338 | ; (text string) |
2339 | ; (tooltip-text string) |
2340 | ; (tooltip-private-text string) |
2341 | ; (icon (or null widget)) |
2342 | ; (nil null) |
2343 | ; (nil null) |
2344 | ; (position int)) |
2345 | |
2346 | ; (defun toolbar-insert-element (toolbar position |
2347 | ; &key tooltip-text tooltip-private-text |
2348 | ; type widget icon text callback) |
2349 | ; (let* ((icon-widget (typecase icon |
2350 | ; ((or null widget) icon) |
2351 | ; (t (pixmap-new icon)))) |
2352 | ; (toolbar-child |
2353 | ; (%toolbar-insert-element |
2354 | ; toolbar (or type (and widget :widget) :button) |
2355 | ; widget text tooltip-text tooltip-private-text icon-widget |
2356 | ; (%toolbar-position-num toolbar position)))) |
2357 | ; (when callback |
2358 | ; (signal-connect toolbar-child 'clicked callback)) |
2359 | ; toolbar-child)) |
2360 | |
2361 | ; (defun toolbar-append-element (toolbar &key tooltip-text tooltip-private-text |
2362 | ; type widget icon text callback) |
2363 | ; (toolbar-insert-element |
2364 | ; toolbar :append :type type :widget widget :icon icon :text text |
2365 | ; :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text |
2366 | ; :callback callback)) |
2367 | |
2368 | ; (defun toolbar-prepend-element (toolbar &key tooltip-text tooltip-private-text |
2369 | ; type widget icon text callback) |
2370 | ; (toolbar-insert-element |
2371 | ; toolbar :prepend :type type :widget widget :icon icon :text text |
2372 | ; :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text |
2373 | ; :callback callback)) |
2374 | |
2375 | ; (defun toolbar-insert-space (toolbar position) |
2376 | ; (toolbar-insert-element toolbar position :type :space)) |
2377 | |
2378 | ; (defun toolbar-append-space (toolbar) |
2379 | ; (toolbar-insert-space toolbar :append)) |
2380 | |
2381 | ; (defun toolbar-prepend-space (toolbar) |
2382 | ; (toolbar-insert-space toolbar :prepend)) |
2383 | |
2384 | ; (defun toolbar-insert-widget (toolbar widget position &key tooltip-text |
2385 | ; tooltip-private-text callback) |
2386 | ; (toolbar-insert-element |
2387 | ; toolbar position :widget widget :tooltip-text tooltip-text |
2388 | ; :tooltip-private-text tooltip-private-text :callback callback)) |
2389 | |
2390 | ; (defun toolbar-append-widget (toolbar widget &key tooltip-text |
2391 | ; tooltip-private-text callback) |
2392 | ; (toolbar-insert-widget |
2393 | ; toolbar widget :append :tooltip-text tooltip-text |
2394 | ; :tooltip-private-text tooltip-private-text :callback callback)) |
2395 | |
2396 | ; (defun toolbar-prepend-widget (toolbar widget &key tooltip-text |
2397 | ; tooltip-private-text callback) |
2398 | ; (toolbar-insert-widget |
2399 | ; toolbar widget :prepend :tooltip-text tooltip-text |
2400 | ; :tooltip-private-text tooltip-private-text :callback callback)) |
2401 | |
2402 | ; (defun toolbar-insert-item (toolbar text icon position &key tooltip-text |
2403 | ; tooltip-private-text callback) |
2404 | ; (toolbar-insert-element |
2405 | ; toolbar position :text text :icon icon :callback callback |
2406 | ; :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text)) |
2407 | |
2408 | ; (defun toolbar-append-item (toolbar text icon &key tooltip-text |
2409 | ; tooltip-private-text callback) |
2410 | ; (toolbar-insert-item |
2411 | ; toolbar text icon :append :callback callback |
2412 | ; :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text)) |
2413 | |
2414 | |
2415 | ; (defun toolbar-prepend-item (toolbar text icon &key tooltip-text |
2416 | ; tooltip-private-text callback) |
2417 | ; (toolbar-insert-item |
2418 | ; toolbar text icon :prepend :callback callback |
2419 | ; :tooltip-text tooltip-text :tooltip-private-text tooltip-private-text)) |
2420 | |
2421 | ; (defun toolbar-enable-tooltips (toolbar) |
2422 | ; (setf (toolbar-tooltips-p toolbar) t)) |
2423 | |
2424 | ; (defun toolbar-disable-tooltips (toolbar) |
2425 | ; (setf (toolbar-tooltips-p toolbar) nil)) |
2426 | |
2427 | |
2428 | |
2429 | ;;; Tree |
2430 | |
2431 | (define-foreign tree-new () tree) |
2432 | |
2433 | (define-foreign tree-append () nil |
2434 | (tree tree) |
2435 | (tree-item tree-item)) |
2436 | |
2437 | (define-foreign tree-prepend () nil |
2438 | (tree tree) |
2439 | (tree-item tree-item)) |
2440 | |
2441 | (define-foreign tree-insert () nil |
2442 | (tree tree) |
2443 | (tree-item tree-item) |
2444 | (position int)) |
2445 | |
2446 | ; (define-foreign tree-remove-items () nil |
2447 | ; (tree tree) |
2448 | ; (items (double-list tree-item))) |
2449 | |
2450 | (define-foreign tree-clear-items () nil |
2451 | (tree tree) |
2452 | (start int) |
2453 | (end int)) |
2454 | |
2455 | (define-foreign tree-select-item () nil |
2456 | (tree tree) |
2457 | (item int)) |
2458 | |
2459 | (define-foreign tree-unselect-item () nil |
2460 | (tree tree) |
2461 | (item int)) |
2462 | |
2463 | (define-foreign tree-select-child () nil |
2464 | (tree tree) |
2465 | (tree-item tree-item)) |
2466 | |
2467 | (define-foreign tree-unselect-child () nil |
2468 | (tree tree) |
2469 | (tree-item tree-item)) |
2470 | |
2471 | (define-foreign tree-child-position () int |
2472 | (tree tree) |
2473 | (tree-item tree-item)) |
2474 | |
2475 | (defun root-tree-p (tree) |
2476 | (eq (tree-root-tree tree) tree)) |
2477 | |
2478 | ;; cl-gtk.c |
2479 | (define-foreign tree-selection () (double-list tree-item) |
2480 | (tree tree)) |
2481 | |
2482 | |
2483 | |
2484 | ;;; Calendar |
2485 | |
2486 | (define-foreign calendar-new () calendar) |
2487 | |
2488 | (define-foreign calendar-select-month () int |
2489 | (calendar calendar) |
2490 | (month unsigned-int) |
2491 | (year unsigned-int)) |
2492 | |
2493 | (define-foreign calendar-select-day () nil |
2494 | (calendar calendar) |
2495 | (day unsigned-int)) |
2496 | |
2497 | (define-foreign calendar-mark-day () int |
2498 | (calendar calendar) |
2499 | (day unsigned-int)) |
2500 | |
2501 | (define-foreign calendar-unmark-day () int |
2502 | (calendar calendar) |
2503 | (day unsigned-int)) |
2504 | |
2505 | (define-foreign calendar-clear-marks () nil |
2506 | (calendar calendar)) |
2507 | |
2508 | (define-foreign calendar-display-options () nil |
2509 | (calendar calendar) |
2510 | (options calendar-display-options)) |
2511 | |
2512 | (define-foreign ("gtk_calendar_get_date" calendar-date) () nil |
2513 | (calendar calendar) |
2514 | (year unsigned-int :out) |
2515 | (month unsigned-int :out) |
2516 | (day unsigned-int :out)) |
2517 | |
2518 | (define-foreign calendar-freeze () nil |
2519 | (calendar calendar)) |
2520 | |
2521 | (define-foreign calendar-thaw () nil |
2522 | (calendar calendar)) |
2523 | |
2524 | |
2525 | |
2526 | ;;; Drawing area |
2527 | |
2528 | ; (define-foreign drawing-area-new () drawing-area) |
2529 | |
2530 | ; (define-foreign ("gtk_drawing_area_size" %drawing-area-set-size) () nil |
2531 | ; (drawing-area drawing-area) |
2532 | ; (width int) |
2533 | ; (height int)) |
2534 | |
2535 | ; (defun (setf drawing-area-size) (size drawing-area) |
2536 | ; (%drawing-area-set-size drawing-area (svref size 0) (svref size 1)) |
2537 | ; (values (svref size 0) (svref size 1))) |
2538 | |
2539 | ; ;; cl-gtk.c |
2540 | ; (define-foreign ("gtk_drawing_area_get_size" drawing-area-size) () nil |
2541 | ; (drawing-area drawing-area) |
2542 | ; (width int :out) |
2543 | ; (height int :out)) |
2544 | |
2545 | |
2546 | |
2547 | ; ;;; Curve |
2548 | |
2549 | |
2550 | |
2551 | ; ;;; Editable |
2552 | |
2553 | ; (define-foreign editable-select-region () nil |
2554 | ; (editable editable) |
2555 | ; (start int) |
2556 | ; (end int)) |
2557 | |
2558 | ; (define-foreign editable-insert-text |
2559 | ; (editable text &optional (position 0)) nil |
2560 | ; (editable editable) |
2561 | ; (text string) |
2562 | ; ((length text) int) |
2563 | ; (position int)) |
2564 | |
2565 | ; (define-foreign editable-delete-text (editable &optional (start 0) end) nil |
2566 | ; (editable editable) |
2567 | ; (start int) |
2568 | ; ((or end -1) int)) |
2569 | |
2570 | ; (define-foreign ("gtk_editable_get_chars" editable-text) |
2571 | ; (editable &optional (start 0) end) string |
2572 | ; (editable editable) |
2573 | ; (start int) |
2574 | ; ((or end -1) int)) |
2575 | |
2576 | ; (defun (setf editable-text) (text editable) |
2577 | ; (editable-delete-text editable) |
2578 | ; (when text |
2579 | ; (editable-insert-text editable text)) |
2580 | ; text) |
2581 | |
2582 | ; (define-foreign editable-cut-clipboard () nil |
2583 | ; (editable editable)) |
2584 | |
2585 | ; (define-foreign editable-copy-clipboard () nil |
2586 | ; (editable editable)) |
2587 | |
2588 | ; (define-foreign editable-paste-clipboard () nil |
2589 | ; (editable editable)) |
2590 | |
2591 | ; (define-foreign editable-claim-selection () nil |
2592 | ; (editable editable) |
2593 | ; (claim boolean) |
2594 | ; (time unsigned-int)) |
2595 | |
2596 | ; (define-foreign editable-delete-selection () nil |
2597 | ; (editable editable)) |
2598 | |
2599 | ; (define-foreign editable-changed () nil |
2600 | ; (editable editable)) |
2601 | |
2602 | |
2603 | |
2604 | ; ;;; Entry |
2605 | |
2606 | ; (define-foreign %entry-new() entry) |
2607 | |
2608 | ; (define-foreign %entry-new-with-max-length () entry |
2609 | ; (max uint16)) |
2610 | |
2611 | ; (defun entry-new (&optional max) |
2612 | ; (if max |
2613 | ; (%entry-new-with-max-length max) |
2614 | ; (%entry-new))) |
2615 | |
2616 | ; (define-foreign entry-append-text () nil |
2617 | ; (entry entry) |
2618 | ; (text string)) |
2619 | |
2620 | ; (define-foreign entry-prepend-text () nil |
2621 | ; (entry entry) |
2622 | ; (text string)) |
2623 | |
2624 | ; (define-foreign entry-select-region () nil |
2625 | ; (entry entry) |
2626 | ; (start int) |
2627 | ; (end int)) |
2628 | |
2629 | |
2630 | |
2631 | ; ;;; Spin button |
2632 | |
2633 | ; (define-foreign spin-button-new () spin-button |
2634 | ; (adjustment adjustment) |
2635 | ; (climb-rate single-float) |
2636 | ; (digits unsigned-int)) |
2637 | |
2638 | ; (defun spin-button-value-as-int (spin-button) |
2639 | ; (round (spin-button-value spin-button))) |
2640 | |
2641 | ; (define-foreign spin-button-spin () nil |
2642 | ; (spin-button spin-button) |
2643 | ; (direction spin-type) |
2644 | ; (increment single-float)) |
2645 | |
2646 | ; (define-foreign spin-button-update () nil |
2647 | ; (spin-button spin-button)) |
2648 | |
2649 | |
2650 | |
2651 | ; ;;; Text |
2652 | |
2653 | ; (define-foreign text-new (&optional hadjustment vadjustment) text |
2654 | ; (hadjustment (or null adjustment)) |
2655 | ; (vadjustment (or null adjustment))) |
2656 | |
2657 | ; (define-foreign text-freeze () nil |
2658 | ; (text text)) |
2659 | |
2660 | ; (define-foreign text-thaw () nil |
2661 | ; (text text)) |
2662 | |
2663 | ; (define-foreign %text-insert () nil |
2664 | ; (text text) |
2665 | ; (font (or null gdk:font)) |
2666 | ; (fore (or null gdk:color)) |
2667 | ; (back (or null gdk:color)) |
2668 | ; (string string) |
2669 | ; (-1 int)) |
2670 | |
2671 | ; (defun text-insert (text string &key font foreground background (start 0) end) |
2672 | ; (let ((real-font (gdk:ensure-font font))) |
2673 | ; (gdk:with-colors ((fore-color foreground) |
2674 | ; (back-color background)) |
2675 | ; (%text-insert |
2676 | ; text real-font fore-color back-color (subseq string start end)) |
2677 | ; (gdk:font-maybe-unref real-font font)))) |
2678 | |
2679 | ; (define-foreign text-backward-delete () int |
2680 | ; (text text) |
2681 | ; (n-chars unsigned-int)) |
2682 | |
2683 | ; (define-foreign text-forward-delete () nil |
2684 | ; (text text) |
2685 | ; (nchars unsigned-int)) |
2686 | |
2687 | |
2688 | |
2689 | ; ;;; Ruler |
2690 | |
2691 | ; (define-foreign ruler-set-range () nil |
2692 | ; (ruler ruler) |
2693 | ; (lower single-float) |
2694 | ; (upper single-float) |
2695 | ; (position single-float) |
2696 | ; (max-size single-float)) |
2697 | |
2698 | ; (define-foreign ruler-draw-ticks () nil |
2699 | ; (ruler ruler)) |
2700 | |
2701 | ; (define-foreign ruler-draw-pos () nil |
2702 | ; (ruler ruler)) |
2703 | |
2704 | ; (define-foreign hruler-new () hruler) |
2705 | |
2706 | ; (define-foreign vruler-new () vruler) |
2707 | |
2708 | |
2709 | |
2710 | ; ;;; Range |
2711 | |
2712 | ; (define-foreign range-draw-background () nil |
2713 | ; (range range)) |
2714 | |
2715 | ; (define-foreign range-clear-background () nil |
2716 | ; (range range)) |
2717 | |
2718 | ; (define-foreign range-draw-trough () nil |
2719 | ; (range range)) |
2720 | |
2721 | ; (define-foreign range-draw-slider () nil |
2722 | ; (range range)) |
2723 | |
2724 | ; (define-foreign range-draw-step-forw () nil |
2725 | ; (range range)) |
2726 | |
2727 | ; (define-foreign range-slider-update () nil |
2728 | ; (range range)) |
2729 | |
2730 | ; (define-foreign range-trough-click () int |
2731 | ; (range range) |
2732 | ; (x int) |
2733 | ; (y int) |
2734 | ; (jump-perc single-float :out)) |
2735 | |
2736 | ; (define-foreign range-default-hslider-update () nil |
2737 | ; (range range)) |
2738 | |
2739 | ; (define-foreign range-default-vslider-update () nil |
2740 | ; (range range)) |
2741 | |
2742 | ; (define-foreign range-default-htrough-click () int |
2743 | ; (range range) |
2744 | ; (x int) |
2745 | ; (y int) |
2746 | ; (jump-perc single-float :out)) |
2747 | |
2748 | ; (define-foreign range-default-vtrough-click () int |
2749 | ; (range range) |
2750 | ; (x int) |
2751 | ; (y int) |
2752 | ; (jump-perc single-float :out)) |
2753 | |
2754 | ; (define-foreign range-default-hmotion () int |
2755 | ; (range range) |
2756 | ; (x-delta int) |
2757 | ; (y-delta int)) |
2758 | |
2759 | ; (define-foreign range-default-vmotion () int |
2760 | ; (range range) |
2761 | ; (x-delta int) |
2762 | ; (y-delta int)) |
2763 | |
2764 | |
2765 | |
2766 | ; ;;; Scale |
2767 | |
2768 | ; (define-foreign scale-draw-value () nil |
2769 | ; (scale scale)) |
2770 | |
2771 | ; (define-foreign hscale-new () hscale |
2772 | ; (adjustment adjustment)) |
2773 | |
2774 | ; (define-foreign vscale-new () hscale |
2775 | ; (adjustment adjustment)) |
2776 | |
2777 | |
2778 | |
2779 | ; ;;; Scrollbar |
2780 | |
2781 | ; (define-foreign hscrollbar-new () hscrollbar |
2782 | ; (adjustment adjustment)) |
2783 | |
2784 | ; (define-foreign vscrollbar-new () vscrollbar |
2785 | ; (adjustment adjustment)) |
2786 | |
2787 | |
2788 | |
2789 | ; ;;; Separator |
2790 | |
2791 | ; (define-foreign vseparator-new () vseparator) |
2792 | |
2793 | ; (define-foreign hseparator-new () hseparator) |
2794 | |
2795 | |
2796 | |
2797 | ; ;;; Preview |
2798 | |
2799 | |
2800 | |
2801 | ; ;;; Progress |
2802 | |
2803 | ; (define-foreign progress-configure () adjustment |
2804 | ; (progress progress) |
2805 | ; (value single-float) |
2806 | ; (min single-float) |
2807 | ; (max single-float)) |
2808 | |
2809 | ; (define-foreign ("gtk_progress_get_text_from_value" |
2810 | ; progress-text-from-value) () string |
2811 | ; (progress progress)) |
2812 | |
2813 | ; (define-foreign ("gtk_progress_get_percentage_from_value" |
2814 | ; progress-percentage-from-value) () single-float |
2815 | ; (progress progress)) |
2816 | |
2817 | |
2818 | |
2819 | ; ;;; Progress bar |
2820 | |
2821 | ; (define-foreign %progress-bar-new () progress-bar) |
2822 | |
2823 | ; (define-foreign %progress-bar-new-with-adjustment () progress-bar |
2824 | ; (adjustment adjustment)) |
2825 | |
2826 | ; (defun progress-bar-new (&optional adjustment) |
2827 | ; (if adjustment |
2828 | ; (%progress-bar-new-with-adjustment adjustment) |
2829 | ; (%progress-bar-new))) |
2830 | |
2831 | ; (define-foreign progress-bar-update () nil |
2832 | ; (progress-bar progress-bar) |
2833 | ; (percentage single-float)) |
2834 | |
2835 | |
2836 | |
2837 | ;;; Adjustment |
2838 | |
2839 | (define-foreign adjustment-new () adjustment |
2840 | (value single-float) |
2841 | (lower single-float) |
2842 | (upper single-float) |
2843 | (step-increment single-float) |
2844 | (page-increment single-float) |
2845 | (page-size single-float)) |
2846 | |
2847 | (define-foreign adjustment-changed () nil |
2848 | (adjustment adjustment)) |
2849 | |
2850 | (define-foreign adjustment-value-changed () nil |
2851 | (adjustment adjustment)) |
2852 | |
2853 | (define-foreign adjustment-clamp-page () nil |
2854 | (adjustment adjustment) |
2855 | (lower single-float) |
2856 | (upper single-float)) |
2857 | |
2858 | |
2859 | |
2860 | ;;; Tooltips |
2861 | |
2862 | ; (define-foreign tooltips-new () tooltips) |
2863 | |
2864 | ; (define-foreign tooltips-enable () nil |
2865 | ; (tooltips tooltips)) |
2866 | |
2867 | ; (define-foreign tooltips-disable () nil |
2868 | ; (tooltips tooltips)) |
2869 | |
2870 | ; (define-foreign tooltips-set-tip () nil |
2871 | ; (tooltips tooltips) |
2872 | ; (widget widget) |
2873 | ; (tip-text string) |
2874 | ; (tip-private string)) |
2875 | |
2876 | ; (declaim (inline tooltips-set-colors-real)) |
2877 | ; (define-foreign ("gtk_tooltips_set_colors" tooltips-set-colors-real) () nil |
2878 | ; (tooltips tooltips) |
2879 | ; (background gdk:color) |
2880 | ; (foreground gdk:color)) |
2881 | |
2882 | ; (defun tooltips-set-colors (tooltips background foreground) |
2883 | ; (gdk:with-colors ((background background) |
2884 | ; (foreground foreground)) |
2885 | ; (tooltips-set-colors-real tooltips background foreground))) |
2886 | |
2887 | ; (define-foreign tooltips-force-window () nil |
2888 | ; (tooltips tooltips)) |
2889 | |
2890 | |
2891 | |
2892 | |
2893 | ; ;;; Rc |
2894 | |
2895 | ; (define-foreign rc-add-default-file (filename) nil |
2896 | ; ((namestring (truename filename)) string)) |
2897 | |
2898 | ; (define-foreign rc-parse (filename) nil |
2899 | ; ((namestring (truename filename)) string)) |
2900 | |
2901 | ; (define-foreign rc-parse-string () nil |
2902 | ; (rc-string string)) |
2903 | |
2904 | ; (define-foreign rc-reparse-all () nil) |
2905 | |
2906 | ; ;(define-foreign rc-get-style () style |
2907 | ; ; (widget widget)) |
2908 | |
2909 | |
2910 | |
2911 | ;;; Accelerator Groups |
2912 | |
2913 | (define-foreign accel-group-new () accel-group) |
2914 | |
2915 | (define-foreign accel-group-get-default () accel-group) |
2916 | |
2917 | (define-foreign accel-group-ref () accel-group |
2918 | (accel-group accel-group)) |
2919 | |
2920 | (define-foreign accel-group-unref () nil |
2921 | (accel-group accel-group)) |
2922 | |
2923 | (define-foreign accel-group-activate (accel-group key modifiers) boolean |
2924 | (accel-group accel-group) |
2925 | ((gdk:keyval-from-name key) unsigned-int) |
2926 | (modifiers gdk:modifier-type)) |
2927 | |
2928 | (define-foreign accel-groups-activate (object key modifiers) boolean |
2929 | (object object) |
2930 | ((gdk:keyval-from-name key) unsigned-int) |
2931 | (modifiers gdk:modifier-type)) |
2932 | |
2933 | (define-foreign accel-group-attach () nil |
2934 | (accel-group accel-group) |
2935 | (object object)) |
2936 | |
2937 | (define-foreign accel-group-detach () nil |
2938 | (accel-group accel-group) |
2939 | (object object)) |
2940 | |
2941 | (define-foreign accel-group-lock () nil |
2942 | (accel-group accel-group)) |
2943 | |
2944 | (define-foreign accel-group-unlock () nil |
2945 | (accel-group accel-group)) |
2946 | |
2947 | |
2948 | ;;; Accelerator Groups Entries |
2949 | |
2950 | (define-foreign accel-group-get-entry (accel-group key modifiers) accel-entry |
2951 | (accel-group accel-group) |
2952 | ((gdk:keyval-from-name key) unsigned-int) |
2953 | (modifiers gdk:modifier-type)) |
2954 | |
2955 | (define-foreign accel-group-lock-entry (accel-group key modifiers) nil |
2956 | (accel-group accel-group) |
2957 | ((gdk:keyval-from-name key) unsigned-int) |
2958 | (modifiers gdk:modifier-type)) |
2959 | |
2960 | (define-foreign accel-group-unlock-entry (accel-group key modifiers) nil |
2961 | (accel-group accel-group) |
2962 | ((gdk:keyval-from-name key) unsigned-int) |
2963 | (modifiers gdk:modifier-type)) |
2964 | |
2965 | (define-foreign accel-group-add |
2966 | (accel-group key modifiers flags object signal) nil |
2967 | (accel-group accel-group) |
2968 | ((gdk:keyval-from-name key) unsigned-int) |
2969 | (modifiers gdk:modifier-type) |
2970 | (flags accel-flags) |
2971 | (object object) |
2972 | ((name-to-string signal) string)) |
2973 | |
2974 | (define-foreign accel-group-add (accel-group key modifiers object) nil |
2975 | (accel-group accel-group) |
2976 | ((gdk:keyval-from-name key) unsigned-int) |
2977 | (modifiers gdk:modifier-type) |
2978 | (object object)) |
2979 | |
2980 | |
2981 | ;;; Accelerator Signals |
2982 | |
2983 | (define-foreign accel-group-handle-add |
2984 | (object signal-id accel-group key modifiers flags) nil |
2985 | (object object) |
2986 | (signal-id unsigned-int) |
2987 | (accel-group accel-group) |
2988 | ((gdk:keyval-from-name key) unsigned-int) |
2989 | (modifiers gdk:modifier-type) |
2990 | (flags accel-flags)) |
2991 | |
2992 | (define-foreign accel-group-handle-remove |
2993 | (object accel-group key modifiers) nil |
2994 | (object object) |
2995 | (accel-group accel-group) |
2996 | ((gdk:keyval-from-name key) unsigned-int) |
2997 | (modifiers gdk:modifier-type)) |
2998 | |
2999 | |
3000 | |
3001 | ;;; Style |
3002 | |
3003 | ; (define-foreign style-new () style) |
3004 | |
3005 | ; (define-foreign style-copy () style |
3006 | ; (style style)) |
3007 | |
3008 | ; (define-foreign style-ref () style |
3009 | ; (style style)) |
3010 | |
3011 | ; (define-foreign style-unref () nil |
3012 | ; (style style)) |
3013 | |
3014 | ; (define-foreign style-get-color () gdk:color |
3015 | ; (style style) |
3016 | ; (color-type color-type) |
3017 | ; (state-type state-type)) |
3018 | |
3019 | ; (define-foreign |
3020 | ; ("gtk_style_set_color" style-set-color-from-color) () gdk:color |
3021 | ; (style style) |
3022 | ; (color-type color-type) |
3023 | ; (state-type state-type) |
3024 | ; (color gdk:color)) |
3025 | |
3026 | ; (defun style-set-color (style color-type state-type color) |
3027 | ; (gdk:with-colors ((color color)) |
3028 | ; (style-set-color-from-color style color-type state-type color))) |
3029 | |
3030 | ; (define-foreign ("gtk_style_get_font" style-font) () gdk:font |
3031 | ; (style style)) |
3032 | |
3033 | ; (define-foreign style-set-font () gdk:font |
3034 | ; (style style) |
3035 | ; (font gdk:font)) |
3036 | |
3037 | ; (defun (setf style-font) (font style) |
3038 | ; (let ((font (gdk:ensure-font font))) |
3039 | ; (gdk:font-unref (style-font style)) |
3040 | ; (style-set-font style font))) |
3041 | |
3042 | ; (defun style-fg (style state) |
3043 | ; (style-get-color style :foreground state)) |
3044 | |
3045 | ; (defun (setf style-fg) (color style state) |
3046 | ; (style-set-color style :foreground state color)) |
3047 | |
3048 | ; (defun style-bg (style state) |
3049 | ; (style-get-color style :background state)) |
3050 | |
3051 | ; (defun (setf style-bg) (color style state) |
3052 | ; (style-set-color style :background state color)) |
3053 | |
3054 | ; (defun style-text (style state) |
3055 | ; (style-get-color style :text state)) |
3056 | |
3057 | ; (defun (setf style-text) (color style state) |
3058 | ; (style-set-color style :text state color)) |
3059 | |
3060 | ; (defun style-base (style state) |
3061 | ; (style-get-color style :base state)) |
3062 | |
3063 | ; (defun (setf style-base) (color style state) |
3064 | ; (style-set-color style :base state color)) |
3065 | |
3066 | ; (defun style-white (style) |
3067 | ; (style-get-color style :white :normal)) |
3068 | |
3069 | ; (defun (setf style-white) (color style) |
3070 | ; (style-set-color style :white :normal color)) |
3071 | |
3072 | ; (defun style-black (style) |
3073 | ; (style-get-color style :black :normal)) |
3074 | |
3075 | ; (defun (setf style-black) (color style) |
3076 | ; (style-set-color style :black :normal color)) |
3077 | |
3078 | ; (define-foreign style-get-gc |
3079 | ; (style color-type &optional (state-type :normal)) gdk:gc |
3080 | ; (style style) |
3081 | ; (color-type color-type) |
3082 | ; (state-type state-type)) |
3083 | |
3084 | |
3085 | |
3086 | |
3087 | |
3088 | |
3089 | |
3090 | |