unmaintained/factory/factory-menus

   1 ! -*-factor-*-
   2
   3 USING: kernel unix vars mortar mortar.sugar slot-accessors
   4        x.widgets.wm.menu x.widgets.wm.unmapped-frames-menu
   5        factory.commands factory.load ;
   6
   7 IN: factory
   8
   9 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  10
  11 ! Helper words
  12
  13 : new-wm-menu ( -- menu ) <wm-menu> new* 1 <-- set-border-width ;
  14
  15 : shrink-wrap ( menu -- ) dup <- calc-size <-- resize drop ;
  16
  17 : set-menu-items ( items menu -- ) swap >>items shrink-wrap ;
  18
  19 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  20
  21 VAR: apps-menu
  22
  23 apps-menu> not [ new-wm-menu >apps-menu ] when
  24
  25 { { "Emacs"     [ "emacs &" system drop ] }
  26   { "KMail"     [ "kmail &" system drop ] }
  27   { "Akregator" [ "akregator &" system drop ] }
  28   { "Amarok"    [ "amarok &" system drop ] }
  29   { "K3b"       [ "k3b &" system drop ] }
  30   { "xchat"     [ "xchat &" system drop ] }
  31   { "Nautilus"  [ "nautilus --no-desktop &" system drop ] }
  32   { "synaptic"  [ "gksudo synaptic &" system drop ] }
  33   { "Volume control" [ "gnome-volume-control &" system drop ] }
  34   { "Azureus"        [ "~/azureus/azureus &" system drop ] }
  35   { "Xephyr"         [ "Xephyr -host-cursor :1 &" system drop ] }
  36   { "Stop Xephyr"    [ "pkill Xephyr &" system drop ] }
  37   { "Stop Firefox"   [ "pkill firefox &" system drop ] }
  38 } apps-menu> set-menu-items
  39
  40 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  41
  42 VAR: emacs-menu
  43
  44 emacs-menu> not [ new-wm-menu >emacs-menu ] when
  45
  46 { { "Start Emacs" [ "emacs &" system drop ] }
  47   { "Small"  [ "emacsclient -e '(make-small-frame-command)' &" system drop ] }
  48   { "Large"  [ "emacsclient -e '(make-frame-command)' &" system drop ] }
  49   { "Full"   [ "emacsclient -e '(make-full-frame-command)' &" system drop ] }
  50   { "Gnus"   [ "emacsclient -e '(gnus-other-frame)' &" system drop ] }
  51   { "Factor" [ "emacsclient -e '(run-factor-other-frame)' &" system drop ] }
  52 } emacs-menu> set-menu-items
  53
  54 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  55
  56 VAR: mail-menu
  57
  58 mail-menu> not [ new-wm-menu >mail-menu ] when
  59
  60 { { "Kmail"   [ "kmail &" system drop ] }
  61   { "compose" [ "kmail --composer &" system drop ] }
  62   { "slava"   [ "kmail slava@factorcode.org &" system drop ] }
  63   { "erg"     [ "kmail doug.coleman@gmail.com &" system drop ] }
  64   { "doublec" [ "kmail chris.double@double.co.nz &" system drop ] }
  65   { "yuuki"   [ "kmail matthew.willis@mac.com &" system drop ] }
  66 } mail-menu> set-menu-items
  67
  68 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  69
  70 VAR: factor-menu
  71
  72 factor-menu> not [ new-wm-menu >factor-menu ] when
  73
  74 { { "Factor" [ "cd /scratch/repos/Factor ; ./factor &" system drop ] }
  75   { "Factor (tty)"
  76     [ "cd /scratch/repos/Factor ; xterm -e ./factor -run=listener &"
  77       system drop ] }
  78   { "Terminal : repos/Factor"
  79     [ "cd /scratch/repos/Factor ; xterm &" system drop ] }
  80   { "darcs whatsnew"
  81     [ "cd /scratch/repos/Factor ; xterm -e 'darcs whatsnew | less' &"
  82       system drop ] }
  83   { "darcs pull"
  84     [ "cd /scratch/repos/Factor ; xterm -e 'darcs pull http://factorcode.org/repos' &" system drop ] }
  85   { "darcs push"
  86     [ "cd /scratch/repos/Factor ; xterm -e 'darcs push dharmatech@onigirihouse.com:doc-root/repos' &" system drop ] }
  87 } factor-menu> set-menu-items
  88
  89 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
  90
  91 VAR: factory-menu
  92
  93 factory-menu> not [ new-wm-menu >factory-menu ] when
  94
  95 { { "Maximize"          [ maximize ] }
  96   { "Maximize Vertical" [ maximize-vertical ] }
  97   { "Restore"           [ restore ] }
  98   { "Hide"              [ minimize ] }
  99   { "Tile Master"       [ tile-master ] }
 100 }
 101
 102 factory-menu> set-menu-items
 103
 104 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 105
 106 ! VAR: root-menu
 107
 108 { { "xterm"             [ "urxvt -bd grey +sb &" system drop ] }
 109   { "Firefox"           [ "firefox &" system drop ] }
 110   { "xclock"            [ "xclock &" system drop ] }
 111   { "Apps >"            [ apps-menu> <- popup ] }
 112   { "Factor >"          [ factor-menu> <- popup ] }
 113   { "Unmapped frames >" [ unmapped-frames-menu> <- popup ] }
 114   { "Emacs >"           [ emacs-menu> <- popup ] }
 115   { "Mail >"            [ mail-menu> <- popup ] }
 116   { "onigirihouse"      [ "xterm -e 'ssh dharmatech@onigirihouse.com' &"
 117                           system drop ] }
 118   { "Edit menus"        [ edit-factory-menus ] }
 119   { "Reload menus"      [ load-factory-menus ] }
 120   { "Factory >"         [ factory-menu> <- popup ] }
 121 } root-menu> set-menu-items
 122