← Back to branch summary

~ubuntu-branches/ubuntu/lucid/sawfish/lucid-updates

« back to all changes in this revision

Viewing changes to scripts/sawfish-menu.jl

  • Committer: Bazaar Package Importer
  • Author(s): Christian Marillat
  • Date: 2005-02-23 16:16:46 UTC
  • mfrom: (1.2.1 upstream) (2.1.2 hoary)
  • Revision ID: james.westby@ubuntu.com-20050223161646-4id6qyw4h9lkvb0v
Tags: 1:1.3+cvs20050222-1
http://bugs.debian.org/295290
* New cvs release.
* Add an emacs initialisation script to load sawfish.el (Closes: #295290)
* Updated sawfish.el to 1.32

Show diffs side-by-side

added added

removed removed

Lines of Context:
scripts/sawfish-menu.jl
3
3
!#
4
4
 
5
5
;; sawmill-menu -- subprocess to handle menus
6
 
;; $Id: sawfish-menu.jl,v 1.6 2000/12/19 23:05:43 jsh Exp $
 
6
;; $Id: sawfish-menu.jl,v 1.8 2003/04/03 02:23:33 jsh Exp $
7
7
 
8
8
;; Copyright (C) 1999 John Harper <john@dcs.warwick.ac.uk>
9
9
 
23
23
;; along with sawmill; see the file COPYING.  If not, write to
24
24
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
25
25
 
26
 
(require 'gui.gtk)
 
26
(require 'gui.gtk-2.gtk)
27
27
(require 'rep.data.tables)
28
28
 
29
29
 
39
39
(define (group-id-ref id) (table-ref (fluid group-table) id))
40
40
 
41
41
(define (create-menu spec #!optional bar)
42
 
  (let* ((menu (if bar (gtk-menu-bar-new) (gtk-menu-new)))
43
 
         (accels (gtk-menu-ensure-uline-accel-group menu)))
 
42
  (let* ((menu (if bar (gtk-menu-bar-new) (gtk-menu-new))))
44
43
 
45
44
    ;; Set the label of the menu item, handling underlined accelerators
46
45
    (define (label-menu-item item label-text #!optional shortcut)
47
 
      (let* ((label (gtk-label-new label-text))
48
 
             (hbox (gtk-hbox-new nil 16))
49
 
             (hkey (gtk-label-parse-uline label label-text)))
 
46
      (let* ((label (gtk-label-new-with-mnemonic label-text))
 
47
             (hbox (gtk-hbox-new nil 16)))
50
48
        (gtk-box-pack-start hbox label nil nil t 0)
51
49
        (when shortcut
52
50
          (let ((accel (gtk-label-new shortcut)))
53
51
            (gtk-box-pack-end hbox accel nil nil 0)))
54
 
        (gtk-widget-add-accelerator item "activate_item" accels hkey 0 0)
55
52
        (gtk-widget-show-all hbox)
56
53
        (gtk-container-add item hbox)))
57
54
 
85
82
                             (group-id-set group item))
86
83
                            (check
87
84
                             (setq item (gtk-check-menu-item-new))
88
 
                             (gtk-check-menu-item-set-show-toggle item t))
 
85
                             (gtk-check-menu-item-set-active item t))
89
86
                            (t (setq item (gtk-menu-item-new))))
90
87
                      (label-menu-item item label shortcut)
91
88
                      (when check
92
 
                        (gtk-check-menu-item-set-state item (cdr check)))
 
89
                        (gtk-check-menu-item-set-active item (cdr check)))
93
90
                      (when insensitive
94
91
                        (gtk-widget-set-sensitive item nil))))
95
92
 
96
 
                  (gtk-signal-connect
 
93
                  (g-signal-connect
97
94
                   item "activate" (lambda ()
98
95
                                     (setq menu-selected (car cell))))))
99
96
              (when item
100
 
                (gtk-widget-lock-accelerators item)
101
 
                ((if bar gtk-menu-bar-append gtk-menu-append) menu item)
 
97
                ;;(gtk-widget-lock-accelerators item)
 
98
                (gtk-menu-shell-append menu item)
102
99
                (gtk-widget-show item))))
103
100
          spec)
104
101
    menu))
106
103
(define (popup-menu spec #!optional timestamp position)
107
104
  (let ((menu (let-fluids ((group-table (make-group-table)))
108
105
                (create-menu spec))))
109
 
    (gtk-signal-connect menu "deactivate" gtk-main-quit)
 
106
    (g-signal-connect menu "deactivate" gtk-main-quit)
110
107
    (setq menu-selected nil)
111
108
    (gtk-menu-popup-interp menu nil nil 0 (or timestamp 0) position)
112
 
    (gtk-main)
 
109
    (when (memq 'visible (GTK-WIDGET-FLAGS menu))
 
110
      (gtk-main))
113
111
    menu-selected))
114
112
 
115
113