[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: gEDA: Attributes



On Wed, 19 Apr 2000, Stephen Tell wrote:

> On Tue, 18 Apr 2000, Ales Hvezda wrote:
> 
> > thinking about the pulldown menus over the past few months.  I would
> > like to put the hotkeystrokes into the menus.  That would unfortunately
> > require a slight rewrite of the pulldown code, but while I'm doing that,
> > I would also like a way to configure what goes into the pulldowns via
> > scheme.  Now I could come up with something that's not coupled to the
> > current keymapping scheme code, but I would rather not have two different
> > decoupled ways of specifying keymaps/functions.  Any ideas on how this
> > could be done (nicely)?
> 
> In my experimental version of gwave, I made menus configurable from guile
> by evicting the entire menu-building code out of C and into scheme, and
> using guile-gtk to build the menus themselves.  Constructing Gtk+ menus is
> much easier when you build a few little helper function anyway (whether in
> C or guile), so I would imagine that a suitable guile function could
> construct and attach a menu item, and also bind a keystroke to the same
> action procedure. 

This sounded so cool to be true. I have a small guile-gtk hack (attached
to this letter) which creates a window and some small pull downs. I
started gschem, ran File/Script Execute ... and the window popped up!! 

I've attached the guile-gtk script because it can give an idea on how to
create a menu by a (quite) simple define and a helper function.

It is a bit messy (todays understatement but the day is currently only
6 minutes old:-) ) but anyhow...

If you have guile-gtk you can run it by 'guile drop-down.scm'.

Regards,
/spe
/----------------------------------\
! Stefan Petersen, MSc EE         !  \    
! http://www.stacken.kth.se/~spe/ !    \___________
! spe@stacken.kth.se              !    /
! stefan.petersen@home.se         !  /
\----------------------------------/
;#! /bin/sh
;exec guile-gtk -e main -s $0 $*
;!#

(use-modules (gtk gtk))

(define (yes-clicked)
  (display "Du tryckte just jaknappen")
  (newline))

(define (no-clicked)
  (display "Du tryckte just nejknappen")
  (newline))

(define (create-my-menu)
  (let ((menu-bar (gtk-menu-bar-new))
	(file-item (gtk-menu-item-new-with-label "File"))
	(file-menu (gtk-menu-new))
	(open-item (gtk-menu-item-new-with-label "Open"))
	(save-item (gtk-menu-item-new-with-label "Save"))
	(quit-item (gtk-menu-item-new-with-label "Quit"))
	(test-button (gtk-button-new))

	(resource-item (gtk-menu-item-new-with-label "Resources"))
	(resource-menu (gtk-menu-new))
	(flight-item (gtk-menu-item-new-with-label "Flight"))
	(car-item (gtk-menu-item-new-with-label "Car"))
	(bus-item (gtk-menu-item-new-with-label "Bus")))
		       

    (gtk-menu-append file-menu open-item)
       (gtk-menu-append file-menu save-item)
       (gtk-menu-append file-menu quit-item)
       (gtk-menu-item-set-submenu file-item file-menu)
       (gtk-menu-bar-append menu-bar file-item)
       
       (gtk-signal-connect open-item "activate"
			   (lambda ()
			     (display "Open")
			     (newline)))
       (gtk-signal-connect save-item "activate"
			   (lambda ()
			     (display "Save")
			     (newline)))
       (gtk-signal-connect quit-item "activate" gtk-exit)

       (gtk-menu-append resource-menu flight-item)
       (gtk-menu-append resource-menu car-item)
       (gtk-menu-append resource-menu bus-item)
       (gtk-menu-item-set-submenu resource-item resource-menu)
       (gtk-menu-bar-append menu-bar resource-item)
       
       menu-bar ))

(define (open-func)
  (display "Open")
  (newline))
(define (save-func)
  (display "Save")
  (newline))
(define (kvinno-func)
  (display "Kvinna")
  (newline))
(define (man-func)
  (display "Man")
  (newline))

(define my-menu
  (list
   (list "File" 
	 (cons "Open" (lambda () 
			(display "Detta är den nya öppningsfunktionen") 
			(newline)))
	 (cons "Save" save-func)
	 (cons "Quit" gtk-exit))
   (list "Människor"
	 (cons "Kvinnor" kvinno-func)
	 (cons "Män" man-func))))

(define (handle-menu menu-desc)
  (let ((menu-bar (gtk-menu-bar-new)))
    (for-each (lambda (submenu)
		(let ((top-menu-item (gtk-menu-item-new-with-label (car submenu)))
		      (top-menu (gtk-menu-new))
		      (submenu-items (cdr submenu)))
		  (gtk-menu-item-set-submenu top-menu-item top-menu)
		     (gtk-menu-bar-append menu-bar top-menu-item)
;		  (display (car submenu))
;		  (display ": ")
		     (for-each (lambda (submenu-item)
				 (let ((submenu-gtk-item (gtk-menu-item-new-with-label (car submenu-item))))
				   (gtk-menu-append top-menu submenu-gtk-item)
				      (gtk-signal-connect submenu-gtk-item "activate" (cdr submenu-item))
;				      (display (car submenu-item))
;				      (display " ")
				      ))
			       submenu-items)
;		     (newline)
		     ))
	      menu-desc)
       menu-bar))

(let ((window (gtk-window-new 'toplevel))
      (ab-box (gtk-hbox-new #t 0))
      (yesno-box (gtk-hbox-new #t 0))
      (main-box (gtk-vbox-new #t 5))
      (a-button (gtk-toggle-button-new-with-label "A"))
      (b-button (gtk-toggle-button-new-with-label "B"))
      (yes-button (gtk-button-new-with-label "YES"))
      (no-button (gtk-button-new-with-label "NO"))
      (close-button (gtk-button-new-with-label "CLOSE")))
  
  (gtk-window-set-title window "Mitt första program")
     (gtk-container-border-width window 10)
     (gtk-container-add window main-box)
;     (gtk-box-pack-start main-box (create-my-menu))
     (gtk-box-pack-start main-box (handle-menu my-menu))
     (gtk-box-pack-start main-box ab-box)
     (gtk-box-pack-start main-box yesno-box)
     (gtk-box-pack-start main-box close-button)

     (gtk-box-pack-start ab-box a-button)
     (gtk-box-pack-start ab-box b-button)
     (gtk-signal-connect a-button "toggled"
			 (lambda ()
			   (display "A ")
			   (if (gtk-toggle-button-active a-button)
			       (display "Active")
			       (display "Inactive"))
			   (newline)))
     (gtk-signal-connect b-button "toggled"
			 (lambda ()
			   (display "B ")
			   (if (gtk-toggle-button-active b-button)
			       (display "Active")
			       (display "Inactive"))
			   (newline)))
     
     
     (gtk-box-pack-start yesno-box yes-button #f)
     (gtk-box-pack-start yesno-box no-button #f)
     (gtk-signal-connect yes-button "clicked" yes-clicked)
     (gtk-signal-connect no-button "clicked" no-clicked)
     (gtk-signal-connect close-button "clicked" 
			 (lambda () 
			   (gtk-main-quit)))
;;     (display (gtk-widget-get-style yesno-box))
     (gtk-widget-show-all window)
     (gtk-standalone-main window))