Re: guile-1.5.1, gtk crashes

[David Pirotte <david at altosw dot be>]

Ariel Rios wrote:
> 
> On 22 Aug 2001 16:35:47 +0200, David Pirotte wrote:
> > hi,
> >
> > is there anything i can do to get more info on the following
> > crash?
> Strange.. Is there an easy and simple way I can reproduce it?


;; -- 1.

ok, here is a piece of code, minimal, which launch itself and correctly
open the dialog, but when either pressing the button "OK", "Annuler",
or hitting the top-right cross to close it, leads to the same strange
bug:

	david@faust:~/alto/projects/guile/share/alto/tactus 68 $ ./test-debug.scm 
* ==>	Gdk-ERROR **: Fatal IO error 0 (Succès.) on X server :0.0.
	david@faust:~/alto/projects/guile/share/alto/tactus 69 $ 


* the Gdk-ERROR ... comes when I close the dialog, using one of the 3 methods


;; -- 2.

the same piece of code sometimes launch itself properly, sometimes immediately
trigger the same error message:

	david@faust:~/alto/projects/guile/share/alto/tactus 68 $ ./test-debug.scm 
	Gdk-ERROR **: Fatal IO error 0 (Succès.) on X server :0.0.
	david@faust:~/alto/projects/guile/share/alto/tactus 69 $ 

;; -- 3.

i'll try to add slowly other signal and other code until it crashes `realiably'
and let you know


thanks a lot for your help,
i hope we can find a solution soon,
david


;; -- begining of "test-debug.scm" content
#!/usr/local/bin/guile -s
!#

;(use-modules (ice-9 format))
;(use-modules (oop goops))
;(use-modules (database postgres))
;(use-modules (site g-wrap sorting))
;; (use-modules (gnome gnome))
(use-modules (gtk gtk))
;; (use-modules (gtk gdk))
;; (use-modules (struct gtrees))

;(use-modules (alto gtk-utils gtk-utils))
;(use-modules (alto db-utils db-attr-def))
;(use-modules (alto db-utils db-con))
;(use-modules (alto db-utils db-tb-def))
;(use-modules (alto db-utils db-tb-cl-mt))
;(use-modules (alto db-utils db-utils))
;(use-modules (alto tactus db))
;(use-modules (alto tactus db-proj))
;; (use-modules (alto tactus db-cha))
;; (use-modules (alto tactus db-equ))
;; (use-modules (alto tactus db-rent))


;(define *rent/cur-proj* #f)
;(define *rent/cur-proj-row* #f)
;(define *rent/status-bar* #f)
;(define *rent/progress-bar* #f)

;(define (update-clist-entries clist)
;  (gtk-clist-clear clist)
;  (let ((ci-vector (make-vector 5 ""))
;	(db-objects (db-objects *db-cha/tb-def*))
;	(db-length (db-length *db-cha/tb-def*)))
;    (if (and db-length
;	     (> db-length 0))
;	(do ((object #f)
;	     (i 0 (+ 1 i)))
;	    ((>= i db-length)
;	     ;; (set! *pays-gui/clist-current-object*
;	     ;;  (db-pays/get-obj-from-pos *db-pays/db-object* 0))
;	     )
;	  (set! object (list-ref db-objects i))
;	  (vector-set! ci-vector 0 (reference object))
;	  (vector-set! ci-vector 1 (nom object))
;	  (vector-set! ci-vector 2 (localite object))
;	  ;; (vector-set! ci-vector 2 (zone object)) ;; via l'equipe et le chef
;	  ;; date me, via la gest fin ...
;	  (gtk-clist-append clist ci-vector))
;	;;(begin
;	;;(set! *pays-gui/clist-current-object* #f)
;	;;(pays-gui/check-nav-tb-sensitive-needs 0))
;	)
;    ))

;(define (rent/select-proj-1 proj-row clist)
;  (let ((project (get-obj-from-pos *db-proj/tb-def* proj-row)))
;    (set! *rent/cur-proj* project)
;    (set! *rent/cur-proj-row* proj-row)
;    ;; chagerment ici
;    (update-class-instances-for-project *rent/cur-proj*
;					*rent/status-bar*
;					*rent/progress-bar*)
;    (update-clist-entries clist)
;    ))

;(define (rent/select-proj-2 proj-name clist)
;  (let ((pos (get-obj-pos-from-value-1 *db-proj/tb-def* proj-name 2)))
;    (rent/select-proj-1 pos clist)))

(define (rent/select-proj . proj-row)
  (let* ((dialog (gtk-dialog-new))

	 (vbox-area (gtk-dialog-vbox dialog))
	 (action-area (gtk-dialog-action-area dialog))
	 
	 (scrollw (gtk-scrolled-window-new #f #f))
	 (clist ;; (gtk-clist-new-with-titles #("Projets"))
		(gtk-clist-new 1))
	 (clist-selection #f)

	 (ok-but (gtk-button-new-with-label "OK"))
	 (annuler-but (gtk-button-new-with-label "Annuler"))

	 )
    
    (gtk-window-set-title dialog "Choississez un projet")
    (gtk-window-set-modal dialog #t)

    (gtk-container-border-width dialog 0)
    (gtk-container-border-width vbox-area 5)
    (gtk-box-set-spacing vbox-area 5) 
    (gtk-container-border-width action-area 0)
    (gtk-box-set-spacing action-area 5)
    ;; (gtk-container-border-width ok-but 0)
    (gtk-widget-set-usize dialog 220 230)
    
    (gtk-box-pack-start vbox-area scrollw #t #t 0)
    (gtk-scrolled-window-set-policy scrollw 'automatic 'automatic)
    ;; (gtk-widget-set-usize scrollw -2 150)
    (gtk-container-add scrollw clist)
    (gtk-clist-set-selection-mode clist 'browse)
    (gtk-clist-set-sort-type clist 'ascending)
    (gtk-clist-set-column-justification clist 0 'center)
    (gtk-clist-set-column-width clist 0 80)

    ;(let ((ci-vector (make-vector 1 ""))
;	  (db-objects (db-objects *db-proj/tb-def*))
;	  (db-length (db-length *db-proj/tb-def*)))
;      ;; we should sort by names, i'll see later
;      (if (and db-length
;	       (> db-length 0))
;	  (do ((object #f)
;	       (i 0 (+ 1 i)))
;	      ((>= i db-length)
;	       )
;	    (set! object (list-ref db-objects i))
;	    (vector-set! ci-vector 0 (nom object))
;	    (gtk-clist-append clist ci-vector))
;	    ))

    ;(gtk-signal-connect clist "select_row"
	;		(lambda (row col event) 
	;		  ;; (format #t "Row: ~S, Col: ~S, Event: ~S~%" row col event)
	;		  (rent/select-proj-1 row clist)
	;		  ))

    ;(gtk-clist-select-row clist
	;		  (if (null? proj-row) 0 (car proj-row))
	;		  0)

    ;; buttons
    (gtk-signal-connect annuler-but "clicked" 
			(lambda () 
			  ;; (rent/gui-1)
			  (gtk-widget-destroy dialog)
			  ))
					;(gtk-widget-grab-default ok-but)
					;(gtk-widget-set-flags ok-but '(can-default))
    (gtk-box-pack-start action-area
			annuler-but #t #t 0)
    
    (gtk-signal-connect ok-but "clicked" 
			(lambda () 
			  ;; (rent/gui-1)
			  (gtk-widget-destroy dialog)
			  ))
					;(gtk-widget-grab-default ok-but)
					;(gtk-widget-set-flags ok-but '(can-default))
    (gtk-box-pack-start action-area ok-but #t #t 0)
    
    (gtk-widget-show-all dialog)
    (gtk-standalone-main dialog)
    ))

(rent/select-proj)
;; -- end of "test-debug.scm" content