Re: guile-1.5.1, gtk crashes

[David Pirotte]

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:

        address@hidden:~/alto/projects/guile/share/alto/tactus 68 $ 
./test-debug.scm 
* ==>   Gdk-ERROR **: Fatal IO error 0 (Succès.) on X server :0.0.
        address@hidden:~/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:

        address@hidden:~/alto/projects/guile/share/alto/tactus 68 $ 
./test-debug.scm 
        Gdk-ERROR **: Fatal IO error 0 (Succès.) on X server :0.0.
        address@hidden:~/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