From rklochkov at common-lisp.net Sun Oct 23 08:39:53 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 23 Oct 2011 01:39:53 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/cffi Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/cffi In directory tiger.common-lisp.net:/tmp/cvs-serv3681/cffi Modified Files: struct.lisp Log Message: Finished TextBuffer support --- /project/gtk-cffi/cvsroot/gtk-cffi/cffi/struct.lisp 2011/09/21 12:03:46 1.8 +++ /project/gtk-cffi/cvsroot/gtk-cffi/cffi/struct.lisp 2011/10/23 08:39:53 1.9 @@ -115,7 +115,7 @@ (defgeneric new-struct (class) (:method (class) - (foreign-alloc class))) + (foreign-alloc class))) (defgeneric free-struct (class value) (:method (class value) @@ -127,9 +127,9 @@ (let ((res (new-struct class))) ; (format t "Allocated ~a~%" res) (mapc (lambda (slot) - (let ((val (cdr (assoc slot (slot-value object 'value))))) - (when val ;; FIXME: I think, that allocated struct zero-filled - (setf (foreign-slot-value res class slot) val)))) + (let ((val (assoc slot (slot-value object 'value)))) + (when (consp val) + (setf (foreign-slot-value res class slot) (cdr val))))) (foreign-slot-names class)) res) (slot-value object 'pointer))) @@ -172,15 +172,18 @@ (define-parse-method struct (class &key free out) (make-instance 'cffi-struct :class class :free free :out out)) -(defmethod translate-to-foreign ((value struct) (type cffi-struct)) - (values (clos->new-struct (obj-class type) value) value)) +(defun %class (type value) + (or (obj-class type) (class-name (class-of value)))) -(defmethod free-translated-object (value (type cffi-struct) param) - (let ((class (obj-class type))) -; (format t "In free: ~a~%" value) - (when (obj-out type) - (struct->clos class value param)) - (free-struct class value))) +(defmethod translate-to-foreign ((value struct) (type cffi-object)) + (values (clos->new-struct (%class type value) value) value)) + +(defmethod free-translated-object (value (type cffi-struct) (param struct)) + (let ((class (%class type param))) + (when (slot-boundp param 'value) + (when (obj-out type) + (struct->clos class value param)) + (free-struct class value)))) (defmethod translate-from-foreign (value (type cffi-struct)) (let ((class (obj-class type))) @@ -189,13 +192,15 @@ (free-if-needed type value)))) ;;; for use with pobject designator - -(defmethod translate-to-foreign ((value struct) (type cffi-object)) - (values (clos->new-struct (class-name (class-of value)) value) value)) +;; pobject == (struct nil :out t) (defmethod free-translated-object (value (type cffi-object) (param struct)) - (let ((class (class-name (class-of type)))) - (free-struct class value))) + (let ((class (%class type param))) + (when (slot-boundp param 'value) + (struct->clos class value param) + (free-struct class value)))) + + ;; This is needed to get correct mem-aref, when used on array of structs (eval-when (:compile-toplevel :load-toplevel :execute) From rklochkov at common-lisp.net Sun Oct 23 08:39:53 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 23 Oct 2011 01:39:53 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/g-lib Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/g-lib In directory tiger.common-lisp.net:/tmp/cvs-serv3681/g-lib Modified Files: error.lisp package.lisp Log Message: Finished TextBuffer support --- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/error.lisp 2011/04/25 19:16:07 1.1.1.1 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/error.lisp 2011/10/23 08:39:53 1.2 @@ -28,14 +28,18 @@ (errno :int) (message gtk-string)) -(defmethod print-object ((g-error g-error) stream) +(defun get-error (g-error) (let ((p (mem-ref (pointer g-error) :pointer))) (unless (null-pointer-p p) (with-foreign-slots ((domain errno message) p g-error) - (format stream "GError ~A (~A): ~A" - (g-quark-to-string domain) errno message))))) + `(:domain ,domain :errno ,errno :message ,message))))) +(defmethod print-object ((g-error g-error) stream) + (let ((err (get-error g-error))) + (format stream "GError ~A (~A): ~A" + (g-quark-to-string (getf err :domain)) + (getf err :errno) (getf err :message)))) (defmacro with-g-error (g-error &body body) `(let ((,g-error (make-instance 'g-error))) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/package.lisp 2011/09/21 12:03:47 1.4 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-lib/package.lisp 2011/10/23 08:39:53 1.5 @@ -18,7 +18,10 @@ #:g-list #:g-slist #:g-quark + #:g-error + #:get-error + #:garray #:*array-length* From rklochkov at common-lisp.net Sun Oct 23 08:39:53 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 23 Oct 2011 01:39:53 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/g-object Message-ID: Update of /project/gtk-cffi/cvsroot/gtk-cffi/g-object In directory tiger.common-lisp.net:/tmp/cvs-serv3681/g-object Modified Files: defslots.lisp package.lisp Log Message: Finished TextBuffer support --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/defslots.lisp 2011/09/21 12:03:47 1.5 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/defslots.lisp 2011/10/23 08:39:53 1.6 @@ -126,7 +126,9 @@ , at body) (free ,(or for-free name))))) -(defvar *cb-foreach*) +(defvar *callback* nil + "Lisp callback for use in gtk methods, that need callback function") + (defgeneric foreach (class func &optional data) (:documentation "For each element in CLASS execute FUNC")) (defmacro make-foreach (class &rest params) @@ -136,9 +138,9 @@ (defcfun ,gtk-name :void (,class pobject) (func pfunction) (data (pdata :free t))) (defcallback ,cb-name :void ,params ;((tag pobject) (data pdata)) - (funcall *cb-foreach* ,@(mapcar #'car params))) + (funcall *callback* ,@(mapcar #'car params))) (defmethod foreach ((,class ,class) func &optional data) (if (functionp func) - (let ((*cb-foreach* func)) + (let ((*callback* func)) (,gtk-name ,class (callback ,cb-name) data)) (,gtk-name ,class func data)))))) --- /project/gtk-cffi/cvsroot/gtk-cffi/g-object/package.lisp 2011/09/21 12:03:47 1.6 +++ /project/gtk-cffi/cvsroot/gtk-cffi/g-object/package.lisp 2011/10/23 08:39:53 1.7 @@ -17,6 +17,7 @@ ;; slots #:signals #:property + #:properties #:gsignal #:connect @@ -87,5 +88,6 @@ #:defgtkfuns #:defgdkfuns + #:*callback* #:foreach #:make-foreach)) From rklochkov at common-lisp.net Sun Oct 23 08:39:53 2011 From: rklochkov at common-lisp.net (CVS User rklochkov) Date: Sun, 23 Oct 2011 01:39:53 -0700 Subject: [gtk-cffi-cvs] CVS gtk-cffi/gtk Message-ID: 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]