Mercurial > hg > xemacs-beta
diff lisp/vm/vm-easymenu.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
author | cvs |
---|---|
date | Mon, 13 Aug 2007 08:45:50 +0200 |
parents | |
children |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/lisp/vm/vm-easymenu.el Mon Aug 13 08:45:50 2007 +0200 @@ -0,0 +1,225 @@ +;;; easymenu.el --- support the easymenu interface for defining a menu. + +;; Copyright (C) 1994 Free Software Foundation, Inc. + +;; Keywords: emulations +;; Author: rms + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation; either version 2, or (at your option) +;; any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to +;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. + +;;; This is compatible with easymenu.el by Per Abrahamsen +;;; but it is much simpler as it doesn't try to support other Emacs versions. +;;; The code was mostly derived from lmenu.el. + +;;; Changed 17-May-1995, Kyle Jones +;;; Made easy-menu-create-keymaps handle the +;;; [ NAME CALLBACK ENABLE ] +;;; case properly. Previously the enabler function was not +;;; being put on the property list of the command. +;;; Changed 20-May-1995, Kyle Jones +;;; Made easy-menu-create-keymaps handle the +;;; [ NAME CALLBACK ENABLE SUFFIX ] +;;; case properly. +;;; Changed 25-May-1995, Kyle Jones +;;; Renamed easy-menu- functions to vm-easy-menu- to avoid +;;; non-vm compatible versions. +;;; Changed 2-July-1995, Kyle Jones +;;; If callback is a symbol use it in the menu keymap instead +;;; of the uninterned menu-function-XXX symbols. This allows +;;; Emacs' menu code to set this-command properly when +;;; launching a command from the menubar. +;;; +;;; Code: + +(provide 'vm-easymenu) + +;;;###autoload +(defmacro vm-easy-menu-define (symbol maps doc menu) + "Define a menu bar submenu in maps MAPS, according to MENU. +The menu keymap is stored in symbol SYMBOL, both as its value +and as its function definition. DOC is used as the doc string for SYMBOL. + +The first element of MENU must be a string. It is the menu bar item name. +The rest of the elements are menu items. + +A menu item is usually a vector of three elements: [NAME CALLBACK ENABLE] + +NAME is a string--the menu item name. + +CALLBACK is a command to run when the item is chosen, +or a list to evaluate when the item is chosen. + +ENABLE is an expression; the item is enabled for selection +whenever this expression's value is non-nil. + +Alternatively, a menu item may have the form: + + [ NAME CALLBACK [ KEYWORD ARG ] ... ] + +Where KEYWORD is one of the symbol defined below. + + :keys KEYS + +KEYS is a string; a complex keyboard equivalent to this menu item. +This is normally not needed because keyboard equivalents are usually +computed automatically. + + :active ENABLE + +ENABLE is an expression; the item is enabled for selection +whenever this expression's value is non-nil. + + :suffix NAME + +NAME is a string; the name of an argument to CALLBACK. + + :style + +STYLE is a symbol describing the type of menu item. The following are +defined: + +toggle: A checkbox. + Currently just prepend the name with the string \"Toggle \". +radio: A radio button. +nil: An ordinary menu item. + + :selected SELECTED + +SELECTED is an expression; the checkbox or radio button is selected +whenever this expression's value is non-nil. +Currently just disable radio buttons, no effect on checkboxes. + +A menu item can be a string. Then that string appears in the menu as +unselectable text. A string consisting solely of hyphens is displayed +as a solid horizontal line. + +A menu item can be a list. It is treated as a submenu. +The first element should be the submenu name. That's used as the +menu item in the top-level menu. The cdr of the submenu list +is a list of menu items, as above." + (` (progn + (defvar (, symbol) nil (, doc)) + (vm-easy-menu-do-define (quote (, symbol)) (, maps) (, doc) (, menu))))) + +(defun vm-easy-menu-do-define (symbol maps doc menu) + ;; We can't do anything that might differ between Emacs dialects in + ;; `vm-easy-menu-define' in order to make byte compiled files + ;; compatible. Therefore everything interesting is done in this + ;; function. + (set symbol (vm-easy-menu-create-keymaps (car menu) (cdr menu))) + (fset symbol (` (lambda (event) (, doc) (interactive "@e") + (easy-popup-menu event (, symbol))))) + (mapcar (function (lambda (map) + (define-key map (vector 'menu-bar (intern (car menu))) + (cons (car menu) (symbol-value symbol))))) + (if (keymapp maps) (list maps) maps))) + +(defvar vm-easy-menu-item-count 0) + +;; Return a menu keymap corresponding to a Lucid-style menu list +;; MENU-ITEMS, and with name MENU-NAME. +;;;###autoload +(defun vm-easy-menu-create-keymaps (menu-name menu-items) + (let ((menu (make-sparse-keymap menu-name))) + ;; Process items in reverse order, + ;; since the define-key loop reverses them again. + (setq menu-items (reverse menu-items)) + (while menu-items + (let* ((item (car menu-items)) + (callback (if (vectorp item) (aref item 1))) + command enabler name) + (cond ((stringp item) + (setq command nil) + (setq name (if (string-match "^-+$" item) "" item))) + ((consp item) + (setq command (vm-easy-menu-create-keymaps (car item) (cdr item))) + (setq name (car item))) + ((vectorp item) + (if (symbolp callback) + (setq command callback) + (setq command (make-symbol (format "menu-function-%d" + vm-easy-menu-item-count))) + (setq vm-easy-menu-item-count (1+ vm-easy-menu-item-count))) + (setq name (aref item 0)) + (let ((keyword (aref item 2))) + (if (and (symbolp keyword) + (= ?: (aref (symbol-name keyword) 0))) + (let ((count 2) + style selected active keys + arg) + (while (> (length item) count) + (setq keyword (aref item count)) + (setq arg (aref item (1+ count))) + (setq count (+ 2 count)) + (cond ((eq keyword ':keys) + (setq keys arg)) + ((eq keyword ':active) + (setq active arg)) + ((eq keyword ':suffix) + (setq name (concat name " " arg))) + ((eq keyword ':style) + (setq style arg)) + ((eq keyword ':selected) + (setq selected arg)))) + (if keys + (setq name (concat name " (" keys ")"))) + (if (eq style 'toggle) + ;; Simulate checkboxes. + (setq name (concat "Toggle " name))) + (if active + (put command 'menu-enable active) + (and (eq style 'radio) + selected + ;; Simulate radio buttons with menu-enable. + (put command 'menu-enable + (list 'not selected))))) + (if (= (length item) 4) + (setq name (concat name " " (aref item 3)))) + (put command 'menu-enable keyword))) + (if (keymapp callback) + (setq name (concat name " ..."))) + (if (symbolp callback) + nil ;;(fset command callback) + (fset command (list 'lambda () '(interactive) callback))))) + (if (null command) + ;; Handle inactive strings specially--allow any number + ;; of identical ones. + (setcdr menu (cons (list nil name) (cdr menu))) + (if name + (define-key menu (vector (intern name)) (cons name command))))) + (setq menu-items (cdr menu-items))) + menu)) + +(defun vm-easy-menu-change (path name items) + "Change menu found at PATH as item NAME to contain ITEMS. +PATH is a list of strings for locating the menu containing NAME in the +menu bar. ITEMS is a list of menu items, as in `vm-easy-menu-define'. +These items entirely replace the previous items in that map. + +Call this from `activate-menubar-hook' to implement dynamic menus." + (let ((map (key-binding (apply 'vector + 'menu-bar + (mapcar 'intern (append path (list name))))))) + (if (keymapp map) + (setcdr map (cdr (vm-easy-menu-create-keymaps name items))) + (error "Malformed menu in `vm-easy-menu-change'")))) + +(defun vm-easy-menu-remove (menu)) + +(defun vm-easy-menu-add (menu &optional map)) + +;;; vm-easymenu.el ends here