scheme/std-menus.scm

   1 ;
   2 ; module providing standard menus for gwave
   3 ;
   4
   5 (define-module (app gwave std-menus)
   6   :use-module (gnome-2)
   7   :use-module (gnome gtk)
   8   :use-module (gnome gtk gdk-event)
   9   :use-module (app gwave gtk-helpers)
  10   :use-module (app gwave cmds)
  11   :use-module (app gwave export)
  12   :use-module (app gwave globals)
  13   :use-module (app gwave utils)
  14 )
  15
  16 (debug-enable 'debug)
  17 (read-enable 'positions)
  18
  19 (dbprint "std-menus.scm running\n")
  20
  21 ;*****************************************************************************
  22 ;
  23 ; create a menuitem that calls proc when selected,
  24 ; add it to the parent widget, and return it just in case the caller needs
  25 ; to do somthing else with it too.
  26 ;
  27 (define-public (add-menuitem parent label proc)
  28   (let ((item (if label
  29                   (gtk-menu-item-new-with-label label)
  30                   (gtk-menu-item-new))))
  31     (gtk-widget-show item)
  32     (if proc
  33         (gtk-signal-connect item "activate"
  34                             (lambda (m) (proc))))
  35     (cond ((gtk-menu? parent) (gtk-menu-append parent item))
  36           ((gtk-menu-bar? parent) (gtk-menu-bar-append parent item)))
  37     item))
  38
  39 ;
  40 ; create an empty menu, along with the menuitem that acts as its title
  41 ; and optionaly attach the title to a parent object:
  42 ;   If the parent is a menu, calls gtk-menu-append
  43 ;   If the parent is a menubar, calls gtk-menu-bar-append
  44 ; returns the menu.
  45 ;
  46 (define-public (menu-create parent label)
  47   (let ((menu (gtk-menu-new)))
  48     (gtk-widget-show menu)
  49     (gtk-menu-item-set-submenu (add-menuitem parent label #f) menu)
  50     menu))
  51
  52 ;
  53 ; create a gtk-radio-menu-item that calls proc when selected,
  54 ; in a fashion very much like add-menuitem.
  55 ; add it to the parent widget, and return it.
  56 ; Caller must still handle threading up the groups.
  57 ; TODO: write a function that takes a list of lists of labels & procs,
  58 ; and creates the whole set of radio-menu-items.
  59 ;
  60 (define-public (add-radio-menuitem parent group label active proc)
  61   (let ((item (if label
  62                   (gtk-radio-menu-item-new-with-label group label)
  63                   (gtk-radio menu-item-new group))))
  64     (gtk-widget-show item)
  65     (if proc
  66         (gtk-signal-connect item "activate" (lambda (x) (proc))))
  67     (if active
  68         (gtk-check-menu-item-set-active item active))
  69     (cond ((gtk-menu? parent) (gtk-menu-append parent item))
  70           ((gtk-menu-bar? parent) (gtk-menu-bar-append parent item)))
  71     (gtk-radio-menu-item-get-group item)
  72 ))
  73
  74
  75 ;*****************************************************************************
  76 ; globals and ancilary procedures related to the menus
  77
  78 (define var-list-submenu #f)
  79
  80 (define (rebuild-varlist-submenu!)
  81   (for-each (lambda (mitem)
  82               (gtk-container-remove var-list-submenu mitem))
  83             (gtk-container-get-children var-list-submenu))
  84   (for-each (lambda (df)
  85    (add-menuitem var-list-submenu
  86                  (string-append (wavefile-tag df)
  87                                 ": "
  88                                 (wavefile-file-name df))
  89                  (lambda () (wavefile-show-listwin! df))))
  90             (wavefile-list)))
  91
  92 ;*****************************************************************************
  93 ; construct the actual menus for gwave.
  94 ;
  95
  96 ; hook called when main window opened.  Main purpose is creating the menus.
  97 (add-hook!
  98  new-wavewin-hook
  99  (lambda ()
 100    (dbprint "in std-menus new-wavewin-hook\n")
 101    (let ((win (get-wavewin))
 102          (mbar (get-wavewin-menubar)))
 103      (let ((file-menu (gtk-menu-new)))
 104        (gtk-widget-show file-menu)
 105        (gtk-menu-item-set-submenu (add-menuitem mbar "File" #f) file-menu)
 106        (add-menuitem file-menu "About GWave" show-about-window!)
 107        (add-menuitem file-menu "Read File..."
 108                      (lambda () (with-selected-filename "Datafile to load"
 109                                  (lambda (fn) (load-wavefile! fn)))))
 110        (add-menuitem file-menu "Plot..."
 111                      (lambda () (popup-plot-dialog (wtable-wavepanels))))
 112        (add-menuitem file-menu #f #f)
 113        (add-menuitem file-menu "Save Configuration as Script"
 114                      (lambda () (with-selected-filename "Scriptfile to write"
 115                                  (lambda (fn) (write-allrestore-script fn))
 116                                  #:default "gwave.gw")))
 117        (add-menuitem file-menu "Execute Guile Script..."
 118                      (lambda () (with-selected-filename
 119                                  "Guile script to run" execute-script)))
 120        (add-menuitem file-menu #f #f)
 121        (add-menuitem file-menu "Quit" (lambda () (gtk-main-quit)))
 122        )
 123      (let ((view-menu (gtk-menu-new)))
 124        (gtk-widget-show view-menu)
 125        (gtk-menu-item-set-submenu (add-menuitem mbar "View" #f) view-menu)
 126        (add-menuitem view-menu "Add Panel"
 127                      (lambda () (wtable-insert-typed-panel! #f default-wavepanel-type)))
 128        (add-menuitem view-menu "Zoom Cursors" x-zoom-cursors!)
 129        (add-menuitem view-menu "Zoom X Full" x-zoom-full!)
 130        (add-menuitem view-menu "Zoom X..." x-zoom-area!)
 131        (add-menuitem view-menu "Zoom Y..." y-zoom-range!)
 132        (add-menuitem view-menu "Zoom XY-Area..." xy-zoom-area!)
 133        (set! var-list-submenu (menu-create view-menu "Variable List"))
 134        (add-menuitem view-menu "Redraw All" wtable-redraw!)
 135        )
 136      (let ((menu (gtk-menu-new)))
 137        (gtk-widget-show menu)
 138        (gtk-menu-item-set-submenu (add-menuitem mbar "Options" #f) menu)
 139 ;       (add-menuitem menu "foo" #f)
 140
 141        (let ((ptmenu (gtk-menu-new))
 142              (group #f)
 143              (save-wp-type default-wavepanel-type)) ; GTK bug - first radio-menu-item gets immediate callback
 144          (gtk-widget-show ptmenu)
 145
 146          (do ((ptno 0 (+ ptno 1)))
 147              ((< (- wavepanel-num-types 1) ptno) #t)
 148            (dbprint (format #f "~s ~s\n" ptno (list-ref wavepanel-type-names ptno)))
 149            (set! group (add-radio-menuitem
 150                         ptmenu group (list-ref wavepanel-type-names ptno)
 151                         (eqv? save-wp-type ptno)
 152                         (lambda ()
 153                           (set! default-wavepanel-type ptno))))
 154            )
 155
 156          (gtk-menu-item-set-submenu
 157           (add-menuitem menu "Default Panel Type" #f) ptmenu)
 158          (set! default-wavepanel-type save-wp-type))
 159
 160        (let ((lxmenu (gtk-menu-new))
 161              (group #f))
 162          (gtk-widget-show lxmenu)
 163          (set! group (add-radio-menuitem
 164                       lxmenu group "Linear" #t
 165                       (lambda () (wtable-set-xlogscale! #f))))
 166          (set! group (add-radio-menuitem
 167                       lxmenu group "Log" #f
 168                       (lambda () (wtable-set-xlogscale! #t))))
 169          (gtk-menu-item-set-submenu
 170           (add-menuitem menu "X Axis Scale" #f) lxmenu))
 171
 172        (let ((submenu (gtk-menu-new))
 173              (group #f))
 174          (gtk-widget-show submenu)
 175          (set! group (add-radio-menuitem
 176                       submenu group "On" (gtk-tooltips-enabled? gwave-tooltips)
 177                       (lambda () (gtk-tooltips-enable gwave-tooltips))))
 178          (set! group (add-radio-menuitem
 179                       submenu group "Off" (not (gtk-tooltips-enabled? gwave-tooltips))
 180                       (lambda () (gtk-tooltips-disable gwave-tooltips))))
 181          (gtk-menu-item-set-submenu
 182           (add-menuitem menu "ToolTips" #f) submenu))
 183
 184        (let ((submenu (gtk-menu-new)))
 185          (gtk-widget-show submenu)
 186          (gtk-menu-item-set-submenu
 187           (add-menuitem menu "Cursor 1 Measurement" #f) submenu)
 188           (add-menuitem submenu "Cursor1 value"
 189                         (lambda () (set-all-measurements! 1 5)
 190                                 (set! default-measure1-function 5)))
 191           (add-menuitem submenu "Cursor1 val - Cursor0 val"
 192                         (lambda () (set-all-measurements! 1 6)
 193                                 (set! default-measure1-function 6)))
 194          )
 195        )
 196 )))
 197
 198 ;
 199 ; new-wavefile hook: add item to the variable-list menu for the file.
 200 ;
 201 (add-hook!
 202  new-wavefile-hook
 203  (lambda (df)
 204    (dbprint "in std-menus new-wavefile-hook " df "\n")
 205
 206    (add-menuitem var-list-submenu
 207                  (string-append (wavefile-tag df)
 208                                 ": "
 209                                 (wavefile-file-name df))
 210                  (lambda () (wavefile-show-listwin! df)))
 211    ) #t )
 212
 213 (add-hook!
 214  new-wavelist-hook
 215  (lambda (df)
 216    (dbprint "in std-menus new-wavelist-hook for " df "\n")
 217    (let* ((mbar (wavefile-listwin-menubar df))
 218           (menu (menu-create mbar "File")))
 219      (dbprint "    mbar is " mbar " menu is " menu "\n")
 220      (show mbar)
 221      (show menu)
 222        (add-menuitem menu "Reload this File"
 223                      (lambda () (wavefile-reload! df)))
 224        (add-menuitem menu "Export Data..."
 225                      (lambda ()
 226                        (popup-export-dialog (wavefile-all-variables df))))
 227        (add-menuitem menu "Unload this File"
 228                      (lambda ()
 229                        (wavefile-delete! df)
 230                        (rebuild-varlist-submenu!)
 231                        (wtable-redraw!)))
 232        (add-menuitem menu "Save Configuration as Script"
 233                      (lambda () (with-selected-filename "Scriptfile to write"
 234                                  (lambda (fn) (write-filerestore-script df fn))
 235                                  #:default (string-append
 236                                             (wavefile-file-name df) ".gw"))))
 237        (add-menuitem menu "Apply Script to File"
 238                      (lambda () (with-selected-filename "Guile script to run"
 239                                  (lambda (fn) (apply-script-to-file fn df)))))
 240
 241        (add-menuitem menu #f #f)
 242        (add-menuitem menu "Close"
 243                  (lambda () (wavefile-remove-listwin! df)))
 244        )))
 245
 246 ;
 247 ; Popup menu on button 3 in a wavepanel.
 248 ; Note that the menu is constructed anew each time, so that it can be
 249 ; context-sensitive.  So far this hasn't produced any noticable popup delay.
 250 ;
 251
 252 (wavepanel-bind-mouse 3
 253  (lambda (wp event)
 254 ;   (display "in wavepanel menu ")(display wp)
 255 ;   (display " type=") (display (wavepanel-type wp))   (newline)
 256    (let ((menu (gtk-menu-new))
 257          (next-ptype (remainder (+ 1 (wavepanel-type wp)) wavepanel-num-types)))
 258      (gtk-widget-show menu)
 259      (add-menuitem menu "Zoom Cursors" x-zoom-cursors!)
 260      (add-menuitem menu "Zoom X..." x-zoom-area!)
 261      (add-menuitem menu "Zoom X Full" x-zoom-full!)
 262      (add-menuitem menu "Zoom Y..." y-zoom-range!)
 263      (add-menuitem menu "Zoom Y Full+Auto" (lambda () (y-zoom-fullauto! wp)))
 264      (add-menuitem menu "Zoom XY-Area..." xy-zoom-area!)
 265      (add-menuitem menu "Zoom Dialog..." (lambda () (show-zoom-dialog! wp)))
 266      (add-menuitem menu "Insert Panel Above"
 267                    (lambda () (wtable-insert-typed-panel! wp default-wavepanel-type)))
 268      (add-menuitem menu "Delete this Panel"
 269                    (lambda () (wtable-delete-panel! wp)))
 270      (add-menuitem menu "Plot..."
 271                    (lambda () (popup-plot-dialog (list wp))))
 272      (add-menuitem
 273       menu
 274       (string-append "Set type " (list-ref wavepanel-type-names next-ptype))
 275       (lambda () (set-wavepanel-type! wp next-ptype)))
 276
 277      (if (wavepanel-ylogscale? wp)
 278          (add-menuitem menu "Linear Y Scale"
 279                    (lambda () (set-wavepanel-ylogscale! wp #f)))
 280          (add-menuitem menu "Log Y Scale"
 281                    (lambda () (set-wavepanel-ylogscale! wp #t))))
 282
 283      (gtk-menu-popup menu #f #f  #f
 284                      ;#f
 285                      (gdk-event-button:button event)
 286                      (gdk-event-button:time event))
 287      )))
 288
 289 (dbprint "std-menus.scm done\n")