;;; @ easymenu.el - Menu support for FSF and Lucid Emacs 19.
;;; 
;;; $Id: easymenu.el,v 5.4 1993/07/21 15:40:13 amanda Exp $
;;;
;;; LCD Archive Entry:
;;; easymenu|Per Abrahamsen|abraham@iesd.auc.dk|
;;; Easy menu support for FSF and Lucid Emacs 19|
;;; 09-Jul-1993|5.4|~/misc/easymenu.el.Z|

(provide 'easymenu)

;;; @@ Copyright
;;;
;;; Copyright (C) 1993 Per Abrahamsen <abraham@iesd.auc.dk>
;;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
;;;
;;; This program 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 1, or (at your option)
;;; any later version.
;;; 
;;; This program 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 this program; if not, write to the Free Software
;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
;;;
;;; The `easy-if19' and `easy-iflemacs' macros was originally written
;;; by Inge Frick <inge@nada.kth.se>.  The code to add and remove
;;; menus for Lucid Emacs was originally from Alastair Burt
;;; <burt@dfki.uni-kl.de>.  The function `easy-menu-create-keymaps' is
;;; derived from code from the file `lemacs.el' in the FSF Emacs 19.15
;;; distribution. 

;;; @@ Description 
;;;
;;; Easymenu allows you to define menus for both FSF and Lucid Emacs
;;; 19.  The advantages of using easymenu are:
;;;
;;; - Easier to use than either the FSF or Lucid menu syntax.
;;;
;;; - Common interface for Emacs 18, FSF Emacs 19, and Lucid Emacs.  
;;;   (The code does nothing when run under Emacs 18).
;;;
;;; - Automatically or manually add keyboard accelerators for FSF
;;;   Emacs 19 and optionally for Lucid Emacs.
;;;
;;; Otherwise easymenu is less powerful than either Lucid or FSF
;;; menus, for example there is no way to make a menu item inactive.
;;; An alternative to easymenu is to use Lucid menus, and enable the
;;; Lucid menu emulator for FSF Emacs 19.  You can find that in
;;; `lmenu.el' in the lisp directory.
;;;
;;; The public functions are:
;;; 
;;; - Function: easy-menu-define SYMBOL MAPS DOC MENU
;;;     SYMBOL is the name of the variable that holds the menu. 
;;;     MAPS is a list of keymaps where the menu should appear.
;;;     DOC is the documentation string for the variable.
;;;     MENU is a Lucid style menu description.  
;;;
;;;     A lucid style menu is a list where the first element is
;;;     a string with the name of the menu, and the remaining elements
;;;     are the menu items.  Each item can be either a
;;;     - Menu: for nested menus.
;;;     - String: for menu items that can not be selected.
;;;     - Vector: for normal items.  It has three elements:
;;;       1. A string with the name of the menu item.
;;;       2. The function to be executed when the item is selected.
;;;          This can be either a function name or a lisp expression.
;;;       3. A string indicating a keyboard accelerator.  This string
;;;          will only be used if easymenu cannot find the accelerator
;;;          by examining the keymaps.  Use the symbol `t' if you
;;;          don't want to specify a keyboard accelerator.
;;;
;;; - Function: easy-menu-add MENU [ MAP ]
;;;     Add MENU to the current menubar, optionally adding keyboard
;;;     accelerators from MAP.
;;;
;;; - Function: easy-menu-remove MENU
;;;     Remove MENU from the current menubar.
;;;
;;; FSF Emacs 19 never uses `easy-menu-add' or `easy-menu-remove',
;;; menus automatically appear and disappear when the keymaps
;;; specified by the MAPS argument to `easy-menu-define' are
;;; activated.
;;;
;;; Lucid Emacs never uses the MAPS argument to `easy-menu-define',
;;; instead menus must explicitly be added and removed with
;;; `easy-menu-add' and `easy-menu-remove'.
;;;
;;; Lucid Emacs should be capable of adding the keyboard
;;; accelerators automatically, but sometimes it does not work.  This
;;; is a bug in Lucid Emacs.  To work around the bug, you must specify
;;; the MAP argument to `easy-menu-add', Easymenu will then add the
;;; keyboard accelerators.

;;; @@ Mode specific macros

(put 'easy-iflemacs 'lisp-indent-hook 1)
(defmacro easy-iflemacs (yy &rest nn)
  "Evaluate first argument if running under Lucid Emacs.
Otherwise evaluate remaining arguments."
  (cond
   ((string-match "Lucid" emacs-version) yy)	; lemacs
   ((null nn) ())
   ((cdr nn) (cons 'progn nn))
   (t (car nn))))

(put 'easy-if19 'lisp-indent-hook 1)
(defmacro easy-if19 (yy &rest nn)
  "Evaluate first argument if running under a flavour of Emacs 19 or later.
Otherwise evaluate remaining arguments." 
  (cond
   ((> (string-to-int emacs-version) 18) yy) ; lemacs or emacs 19
   ((null nn) ())
   ((cdr nn) (cons 'progn nn))
   (t (car nn))))

;;; @@ FSF Emacs 19 Support

(easy-if19
    (easy-iflemacs
	(defun easy-menu-add-accelerator (menu map)
	  ;; Add keyboard accelerator information to MENU from MAP.
	  (let ((loop (cdr menu))
		(max-length 0)
		item spec)
	    (while loop
	      (setq item (car loop))
	      (setq max-length
		    (max max-length
			 (length (cond ((stringp item) item)
				       ((consp item) (car item))
				       ((vectorp item) (aref item 0))))))
	      (setq loop (cdr loop)))
	    (setq spec (format "%%-%ds%%s" max-length))
	    (cons (car menu)
		  (mapcar (function (lambda (item)
			    (cond ((stringp item)
				   item)
				  ((consp item)
				   (easy-menu-add-accelerator item map))
				  ((vectorp item)
				   (let* ((where (where-is-internal
						  (aref item 1) map t))
					  (key (cond (where
						      (concat "  " (key-description where)))
						     ((stringp (aref item 2))
						      (aref item 2))
						     (t nil)))
					  (name (if key
						    (format spec (aref item 0) key)
						  (aref item 0))))
				     (vector name
					     (aref item 1)
					     (aref item 2)))))))
			  (cdr menu)))))

      (defun easy-menu-create-keymaps (menu-name menu-items map)
	(let ((menu (make-sparse-keymap menu-name))
	      (max-length 0)
	      format-spec item
	      (loop menu-items))
	  ;; Process items in reverse order,
	  ;; since the define-key loop reverses them again.
	  (setq menu-items (reverse menu-items))

	  ;; Find longest item.
	  (while loop
	    (setq item (car loop))
	    (setq max-length
		  (max max-length
		       (length (cond ((stringp item) item)
				     ((consp item) (car item))
				     ((vectorp item) (aref item 0))))))
	    (setq loop (cdr loop)))
	  (setq format-spec (format "%%-%ds%%s" max-length))

	  (while menu-items
	    (let* ((item (car menu-items))
		   (callback (if (vectorp item) (aref item 1)))
		   command name desc)
	      (cond ((stringp item)
		     (setq command nil)
		     (setq name item)
		     (setq desc ""))
		    ((consp item)
		     (setq command
			   (easy-menu-create-keymaps (car item)
						       (cdr item) map))
		     (setq name (car item))
		     (setq desc "  >>"))
		    ((vectorp item)
		     (setq command 
			   (if (symbolp callback)
			       callback
			     (list 'lambda () '(interactive) callback)))
		     (setq name (aref item 0))
		     (setq desc (where-is-internal command map nil t))
		     (setq desc (cond (desc (concat "  "
						    (key-description desc)))
				      ((stringp (aref item 2)) (aref item 2))
				      ("")))))
	      (if name 
		  (define-key menu (vector (intern name))
		    (cons (format format-spec name desc) command))))
	    (setq menu-items (cdr menu-items)))
	  menu))))

;;; @@ Defining, adding, and removing menus

(put 'easy-menu-define 'lisp-indent-hook 3)
(defmacro easy-menu-define (symbol maps doc menu)
  "Define SYMBOL to be a menu for keymaps MAPS.
DOC is the documentation string, and MENU is a Lucid style menu."
  (easy-if19
      (easy-iflemacs
          (` (progn
	       (defvar (, symbol) (, menu) (, doc))
	       (defun (, symbol) (e)
		 (, doc)
		 (interactive "@e")
		 (setq zmacs-region-stays 't)
		 (popup-menu (, symbol)))))
	(` (let ((maps (, maps))
		 (menu (, menu)))
	     (mapcar (function (lambda (map) 
		       (define-key map (vector 'menu-bar (intern (car menu)))
			 (cons (car menu)
			       (easy-menu-create-keymaps (car menu)
							 (cdr menu) map)))))
		     (if (keymapp maps) (list maps) maps))))) nil))

(easy-iflemacs
    (defvar easy-menu-disable-lucid-accelerator nil
      "*Set this to `t' to prevent adding accelerator keys to menus."))

(easy-if19
    (easy-iflemacs
	(defun easy-menu-add (menu &optional map)
	  "Add MENU to the current menu bar."
	  (if current-menubar
	      (if (assoc (car menu) current-menubar)
		  nil
		(set-buffer-menubar (copy-sequence current-menubar))
		(if (and map (not easy-menu-disable-lucid-accelerator))
		    (setq menu (easy-menu-add-accelerator menu map)))
		(add-menu nil (car menu) (cdr menu)))))
      (defmacro easy-menu-add (menu &optional map)))
  (defmacro easy-menu-add (menu &optional map)))

(easy-if19
    (easy-iflemacs
	(defun easy-menu-remove (menu)
	  "Remove MENU from the current menu bar."
		  (if current-menubar
		      (if (assoc (car menu) current-menubar)
			  (delete-menu-item (list (car menu))))))
      	(defmacro easy-menu-remove (menu)))
  (defmacro easy-menu-remove (menu)))

;;; @@ Emacs

;;; Local Variables:
;;; mode: emacs-lisp
;;; mode: outline-minor
;;; outline-regexp: ";;; @+\\|(......"
;;; eval: (put 'easy-menu-define 'lisp-indent-hook 3)
;;; eval: (put 'easy-iflemacs 'lisp-indent-hook 1)
;;; eval: (put 'easy-if19 'lisp-indent-hook 1)
;;; End:
