Change to COLOR-PARSE and some bug fixes

[clg] / gdk / gdk.lisp

;; Common Lisp bindings for GTK+ v2.x
;; Copyright 2000-2005 Espen S. Johnsen <espen@users.sf.net>
;;
;; Permission is hereby granted, free of charge, to any person obtaining
;; a copy of this software and associated documentation files (the
;; "Software"), to deal in the Software without restriction, including
;; without limitation the rights to use, copy, modify, merge, publish,
;; distribute, sublicense, and/or sell copies of the Software, and to
;; permit persons to whom the Software is furnished to do so, subject to
;; the following conditions:
;;
;; The above copyright notice and this permission notice shall be
;; included in all copies or substantial portions of the Software.
;;
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
;; IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
;; CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

;; $Id: gdk.lisp,v 1.25 2006/04/11 18:28:38 espen Exp $


(in-package "GDK")

;;; Initialization
 
(defbinding (gdk-init "gdk_parse_args") () nil
  "Initializes the library without opening the display."
  (nil null)
  (nil null))



;;; Display

(defbinding %display-open () display
  (display-name (or null string)))

(defun display-open (&optional display-name)
  (let ((display (%display-open display-name)))
    (unless (display-get-default)
      (display-set-default display))
    display))

(defbinding %display-get-n-screens () int
  (display display))

(defbinding %display-get-screen () screen
  (display display)
  (screen-num int))

(defun display-screens (&optional (display (display-get-default)))
  (loop
   for i from 0 below (%display-get-n-screens display)
   collect (%display-get-screen display i)))

(defbinding display-get-default-screen 
    (&optional (display (display-get-default))) screen
  (display display))

(defbinding display-beep (&optional (display (display-get-default))) nil
  (display display))

(defbinding display-sync (&optional (display (display-get-default))) nil
  (display display))

(defbinding display-flush (&optional (display (display-get-default))) nil
  (display display))

(defbinding display-close (&optional (display (display-get-default))) nil
  (display display))

(defbinding display-get-event
    (&optional (display (display-get-default))) event
  (display display))

(defbinding display-peek-event
    (&optional (display (display-get-default))) event
  (display display))

(defbinding display-put-event
    (event &optional (display (display-get-default))) event
  (display display)
  (event event))

(defbinding (display-connection-number "clg_gdk_connection_number")
    (&optional (display (display-get-default))) int
  (display display))



;;; Display manager

(defbinding display-get-default () display)

(defbinding (display-manager "gdk_display_manager_get") () display-manager)

(defbinding (display-set-default "gdk_display_manager_set_default_display")
    (display) nil
  ((display-manager) display-manager)
  (display display))



;;; Events

(defbinding (events-pending-p "gdk_events_pending") () boolean)

(defbinding event-get () event)

(defbinding event-peek () event)

(defbinding event-get-graphics-expose () event
  (window window))

(defbinding event-put () event
  (event event))

;(defbinding event-handler-set () ...)

(defbinding set-show-events () nil
  (show-events boolean))

(defbinding get-show-events () boolean)


;;; Miscellaneous functions

(defbinding screen-width () int)
(defbinding screen-height () int)

(defbinding screen-width-mm () int)
(defbinding screen-height-mm () int)

(defbinding pointer-grab 
    (window &key owner-events events confine-to cursor time) grab-status
  (window window)
  (owner-events boolean)
  (events event-mask)
  (confine-to (or null window))
  (cursor (or null cursor))
  ((or time 0) (unsigned 32)))

(defbinding (pointer-ungrab "gdk_display_pointer_ungrab")
    (&optional time (display (display-get-default))) nil
  (display display)
  ((or time 0) (unsigned 32)))

(defbinding (pointer-is-grabbed-p "gdk_display_pointer_is_grabbed") 
    (&optional (display (display-get-default))) boolean)

(defbinding keyboard-grab (window &key owner-events time) grab-status
  (window window)
  (owner-events boolean)
  ((or time 0) (unsigned 32)))

(defbinding (keyboard-ungrab "gdk_display_keyboard_ungrab")
    (&optional time (display (display-get-default))) nil
  (display display)
  ((or time 0) (unsigned 32)))



(defbinding atom-intern (atom-name &optional only-if-exists) atom
  ((string atom-name) string)
  (only-if-exists boolean))

(defbinding atom-name () string
  (atom atom))



;;; Visuals

(defbinding visual-get-best-depth () int)

(defbinding visual-get-best-type () visual-type)

(defbinding visual-get-system () visual)


(defbinding (%visual-get-best-with-nothing "gdk_visual_get_best") () visual)

(defbinding %visual-get-best-with-depth () visual
  (depth int))

(defbinding %visual-get-best-with-type () visual
  (type visual-type))

(defbinding %visual-get-best-with-both () visual
  (depth int)
  (type visual-type))

(defun visual-get-best (&key depth type)
  (cond
   ((and depth type) (%visual-get-best-with-both depth type))
   (depth (%visual-get-best-with-depth depth))
   (type (%visual-get-best-with-type type))
   (t (%visual-get-best-with-nothing))))

;(defbinding query-depths ..)

;(defbinding query-visual-types ..)

(defbinding list-visuals () (glist visual))


;;; Windows

(defbinding window-destroy () nil
  (window window))


(defbinding window-at-pointer () window
  (x int :out)
  (y int :out))

(defbinding window-show () nil
  (window window))

(defbinding window-show-unraised () nil
  (window window))

(defbinding window-hide () nil
  (window window))

(defbinding window-is-visible-p () boolean
  (window window))

(defbinding window-is-viewable-p () boolean
  (window window))

(defbinding window-withdraw () nil
  (window window))

(defbinding window-iconify () nil
  (window window))

(defbinding window-deiconify () nil
  (window window))

(defbinding window-stick () nil
  (window window))

(defbinding window-unstick () nil
  (window window))

(defbinding window-maximize () nil
  (window window))

(defbinding window-unmaximize () nil
  (window window))

(defbinding window-fullscreen () nil
  (window window))

(defbinding window-unfullscreen () nil
  (window window))

(defbinding window-set-keep-above () nil
  (window window)
  (setting boolean))

(defbinding window-set-keep-below () nil
  (window window)
  (setting boolean))

(defbinding window-move () nil
  (window window)
  (x int)
  (y int))

(defbinding window-resize () nil
  (window window)
  (width int)
  (height int))

(defbinding window-move-resize () nil
  (window window)
  (x int)
  (y int)
  (width int)
  (height int))

(defbinding window-scroll () nil
  (window window)
  (dx int)
  (dy int))

(defbinding window-reparent () nil
  (window window)
  (new-parent window)
  (x int)
  (y int))

(defbinding window-clear () nil
  (window window))

(defbinding %window-clear-area () nil
  (window window)
  (x int) (y int) (width int) (height int))

(defbinding %window-clear-area-e () nil
  (window window)
  (x int) (y int) (width int) (height int))

(defun window-clear-area (window x y width height &optional expose)
  (if expose
      (%window-clear-area-e window x y width height)
    (%window-clear-area window x y width height)))

(defbinding window-raise () nil
  (window window))

(defbinding window-lower () nil
  (window window))

(defbinding window-focus () nil
  (window window)
  (timestamp unsigned-int))

(defbinding window-register-dnd () nil
  (window window))

(defbinding window-begin-resize-drag () nil
  (window window)
  (edge window-edge)
  (button int)
  (root-x int)
  (root-y int)
  (timestamp unsigned-int))

(defbinding window-begin-move-drag () nil
  (window window)
  (button int)
  (root-x int)
  (root-y int)
  (timestamp unsigned-int))