[gtk-cffi-cvs] CVS gtk-cffi/gtk
CVS User rklochkov
rklochkov at common-lisp.net
Thu Mar 8 09:58:12 UTC 2012
Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk
In directory tiger.common-lisp.net:/tmp/cvs-serv18432/gtk
Modified Files:
assistant.lisp builder.lisp dialog.lisp entry.lisp
generics.lisp gtk-cffi.asd label.lisp list-store.lisp
package.lisp statusbar.lisp text-buffer.lisp
Added Files:
accel-label.lisp offscreen-window.lisp
Log Message:
GtkLabel* now is fully supported
added GtkOffscreenWindow
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/assistant.lisp 2012/03/06 01:25:26 1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/assistant.lisp 2012/03/08 09:58:12 1.2
@@ -52,4 +52,4 @@
(set-callback assistant gtk-assistant-set-forward-page-func
cb-forward-page-func func data destroy-notify))
-
\ No newline at end of file
+(init-slots assistant)
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/builder.lisp 2012/03/06 01:25:26 1.1
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/builder.lisp 2012/03/08 09:58:12 1.2
@@ -63,9 +63,9 @@
(deffuns builder
- (object pobject (name :string))
- (objects (g-slist :elt pobject))
- (type-from-name g-type (type-name :string)))
+ (:get object pobject (name :string))
+ (:get objects (g-slist :elt pobject))
+ (:get type-from-name g-type (type-name :string)))
(defslots builder
translation-domain :string)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/dialog.lisp 2012/03/06 01:25:26 1.5
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/dialog.lisp 2012/03/08 09:58:12 1.6
@@ -18,11 +18,11 @@
(:help -11)
:apply :no :yes :close :cancel :ok :delete :accept :reject :none)
-(defcfun "gtk_dialog_new_with_buttons"
+(defcfun gtk-dialog-new-with-buttons
:pointer (title :string)
(parent pobject) (flags dialog-flags) (null :pointer))
-(defcfun "gtk_dialog_new" :pointer)
+(defcfun gtk-dialog-new :pointer)
(defmethod gconstructor ((dialog dialog)
&key title parent (flags 0) &allow-other-keys)
@@ -40,80 +40,46 @@
with-buttons))
-(defcfun "gtk_dialog_run" dialog-response (dialog :pointer))
+(defcfun gtk-dialog-run dialog-response (dialog pobject))
-(defmethod run ((dialog dialog) &key (keep-alive t))
- (let ((resp (gtk-dialog-run (pointer dialog))))
- (unless keep-alive
- (destroy dialog))
- resp))
+(defgeneric run (dialog &key)
+ (:method ((dialog dialog) &key (keep-alive t))
+ (prog1 (gtk-dialog-run dialog)
+ (unless keep-alive
+ (destroy dialog)))))
-(defcfun "gtk_dialog_add_button" pobject (dialog pobject)
+(defcfun gtk-dialog-add-button pobject (dialog pobject)
(str :string) (resp dialog-response))
-(defmethod add-button ((dialog dialog) str response)
- (gtk-dialog-add-button dialog (if (keywordp str) (string-downcase str) str)
- response))
-
-(defcfun gtk-dialog-response :void (dialog pobject) (resp dialog-response))
-
-(defmethod response ((dialog dialog) response)
- (gtk-dialog-response dialog response))
-
-(defcfun gtk-dialog-add-action-widget
- :void (dialog pobject) (child pobject) (resp dialog-response))
-
-(defmethod add-action-widget ((dialog dialog) (child widget) &key response &allow-other-keys)
- (gtk-dialog-add-action-widget dialog child response))
-
-(defcfun gtk-dialog-set-default-response
- :void (dialog pobject) (resp dialog-response))
-
-(defmethod (setf default-response) (response (dialog dialog))
- (gtk-dialog-set-default-response dialog response))
-
-(defcfun gtk-dialog-set-response-sensitive
- :void (dialog pobject) (resp dialog-response) (setting :boolean))
-
-(defmethod (setf response-sensitive) (setting (dialog dialog) response)
- (gtk-dialog-set-response-sensitive dialog response setting))
-
-(defcfun gtk-dialog-get-response-for-widget
- dialog-response (dialog pobject) (widget pobject))
-
-(defmethod response-for-widget ((dialog dialog) (widget widget))
- (gtk-dialog-get-response-for-widget dialog widget))
-
-(defcfun gtk-dialog-get-widget-for-response
- pobject (dialog pobject) (response dialog-response))
-
-(defmethod widget-for-response ((dialog dialog) response)
- (gtk-dialog-get-widget-for-response dialog response))
-
-(defcfun gtk-dialog-get-action-area pobject (dialog pobject))
-
-(defmethod action-area ((dialog dialog))
- (gtk-dialog-get-action-area dialog))
-
-(defcfun gtk-dialog-get-content-area pobject (dialog pobject))
-
-(defmethod content-area ((dialog dialog))
- (gtk-dialog-get-content-area dialog))
+(defgeneric add-button (dialog string response)
+ (:method ((dialog dialog) str response)
+ (gtk-dialog-add-button dialog (if (keywordp str) (string-downcase str) str)
+ response)))
+
+(deffuns dialog
+ (response :void (resp dialog-response))
+ (add-action-widget :void (child pobject) &key (response dialog-response))
+ (:set default-response dialog-response)
+ (:set-last response-sensitive :boolean (response dialog-response))
+ (:get response-for-widget dialog-response (widget pobject))
+ (:get widget-for-response pobject (response dialog-response))
+ (:get action-area pobject)
+ (:get content-area pobject))
(defcfun gtk-alternative-dialog-button-order :boolean (screen pobject))
-(defmethod alternative-dialog-button-order ((screen screen))
- (gtk-alternative-dialog-button-order screen))
+(defgeneric alternative-dialog-button-order (screen)
+ (:method ((screen screen))
+ (gtk-alternative-dialog-button-order screen)))
(defcfun gtk-dialog-set-alternative-button-order-from-array
- :void (dialog pobject) (n-params :int) (new-order :pointer))
+ :void (dialog pobject) (n-params :int) (new-order (carray :int)))
+
+(defgeneric (setf alternative-button-order) (order dialog)
+ (:method (order (dialog dialog))
+ (gtk-dialog-set-alternative-button-order-from-array
+ dialog (length order) order)
+ order))
+(save-setter dialog alternative-button-order)
-(defmethod (setf alternative-button-order) (order (dialog dialog))
- (let ((n-params (length order)))
- (with-foreign-object (arr :int n-params)
- (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
+(init-slots dialog)
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/entry.lisp 2012/02/12 17:29:42 1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/entry.lisp 2012/03/08 09:58:12 1.4
@@ -21,12 +21,10 @@
(defcfun gtk-entry-get-text :string (entry pobject))
(defcfun gtk-entry-set-text :void (entry pobject) (text :string))
-(defmethod text ((entry entry) &rest rest)
- (declare (ignore rest))
+(defmethod text ((entry entry) &key)
(gtk-entry-get-text entry))
-(defmethod (setf text) (value (entry entry) &rest rest)
- (declare (ignore rest))
+(defmethod (setf text) (value (entry entry) &key)
(gtk-entry-set-text entry value))
(defgtkslots entry
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/generics.lisp 2011/09/10 16:26:11 1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/generics.lisp 2012/03/08 09:58:12 1.4
@@ -1,129 +1,7 @@
(in-package :gtk-cffi)
-;; (defgeneric destroy (gtk-object))
-;; (defgeneric flags (gtk-object))
+(defgeneric selection-bounds (widget &key)) ;; text-buffer, label
+(defgeneric text (widget &key)) ;; entry, label, text-buffer
+(defgeneric (setf text) (value widget &key))
-;; (defgeneric text (widget &rest flags))
-;; (defgeneric (setf text) (text widget &rest rest))
-;; (defgeneric (setf mnemonic-widget) (widget label))
-;; (defgeneric mnemonic-widget (label))
-;; (defgeneric activate (widget))
-;; (defgeneric realize (widget))
-;; (defgeneric size-request (widget))
-;; (defgeneric (setf size-request) (size widget))
-;; (defgeneric style-field (widget field &optional state type))
-;; (defgeneric (setf style-field) (value widget field &optional state type))
-;; (defgeneric color (widget &rest rest))
-;; (defgeneric (setf color) (color widget &rest rest))
-;; (defgeneric font (widget &rest rest))
-;; (defgeneric (setf font) (font widget &rest rest))
-;; (defgeneric bg-pixmap (widget &rest state))
-;; (defgeneric (setf bg-pixmap) (pixmap widget &rest rest))
-;; (defgeneric allocation (widget))
-;; (defgeneric (setf allocation) (value widget))
-;; (defgeneric show (widget &rest flags))
-;; (defgeneric hide (widget))
-;; (defgeneric gdk-window (widget))
-;; (defgeneric (setf justify) (justify label))
-;; (defgeneric justify (label))
-;; (defgeneric child (bin))
-
-;; (defgeneric (setf default-size) (coords window))
-;; (defgeneric default-size (window))
-;; (defgeneric (setf screen) (screen window))
-;; (defgeneric screen (window))
-;; (defgeneric transient-for (window))
-;; (defgeneric (setf transient-for) (window parent))
-;; (defgeneric (setf win-position) (pos window))
-
-;; (defgeneric add (container widget))
-;; (defgeneric border-width (container))
-;; (defgeneric (setf border-width) (value container))
-;; (defgeneric reparent (widget new-parent))
-;; (defgeneric propagate-expose (container child event))
-
-;; (defgeneric run (dialog &key keep-alive))
-;; (defgeneric (setf has-separator) (has dialog))
-;; (defgeneric has-separator (dialog))
-;; (defgeneric add-button (dialog string response))
-
-;; ;(defgeneric get-iter (text-buffer text-iter pos))
-;; (defgeneric buffer (text-view))
-;; (defgeneric (setf buffer) (buffer text-view))
-
-;; (defgeneric add-attribute (cell-layout cell-renderer attr column))
-;; (defgeneric (setf cell-data-func) (c-handler
-;; cell-layout cell-renderer
-;; &optional data destroy-notify))
-;; (defgeneric clear-attributes (cell-layout cell-renderer))
-;; (defgeneric clear (cell-layout))
-
-;; (defgeneric (setf sort-column-id) (id tree-view-column))
-;; (defgeneric (setf reorderable) (reorderable tree-view-column))
-;; (defgeneric reorderable (tree-view-column))
-;; (defgeneric (setf widget) (widget tree-view-column))
-;; (defgeneric widget (tree-view-column))
-;; (defgeneric pack (tree-view-column cell-renderer &rest flags))
-;; (defgeneric cell-get-position (tree-view-column cell-renderer))
-;; (defgeneric cell-renderers (tree-view-column))
-;; (defgeneric get-cell-at (tree-view-column x))
-;; (defgeneric (setf title) (title tree-view-column))
-;; (defgeneric title (tree-view-column))
-
-;; (defgeneric get-indices (tree-path))
-;; (defgeneric get-index (tree-path &optional pos))
-;; (defgeneric copy (struct-object))
-;; (defgeneric foreach (tree-model func &optional data))
-;; (defgeneric iter->path (tree-model tree-iter))
-;; (defgeneric iter->string (tree-model tree-iter))
-;; (defgeneric model-values (tree-model &key iter columns col))
-;; (defgeneric path->iter (tree-model tree-path &optional tree-iter))
-;; (defgeneric n-columns (tree-model))
-;; (defgeneric column-type (tree-model col))
-
-
-;; (defgeneric path-from-child (tree-model-filter tree-path))
-;; (defgeneric iter-to-child (tree-model-filter tree-iter))
-;; (defgeneric (setf model-values) (values tree-model-filter
-;; &key iter columns col))
-;; (defgeneric (setf visible-column) (column tree-model-filter))
-
-;; (defgeneric (setf shadow-type) (shadow-type frame))
-;; (defgeneric shadow-type (frame))
-
-;; (defgeneric (setf policy) (policy scrolled-window))
-
-;; (defgeneric get-selection (tree-view))
-;; (defgeneric path-at-pos (tree-view x y))
-;; (defgeneric get-cursor (tree-view))
-;; (defgeneric column (tree-view n))
-;; (defgeneric append-column (tree-view tree-view-column))
-;; (defgeneric (setf search-column) (n tree-view))
-;; (defgeneric search-column (tree-view))
-;; (defgeneric model (tree-view))
-;; (defgeneric (setf model) (model tree-view))
-
-;; (defgeneric get-selected (tree-selection))
-;; (defgeneric tree-selection-foreach (tree-selection func &optional data))
-
-;; (defgeneric append-iter (list-store &optional tree-iter))
-;; (defgeneric append-values (list-store values))
-
-;; (defgeneric append-text (combo-box text))
-;; (defgeneric prepend-text (combo-box text))
-;; (defgeneric insert-text (combo-box text))
-;; (defgeneric remove-text (combo-box pos))
-;; (defgeneric active-text (combo-box))
-
-
-;; (defgeneric fraction (progress-bar))
-;; (defgeneric (setf fraction) (fraction progress-bar))
-
-;; (defgeneric (setf kid) (kid container))
-;; (defgeneric (setf kids) (kids container))
-
-;; (defgeneric resize (table &key rows columns))
-
-;; (defgeneric attach (table widget &key left right top bottom
-;; xoptions yoptions xpadding ypadding))
\ No newline at end of file
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/03/06 01:25:26 1.16
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd 2012/03/08 09:58:12 1.17
@@ -55,7 +55,8 @@
:license "LLGPL"
:depends-on (gtk-cffi-misc)
:components
- ((:file label)))
+ ((:file label)
+ (:file accel-label :depends-on (label))))
(defsystem gtk-cffi-container
:description "Interface to GTK/Glib via CFFI"
@@ -85,7 +86,8 @@
:depends-on (gtk-cffi-bin)
:components
((:file window)
- (:file assistant :depends-on (window))))
+ (:file assistant :depends-on (window))
+ (:file offscreen-window :depends-on (window))))
(defsystem gtk-cffi-dialog
:description "Interface to GTK/Glib via CFFI"
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/label.lisp 2012/02/12 17:29:42 1.3
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/label.lisp 2012/03/08 09:58:12 1.4
@@ -1,3 +1,9 @@
+;;;
+;;; label.lisp -- GtkLabel
+;;;
+;;; Copyright (C) 2007, Roman Klochkov <kalimehtar at mail.ru>
+;;;
+
(in-package :gtk-cffi)
(defclass label (misc)
@@ -6,21 +12,21 @@
(defcenum justification
:left :right :center :fill)
-(defcfun "gtk_label_new" :pointer (text :string))
+(defcfun gtk-label-new :pointer (text :string))
(defmethod gconstructor ((label label)
&key text &allow-other-keys)
(gtk-label-new text))
-(defcfun "gtk_label_set_markup" :void (label pobject) (text :string))
+(defcfun gtk-label-set-markup :void (label pobject) (text :string))
-(defcfun "gtk_label_set_markup_with_mnemonic"
+(defcfun gtk-label-set-markup-with-mnemonic
:void (label pobject) (text :string))
-(defcfun "gtk_label_set_text_with_mnemonic"
+(defcfun gtk-label-set-text-with-mnemonic
:void (label pobject) (text :string))
-(defcfun "gtk_label_set_text"
+(defcfun gtk-label-set-text
:void (label pobject) (text :string))
(defmethod (setf text) (text (label label) &key mnemonic markup)
@@ -31,21 +37,55 @@
#'gtk-label-set-text-with-mnemonic)
(if markup #'gtk-label-set-markup
#'gtk-label-set-text))
- (list label text)))
-
-(defcfun "gtk_label_get_text" :string (label pobject))
+ (list label text))
+ text)
-(defcfun "gtk_label_get_label" :string (label pobject))
+(defcfun gtk-label-get-text :string (label pobject))
(defmethod text ((label label) &key markup)
(apply
- (if markup #'gtk-label-get-label
- #'gtk-label-get-text) label))
+ (if markup #'gtk-label-get-label #'gtk-label-get-text)
+ label))
(defslots label
mnemonic-widget pobject
- justify justification)
-
+ justify justification
+ ellipsize pango-cffi:ellipsize-mode
+ width-chars :int
+ max-width-chars :int
+ line-wrap :boolean
+ line-wrap-mode pango-cffi:wrap-mode
+ selectable :boolean
+ attributes pango-cffi:attr-list
+ label :string
+ use-markup :boolean
+ use-underline :boolean
+ single-line-mode :boolean
+ angle :double
+ track-visited-links :boolean)
+
+(deffuns label
+ (:set pattern :string)
+ (:get layout pobject)
+ (:get mnemonic-keyval :uint)
+ (select-region :void (start :int) (end :int))
+ (:get current-uri :string))
+
+
+(defcfun gtk-label-get-layout-offsets :void (label pobject)
+ (x :pointer) (y :pointer))
+
+(defgeneric layout-offsets (label)
+ (:method ((label label))
+ (with-foreign-outs-list ((x :int) (y :int)) :ignore
+ (gtk-label-get-layout-offsets label x y))))
+
+(defcfun gtk-label-get-selection-bounds :void (label pobject)
+ (start :pointer) (end :pointer))
+
+(defmethod selection-bounds ((label label) &key)
+ (with-foreign-outs-list ((start :int) (end :int)) :ignore
+ (gtk-label-get-selection-bounds label start end)))
;; taken from cells-gtk
(defun to-str (sym)
@@ -60,8 +100,8 @@
(let ((markup-start
`(format nil "<span~{ ~a=~s~}>"
(list
- ,@(when font-desc `("font_desc" (to-str ,font-desc)))
- ,@(when font-family `("font_family" (to-str ,font-family)))
+ ,@(when font-desc `("font-desc" (to-str ,font-desc)))
+ ,@(when font-family `("font-family" (to-str ,font-family)))
,@(when face `("face" (to-str ,face)))
,@(when size `("size" (to-str ,size)))
,@(when style `("style" (to-str ,style)))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/list-store.lisp 2011/08/26 17:16:14 1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/list-store.lisp 2012/03/08 09:58:12 1.3
@@ -7,7 +7,6 @@
;;;
(in-package :gtk-cffi)
-(declaim (optimize (speed 3)))
(defclass list-store (g-object tree-model)
())
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/03/06 01:25:26 1.16
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp 2012/03/08 09:58:12 1.17
@@ -281,6 +281,10 @@
#:next-page
#:previous-page
+ #:offscreen-window
+ #:surface
+ #:pixbuf
+
#:window-group
;; methods
#:add-window
@@ -376,6 +380,32 @@
#:text
#:mnemonic-widget
#:justify
+ #:ellipsize
+ #:width-chars
+ #:max-width-chars
+ #:line-wrap
+ #:line-wrap-mode
+ #:selectable
+ #:attributes
+ #:use-markup
+ #:use-underline
+ #:single-line-mode
+ #:angle
+ #:track-visited-links
+ ;; methods
+ #:pattern
+ #:layout
+ #:mnemonic-keyval
+ #:select-region
+ #:current-uri
+ #:layout-offsets
+ #:selection-bounds
+
+ #:accel-label
+ #:accel-widget
+ #:accel-closure
+ #:accel-width
+ #:refetch
#:with-markup
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/statusbar.lisp 2012/02/12 17:29:42 1.4
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/statusbar.lisp 2012/03/08 09:58:12 1.5
@@ -19,8 +19,8 @@
(defcfun gtk-statusbar-remove-all :void
(statusbar pobject) (context-id :uint))
-(defmethod statusbar-remove ((statusbar statusbar) context-id
- &optional message-id)
- (if message-id
- (gtk-statusbar-remove statusbar context-id message-id)
- (gtk-statusbar-remove-all statusbar context-id)))
+(defgeneric statusbar-remove (statusbar context-id &optional message-id)
+ (:method ((statusbar statusbar) context-id &optional message-id)
+ (if message-id
+ (gtk-statusbar-remove statusbar context-id message-id)
+ (gtk-statusbar-remove-all statusbar context-id))))
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-buffer.lisp 2012/02/12 17:29:42 1.6
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-buffer.lisp 2012/03/08 09:58:12 1.7
@@ -430,12 +430,11 @@
(defcfun gtk-text-buffer-get-selection-bounds :void
(buffer pobject) (start pobject) (end pobject))
-(defgeneric selection-bounds (text-buffer &key start end)
- (:method ((text-buffer text-buffer) &key start end)
- (let ((start (or start (make-instance 'text-iter)))
- (end (or end (make-instance 'text-iter))))
- (let ((res (gtk-text-buffer-get-selection-bounds text-buffer start end)))
- (values res start end)))))
+(defmethod selection-bounds ((text-buffer text-buffer) &key start end)
+ (let ((start (or start (make-instance 'text-iter)))
+ (end (or end (make-instance 'text-iter))))
+ (let ((res (gtk-text-buffer-get-selection-bounds text-buffer start end)))
+ (values res start end))))
(defcfun gtk-text-buffer-deserialize :boolean
(register-buffer pobject) (content-buffer pobject) (format gatom)
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/accel-label.lisp 2012/03/08 09:58:12 NONE
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/accel-label.lisp 2012/03/08 09:58:12 1.1
;;;
;;; accel-label.lisp -- GtkAccelLabel
;;;
;;; Copyright (C) 2012, Roman Klochkov <kalimehtar at mail.ru>
;;;
(in-package :gtk-cffi)
(defclass accel-label (label)
())
(defcfun gtk-accel-label-new :pointer (text :string))
(defmethod gconstructor ((accel-label accel-label) &key text)
(gtk-accel-label-new text))
(defslots accel-label
accel-widget pobject)
(deffuns accel-label
(:set accel-closure :pointer)
(:get accel-width :uint)
(refetch :boolean))
(init-slots accel-label)--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/offscreen-window.lisp 2012/03/08 09:58:12 NONE
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/offscreen-window.lisp 2012/03/08 09:58:12 1.1
;;;
;;; offscreen-window.lisp -- GtkOffscreenWindow
;;;
;;; Copyright (C) 2012, Roman Klochkov <kalimehtar at mail.ru>
;;;
(in-package :gtk-cffi)
(defclass offscreen-window (window) ())
(defcfun gtk-offscreen-window-new :pointer)
(defmethod gconstructor ((offscreen-window offscreen-window) &key)
(gtk-offscreen-window-new))
(deffuns offscreen-window
(:get pixbuf pobject))
(defcfun gtk-offscreen-window-get-surface :pointer (off-win pobject))
(defgeneric surface (offscreen-window)
(:method ((offscreen-window offscreen-window))
(cairo:create-surface-from-foreign
(gtk-offscreen-window-get-surface offscreen-window))))
More information about the gtk-cffi-cvs
mailing list