public inbox for guile-gtk@sourceware.org
 help / color / mirror / Atom feed
* how to avoid gtk-standalone-main in guile, when developping
@ 2001-08-30  3:26 David Pirotte
  2001-08-31  1:57 ` Neil Jerram
  2001-08-31  6:16 ` Joshua Rosen
  0 siblings, 2 replies; 5+ messages in thread
From: David Pirotte @ 2001-08-30  3:26 UTC (permalink / raw)
  To: guile-user, guile-gtk

[-- Attachment #1: Type: text/plain, Size: 608 bytes --]

Hi,

Can someone tell me how another way then gtk-standalone-main
to launch a gui in guile? this kills the development environment
when quitting the app ... (a terrible thing, when you have 15 modules
including postres connection ... and just the latest that you work on
...)

Attached is a very simple example that uses gtk-standalone-main: what
should I do to avoid it (but be abble to 'launch' the gui of course),
getting error display messages in the guile listener and above all,
not loosing the environment, whether the gui is bugged, or whether 
I use the quit menu ...

thanks,
david
test-debug.scm


[-- Attachment #2: test-debug.scm --]
[-- Type: text/plain, Size: 4707 bytes --]

#!/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))
	  (items '("1. blabla" "2. bleble" "3. blibli" "4. bloblo"))
	  )
      ;; we should sort by names, i'll see later
      (do ((i 0 (+ 1 i)))
	  ((>= i (length items))
	   ;; (gtk-clist-append clist ci-vector)
	   )
	(vector-set! ci-vector 0 (list-ref items i))
	(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)

^ permalink raw reply	[flat|nested] 5+ messages in thread
end of thread, other threads:[~2001-09-01  4:57 UTC | newest]

Thread overview: 5+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2001-08-30  3:26 how to avoid gtk-standalone-main in guile, when developping David Pirotte
2001-08-31  1:57 ` Neil Jerram
2001-08-31  4:01   ` David Pirotte
     [not found]     ` <999269215.1502.15.camel@soleil>
2001-09-01  4:57       ` David Pirotte
2001-08-31  6:16 ` Joshua Rosen

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).