1 ;;; x-menu.el --- menu support for X
3 ;; Copyright (C) 1986 Free Software Foundation, Inc.
5 ;; This file is part of GNU Emacs.
7 ;; GNU Emacs is free software; you can redistribute it and/or modify
8 ;; it under the terms of the GNU General Public License as published by
9 ;; the Free Software Foundation; either version 2, or (at your option)
12 ;; GNU Emacs is distributed in the hope that it will be useful,
13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;; GNU General Public License for more details.
17 ;; You should have received a copy of the GNU General Public License
18 ;; along with GNU Emacs; see the file COPYING. If not, write to
19 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
24 "Major mode for creating permanent menus for use with X.
25 These menus are implemented entirely in Lisp; popup menus, implemented
26 with x-popup-menu, are implemented using XMenu primitives."
27 (make-local-variable 'x-menu-items-per-line
)
28 (make-local-variable 'x-menu-item-width
)
29 (make-local-variable 'x-menu-items-alist
)
30 (make-local-variable 'x-process-mouse-hook
)
31 (make-local-variable 'x-menu-assoc-buffer
)
32 (setq buffer-read-only t
)
33 (setq truncate-lines t
)
34 (setq x-process-mouse-hook
'x-menu-pick-entry
)
35 (setq mode-line-buffer-identification
'("MENU: %32b")))
37 (defvar x-menu-max-width
0)
38 (defvar x-menu-items-per-line
0)
39 (defvar x-menu-item-width
0)
40 (defvar x-menu-items-alist nil
)
41 (defvar x-menu-assoc-buffer nil
)
43 (defvar x-menu-item-spacing
1
44 "*Minimum horizontal spacing between objects in a permanent X menu.")
46 (defun x-menu-create-menu (name)
47 "Create a permanent X menu.
48 Returns an item which should be used as a
49 menu object whenever referring to the menu."
50 (let ((old (current-buffer))
51 (buf (get-buffer-create name
)))
54 (setq x-menu-assoc-buffer old
)
58 (defun x-menu-change-associated-buffer (menu buffer
)
59 "Change associated buffer of MENU to BUFFER.
60 BUFFER should be a buffer object."
61 (let ((old (current-buffer)))
63 (setq x-menu-assoc-buffer buffer
)
66 (defun x-menu-add-item (menu item binding
)
67 "Add to MENU an item with name ITEM, associated with BINDING.
68 Following a sequence of calls to x-menu-add-item, a call to x-menu-compute
69 should be performed before the menu will be made available to the user.
71 BINDING should be a function of one argument, which is the numerical
72 button/key code as defined in x-menu.el."
73 (let ((old (current-buffer))
76 (if (setq elt
(assoc item x-menu-items-alist
))
78 (setq x-menu-items-alist
(append x-menu-items-alist
79 (list (cons item binding
)))))
83 (defun x-menu-delete-item (menu item
)
84 "Delete from MENU the item named ITEM.
85 Call `x-menu-compute' before making the menu available to the user."
86 (let ((old (current-buffer))
89 (if (setq elt
(assoc item x-menu-items-alist
))
94 (defun x-menu-activate (menu)
95 "Compute all necessary parameters for MENU.
96 This must be called whenever a menu is modified before it is made
97 available to the user. This also creates the menu itself."
98 (let ((buf (current-buffer)))
100 (let (buffer-read-only)
101 (setq x-menu-max-width
(1- (frame-width)))
102 (setq x-menu-item-width
0)
104 (items-tail x-menu-items-alist
))
106 (if (car (car items-tail
))
107 (progn (setq items-head
(cons (car items-tail
) items-head
))
108 (setq x-menu-item-width
109 (max x-menu-item-width
110 (length (car (car items-tail
)))))))
111 (setq items-tail
(cdr items-tail
)))
112 (setq x-menu-items-alist
(reverse items-head
)))
113 (setq x-menu-item-width
(+ x-menu-item-spacing x-menu-item-width
))
114 (setq x-menu-items-per-line
115 (max 1 (/ x-menu-max-width x-menu-item-width
)))
117 (let ((items-head x-menu-items-alist
))
120 (while (and items-head
121 (<= (setq items
(1+ items
)) x-menu-items-per-line
))
122 (insert (format (concat "%"
123 (int-to-string x-menu-item-width
) "s")
124 (car (car items-head
))))
125 (setq items-head
(cdr items-head
))))
127 (shrink-window (max 0
129 (1+ (count-lines (point-min) (point-max))))))
130 (goto-char (point-min)))
131 (pop-to-buffer buf
)))
133 (defun x-menu-pick-entry (position event
)
134 "Internal function for dispatching on mouse/menu events"
135 (let* ((x (min (1- x-menu-items-per-line
)
136 (/ (current-column) x-menu-item-width
)))
137 (y (- (count-lines (point-min) (point))
138 (if (zerop (current-column)) 0 1)))
139 (item (+ x
(* y x-menu-items-per-line
)))
140 (litem (cdr (nth item x-menu-items-alist
))))
141 (and litem
(funcall litem event
)))
142 (pop-to-buffer x-menu-assoc-buffer
))
144 ;;; x-menu.el ends here