[gtk-cffi-cvs] CVS gtk-cffi/gtk
CVS User rklochkov
rklochkov at common-lisp.net
Mon Feb 20 16:51:37 UTC 2012
Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk
In directory tiger.common-lisp.net:/tmp/cvs-serv21507/gtk
Modified Files:
dialog.lisp gtk-cffi.asd loadlib.lisp message-dialog.lisp
package.lisp text-view.lisp tree-selection.lisp widget.lisp
window.lisp
Log Message:
Finished GtkWindow
Made global clean-up. Now it compiles all from scratch with asdf:compile-op
Add version-dependent functions (for ex. "since gtk 3.2")
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/dialog.lisp 2012/02/12 17:29:42 1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/dialog.lisp 2012/02/20 16:51:37 1.4
@@ -1,3 +1,9 @@
+;;;
+;;; dialog.lisp -- GtkDialog
+;;;
+;;; Copyright (C) 2007, Roman Klochkov <kalimehtar at mail.ru>
+;;;
+
(in-package :gtk-cffi)
(defclass dialog (window)
@@ -105,9 +111,9 @@
(defmethod (setf alternative-button-order) (order (dialog dialog))
(let ((n-params (length order)))
(with-foreign-object (arr :int n-params)
- (loop
- :for i :from 0 :to n-params
- :for l :in order
- :do (setf (mem-aref arr :int i) l))
+ (iter
+ (for i to n-params)
+ (for l in order)
+ (setf (mem-aref arr :int i) l))
(gtk-dialog-set-alternative-button-order-from-array dialog
n-params arr))))
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/02/13 02:56:32 1.13
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/02/20 16:51:37 1.14
@@ -34,7 +34,8 @@
:license "LLGPL"
:depends-on (gtk-cffi-core)
:components
- ((:file widget)))
+ ((:file widget)
+ (:file invisible :depends-on (widget))))
(defsystem gtk-cffi-misc
:description "Interface to GTK/Glib via CFFI"
@@ -77,7 +78,7 @@
(defsystem gtk-cffi-window
:description "Interface to GTK/Glib via CFFI"
:author "Roman Klochkov <kalimehtar at mail.ru>"
- :version "0.1"
+ :version "0.99"
:license "LLGPL"
:depends-on (gtk-cffi-bin)
:components
@@ -323,7 +324,7 @@
(defsystem gtk-cffi-message-dialog
:description "Interface to GTK/Glib via CFFI"
:author "Roman Klochkov <kalimehtar at mail.ru>"
- :version "0.1"
+ :version "0.99"
:license "LLGPL"
:depends-on (gtk-cffi-dialog)
:components
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/loadlib.lisp 2012/01/27 18:41:31 1.4
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/loadlib.lisp 2012/02/20 16:51:37 1.5
@@ -17,12 +17,26 @@
;; (t value)))
-;(eval-when (:compile-toplevel :load-toplevel :execute)
-(define-foreign-library :gtk
- (:unix "libgtk-3.so.0") ;libgtk-x11-2.0.so")
- (:windows "libgtk-win32-3-0.dll"))
-
-(use-foreign-library :gtk)
+(eval-when (:compile-toplevel :load-toplevel)
+ (unless (find :gtk *features*)
+ (push :gtk *features*)
+ (define-foreign-library :gtk
+ (:unix "libgtk-3.so.0") ;libgtk-x11-2.0.so")
+ (:windows "libgtk-win32-3-0.dll"))
+
+ (use-foreign-library :gtk)))
+(eval-when (:compile-toplevel)
+ (defcfun ("gtk_init" %gtk-init) :void (argc :pointer) (argv :pointer))
+ #+sbcl (sb-ext::set-floating-point-modes :traps nil)
+ (with-foreign-objects ((argc :int) (argv :pointer))
+ (setf (mem-ref argc :int) 0
+ (mem-ref argv :pointer) (foreign-alloc :string
+ :initial-element "program"))
+ (%gtk-init argc argv))
+ (defcfun gtk-get-major-version :uint)
+ (defcfun gtk-get-minor-version :uint)
+ (when (and (>= (gtk-get-major-version) 3) (>= (gtk-get-minor-version) 2))
+ (push :gtk3.2 *features*)))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/message-dialog.lisp 2012/02/12 17:29:42 1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/message-dialog.lisp 2012/02/20 16:51:37 1.3
@@ -9,11 +9,11 @@
(defcenum message-type
:info :warning :question :error :other)
-(defcfun "gtk_message_dialog_new" :pointer (parent pobject)
+(defcfun gtk-message-dialog-new :pointer (parent pobject)
(flags dialog-flags) (type message-type) (buttons buttons-type)
(message :string) (null :pointer))
-(defcfun "gtk_message_dialog_new_with_markup" :pointer (parent pobject)
+(defcfun gtk-message-dialog-new-with-markup :pointer (parent pobject)
(flags dialog-flags) (type message-type) (buttons buttons-type)
(message :string) (null :pointer))
@@ -32,3 +32,10 @@
:message message
:type type :buttons buttons :markup markup)
:keep-alive nil))
+
+(defslot message-dialog image pobject)
+(deffuns message-dialog
+ (:set markup :string)
+ (:get message-area pobject)
+ (format-secondary-text :void (message :string))
+ (format-secondary-markup :void (message :string)))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/02/12 17:29:42 1.13
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/02/20 16:51:37 1.14
@@ -170,6 +170,8 @@
#:find-style-property
#:style-property
+ #:invisible
+
#:bin
;; methods
#:child
@@ -187,7 +189,70 @@
#:screen
#:transient-for
#:window-position
+ #:title
+ #:role
+ #:resizable
+ #:modal
+ #:gravity
+ #:destroy-with-parent
+ #:focus
+ #:decorated
+ #:deletable
+ #:mnemonic-modifier
+ #:type-hint
+ #:skip-taskbar-hint
+ #:skip-pager-hint
+ #:urgency-hint
+ #:accept-focus
+ #:focus-on-map
+ #:startup-id
+ #:default-icon-list
+ #:default-icon-name
+ #:icon
+ #:icon-list
+ #:icon-name
+ #:group
+ #:opacity
+ #:mnemonics-visible
+ #:focus-visible
+ #:has-resize-grip
+ #:application
+ #:window-size
;; methods
+ #:position-type
+ #:add-accel-group
+ #:remove-accel-group
+ #:activate-focus
+ #:activate-default
+ #:set-geometry-hints
+ #:is-active
+ #:has-toplevel-focus
+ #:list-toplevels
+ #:add-mnemonic
+ #:remove-mnemonic
+ #:mnemonic-activate
+ #:activate-key
+ #:propagate-key-event
+ #:default-widget
+ #:present
+ #:present-with-time
+ #:iconify
+ #:deiconify
+ #:stick
+ #:unstick
+ #:maximize
+ #:unmaximize
+ #:fullscreen
+ #:unfullscreen
+ #:keep-above
+ #:keep-below
+ #:begin-resize-drag
+ #:begin-move-drag
+ #:window-type
+ #:parse-geometry
+ #:reshow-with-initial-size
+ #:auto-startup-notification
+ #:resize-grip-is-visible
#:dialog
;;methods
@@ -553,6 +618,11 @@
#:active-text
#:message-dialog
+ #:markup
+ #:image
+ #:message-area
+ #:format-secondary-text
+ #:format-secondary-markup
;; handy defun
#:show-message
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-view.lisp 2011/09/18 18:10:48 1.4
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-view.lisp 2012/02/20 16:51:37 1.5
@@ -46,7 +46,7 @@
(move-mark-onscreen :boolean (text-mark pobject))
(place-cursor-onscreen :boolean)
((text-view-window . get-window) pobject (win text-window-type))
- (:get window-type text-window-type (window pobject))
+ (:get window-type text-window-type &key (window pobject))
(:get border-window-size :int (type text-window-type))
(:set-last border-window-size :int (type text-window-type))
(forward-display-line :boolean (text-iter pobject))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-selection.lisp 2011/04/25 19:16:08 1.1.1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/tree-selection.lisp 2012/02/20 16:51:37 1.2
@@ -24,10 +24,10 @@
((model :pointer) (path :pointer) (iter :pointer) (data :pointer))
(when *tree-selection-foreach*
(funcall *tree-selection-foreach*
- (object model)
+ (find-object model)
(make-instance 'tree-path :pointer path)
(make-instance 'tree-iter :pointer iter)
- (object data))))
+ (find-object data))))
(defmethod tree-selection-foreach ((tree-selection tree-selection)
func &optional (data (null-pointer)))
@@ -57,7 +57,7 @@
(when (gtk-tree-selection-get-selected
(pointer tree-selection)
model-ptr (pointer iter))
- (list (object (mem-ref model-ptr :pointer))
+ (list (find-object (mem-ref model-ptr :pointer))
iter))))))
(defmacro with-selection (selection tree-selection &body body)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/widget.lisp 2012/02/12 17:29:42 1.9
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/widget.lisp 2012/02/20 16:51:37 1.10
@@ -1,6 +1,6 @@
;;;; -*- Mode: lisp; indent-tabs-mode: nil -*-
;;;
-;;; widget.asd --- Wrapper for GtkWidget
+;;; widget.lisp --- Wrapper for GtkWidget
;;;
;;; Copyright (C) 2007, Roman Klochkov <kalimehtar at mail.ru>
;;;
@@ -204,7 +204,7 @@
(:get pango-context pobject)
(create-pango-layout pobject)
(:set redraw-on-allocate :boolean)
- (mnemonic-activate :boolean (group-cycling :boolean))
+ (mnemonic-activate :boolean &key (group-cycling :boolean))
(unparent :void)
((widget-map . map) :void)
(unmap :void)
@@ -246,20 +246,6 @@
(setf (documentation 'clipboard 'function)
"SELECTION should be :PRIMARY or :CLIPOARD")
-;; (defcfun gtk-widget-set-device-events :void
-;; (widget pobject) (device pobject) (events event-mask))
-
-;; (defgeneric (setf device-events) (events widget device))
-;; (defmethod (setf device-events) (events (widget widget) device)
-;; (gtk-widget-set-device-events widget device events))
-
-;; (defcfun gtk-widget-set-device-enabled :void
-;; (widget pobject) (device pobject) (enabled :boolean))
-
-;; (defgeneric (setf device-enabled) (enable widget device))
-;; (defmethod (setf device-enabled) (enabled (widget widget) device)
-;; (gtk-widget-set-device-enabled widget device enabled))
-
(defcfun ("gtk_widget_pop_composite_child" pop-composite-child) :void)
(defcfun ("gtk_widget_push_composite_child" push-composite-child) :void)
@@ -394,24 +380,22 @@
(gtk-distribute-natural-allocation extra-space length sizes-struct))))
-(init-slots widget nil)
+(init-slots widget)
-(template
- ((color t)
- (font nil)
- (bg-pixmap nil))
- (destructuring-bind (name with-type) param
- `(progn
- (defmethod ,name ((widget widget)
- &key ,@(when with-type '(type)) (state :normal))
- (,name (style-context widget) ,@(when with-type '(:type type))
- :state state))
+(template (name with-type) ((color t)
+ (font nil)
+ (bg-pixmap nil))
+ `(progn
+ (defmethod ,name ((widget widget)
+ &key ,@(when with-type '(type)) (state :normal))
+ (,name (style-context widget) ,@(when with-type '(:type type))
+ :state state))
- (defmethod (setf ,name) (value (widget widget)
- &key ,@(when with-type '(type)) (state :normal))
- (setf (,name (style-context widget) ,@(when with-type '(:type type))
- :state state)
- value)))))
+ (defmethod (setf ,name) (value (widget widget)
+ &key ,@(when with-type '(type)) (state :normal))
+ (setf (,name (style-context widget) ,@(when with-type '(:type type))
+ :state state)
+ value))))
(defclass widget-class (g-object-class)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/window.lisp 2012/02/12 17:29:42 1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/window.lisp 2012/02/20 16:51:37 1.4
@@ -1,3 +1,13 @@
+;;;
+;;; window.lisp --- GtkWindow
+;;;
+;;; Copyright (C) 2007, Roman Klochkov <kalimehtar at mail.ru>
+;;;
+;;; Some conventions
+;;; gtk_window_set_position -> (setf (position-type ...))
+;;; gtk_window_get_position/gtk_window_move -> window-position (setf'able)
+;;; gtk_window_get_default_widget/gtk_window_set_default -> default-widget
+
(in-package :gtk-cffi)
(defcenum window-type
@@ -6,33 +16,63 @@
(defclass window (bin)
())
+(defcfun gtk-window-new :pointer (type window-type))
+
(defmethod gconstructor ((window window)
&key (type :top-level) &allow-other-keys)
(gtk-window-new type))
-(defgtkslots window
- title :string
- screen pobject
- transient-for pobject)
+(defslots window
+ title :string
+ role :string
+ resizable :boolean
+ modal :boolean
+ gravity gravity
+ transient-for pobject
+ destroy-with-parent :boolean
+ focus pobject
+ decorated :boolean
+ deletable :boolean
+ mnemonic-modifier modifier-type
+ type-hint window-type-hint
+ skip-taskbar-hint :boolean
+ skip-pager-hint :boolean
+ urgency-hint :boolean
+ accept-focus :boolean
+ focus-on-map :boolean
+ default-icon-list g-list-object
+ default-icon-name :string
+ icon pobject
+ icon-list g-list-object
+ icon-name :string
+ opacity :double
+ mnemonics-visible :boolean
+ #+gtk3.2 focus-visible #+gtk3.2 :boolean
+ has-resize-grip :boolean
+ application pobject
+ screen pobject)
-(defcfun "gtk_window_new" :pointer (type window-type))
-
-(defcfun "gtk_window_set_default_size"
+(defcfun gtk-window-set-default-size
:void (window pobject) (w :int) (h :int))
-(defcfun "gtk_window_get_default_size"
+(defcfun gtk-window-get-default-size
:void (window pobject) (w :pointer) (h :pointer))
-(defmethod (setf default-size) (coords (window window))
- (let ((width (first coords))
- (height (second coords)))
- (gtk-window-set-default-size window (round width) (round height))))
-
-(defmethod default-size ((window window))
- (with-foreign-objects
- ((width :int) (height :int))
- (gtk-window-get-default-size window width height)
- (list (mem-ref width :int) (mem-ref height :int))))
+(defcfun gtk-window-set-default-geometry
+ :void (window pobject) (w :int) (h :int))
+
+(defgeneric (setf default-size) (coords window &key geometry &allow-other-keys)
+ (:method (coords (window window) &key geometry &allow-other-keys)
+ (destructuring-bind (width height) coords
+ (if geometry
+ (gtk-window-set-default-geometry window (round width) (round height))
+ (gtk-window-set-default-size window (round width) (round height))))))
+
+(defgeneric default-size (window)
+ (:method ((window window))
+ (with-foreign-outs-list ((width :int) (height :int)) :ignore
+ (gtk-window-get-default-size window width height))))
+
(defcenum position
:none
@@ -41,13 +81,98 @@
:center-always
:center-on-parent)
-(defcfun "gtk_window_set_position" :void (window pobject) (pos position))
-
-(defmethod (setf window-position) (pos (window window))
- (gtk-window-set-position window pos))
+(deffuns window
+ (:set (position-type . position) position)
+ (add-accel-group :void (accel-group pobject))
+ (remove-accel-group :void (accel-group pobject))
+ (activate-focus :boolean)
+ (activate-default :boolean)
+ (set-geometry-hints :void (widget pobject) (geometry (struct geometry))
+ (mask window-hints))
+ (is-active :boolean)
+ (has-toplevel-focus :boolean)
+ (list-toplevels (g-list :free :none))
+ (add-mnemonic :void (keyval key) (target pobject))
+ (remove-mnemonic :void (keyval key) (target pobject))
+ (mnemonic-activate :boolean &key (keyval key) (modifier modifier-type))
+ (activate-key :boolean (event event))
+ (propagate-key-event :boolean (event event))
+ (:get default-widget pobject)
+ (:set (default-widget . default) pobject)
+ (present :void)
+ (present-with-time :void (timestamp :uint32))
+ (iconify :void)
+ (deiconify :void)
+ (stick :void)
+ (unstick :void)
+ (maximize :void)
+ (unmaximize :void)
+ (fullscreen :void)
+ (unfullscreen :void)
+ (:set keep-above :boolean)
+ (:set keep-below :boolean)
+ (begin-resize-drag :void (edge window-edge) (button :int) (root-x :int)
+ (root-y :int) (timestamp :uint32))
+ (begin-move-drag :void (button :int) (root-x :int)
+ (root-y :int) (timestamp :uint32))
+ (:get window-type window-type &key)
+ (parse-geometry :boolean (geometry :string))
+ (reshow-with-initial-size :void)
+ (:set auto-startup-notification :boolean)
+ (resize-grip-is-visible :boolean)
+ (:get group pobject)
+ (has-group :boolean)
+ (:set startup-id :string))
+
+(defcfun gtk-window-get-resize-grip-area :boolean
+ (window pobject) (rect (struct rectangle :out t)))
+
+(defgeneric resize-grip-area (window)
+ (:method ((window window))
+ (let ((dest (make-instance 'rectangle)))
+ (when (gtk-window-get-resize-grip-area window dest)
+ dest))))
+
+(defcfun gtk-window-get-position :void (window pobject)
+ (x :pointer) (y :pointer))
+
+(defgeneric window-position (window)
+ (:method ((window window))
+ (with-foreign-outs-list ((x :int) (y :int)) :ignore
+ (gtk-window-get-position window x y))))
+
+(defcfun gtk-window-move :void (window pobject) (x :int) (y :int))
+
+(defgeneric (setf window-position) (coords window)
+ (:method (coords (window window))
+ (destructuring-bind (x y) coords
+ (gtk-window-move window x y))))
+
+(defcfun gtk-window-get-size :void (window pobject)
+ (width :pointer) (height :pointer))
+
+(defcfun gtk-window-resize :void (window pobject)
+ (width :int) (height :int))
+
+(defcfun gtk-window-resize-to-geometry :void (window pobject)
+ (width :int) (height :int))
+
+(defgeneric (setf window-size) (coords window &key geometry &allow-other-keys)
+ (:method (coords (window window) &key geometry &allow-other-keys)
+ (destructuring-bind (width height) coords
+ (if geometry
+ (gtk-window-resize-to-geometry window (round width) (round height))
+ (gtk-window-resize window (round width) (round height))))))
+
+(defgeneric window-size (window)
+ (:method ((window window))
+ (with-foreign-outs-list ((width :int) (height :int)) :ignore
+ (gtk-window-get-size window width height))))
-(init-slots window ((width -1) (height -1) position)
+(init-slots window ((width -1) (height -1) geometry resize)
(when (or (/= width -1) (/= height -1))
- (gtk-window-set-default-size window width height))
- (when position (setf (window-position window) position)))
+ (let ((sizes (list width height)))
+ (if resize
+ (setf (window-size window :geometry geometry) sizes)
+ (setf (default-size window :geometry geometry) sizes)))))
More information about the gtk-cffi-cvs
mailing list