chiark - git - mdw - clg/blob - gtk/gtktypes.lisp

   1 ;; Common Lisp bindings for GTK+ v2.0.x
   2 ;; Copyright (C) 1999-2001 Espen S. Johnsen <esj@stud.cs.uit.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
  18 ;; $Id: gtktypes.lisp,v 1.7 2001-05-29 15:56:58 espen Exp $
  19
  20
  21 (in-package "GTK")
  22
  23 (defclass requisition (boxed)
  24   ((width
  25     :allocation :alien
  26     :accessor requisition-width
  27     :initarg :width
  28     :type int)
  29    (height
  30     :allocation :alien
  31     :accessor requisition-height
  32     :initarg :height
  33     :type int))
  34   (:metaclass boxed-class)
  35   (:alien-name "GtkRequisition"))
  36
  37 (defclass border (boxed)
  38   ((left
  39     :allocation :alien
  40     :accessor border-left
  41     :initarg :left
  42     :type int)
  43    (right
  44     :allocation :alien
  45     :accessor border-right
  46     :initarg :right
  47     :type int)
  48    (top
  49     :allocation :alien
  50     :accessor border-top
  51     :initarg :top
  52     :type int)
  53    (bottom
  54     :allocation :alien
  55     :accessor border-bottom
  56     :initarg :bottom
  57     :type int))
  58   (:metaclass boxed-class)
  59   (:alien-name "GtkBorder"))
  60
  61 (defclass adjustment (%object)
  62   ((lower
  63     :allocation :alien
  64     :accessor adjustment-lower
  65     :initarg :lower
  66     :type single-float)
  67    (upper
  68     :allocation :alien
  69     :accessor adjustment-upper
  70     :initarg :upper
  71     :type single-float)
  72    (value
  73     :allocation :alien
  74     :accessor adjustment-value
  75     :initarg :value
  76     :type single-float)
  77    (step-increment
  78     :allocation :alien
  79     :accessor adjustment-step-increment
  80     :initarg :step-increment
  81     :type single-float)
  82    (page-increment
  83     :allocation :alien
  84     :accessor adjustment-page-increment
  85     :initarg :page-increment
  86     :type single-float)
  87    (page-size
  88     :allocation :alien
  89     :accessor adjustment-page-size
  90     :initarg :page-size
  91     :type single-float))
  92   (:metaclass gobject-class)
  93   (:alien-name "GtkAdjustment"))
  94
  95
  96 (define-types-by-introspection "Gtk"
  97   ;; Manually defined
  98   ("GtkObject" :ignore t)
  99   ("GtkRequisition" :ignore t)
 100   ("GtkBorder" :ignore t)
 101   ("GtkAdjustment" :ignore t)
 102
 103   ;; Temporary disabled
 104   ("GtkCellRenderer" :ignore-prefix t)
 105
 106   ;; Manual override
 107
 108   ;; Not needed
 109   ("GtkFundamentalType" :ignore t)
 110   ("GtkArgFlags" :ignore t)
 111
 112   ;; Deprecated
 113   ("GtkCList" :ignore-prefix t)
 114   ("GtkCTree" :ignore-prefix t)
 115   ("GtkList" :ignore t)
 116   ("GtkTree" :ignore t)
 117   ("GtkTreeItem" :ignore t)
 118   ("GtkText" :ignore-prefix t)
 119   ("GtkPacker" :ignore-prefix t)
 120   ("GtkPixmap" :ignore t)
 121   ("GtkPreview" :ignore-prefix t)
 122   ("GtkTipsQuery" :ignore t)
 123   ("GtkOldEditable" :ignore t))
 124
 125
 126
 127 #|
 128 (deftype color-type ()
 129   '(enum
 130     :foreground
 131     :background
 132     :light
 133     :dark
 134     :mid
 135     :text
 136     :base
 137     :white
 138     :black))
 139
 140
 141 (defclass style (gobject)
 142   ((white
 143     :allocation :virtual
 144     :location style-white
 145     :initarg :white
 146     :type gdk:color)
 147    (black
 148     :allocation :virtual
 149     :location style-black
 150     :initarg :black
 151     :type gdk:color)
 152    (font
 153     :allocation :virtual
 154     :location ("gtk_style_get_font" "gtk_style_set_font")
 155     :accessor style-font
 156     :initarg :font
 157     :type gdk:font))
 158   (:metaclass gobject-class)
 159   (:alien-name "GtkStyle"))
 160
 161
 162 ;(deftype accel-entry () 'pointer) ; internal?
 163
 164
 165
 166 (defclass tooltips (%object)
 167   ((delay
 168     :allocation :virtual
 169     :location ("gtk_tooltips_get_delay" "gtk_tooltips_set_delay")
 170     :accessor tooltips-delay
 171     :type unsigned-int)
 172    (enabled
 173     :allocation :virtual
 174     :location ("gtk_tooltips_get_enabled" (setf tooltips-enabled-p))
 175     :reader tooltips-enabled-p
 176     :initarg :enabled
 177     :type boolean))
 178   (:metaclass object-class)
 179   (:alien-name "GtkTooltips"))
 180
 181
 182 (defclass widget (object)
 183   ((child-slots
 184     :allocation :instance
 185     :accessor widget-child-slots
 186     :type container-child)
 187    (state
 188     :allocation :virtual
 189     :location ("gtk_widget_get_state" "gtk_widget_set_state")
 190     :accessor widget-state
 191     :initarg :state
 192     :type state-type)
 193    (window
 194     :allocation :virtual
 195     :location "gtk_widget_get_window"
 196     :reader widget-window
 197     :type gdk:window)
 198    (colormap
 199     :allocation :virtual
 200     :location "gtk_widget_get_colormap"
 201     :reader widget-colormap
 202     :type gdk:colormap)
 203    (visual
 204     :allocation :virtual
 205     :location "gtk_widget_get_visual"
 206     :reader widget-visual
 207     :type gdk:visual))
 208   (:metaclass object-class)
 209   (:alien-name "GtkWidget"))
 210
 211
 212
 213 (defclass accel-label (label)
 214    (width
 215     :allocation :virtual
 216     :location "gtk_accel_label_get_accel_width"
 217     :reader width
 218     :type unsigned-int))
 219   (:metaclass widget-class)
 220   (:alien-name "GtkAccelLabel"))
 221
 222
 223 (defclass container (widget)
 224    (children
 225     :allocation :virtual
 226     :location container-children)
 227    (focus-child
 228     :allocation :virtual
 229     :location ("gtk_container_get_focus_child" "gtk_container_set_focus_child")
 230     :accessor container-focus-child
 231     :initarg :focus-child
 232     :type widget)
 233    (focus-hadjustment
 234     :allocation :virtual
 235     :location (nil "gtk_container_set_focus_hadjustment")
 236     :writer (setf container-focus-hadjustment)
 237     :initarg :focus-hadjustment
 238     :type adjustment)
 239    (focus-vadjustment
 240     :allocation :virtual
 241     :location (nil "gtk_container_set_focus_vadjustment")
 242     :writer (setf container-focus-vadjustment)
 243     :initarg :focus-vadjustment
 244     :type adjustment))
 245   (:metaclass widget-class)
 246   (:alien-name "GtkContainer"))
 247
 248
 249
 250 (defclass bin (container)
 251   ((child
 252     :allocation :virtual
 253     :location bin-child
 254     :type widget))
 255   (:metaclass container-class)
 256   (:alien-name "GtkBin"))
 257
 258
 259
 260 (defclass radio-button (check-button)
 261   ((group
 262     :allocation :virtual
 263     :location ("gtk_radio_button_group")
 264     :reader radio-button-group
 265     :type (static (gslist widget))))
 266   (:metaclass container-class)
 267   (:alien-name "GtkRadioButton"))
 268
 269 (defclass option-menu (button)
 270   ((menu
 271     :allocation :virtual
 272     :location ("gtk_option_menu_get_menu" (setf option-menu-menu))
 273     :reader option-menu-menu
 274     :initarg :menu
 275     :type widget)
 276    (history
 277     :allocation :virtual
 278     :location (nil "gtk_option_menu_set_history")
 279     :writer (setf option-menu-history)
 280     :initarg :history
 281     :type unsigned-int))
 282   (:metaclass container-class)
 283   (:alien-name "GtkOptionMenu"))
 284
 285 (defclass menu-item (item)
 286   ((label
 287     :allocation :virtual
 288     :location menu-item-label
 289     :initarg :label
 290     :type string)
 291    (submenu
 292     :allocation :virtual
 293     :location ("gtk_menu_item_get_submenu" (setf menu-item-submenu))
 294     :reader menu-item-submenu
 295     :initarg :submenu
 296     :type menu-item)
 297    (placement
 298     :allocation :virtual
 299     :location ("gtk_menu_item_get_placement" "gtk_menu_item_set_placement")
 300     :accessor menu-item-placement
 301     :initarg :placement
 302     :type submenu-placement)
 303    (toggle-indicator
 304     :allocation :virtual
 305     :location ("gtk_menu_item_get_show_toggle"
 306                (setf menu-item-toggle-indicator-p))
 307     :reader menu-item-toggle-indicator-p
 308     :initarg :toggle-indicator
 309     :type boolean)
 310    (submenu-indicator
 311     :allocation :virtual
 312     :location ("gtk_menu_item_get_show_submenu"
 313                (setf menu-item-submenu-indicator-p))
 314     :reader menu-item-submenu-indicator-p
 315     :initarg :submenu-indicator
 316     :type boolean))
 317   (:metaclass container-class)
 318   (:alien-name "GtkMenuItem"))
 319
 320
 321 (defclass radio-menu-item (check-menu-item)
 322   ((group
 323     :allocation :virtual
 324     :location ("gtk_radio_menu_item_group")
 325     :reader radio-menu-item-group
 326     :type (static (gslist widget))))
 327   (:metaclass container-class)
 328   (:alien-name "GtkRadioMenuItem"))
 329
 330
 331
 332 (defclass dialog (window)
 333   ((main-box
 334     :allocation :alien
 335     :reader dialog-main-box
 336     :type widget)
 337    (action-area
 338     :allocation :alien
 339     :reader dialog-action-area
 340     :type widget))
 341   (:metaclass container-class)
 342   (:alien-name "GtkDialog"))
 343
 344
 345 (defclass color-selection-dialog (dialog)
 346   ((colorsel
 347     :allocation :alien
 348     :reader color-selection-dialog-colorsel
 349     :type widget)
 350    (ok-button
 351     :allocation :alien
 352     :reader color-selection-dialog-ok-button
 353     :type widget)
 354    (cancel-button
 355     :allocation :alien
 356     :reader color-selection-dialog-cancel-button
 357     :type widget)
 358    (help-button
 359     :allocation :alien
 360     :reader color-selection-dialog-help-button
 361     :type widget))
 362   (:metaclass container-class)
 363   (:alien-name "GtkColorSelectionDialog"))
 364
 365
 366 (defclass file-selection (window)
 367   ((filename
 368     :allocation :virtual
 369     :location ("gtk_file_selection_get_filename"
 370                "gtk_file_selection_set_filename")
 371     :accessor file-selection-filename
 372     :initarg :filename
 373     :type string)
 374     (action-area
 375      :allocation :virtual
 376      :location "gtk_file_selection_get_action_area"
 377      :reader file-selection-action-area
 378      :type widget)
 379     (ok-button
 380      :allocation :virtual
 381      :location "gtk_file_selection_get_ok_button"
 382      :reader file-selection-ok-button
 383      :type widget)
 384     (cancel-button
 385      :allocation :virtual
 386      :location "gtk_file_selection_get_cancel_button"
 387      :reader file-selection-cancel-button
 388      :type widget))
 389   (:metaclass container-class)
 390   (:alien-name "GtkFileSelection"))
 391
 392
 393 (defclass scrolled-window (bin)
 394    (hscrollbar
 395     :allocation :virtual
 396     :location "gtk_scrolled_window_get_hscrollbar"
 397     :accessor scrolled-window-hscrollbar
 398     :type widget)
 399    (vscrollbar
 400     :allocation :virtual
 401     :location "gtk_scrolled_window_get_vscrollbar"
 402     :accessor scrolled-window-vscrollbar
 403     :type widget))
 404   (:metaclass container-class)
 405   (:alien-name "GtkScrolledWindow"))
 406
 407
 408 (defclass button-box (box)
 409   ((spacing
 410     :allocation :virtual
 411     :location ("gtk_button_box_get_spacing" "gtk_button_box_set_spacing")
 412     :accessor button-box-spacing
 413     :initarg :spacing
 414     :type int)
 415    (child-min-width
 416     :allocation :alien
 417     :offset #.(size-of 'int)
 418     :accessor button-box-child-min-width
 419     :initarg :child-min-width
 420     :type int)
 421    (child-min-height
 422     :allocation :alien
 423     :accessor button-box-child-min-height
 424     :initarg :child-min-height
 425     :type int)
 426    (child-ipad-x
 427     :allocation :alien
 428     :accessor button-box-child-ipad-x
 429     :initarg :child-ipad-x
 430     :type int)
 431    (child-ipad-y
 432     :allocation :alien
 433     :accessor button-box-child-ipad-y
 434     :initarg :child-ipad-y
 435     :type int)
 436    (layout
 437     :allocation :virtual
 438     :location ("gtk_button_box_get_layout" "gtk_button_box_set_layout")
 439     :accessor button-box-layout
 440     :initarg :layout
 441     :type button-box-style))
 442   (:metaclass container-class)
 443   (:alien-name "GtkButtonBox"))
 444
 445
 446
 447 (defclass color-selection (vbox)
 448   ((use-opacity
 449     :allocation :virtual
 450     :location ("gtk_color_selection_get_use_opacity"
 451                "gtk_color_selection_set_use_opacity")
 452     :accessor color-selection-use-opacity-p
 453     :initarg :use-opacity
 454     :type boolean)
 455    (use-palette
 456     :allocation :virtual
 457     :location ("gtk_color_selection_get_use_palette"
 458                "gtk_color_selection_set_use_palette")
 459     :accessor color-selection-use-palette-p
 460     :initarg :use-palette
 461     :type boolean)
 462    (color
 463     :allocation :virtual
 464     :location color-selection-color
 465     :initarg :color)
 466    (old-color
 467     :allocation :virtual
 468     :location color-selection-old-color
 469     :initarg :old-color
 470     :type (vector double-float 4)))
 471   (:metaclass container-class)
 472   (:alien-name "GtkColorSelection"))
 473
 474
 475
 476
 477 (defclass paned (container)
 478    (position
 479     :allocation :virtual
 480     :location ("gtk_paned_get_position" "gtk_paned_set_position")
 481     :accessor paned-position
 482     :initarg :position
 483     :type int)
 484    (child1
 485     :allocation :virtual
 486     :location paned-child1
 487     :initarg :child1
 488     :type widget)
 489    (child2
 490     :allocation :virtual
 491     :location paned-child2
 492     :initarg :child2
 493     :type widget))
 494   (:metaclass container-class)
 495   (:alien-name "GtkPaned"))
 496
 497
 498 (defclass layout (container)
 499   ((hadjustment
 500     :allocation :virtual
 501     :location ("gtk_layout_get_hadjustment" "gtk_layout_set_hadjustment")
 502     :accessor layout-hadjustment
 503     :initarg :hadjustment
 504     :type adjustment)
 505    (vadjustment
 506     :allocation :virtual
 507     :location ("gtk_layout_get_vadjustment" "gtk_layout_set_vadjustment")
 508     :accessor layout-vadjustment
 509     :initarg :vadjustment
 510     :type adjustment)
 511    (x-size
 512     :allocation :virtual
 513     :location layout-x-size
 514     :initarg :x-size)
 515    (y-size
 516     :allocation :virtual
 517     :location layout-y-size
 518     :initarg :y-size)
 519    (x-offset
 520     :allocation :alien
 521     :offset #.(+ (size-of 'pointer) (* (size-of 'int) 2))
 522     :accessor layout-x-offset
 523     :initarg :x-offset
 524     :type unsigned-int)
 525    (y-offset
 526     :allocation :alien
 527     :accessor layout-y-offset
 528     :initarg :y-offset
 529     :type unsigned-int))
 530   (:metaclass container-class)
 531   (:alien-name "GtkLayout"))
 532
 533
 534
 535 (defclass menu (menu-shell)
 536   ((accel-group
 537     :allocation :virtual
 538     :location ("gtk_menu_get_accel_group" "gtk_menu_set_accel_group")
 539     :accessor menu-accel-group
 540     :initarg :accel-group
 541     :type accel-group)
 542    (tornoff
 543     :allocation :virtual
 544     :location ("gtk_menu_get_tearoff_state" "gtk_menu_set_tearoff_state")
 545     :accessor menu-tornoff-p
 546     :initarg :tearoff
 547     :type boolean)
 548    (title
 549     :allocation :virtual
 550     :location ("gtk_menu_get_title" "gtk_menu_set_title")
 551     :accessor menu-title
 552     :initarg :title
 553     :type string))
 554   (:metaclass container-class)
 555   (:alien-name "GtkMenu"))
 556
 557
 558 (defclass table-child (container-child)
 559    (x-expand
 560     :allocation :virtual
 561     :location table-child-x-expand-p
 562     :initarg :x-expand
 563     :type boolean)
 564    (y-expand
 565     :allocation :virtual
 566     :location table-child-y-expand-p
 567     :initarg :y-expand
 568     :type boolean)
 569    (x-shrink
 570     :allocation :virtual
 571     :location table-child-x-shrink-p
 572     :initarg :x-shrink
 573     :type boolean)
 574    (y-shrink
 575     :allocation :virtual
 576     :location table-child-y-shrink-p
 577     :initarg :y-shrink
 578     :type boolean)
 579    (x-fill
 580     :allocation :virtual
 581     :location table-child-x-fill-p
 582     :initarg :x-fill
 583     :type boolean)
 584    (y-fill
 585     :allocation :virtual
 586     :location table-child-y-fill-p
 587     :initarg :y-fill
 588     :type boolean))
 589   (:metaclass child-class))
 590
 591
 592 (defclass toolbar (container)
 593    (tooltips
 594     :allocation :virtual
 595     :location ("gtk_toolbar_get_tooltips" "gtk_toolbar_set_tooltips")
 596     :accessor toolbar-tooltips-p
 597     :initarg :tooltips
 598     :type boolean))
 599   (:metaclass container-class)
 600   (:alien-name "GtkToolbar"))
 601
 602
 603
 604 (defclass combo (hbox)
 605   ((entry
 606     :allocation :virtual
 607     :location "gtk_combo_get_entry"
 608     :reader combo-entry
 609     :type entry))
 610   (:metaclass widget-class)
 611   (:alien-name "GtkCombo"))
 612
 613
 614 (defclass ruler (widget)
 615    (metric
 616     :allocation :virtual
 617     :location (nil "gtk_ruler_set_metric")
 618     :accessor ruler-metric
 619     :initarg :metric
 620     :type metric-type))
 621   (:metaclass widget-class)
 622   (:alien-name "GtkRuler"))
 623
 624 (defclass scale (range)
 625    (value-width
 626     :allocation :virtual
 627     :location "gtk_scale_get_value_width"
 628     :reader ruler-value-width
 629     :type int))
 630   (:metaclass widget-class)
 631   (:alien-name "GtkScale"))
 632
 633
 634
 635 (defclass progress (widget)
 636    (format-string
 637     :allocation :virtual
 638     :location ("gtk_progress_get_format_string"
 639                "gtk_progress_set_format_string")
 640     :accessor progress-format-string
 641     :initarg :format-string
 642     :type string)
 643    (adjustment
 644     :allocation :virtual
 645     :location ("gtk_progress_get_adjustment"
 646                "gtk_progress_set_adjustment")
 647     :accessor progress-adjustment
 648     :initarg :adjustment
 649     :type adjustment)
 650    (percentage
 651     :allocation :virtual
 652     :location ("gtk_progress_get_current_percentage"
 653                "gtk_progress_set_percentage")
 654     :accessor progress-percentage
 655     :initarg :percentage
 656     :type single-float)
 657    (value
 658     :allocation :virtual
 659     :location ("gtk_progress_get_value" "gtk_progress_set_value")
 660     :accessor progress-value
 661     :initarg :value
 662     :type single-float)
 663   (:metaclass widget-class)
 664   (:alien-name "GtkProgress"))
 665
 666
 667 (defclass progress-bar (progress)
 668    (activity-blocks ;; deprecated
 669     :allocation :param
 670     :accessor progress-bar-activity-blocks
 671     :initarg :activity-blocks
 672     :type unsigned-int)
 673   (:metaclass widget-class)
 674   (:alien-name "GtkProgressBar"))
 675
 676
 677 |#