emacs/guileint/defmenu.el

   1 ;;; @(#) defmenu.el -- A GNU Emacs extension which helps building menus
   2 ;;; @(#) $Keywords: X, menu $
   3
   4 ;; Copyright (C) 1995 Mikael Djurfeldt
   5
   6 ;; LCD Archive Entry:
   7 ;; defmenu|djurfeldt@nada.kth.se|
   8 ;; A GNU Emacs extension which helps building menus|
   9 ;; $Date: 2003-08-20 19:00:44 $|$Revision: 1.1 $|~/misc/defmenu.el.Z|
  10
  11 ;; Author:       Mikael Djurfeldt <djurfeldt@nada.kth.se>
  12 ;; Version: 1.0
  13
  14 ;; This program is free software; you can redistribute it and/or modify it
  15 ;; under the terms of the GNU General Public License as published by the Free
  16 ;; Software Foundation; either version 2 of the License, or (at your option)
  17 ;; any later version.
  18 ;;
  19 ;; This program is distributed in the hope that it will be useful, but
  20 ;; WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
  21 ;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  22 ;; for more details.
  23 ;;
  24 ;; You should have received a copy of the GNU General Public License along
  25 ;; with GNU Emacs.  If you did not, write to the Free Software Foundation,
  26 ;; Inc., 675 Mass Ave., Cambridge, MA 02139, USA.
  27
  28 ;;; Commentary:
  29 ;;
  30 ;; Requirements:
  31 ;;
  32 ;; Usage:
  33 ;;
  34 ;; Bugs:
  35 ;;
  36 ;;
  37
  38 (defun define-menu (keymap key name entries)
  39   "Define a menu in KEYMAP on fake function key KEY with label NAME.
  40 Every entry in the list ENTRIES defines a menu item and looks like this:
  41
  42   (LABEL DEFINITION [ENABLE-EXP])
  43
  44 LABEL is a string which will appear in the menu.
  45 DEFINITION is either a symbol, in which case it will be used both as
  46 fake function key and binding, or a pair, where the car is the fake
  47 function key and the cdr is the binding.
  48 The optional ENABLE-EXP is an expression which will be evaluated every
  49 time the menu is displayed.  If it returns nil the menu item will
  50 be disabled.
  51
  52 You can get a separator by including nil in the ENTRIES list."
  53   (define-key keymap
  54     (vector 'menu-bar key)
  55     (cons name (make-menu name entries))))
  56
  57 (defun make-menu (name entries)
  58   "Make a menu with label NAME.
  59 Every entry in the list ENTRIES defines a menu item and looks like this:
  60
  61   (LABEL DEFINITION [ENABLE-EXP])
  62
  63 LABEL is a string which will appear in the menu.
  64 DEFINITION is either a symbol, in which case it will be used both as
  65 fake function key and binding, or a pair, where the car is the fake
  66 function key and the cdr is the binding.
  67 The optional ENABLE-EXP is an expression which will be evaluated every
  68 time the menu is displayed.  If it returns nil the menu item will
  69 be disabled.
  70
  71 You can get a separator by including nil in the ENTRIES list."
  72   (let ((menu (make-sparse-keymap name))
  73         (entries (reverse entries)))
  74     (while entries
  75       (let ((entry (car entries)))
  76         (if (null entry)
  77             (define-key menu (vector (defmenu-gensym "separator")) '("--"))
  78           (if (symbolp (nth 1 entry))
  79               (define-key menu (vector (nth 1 entry))
  80                 (cons (car entry) (nth 1 entry)))
  81             (define-key menu (vector (car (nth 1 entry)))
  82               (cons (car entry) (cdr (nth 1 entry)))))
  83           (if (not (null (nthcdr 2 entry)))
  84               (put (nth 1 entry) 'menu-enable (nth 2 entry)))))
  85       (setq entries (cdr entries)))
  86     menu))
  87
  88 (defun defmenu-gensym (prefix)
  89   (let ((counter (intern (concat "defmenu-" prefix "count"))))
  90     (if (boundp counter) (set counter (1+ (symbol-value counter)))
  91       (set counter 0))
  92     (intern (concat prefix (int-to-string (symbol-value counter))))))
  93
  94 (provide 'defmenu)