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                        (format #t "wavefile-list: ~a\n" (wavefile-list))))
  52
  53        (add-menuitem menu "waveform calculate test"
  54                      (lambda ()
  55                        (display "calculate-waves stub\n")
  56                        (let ((wvlist (all-selected-waves)))
  57                          (cond
  58                           ((eq? 2 (length wvlist))
  59                            (let* ((w1 (car wvlist))
  60                                   (w2 (cadr wvlist))
  61                                   (newname (format #f "~a-~a"
  62                                                    (visiblewave-varname w1)
  63                                                    (visiblewave-varname w2))))
  64                              (format #t "calc ~s - ~s => ~s\n"  w1 w2 newname)
  65                              (new-wavevar-calc! newname - w1 w2)
  66                              ))
  67
  68                           ((eq? 1 (length wvlist))
  69                            (let* ((w1 (car wvlist))
  70                                   (newname (format #f "(-~a)"
  71                                                    (visiblewave-varname w1))))
  72                              (format #t "calc - ~s => ~s\n"  w1 newname)
  73                              (new-wavevar-calc! newname - w1)
  74                              ))
  75
  76                           (else (display "calculate requires one or two waves.\n"))
  77                           ))))
  78
  79
  80 )))
  81
  82
  83 (append-hook!
  84  new-wavelist-hook
  85  (lambda (df)
  86 ;   (display "in extra-menus new-wavelist-hook for") (display df) (newline)
  87    (let* ((mbar (wavefile-listwin-menubar df))
  88           (menu (menu-create mbar "Debug")))
  89        (add-menuitem menu "List Variables"
  90                      (lambda ()
  91                        (display (wavefile-all-variables df))
  92                        (newline)
  93                      ))
  94        (add-menuitem menu "List Sweeps"
  95                      (lambda ()
  96                        (format #t "~s sweeps:\n" (wavefile-nsweeps df))
  97                        (display (wavefile-sweeps df)) (newline)
  98                        (for-each (lambda (s)
  99                                  (format #t " ~s = ~s\n" (car s) (cdr s)))
 100                                  (wavefile-sweeps df))
 101                      ))
 102
 103        (add-menuitem menu #f #f)
 104        )))
 105
 106 (dbprint "extra-menus.scm done\n")