X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/0aaa4dc1363647c8994afb722dfac10fabc21a08..4280ef98d488972c3c18fd9b727b58bfe04e6236:/gdk/gdk.lisp diff --git a/gdk/gdk.lisp b/gdk/gdk.lisp index d418022..8fffdb6 100644 --- a/gdk/gdk.lisp +++ b/gdk/gdk.lisp @@ -1,5 +1,5 @@ -;; Common Lisp bindings for GTK+ v1.2.x -;; Copyright (C) 1999 Espen S. Johnsen +;; Common Lisp bindings for GTK+ v2.0 +;; Copyright (C) 1999-2001 Espen S. Johnsen ;; ;; This library is free software; you can redistribute it and/or ;; modify it under the terms of the GNU Lesser General Public @@ -15,131 +15,89 @@ ;; License along with this library; if not, write to the Free Software ;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -;; $Id: gdk.lisp,v 1.5 2000-10-05 17:19:26 espen Exp $ +;; $Id: gdk.lisp,v 1.13 2005-01-30 15:08:03 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-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)) + +(defbinding display-get-default () 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-connection-number "clg_gdk_connection_number") + (&optional (display (display-get-default))) int + (display display)) + ;;; Events -; (defmethod initialize-instance ((event event) &rest initargs &key) -; (declare (ignore initargs)) -; (call-next-method) -; ) - -(defun find-event-class (event-type) - (find-class - (ecase event-type - (:delete 'delete-event) - (:destroy 'destroy-event) - (:expose 'expose-event) - (:motion-notify 'motion-notify-event) - (:button-press 'button-press-event) - (:2button-press '2-button-press-event) - (:3button-press '3-button-press-event) - (:button-release 'button-release-event) - (:key-press 'key-press-event) - (:key-release 'key-release-event) - (:enter-notify 'enter-notify-event) - (:leave-notify 'leave-notify-event) - (:focus-change 'focus-change-event) - (:configure 'configure-event) - (:map 'map-event) - (:unmap 'unmap-event) - (:property-notify 'property-notify-event) - (:selection-clear 'selection-clear-event) - (:selection-request 'selection-request-event) - (:selection-notify 'selection-notify-event) - (:proximity-in 'proximity-in-event) - (:proximity-out 'proximity-out-event) - (:drag-enter 'drag-enter-event) - (:drag-leave 'drag-leave-event) - (:drag-motion 'drag-motion-event) - (:drag-status 'drag-status-event) - (:drop-start 'drop-start-event) - (:drop-finished 'drop-finished-event) - (:client-event 'client-event-event) - (:visibility-notify 'visibility-notify-event) - (:no-expose 'no-expose-event) - (:scroll 'scroll-event)))) - - -(deftype-method alien-copier event (type-spec) - (declare (ignore type-spec)) - '%event-copy) - -(deftype-method alien-deallocator event (type-spec) - (declare (ignore type-spec)) - '%event-free) - -(deftype-method translate-from-alien - event (type-spec location &optional (alloc :reference)) - `(let ((location ,location)) - (unless (null-pointer-p location) - (let ((event-class - (find-event-class - (funcall (get-reader-function 'event-type) location 0)))) - ,(ecase alloc - (:copy '(ensure-alien-instance event-class location)) - (:static '(ensure-alien-instance event-class location :static t)) - (:reference '(ensure-alien-instance - event-class (%event-copy location)))))))) - - -(define-foreign event-poll-fd () int) - -(define-foreign ("gdk_events_pending" events-pending-p) () boolean) - -(define-foreign event-get () event) - -(define-foreign event-peek () event) - -(define-foreign event-get-graphics-expose () event - (window window)) +(defbinding (events-pending-p "gdk_events_pending") () boolean) -(define-foreign event-put () event - (event event)) +(defbinding event-get () event) -(define-foreign %event-copy (event &optional size) pointer - (event (or event pointer))) +(defbinding event-peek () event) -(define-foreign %event-free () nil - (event (or event pointer))) +(defbinding event-get-graphics-expose () event + (window window)) -(define-foreign event-get-time () (unsigned 32) +(defbinding event-put () event (event event)) -;(define-foreign event-handler-set () ...) +;(defbinding event-handler-set () ...) -(define-foreign set-show-events () nil +(defbinding set-show-events () nil (show-events boolean)) ;;; Misc -(define-foreign set-use-xshm () nil +(defbinding set-use-xshm () nil (use-xshm boolean)) -(define-foreign get-show-events () boolean) +(defbinding get-show-events () boolean) -(define-foreign get-use-xshm () boolean) +(defbinding get-use-xshm () boolean) -(define-foreign get-display () string) +(defbinding get-display () string) -; (define-foreign time-get () (unsigned 32)) +; (defbinding time-get () (unsigned 32)) -; (define-foreign timer-get () (unsigned 32)) +; (defbinding timer-get () (unsigned 32)) -; (define-foreign timer-set () nil +; (defbinding timer-set () nil ; (milliseconds (unsigned 32))) -; (define-foreign timer-enable () nil) +; (defbinding timer-enable () nil) -; (define-foreign timer-disable () nil) +; (defbinding timer-disable () nil) ; input ... -(define-foreign pointer-grab () int +(defbinding pointer-grab () int (window window) (owner-events boolean) (event-mask event-mask) @@ -147,52 +105,55 @@ (define-foreign pointer-grab () int (cursor (or null cursor)) (time (unsigned 32))) -(define-foreign pointer-ungrab () nil +(defbinding pointer-ungrab () nil (time (unsigned 32))) -(define-foreign keyboard-grab () int +(defbinding keyboard-grab () int (window window) (owner-events boolean) (time (unsigned 32))) -(define-foreign keyboard-ungrab () nil +(defbinding keyboard-ungrab () nil (time (unsigned 32))) -(define-foreign ("gdk_pointer_is_grabbed" pointer-is-grabbed-p) () boolean) +(defbinding (pointer-is-grabbed-p "gdk_pointer_is_grabbed") () boolean) -(define-foreign screen-width () int) -(define-foreign screen-height () int) +(defbinding screen-width () int) +(defbinding screen-height () int) -(define-foreign screen-width-mm () int) -(define-foreign screen-height-mm () int) +(defbinding screen-width-mm () int) +(defbinding screen-height-mm () int) -(define-foreign flush () nil) -(define-foreign beep () nil) +(defbinding flush () nil) +(defbinding beep () nil) -(define-foreign key-repeat-disable () nil) -(define-foreign key-repeat-restore () nil) +(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 -(define-foreign visual-get-best-depth () int) +(defbinding visual-get-best-depth () int) -(define-foreign visual-get-best-type () visual-type) +(defbinding visual-get-best-type () visual-type) -(define-foreign visual-get-system () visual) +(defbinding visual-get-system () visual) -(define-foreign - ("gdk_visual_get_best" %visual-get-best-with-nothing) () visual) +(defbinding (%visual-get-best-with-nothing "gdk_visual_get_best") () visual) -(define-foreign %visual-get-best-with-depth () visual +(defbinding %visual-get-best-with-depth () visual (depth int)) -(define-foreign %visual-get-best-with-type () visual +(defbinding %visual-get-best-with-type () visual (type visual-type)) -(define-foreign %visual-get-best-with-both () visual +(defbinding %visual-get-best-with-both () visual (depth int) (type visual-type)) @@ -203,142 +164,209 @@ (defun visual-get-best (&key depth type) (type (%visual-get-best-with-type type)) (t (%visual-get-best-with-nothing)))) -;(define-foreign query-depths ..) +;(defbinding query-depths ..) -;(define-foreign query-visual-types ..) +;(defbinding query-visual-types ..) -(define-foreign list-visuals () (glist visual)) +(defbinding list-visuals () (glist visual)) ;;; Windows -; (define-foreign window-new ... ) +(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)) -(define-foreign window-destroy () nil +(defbinding window-withdraw () nil (window window)) +(defbinding window-iconify () nil + (window window)) -; (define-foreign window-at-pointer () window -; (window window) -; (x int :in-out) -; (y int :in-out)) +(defbinding window-deiconify () nil + (window window)) -(define-foreign window-show () nil +(defbinding window-stick () nil (window window)) -(define-foreign window-hide () nil +(defbinding window-unstick () nil (window window)) -(define-foreign window-withdraw () nil +(defbinding window-maximize () nil (window window)) -(define-foreign window-move () nil +(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)) -(define-foreign window-resize () nil +(defbinding window-resize () nil (window window) (width int) (height int)) -(define-foreign window-move-resize () nil +(defbinding window-move-resize () nil (window window) (x int) (y int) (width int) (height int)) -(define-foreign window-reparent () nil +(defbinding window-scroll () nil + (window window) + (dx int) + (dy int)) + +(defbinding window-reparent () nil (window window) (new-parent window) (x int) (y int)) -(define-foreign window-clear () nil +(defbinding window-clear () nil (window window)) -(unexport - '(window-clear-area-no-e window-clear-area-e)) - -(define-foreign ("gdk_window_clear_area" window-clear-area-no-e) () nil +(defbinding %window-clear-area () nil (window window) (x int) (y int) (width int) (height int)) -(define-foreign window-clear-area-e () nil +(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-no-e window x y width height))) - -; (define-foreign window-copy-area () nil -; (window window) -; (gc gc) -; (x int) -; (y int) -; (source-window window) -; (source-x int) -; (source-y int) -; (width int) -; (height int)) - -(define-foreign window-raise () nil + (%window-clear-area-e window x y width height) + (%window-clear-area window x y width height))) + +(defbinding window-raise () nil (window window)) -(define-foreign window-lower () nil +(defbinding window-lower () nil (window window)) -; (define-foreign window-set-user-data () nil +(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)) + +;; komplett så langt -(define-foreign window-set-override-redirect () nil +(defbinding window-set-user-data () nil + (window window) + (user-data pointer)) + +(defbinding window-set-override-redirect () nil (window window) (override-redirect boolean)) -; (define-foreign window-add-filter () nil +; (defbinding window-add-filter () nil -; (define-foreign window-remove-filter () nil +; (defbinding window-remove-filter () nil -(define-foreign window-shape-combine-mask () nil +(defbinding window-shape-combine-mask () nil (window window) (shape-mask bitmap) (offset-x int) (offset-y int)) -(define-foreign window-set-child-shapes () nil +(defbinding window-set-child-shapes () nil (window window)) -(define-foreign window-merge-child-shapes () nil +(defbinding window-merge-child-shapes () nil (window window)) -(define-foreign ("gdk_window_is_visible" window-is-visible-p) () boolean - (window window)) -(define-foreign ("gdk_window_is_viewable" window-is-viewable-p) () boolean - (window window)) - -(define-foreign window-set-static-gravities () boolean +(defbinding window-set-static-gravities () boolean (window window) (use-static boolean)) -; (define-foreign add-client-message-filter ... +; (defbinding add-client-message-filter ... +(defbinding window-set-cursor () nil + (window window) + (cursor (or null cursor))) -;;; Drag and Drop +(defbinding window-get-pointer () window + (window window) + (x int :out) + (y int :out) + (mask modifier-type :out)) + +(defbinding %window-get-toplevels () (glist window)) + +(defun window-get-toplevels (&optional screen) + (if screen + (error "Not implemented") + (%window-get-toplevels))) -(define-foreign drag-context-new () drag-context) +(defbinding %get-default-root-window () window) -(define-foreign drag-context-ref () nil - (context drag-context)) +(defun get-root-window (&optional display) + (if display + (error "Not implemented") + (%get-default-root-window))) -(define-foreign drag-context-unref () nil - (context drag-context)) + + +;;; Drag and Drop ;; Destination side -(define-foreign drag-status () nil +(defbinding drag-status () nil (context drag-context) (action drag-action) (time (unsigned 32))) @@ -346,88 +374,74 @@ (define-foreign drag-status () nil -(define-foreign window-set-cursor () nil - (window window) - (cursor cursor)) - -(define-foreign window-get-pointer () window - (window window) - (x int :out) - (y int :out) - (mask modifier-type :out)) - -(define-foreign get-root-window () window) - ;; -(define-foreign rgb-init () nil) +(defbinding rgb-init () nil) ;;; Cursor -(deftype-method alien-ref cursor (type-spec) - (declare (ignore type-spec)) - '%cursor-ref) - -(deftype-method alien-unref cursor (type-spec) - (declare (ignore type-spec)) - '%cursor-unref) +(defmethod initialize-instance ((cursor cursor) &key type mask fg bg + (x 0) (y 0) (display (display-get-default))) + (setf + (slot-value cursor 'location) + (etypecase type + (keyword (%cursor-new-for-display display type)) + (pixbuf (%cursor-new-from-pixbuf display type x y)) + (pixmap (%cursor-new-from-pixmap type mask fg bg x y))))) -(define-foreign cursor-new () cursor +(defbinding %cursor-new-for-display () pointer + (display display) (cursor-type cursor-type)) -(define-foreign cursor-new-from-pixmap () cursor +(defbinding %cursor-new-from-pixmap () pointer (source pixmap) (mask bitmap) (foreground color) (background color) (x int) (y int)) -(define-foreign %cursor-ref () pointer - (cursor (or cursor pointer))) - -(define-foreign %cursor-unref () nil - (cursor (or cursor pointer))) - - +(defbinding %cursor-new-from-pixbuf () pointer + (display display) + (pixbuf pixbuf) + (x int) (y int)) -;;; Pixmaps +(defbinding %cursor-ref () pointer + (location pointer)) -;; See the class definition for an explanation of this -(deftype-method alien-ref bitmap (type-spec) - (declare (ignore type-spec)) - '%drawable-ref) +(defbinding %cursor-unref () nil + (location pointer)) -(deftype-method alien-unref bitmap (type-spec) - (declare (ignore type-spec)) - '%drawable-unref) +(defmethod reference-foreign ((class (eql (find-class 'cursor))) location) + (declare (ignore class)) + (%cursor-ref location)) -(define-foreign %drawable-ref () pointer - (object (or bitmap pointer))) +(defmethod unreference-foreign ((class (eql (find-class 'cursor))) location) + (declare (ignore class)) + (%cursor-unref location)) -(define-foreign %drawable-unref () nil - (object (or bitmap pointer))) +;;; Pixmaps -(define-foreign pixmap-new (width height depth &key window) pixmap +(defbinding pixmap-new (width height depth &key window) pixmap (width int) (height int) (depth int) (window (or null window))) -(define-foreign %pixmap-colormap-create-from-xpm () pixmap +(defbinding %pixmap-colormap-create-from-xpm () pixmap (window (or null window)) (colormap (or null colormap)) (mask bitmap :out) (color (or null color)) (filename string)) -(define-foreign %pixmap-colormap-create-from-xpm-d () pixmap +(defbinding %pixmap-colormap-create-from-xpm-d () pixmap (window (or null window)) (colormap (or null colormap)) (mask bitmap :out) @@ -446,10 +460,10 @@ (defun pixmap-create (source &key color window colormap) window colormap color (namestring (truename source)))) ((vector string) (%pixmap-colormap-create-from-xpm-d window colormap color source))) - (unreference-instance pixmap) - (unreference-instance mask) +;; (unreference-instance pixmap) +;; (unreference-instance mask) (values pixmap mask)))) - + ;;; Color @@ -469,7 +483,6 @@ (defmethod initialize-instance ((color color) &rest initargs %green (%scale-value green) %blue (%scale-value blue)))) - (defun ensure-color (color) (etypecase color (null nil) @@ -481,116 +494,177 @@ (defun ensure-color (color) -;;; Fonts - -(define-foreign font-load () font - (font-name string)) - -(defun ensure-font (font) - (etypecase font - (null nil) - (font font) - (string (font-load font)))) - -(define-foreign fontset-load () font - (fontset-name string)) - -(define-foreign font-ref () font - (font font)) - -(define-foreign font-unref () nil - (font font)) +;;; Drawable -(defun font-maybe-unref (font1 font2) - (unless (eq font1 font2) - (font-unref font1))) +(defbinding drawable-get-size () nil + (drawable drawable) + (width int :out) + (height int :out)) -(define-foreign font-id () int - (font font)) +(defbinding (drawable-width "gdk_drawable_get_size") () nil + (drawable drawable) + (width int :out) + (nil null)) -(define-foreign ("gdk_font_equal" font-equalp) () boolean - (font-a font) - (font-b font)) +(defbinding (drawable-height "gdk_drawable_get_size") () nil + (drawable drawable) + (nil null) + (height int :out)) -(define-foreign string-width () int - (font font) - (string string)) +;; (defbinding drawable-get-clip-region () region +;; (drawable drawable)) -(define-foreign text-width - (font text &aux (length (length text))) int - (font font) - (text string) - (length int)) - -; (define-foreign ("gdk_text_width_wc" text-width-wc) -; (font text &aux (length (length text))) int -; (font font) -; (text string) -; (length int)) - -(define-foreign char-width () int - (font font) - (char char)) - -; (define-foreign ("gdk_char_width_wc" char-width-wc) () int -; (font font) -; (char char)) - - -(define-foreign string-measure () int - (font font) - (string string)) - -(define-foreign text-measure - (font text &aux (length (length text))) int - (font font) - (text string) - (length int)) - -(define-foreign char-measure () int - (font font) - (char char)) - -(define-foreign string-height () int - (font font) - (string string)) - -(define-foreign text-height - (font text &aux (length (length text))) int - (font font) - (text string) - (length int)) - -(define-foreign char-height () int - (font font) - (char char)) +;; (defbinding drawable-get-visible-region () region +;; (drawable drawable)) +(defbinding draw-point () nil + (drawable drawable) (gc gc) + (x int) (y int)) -;;; Drawing functions +(defbinding %draw-points () nil + (drawable drawable) (gc gc) + (points pointer) + (n-points int)) -(define-foreign draw-rectangle () nil - (drawable (or window pixmap bitmap)) - (gc gc) (filled boolean) - (x int) (y int) (width int) (height int)) +;; (defun draw-points (drawable gc &rest points) + +;; ) + +(defbinding draw-line () nil + (drawable drawable) (gc gc) + (x1 int) (y1 int) + (x2 int) (y2 int)) + +;; (defbinding draw-lines (drawable gc &rest points) nil +;; (drawable drawable) (gc gc) +;; (points (vector point)) +;; ((length points) int)) + +(defbinding draw-pixbuf + (drawable gc pixbuf src-x src-y dest-x dest-y &optional + width height (dither :none) (x-dither 0) (y-dither 0)) nil + (drawable drawable) (gc (or null gc)) + (pixbuf pixbuf) + (src-x int) (src-y int) + (dest-x int) (dest-y int) + ((or width -1) int) ((or height -1) int) + (dither rgb-dither) + (x-dither int) (y-dither int)) + +;; (defbinding draw-segments (drawable gc &rest points) nil +;; (drawable drawable) (gc gc) +;; (segments (vector segments)) +;; ((length segments) int)) + +(defbinding draw-rectangle () nil + (drawable drawable) (gc gc) + (filled boolean) + (x int) (y int) + (width int) (height int)) + +(defbinding draw-arc () nil + (drawable drawable) (gc gc) + (filled boolean) + (x int) (y int) + (width int) (height int) + (angle1 int) (angle2 int)) + +;; (defbinding draw-polygon (drawable gc &rest points) nil +;; (drawable drawable) (gc gc) +;; (points (vector point)) +;; ((length points) int)) + +;; (defbinding draw-trapezoid (drawable gc &rest points) nil +;; (drawable drawable) (gc gc) +;; (points (vector point)) +;; ((length points) int)) + +;; (defbinding %draw-layout-line () nil +;; (drawable drawable) (gc gc) +;; (font pango:font) +;; (x int) (y int) +;; (line pango:layout-line)) + +;; (defbinding %draw-layout-line-with-colors () nil +;; (drawable drawable) (gc gc) +;; (font pango:font) +;; (x int) (y int) +;; (line pango:layout-line) +;; (foreground (or null color)) +;; (background (or null color))) + +;; (defun draw-layout-line (drawable gc font x y line &optional foreground background) +;; (if (or foreground background) +;; (%draw-layout-line-with-colors drawable gc font x y line foreground background) +;; (%draw-layout-line drawable gc font x y line))) + +(defbinding %draw-layout () nil + (drawable drawable) (gc gc) + (font pango:font) + (x int) (y int) + (layout pango:layout)) + +(defbinding %draw-layout-with-colors () nil + (drawable drawable) (gc gc) + (font pango:font) + (x int) (y int) + (layout pango:layout) + (foreground (or null color)) + (background (or null color))) + +(defun draw-layout (drawable gc font x y layout &optional foreground background) + (if (or foreground background) + (%draw-layout-with-colors drawable gc font x y layout foreground background) + (%draw-layout drawable gc font x y layout))) + +(defbinding draw-drawable + (drawable gc src src-x src-y dest-x dest-y &optional width height) nil + (drawable drawable) (gc gc) + (src drawable) + (src-x int) (src-y int) + (dest-x int) (dest-y int) + ((or width -1) int) ((or height -1) int)) + +(defbinding draw-image + (drawable gc image src-x src-y dest-x dest-y &optional width height) nil + (drawable drawable) (gc gc) + (image image) + (src-x int) (src-y int) + (dest-x int) (dest-y int) + ((or width -1) int) ((or height -1) int)) + +(defbinding drawable-get-image () image + (drawable drawable) + (x int) (y int) + (width int) (height int)) + +(defbinding drawable-copy-to-image + (drawable src-x src-y width height &optional image dest-x dest-y) image + (drawable drawable) + (image (or null image)) + (src-x int) (src-y int) + ((if image dest-x 0) int) + ((if image dest-y 0) int) + (width int) (height int)) ;;; Key values -(define-foreign keyval-name () string +(defbinding keyval-name () string (keyval unsigned-int)) -(define-foreign keyval-from-name () unsigned-int +(defbinding keyval-from-name () unsigned-int (name string)) -(define-foreign keyval-to-upper () unsigned-int +(defbinding keyval-to-upper () unsigned-int (keyval unsigned-int)) -(define-foreign keyval-to-lower ()unsigned-int +(defbinding keyval-to-lower () unsigned-int (keyval unsigned-int)) -(define-foreign ("gdk_keyval_is_upper" keyval-is-upper-p) () boolean +(defbinding (keyval-is-upper-p "gdk_keyval_is_upper") () boolean (keyval unsigned-int)) -(define-foreign ("gdk_keyval_is_lower" keyval-is-lower-p) () boolean +(defbinding (keyval-is-lower-p "gdk_keyval_is_lower") () boolean (keyval unsigned-int))