[gtk-cffi-cvs] CVS gtk-cffi/gtk

CVS User rklochkov rklochkov at common-lisp.net
Sun Oct 23 08:39:53 UTC 2011


Update of /project/gtk-cffi/cvsroot/gtk-cffi/gtk
In directory tiger.common-lisp.net:/tmp/cvs-serv3681/gtk

Modified Files:
	gtk-cffi.asd package.lisp text-buffer.lisp 
Log Message:
Finished TextBuffer support



--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd	2011/09/17 20:04:56	1.8
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/gtk-cffi.asd	2011/10/23 08:39:53	1.9
@@ -298,7 +298,8 @@
   :license "GPL"
   :depends-on (gtk-cffi-core)
   :components
-  ((:file :text-buffer)))
+  ((:file text-tag)
+   (:file text-buffer :depends-on (text-tag))))
 
 (defsystem gtk-cffi-text-view
   :description "Interface to GTK/Glib via CFFI"
@@ -307,9 +308,8 @@
   :license "GPL"
   :depends-on (gtk-cffi-text-buffer)
   :components
-  ((:file text-tag)
-   (:file text-mark)
-   (:file text-view :depends-on (text-tag))))
+  ((:file text-mark)
+   (:file text-view)))
 
 (defsystem gtk-cffi-combo-box
   :description "Interface to GTK/Glib via CFFI"
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp	2011/09/18 18:10:48	1.8
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/package.lisp	2011/10/23 08:39:53	1.9
@@ -339,8 +339,146 @@
    #:with-selection
    #:get-selected
 
+   #:text-iter
+   ;; slots
+   #:line
+   #:offset
+   #:line-offset
+   #:line-index
+   #:visible-line-index
+   #:visible-line-offset
+   ;; methods
+   #:text-iter-char
+   #:slice
+   #:text-iter-text
+   #:visible-slice
+   #:visible-text
+   #:pixbuf
+   #:marks
+   #:toggled-tags
+   #:child-anchor
+   #:begins-tag
+   #:ends-tag
+   #:toggles-tag
+   #:has-tag
+   #:tags
+   #:text-iter-editable
+   #:can-insert
+   #:starts-word
+   #:end-word
+   #:inside-word
+   #:starts-line
+   #:starts-sentence
+   #:ends-sentence
+   #:inside-sentence
+   #:is-cursor-position
+   #:chars-in-line
+   #:bytes-in-line
+   #:get-attributes
+   #:language
+   #:is-end
+   #:is-start
+   #:forward-char
+   #:backward-char
+   #:forward-chars
+   #:backward-chars
+   #:forward-line
+   #:backward-line
+   #:forward-lines
+   #:backward-lines
+   #:forward-word-end
+   #:backward-word-start
+   #:forward-word-ends
+   #:backward-word-starts
+   #:forward-cursor-position
+   #:backward-cursor-position
+   #:forward-cursor-positions
+   #:backward-cursor-positions
+   #:backward-sentence-start
+   #:forward-sentence-end
+   #:backward-sentence-starts
+   #:forward-sentence-ends
+   #:forward-visible-word-end
+   #:backward-visible-word-start
+   #:forward-visible-word-ends
+   #:backward-visible-word-starts
+   #:forward-visible-cursor-position
+   #:backward-visible-cursor-position
+   #:forward-visible-cursor-positions
+   #:backward-visible-cursor-positions
+   #:forward-visible-line
+   #:backward-visible-line
+   #:forward-visible-lines
+   #:backward-visible-lines
+   #:forward-to-end
+   #:forward-to-line-end
+   #:forward-to-tag-toggle
+   #:backward-to-tag-toggle
+   #:forward-search
+   #:backward-search
+   #:text-iter-equal
+   #:compare
+   #:in-range
+   #:order
+   #:forward-find-char
+   #:backward-find-char
+
    #:text-buffer
+   ;; slot
+   #:modified
+   ;; methods
+   #:line-count
+   #:char-count
+   #:tag-table
+   #:insert-pixbuf
+   #:insert-child-anchor
+   #:create-child-anchor
+   #:create-mark
+   #:add-mark
+   #:mark
+   #:get-insert
+   #:selection-bound
+   #:has-selection
+   #:place-cursor
+   #:select-range
+   #:remove-all-tags
+   #:delete-selection
+   #:paste-clipboard
+   #:copy-clipboard
+   #:cut-clipboard
+   #:begin-user-action
+   #:end-user-action
+   #:add-selection-clipboard
+   #:remove-selection-clipboard
+   #:deserialize-can-create-tags
+   #:copy-target-list
+   #:paste-target-list
+   #:register-deserialize-tagset
+   #:register-serialize-tagset
+   #:unregister-deserialize-format
+   #:unregister-serialize-format
+   #:start-iter
+   #:end-iter 
    #:text
+   #:insert
+   #:insert-range
+   #:text-buffer-delete
+   #:backspace
+   #:text-buffer-slice
+   #:move-mark
+   #:delete-mark
+   #:apply-tag
+   #:remove-tag
+   #:create-tag
+   #:text-buffer-iter
+   #:bounds
+   #:selection-bounds
+   #:deserialize
+   #:deserialize-formats
+   #:serialize
+   #:serialize-formats
+   #:register-serialize-format
+   #:register-deserialize-format
    
    #:text-view
    ;; slots
--- /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-buffer.lisp	2011/09/21 12:03:47	1.2
+++ /project/gtk-cffi/cvsroot/gtk-cffi/gtk/text-buffer.lisp	2011/10/23 08:39:53	1.3
@@ -49,6 +49,9 @@
   visible-line-index :int
   visible-line-offset :int)
 
+(defbitfield text-search-flags
+  :visible-only :text-only :case-insensitive)
+
 (defgtkfuns text-iter
   ((text-iter-char . get-char) unichar)
   (:get slice gtk-string (end pobject))
@@ -56,14 +59,110 @@
   (:get visible-slice gtk-string (end pobject))
   (:get visible-text gtk-string (end pobject))
   (:get pixbuf pobject)
-  (:get marks (g-slist text-mark))
-  (:get toggled-tags (g-slist text-mark) (toggle-on :boolean))
-  (:get child-anchor pobject))
-    
+  (:get marks (g-slist pobject))
+  (:get toggled-tags (g-slist pobject) (toggle-on :boolean))
+  (:get child-anchor pobject)
+  (begins-tag :boolean (tag pobject))
+  (ends-tag :boolean (tag pobject))
+  (toggles-tag :boolean (tag pobject))
+  (has-tag :boolean (tag pobject))
+  (:get tags (g-slist pobject))
+  ((text-iter-editable . editable) :boolean (default-setting :boolean))
+  (can-insert :boolean (default-editability :boolean))
+  (starts-word :boolean)
+  (end-word :boolean)
+  (inside-word :boolean)
+  (starts-line :boolean)
+  (starts-sentence :boolean)
+  (ends-sentence :boolean)
+  (inside-sentence :boolean)
+  (is-cursor-position :boolean)
+  (:get chars-in-line :int)
+  (:get bytes-in-line :int)
+  (get-attributes :boolean (struct text-attributes :out t))
+  (:get language pango-cffi:language)
+  (is-end :boolean)
+  (is-start :boolean)
+  (forward-char :boolean)
+  (backward-char :boolean)
+  (forward-chars :boolean (count :int))
+  (backward-chars :boolean (count :int))
+  (forward-line :boolean)
+  (backward-line :boolean)
+  (forward-lines :boolean (count :int))
+  (backward-lines :boolean (count :int))
+  (forward-word-end :boolean)
+  (backward-word-start :boolean)
+  (forward-word-ends :boolean (count :int))
+  (backward-word-starts :boolean (count :int))
+  (forward-cursor-position :boolean)
+  (backward-cursor-position :boolean)
+  (forward-cursor-positions :boolean (count :int))
+  (backward-cursor-positions :boolean (count :int))
+  (backward-sentence-start :boolean)
+  (forward-sentence-end :boolean)
+  (backward-sentence-starts :boolean (count :int))
+  (forward-sentence-ends :boolean (count :int))
+  (forward-visible-word-end :boolean)
+  (backward-visible-word-start :boolean)
+  (forward-visible-word-ends :boolean (count :int))
+  (backward-visible-word-starts :boolean (count :int))
+  (forward-visible-cursor-position :boolean)
+  (backward-visible-cursor-position :boolean)
+  (forward-visible-cursor-positions :boolean (count :int))
+  (backward-visible-cursor-positions :boolean (count :int))
+  (forward-visible-line :boolean)
+  (backward-visible-line :boolean)
+  (forward-visible-lines :boolean (count :int))
+  (backward-visible-lines :boolean (count :int))
+  (forward-to-end :void)
+  (forward-to-line-end :boolean)
+  (forward-to-tag-toggle :boolean (tag pobject))
+  (backward-to-tag-toggle :boolean (tag pobject))
+  (forward-search :boolean 
+                  (str gtk-string) (flags text-search-flags)
+                  (match-start (struct text-iter :out t))
+                  (match-end (struct text-iter :out t)) (limit pobject))
+  (backward-search :boolean 
+                   (str gtk-string) (flags text-search-flags)
+                   (match-start (struct text-iter :out t))
+                   (match-end (struct text-iter :out t)) (limit pobject))
+  ((text-iter-equal . equal) :boolean (rhs (struct text-iter)))
+  (compare :int (rhs (struct text-iter)))
+  (in-range :boolean (start (struct text-iter) (end (struct text-iter))))
+  (order :void (rhs pobject)))
+
+(defcallback cb-char-predicate :boolean ((ch unichar) (data :pointer))
+  (funcall *callback* ch data))
+
+(defcfun gtk-text-iter-forward-find-char :boolean 
+  (text-iter pobject) (pred pfunction) (data (pdata :free t)) (limit pobject))
+
+(defgeneric forward-find-char (text-iter pred &key data limit)
+  (:method ((text-iter text-iter) pred &key data limit)
+    (if (functionp pred)
+        (let ((*callback* pred))
+          (gtk-text-iter-forward-find-char text-iter 
+                                           (callback cb-char-predicate) 
+                                           data limit))
+        (gtk-text-iter-forward-find-char text-iter pred data limit))))
+
+(defcfun gtk-text-iter-backward-find-char :boolean 
+  (text-iter pobject) (pred pfunction) (data (pdata :free t)) (limit pobject))
+
+(defgeneric backward-find-char (text-iter pred &key data limit)
+  (:method ((text-iter text-iter) pred &key data limit)
+    (if (functionp pred)
+        (let ((*callback* pred))
+          (gtk-text-iter-backward-find-char text-iter 
+                                            (callback cb-char-predicate) 
+                                            data limit))
+        (gtk-text-iter-backward-find-char text-iter pred data limit))))
+
+
 
 (defclass text-buffer (g-object)
-  ((start :accessor start)
-   (end :accessor end)))
+  ())
 
 (defcfun gtk-text-buffer-new :pointer (tag-table pobject))
 
@@ -71,44 +170,373 @@
                          &key tag-table &allow-other-keys)
   (gtk-text-buffer-new tag-table))
 
-(defmethod initialize-instance :after ((text-buffer text-buffer)
-                                       &key &allow-other-keys)
-  (setf (start text-buffer) (make-instance 'text-iter); :new-struct t)
-        (end text-buffer) (make-instance 'text-iter))); :new-struct t)))
-
+(defgtkslots text-buffer
+  modified :boolean)
 
-(defmethod free :before ((text-buffer text-buffer))
-  (free (start text-buffer))
-  (free (end text-buffer)))
+(defcenum text-buffer-target-info
+  (:buffer-ocntent -1)
+  (:rich-text -2)
+  (:info-text -3))
+
+(defgtkfuns text-buffer
+  (:get line-count :int)
+  (:get char-count :int)
+  (:get tag-table pobject)
+  (insert-pixbuf :void (text-iter pobject) (pixbuf pobject))
+  (insert-child-anchor :void (text-iter pobject) (child-anchor pobject))
+  (create-child-anchor pobject (text-iter pobject))
+  (create-mark pobject (mark-name gtk-string) (where (struct text-iter)) 
+               (left-gravity :boolean))
+  (add-mark :void (mark pobject) (where (struct text-iter)))
+  (:get mark pobject (name gtk-string))
+  (get-insert pobject)
+  (:get selection-bound pobject)
+  (:get has-selection :boolean)
+  (place-cursor :void (where (struct text-iter)))
+  (select-range :void (ins (struct text-iter)) (bound (struct text-iter)))
+  (remove-all-tags :void 
+                   (start (struct text-iter)) (end (struct text-iter)))
+  (delete-selection :boolean (interactive :boolean) (default-editable :boolean))
+  (paste-clipboard :void (clipboard pobject) (location pobject) 
+                   (default-editable :boolean))
+  (copy-clipboard :void (clipboard pobject))
+  (cut-clipboard :void (clipboard pobject) (default-editable :boolean))
+  (begin-user-action :void)
+  (end-user-action :void)
+  (add-selection-clipboard :void (clipboard pobject))
+  (remove-selection-clipboard :void (clipboard pobject))
+  ((deserialize-can-create-tags . deserialize-get-can-create-tags) 
+   :boolean (format gatom))
+  (:get copy-target-list (object target-list))
+  (:get paste-target-list (object target-list))
+  (register-deserialize-tagset gatom (tagset-name gtk-string))
+  (register-serialize-tagset gatom (tagset-name gtk-string))
+  (unregister-deserialize-format :void (format gatom))
+  (unregister-serialize-format :void (format gatom)))
+
+(defcfun gtk-text-buffer-deserialize-set-can-create-tags :void
+  (buffer pobject) (format gatom) (val :boolean))
+
+(defgeneric (setf deserialize-can-create-tags) (value text-buffer format)
+  (:method (value (text-buffer text-buffer) format)
+    (gtk-text-buffer-deserialize-set-can-create-tags text-buffer format value)))
+
+(defcfun gtk-text-buffer-get-start-iter :void 
+  (buffer pobject) (text-iter pobject))
+
+(defgeneric start-iter (text-buffer &optional text-iter)
+  (:method ((text-buffer text-buffer) 
+            &optional (text-iter (make-instance 'text-iter)))
+    (gtk-text-buffer-get-start-iter text-buffer text-iter)
+    text-iter))
+
+(defcfun gtk-text-buffer-get-end-iter :void 
+  (buffer pobject) (text-iter pobject))
+
+(defgeneric end-iter (text-buffer &optional text-iter)
+  (:method ((text-buffer text-buffer) 
+            &optional (text-iter (make-instance 'text-iter)))
+    (gtk-text-buffer-get-end-iter text-buffer text-iter)
+    text-iter))
 
-(defcfun "gtk_text_buffer_get_text" gtk-string (buffer pobject)
+(defcfun gtk-text-buffer-get-text gtk-string (buffer pobject)
   (start pobject) (end pobject) (include-hidden :boolean))
 
-(defcfun "gtk_text_buffer_get_start_iter" :void
-  (buffer pobject) (iter (struct text-iter :out t)))
+(defmethod text ((text-buffer text-buffer) &key 
+                 (start (start-iter text-buffer)) 
+                 (end (end-iter text-buffer)) include-hidden)
+  (gtk-text-buffer-get-text text-buffer start end include-hidden))
 
-(defcfun "gtk_text_buffer_get_end_iter" :void
-  (buffer pobject) (iter (struct text-iter :out t)))
+(defcfun gtk-text-buffer-set-text :void (buffer pobject)
+  (str gtk-string) (length :int))
 
-(defmethod get-iter ((text-buffer text-buffer) (text-iter text-iter) pos)
-  (case pos
-    (:start (gtk-text-buffer-get-start-iter text-buffer text-iter))
-    (:end (gtk-text-buffer-get-end-iter text-buffer text-iter)))
-  text-iter)
-
-(defmethod text ((text-buffer text-buffer) &key start end include-hidden)
-  (gtk-text-buffer-get-text text-buffer
-                            (or start
-                                (get-iter text-buffer
-                                          (start text-buffer) :start))
-                            (or end
-                                (get-iter text-buffer
-                                          (end text-buffer) :end))
-                            include-hidden))
+(defmethod (setf text) (text (text-buffer text-buffer) &key (length -1))
+  (gtk-text-buffer-set-text text-buffer text length))
 
-(defcfun "gtk_text_buffer_set_text" :void (buffer pobject)
-  (str gtk-string) (length :int))
+(save-setter text-buffer text)
+
+(defcfun gtk-text-buffer-insert :void (buffer pobject) (iter pobject)
+         (text gtk-string) (len :int))
+(defcfun gtk-text-buffer-insert-at-cursor :void (buffer pobject)
+         (text gtk-string) (len :int))
+(defcfun gtk-text-buffer-insert-interactive :boolean (buffer pobject) 
+         (iter pobject) (text gtk-string) (len :int) 
+         (default-editable :boolean))
+(defcfun gtk-text-buffer-insert-interactive-at-cursor :boolean (buffer pobject)
+         (text gtk-string) (len :int) (default-editable :boolean))
+
+(defgeneric insert (text-buffer place text 
+                                &key length interactive default-editable))
+
+(defmethod insert ((text-buffer text-buffer) (text-iter (eql :at-cursor)) 
+                   text &key (length -1) interactive default-editable)
+  (if interactive
+      (gtk-text-buffer-insert-interactive-at-cursor text-buffer text 
+                                                    length default-editable)
+      (gtk-text-buffer-insert-at-cursor text-buffer text length)))
+  
+(defmethod insert ((text-buffer text-buffer) text-iter text 
+                   &key (length -1) interactive default-editable)
+  (if interactive
+      (gtk-text-buffer-insert-interactive text-buffer text-iter text 
+                                          length default-editable)
+      (gtk-text-buffer-insert text-buffer text-iter text length)))
+
+(defcfun gtk-text-buffer-insert-range :void 
+  (buffer pobject) (text-iter pobject) 
+  (start (struct text-iter)) (end (struct text-iter)))
+
+(defcfun gtk-text-buffer-insert-range-interactive :boolean
+  (buffer pobject) (text-iter pobject) (start (struct text-iter)) 
+  (end (struct text-iter)) (default-editable :boolean))
+
+
+(defgeneric insert-range (text-buffer text-iter start end 
+                                      &key interactive default-editable)
+  (:method ((text-buffer text-buffer) text-iter start end 
+            &key interactive default-editable)
+    (if interactive
+        (gtk-text-buffer-insert-range-interactive text-buffer text-iter
+                                                  start end default-editable)
+        (gtk-text-buffer-insert-range text-buffer text-iter start end))))
+
+
+(defcfun gtk-text-buffer-delete :void 
+  (buffer pobject) (start pobject) (end pobject))
+
+(defcfun gtk-text-buffer-delete-interactive :boolean
+  (buffer pobject) (start pobject) (end pobject) (default-editable :boolean))
+
+(defgeneric text-buffer-delete (text-buffer start end 
+                                            &key interactive default-editable)
+  (:method ((text-buffer text-buffer) start end
+            &key interactive default-editable)
+    (if interactive
+        (gtk-text-buffer-delete-interactive text-buffer
+                                            start end default-editable)
+        (gtk-text-buffer-delete text-buffer start end))))
+
+(defcfun gtk-text-buffer-backspace :boolean                  
+  (buffer pobject) (text-iter pobject) (interactive :boolean)
+  (default-editable :boolean))
+
+(defgeneric backspace (text-buffer text-iter &key interactive default-editable)
+  (:method ((text-buffer text-buffer) text-iter 
+            &key interactive default-editable)
+    (gtk-text-buffer-backspace text-buffer text-iter 
+                               interactive default-editable)))
+
+(defcfun gtk-text-buffer-get-slice gtk-string (buffer pobject)
+         (start pobject) (end pobject) (include-hidden :boolean))
+
+(defgeneric text-buffer-slice (text-buffer &key start end)
+  (:method ((text-buffer text-buffer) &key 
+            (start (start-iter text-buffer)) 
+            (end (end-iter text-buffer)) include-hidden)
+    (gtk-text-buffer-get-slice text-buffer start end include-hidden)))
+
+(macrolet ((by-name-accessor (name tag-name &rest params)
+             (let ((cars-params (mapcar #'car params))
+                   (by-obj (symbolicate 'gtk-text-buffer- name))
+                   (by-name (symbolicate 'gtk-text-buffer- name '-by-name)))
+               `(progn
+                  (defcfun ,by-obj :void
+                    (buffer pobject) (,tag-name pobject) , at params)
+                  (defcfun ,by-name :void
+                    (buffer pobject) (,tag-name gtk-string) , at params)
+                  (defgeneric ,name (text-buffer ,tag-name , at cars-params)
+                    (:method ((text-buffer text-buffer) (,tag-name string) 
+                              , at cars-params)
+                      (,by-name text-buffer ,tag-name , at cars-params))
+                    (:method ((text-buffer text-buffer) ,tag-name 
+                              , at cars-params)
+                      (check-type ,tag-name (or foreign-pointer object))
+                      (,by-obj text-buffer ,tag-name , at cars-params)))))))
+             
+  (by-name-accessor move-mark mark (where (struct text-iter)))
+  (by-name-accessor delete-mark mark (where (struct text-iter)))
+  (by-name-accessor apply-tag tag
+                    (start (struct text-iter)) (end (struct text-iter)))
+  (by-name-accessor remove-tag tag
+                    (start (struct text-iter)) (end (struct text-iter))))
+  
+(defcfun gtk-text-buffer-create-tag :pointer (buffer pobject)
+         (name gtk-string) (null :pointer))
+
+(defgeneric create-tag (text-buffer name &rest properties)
+  (:method ((text-buffer text-buffer) name &rest properties)
+    (let ((res (make-instance 
+                'text-tag :pointer
+                (gtk-text-buffer-create-tag text-buffer name (null-pointer)))))
+      (setf (properties res) properties))))
+
+
+(defcfun gtk-text-buffer-get-iter-at-line-offset :void
+  (buffer pobject) (text-iter pobject) (line :int) (offset :int))
+(defcfun gtk-text-buffer-get-iter-at-offset :void
+  (buffer pobject) (text-iter pobject) (offset :int))
+(defcfun gtk-text-buffer-get-iter-at-line :void
+  (buffer pobject) (text-iter pobject) (line :int))
+(defcfun gtk-text-buffer-get-iter-at-line-index :void
+  (buffer pobject) (text-iter pobject) (line :int) (index :int))
+(defcfun gtk-text-buffer-get-iter-at-mark :void
+  (buffer pobject) (text-iter pobject) (mark pobject))
+(defcfun gtk-text-buffer-get-iter-at-child-anchor :void
+  (buffer pobject) (text-iter pobject) (child-anchor pobject))
+
+
+(defgeneric text-buffer-iter (text-buffer text-iter 
+                                          &key line offset index 
+                                          mark child-anchor)
+  (:documentation "Sets the TEXT-ITER to given position:
+priority is CHILD-ANCHOR, MARK, LINE+INDEX, LINE+OFFSET, LINE, OFFSET
+OFFSET may be also :start or :end, the sama as 0 and -1")
+  (:method ((text-buffer text-buffer) text-iter
+            &key line offset index mark child-anchor)
+    (unless text-iter
+      (setf text-iter (make-instance 'text-iter)))
+    (cond
+      (child-anchor 
+       (gtk-text-buffer-get-iter-at-child-anchor text-buffer 
+                                                 text-iter child-anchor))
+      (mark
+       (gtk-text-buffer-get-iter-at-mark text-buffer text-iter mark))
+      (line
+       (cond
+         (index (gtk-text-buffer-get-iter-at-line-index text-buffer 
+                                                        text-iter line index))
+         (offset (gtk-text-buffer-get-iter-at-line-offset text-buffer 
+                                                          text-iter 

[138 lines skipped]





More information about the gtk-cffi-cvs mailing list