1;; Copyright (C) 2004 Patrick Bernaud
2;; GNU General Public License version 2 or later. No warrantee.
3
4(define-module (demos menus)
5  :use-module (oop goops)
6  :use-module (gnome gobject)
7  :use-module (gnome gtk))
8
9
10(define (main)
11
12  (define (create-menu depth tearoff)
13    (and=> (>= depth 1)
14	   (lambda (x)
15	     (let ((menu  (make <gtk-menu>)))
16	       (if tearoff (append menu (make <gtk-tearoff-menu-item>)))
17	       (let loop ((i     0)
18			  (group #f))
19		 (let ((menuitem (gtk-radio-menu-item-new-with-label
20				  group
21				  (format #f "item ~A - ~A" depth (+ 1 i)))))
22		   (append menu menuitem)
23		   (set-sensitive menuitem (not (eq? i 3)))
24		   (if (> depth 1)
25		       (set-submenu menuitem
26				    (create-menu (- depth 1) tearoff)))
27		   (if (< i 4)
28		       (loop (+ i 1) (get-group menuitem)))))
29	       menu))))
30
31  (let ((window     (make <gtk-window>
32		      :type 'toplevel :title "menus" :border-width 0))
33	(accelgroup (make <gtk-accel-group>))
34	(box1       (make <gtk-vbox> :homogeneous #f :spacing 0))
35	(menubar    (make <gtk-menu-bar>))
36	(box2       (make <gtk-vbox>
37		      :homogeneous #f :spacing 10 :border-width 10))
38	(button     (make <gtk-button> :label "close")))
39    (connect window 'delete-event (lambda (w e) (gtk-true)))
40
41    (add-accel-group window accelgroup)
42
43    (add window box1)
44
45    (pack-start box1 menubar #f #t 0)
46
47    (for-each
48     (lambda (m)
49       (let ((menu       (create-menu (cdr m) #t))
50	     (menuitem   (gtk-menu-item-new-with-label (car m))))
51	 (set-submenu menuitem menu)
52	 (set-right-justified menuitem (string=? (car m) "bar"))
53	 (append menubar menuitem)))
54     '(("test\nline2" . 2)
55       ("foo" . 3)
56       ("bar" . 4)))
57
58    (pack-start box1 box2 #f #t 0)
59
60    (connect button 'clicked (lambda (w)
61			       (destroy window)))
62    (pack-start box2 button #t #t 0)
63;    GTK_WIDGET_SET_FLAGS (button, GTK_CAN_DEFAULT);
64;    (grab-default button)
65
66    (show-all window)))
67
68
69(define name "Menus")
70(define description
71  (string-append
72   "There are several widgets involved in displaying menus. The"
73   "GtkMenuBar widget is a horizontal menu bar, which normally appears"
74   "at the top of an application. The GtkMenu widget is the actual menu"
75   "that pops up. Both GtkMenuBar and GtkMenu are subclasses of"
76   "GtkMenuShell; a GtkMenuShell contains menu items"
77   "(GtkMenuItem). Each menu item contains text and/or images and can"
78   "be selected by the user."
79   "\n"
80   "There are several kinds of menu item, including plain GtkMenuItem,"
81   "GtkCheckMenuItem which can be checked/unchecked, GtkRadioMenuItem"
82   "which is a check menu item that's in a mutually exclusive group,"
83   "GtkSeparatorMenuItem which is a separator bar, GtkTearoffMenuItem"
84   "which allows a GtkMenu to be torn off, and GtkImageMenuItem which"
85   "can place a GtkImage or other widget next to the menu text."
86   "\n"
87   "A GtkMenuItem can have a submenu, which is simply a GtkMenu to pop"
88   "up when the menu item is selected. Typically, all menu items in a menu bar"
89   "have submenus."
90   "\n"
91   "GtkUIManager provides a higher-level interface for creating menu bars"
92   "and menus; while you can construct menus manually, most people don't"
93   "do that. There's a separate demo for GtkUIManager."))
94