scheme/extra-menus.scm

   1 ;
   2 ; module illustrating how to add your own menus to gwave
   3 ;
   4
   5 (define-module (app gwave extra-menus)
   6   :use-module (gnome-2)
   7   :use-module (gnome gtk)
   8   :use-module (app gwave cmds)
   9   :use-module (app gwave std-menus)
  10 )
  11
  12 (debug-enable 'debug)
  13 (read-enable 'positions)
  14
  15 (dbprint "extra-menus.scm running\n")
  16
  17 ; demonstrating how we can add our own menu to the end
  18 ; of the menubar by using append-hook.
  19 ; this adds some debugging options.
  20 (append-hook!
  21  new-wavewin-hook
  22  (lambda ()
  23 ;   (display "in new-wavewin-hook") (newline)
  24    (let* ((mbar (get-wavewin-menubar))
  25           (menu (menu-create mbar "Debug")))
  26        (add-menuitem menu "my menu" #f)
  27        (add-menuitem menu "garbage collect" gc)
  28
  29        (add-menuitem menu "list panels"
  30                      (lambda ()
  31                        (display "panel-list:") (newline)
  32                        (for-each (lambda (wp)
  33                                    (display wp)
  34                                    (if (wavepanel-selected? wp)
  35                                        (display "[selected]"))
  36                                    (newline))
  37                                  (wtable-wavepanels))
  38                        (newline)))
  39
  40        (add-menuitem menu "list visiblewaves"
  41                      (lambda ()
  42                        (for-each (lambda (wp)
  43                            (display "wp:") (display wp) (newline)
  44                            (for-each (lambda (vw)
  45                                        (display vw)(newline))
  46                                      (wavepanel-visiblewaves wp)))
  47                                      (wtable-wavepanels))))
  48
  49        (add-menuitem menu "list files"
  50                      (lambda ()
  51                        (display "wavefile-list:") (newline)
  52                        (display (wavefile-list))
  53                        (newline)))
  54 )))
  55
  56
  57 (append-hook!
  58  new-wavelist-hook
  59  (lambda (df)
  60 ;   (display "in extra-menus new-wavelist-hook for") (display df) (newline)
  61    (let* ((mbar (wavefile-listwin-menubar df))
  62           (menu (menu-create mbar "Debug")))
  63        (add-menuitem menu "List Variables"
  64                      (lambda ()
  65                        (display (wavefile-all-variables df))
  66                        (newline)
  67                      ))
  68        (add-menuitem menu "List Sweeps"
  69                      (lambda ()
  70                        (format #t "~s sweeps:\n" (wavefile-nsweeps df))
  71                        (display (wavefile-sweeps df)) (newline)
  72                        (for-each (lambda (s)
  73                                  (format #t " ~s = ~s\n" (car s) (cdr s)))
  74                                  (wavefile-sweeps df))
  75                      ))
  76
  77        (add-menuitem menu #f #f)
  78        )))
  79
  80 (dbprint "extra-menus.scm done\n")