home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / easymenu.el < prev    next >
Encoding:
Text File  |  1993-07-07  |  9.6 KB  |  280 lines
  1. ;;; @ easymenu.el - Menu support for FSF and Lucid Emacs 19.
  2. ;;; 
  3. ;;; $Id: NEW $
  4.  
  5. ;; LCD Archive Entry:
  6. ;; easymenu|Per Abrahamsen|abraham@iesd.auc.dk|
  7. ;; Easy menu support for FSF and Lucid Emacs 19|
  8. ;; 04-Jul-1993|0.0|~/misc/easymenu.el.Z|
  9.  
  10. (provide 'easymenu)
  11.  
  12. ;;; @@ Copyright
  13. ;;;
  14. ;;; Copyright (C) 1993 Per Abrahamsen <abraham@iesd.auc.dk>
  15. ;;; Copyright (C) 1992, 1993 Free Software Foundation, Inc.
  16. ;;;
  17. ;;; This program is free software; you can redistribute it and/or modify
  18. ;;; it under the terms of the GNU General Public License as published by
  19. ;;; the Free Software Foundation; either version 1, or (at your option)
  20. ;;; any later version.
  21. ;;; 
  22. ;;; This program is distributed in the hope that it will be useful,
  23. ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  24. ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  25. ;;; GNU General Public License for more details.
  26. ;;; 
  27. ;;; You should have received a copy of the GNU General Public License
  28. ;;; along with this program; if not, write to the Free Software
  29. ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  30. ;;;
  31. ;;; The `easy-if19' and `easy-iflemacs' macros was originally written
  32. ;;; by Inge Frick <inge@nada.kth.se>.  The code to add and remove
  33. ;;; menus for Lucid Emacs was originally from Alastair Burt
  34. ;;; <burt@dfki.uni-kl.de>.  The function `easy-menu-create-keymaps' is
  35. ;;; derived from code from the file `lemacs.el' in the FSF Emacs 19.15
  36. ;;; distribution. 
  37.  
  38. ;;; @@ Description 
  39. ;;;
  40. ;;; Easymenu allows you to define menus for both FSF and Lucid Emacs
  41. ;;; 19.  The advantages of using easymenu are:
  42. ;;;
  43. ;;; - Easier to use than either the FSF or Lucid menu syntax.
  44. ;;;
  45. ;;; - Common interface for Emacs 18, FSF Emacs 19, and Lucid Emacs.  
  46. ;;;   (The code does nothing when run under Emacs 18).
  47. ;;;
  48. ;;; - Automatically or manually add keyboard accelerators for FSF
  49. ;;;   Emacs 19 and optionally for Lucid Emacs.
  50. ;;;
  51. ;;; Otherwise easymenu is less powerful than either Lucid or FSF
  52. ;;; menus, for example there is no way to make a menu item inactive.
  53. ;;; An alternative to easymenu is to use Lucid menus, and enable the
  54. ;;; Lucid menu emulator for FSF Emacs 19.  You can find that in
  55. ;;; `lmenu.el' in the lisp directory.
  56. ;;;
  57. ;;; The public functions are:
  58. ;;; 
  59. ;;; - Function: easy-menu-define SYMBOL MAPS DOC MENU
  60. ;;;     SYMBOL is the name of the variable that holds the menu. 
  61. ;;;     MAPS is a list of keymaps where the menu should appear.
  62. ;;;     DOC is the documentation string for the variable.
  63. ;;;     MENU is a Lucid style menu description.  
  64. ;;;
  65. ;;;     A lucid style menu is a list where the first element is
  66. ;;;     a string with the name of the menu, and the remaining elements
  67. ;;;     are the menu items.  Each item can be either a
  68. ;;;     - Menu: for nested menus.
  69. ;;;     - String: for menu items that can not be selected.
  70. ;;;     - Vector: for normal items.  It has three elements:
  71. ;;;       1. A string with the name of the menu item.
  72. ;;;       2. The function to be executed when the item is selected.
  73. ;;;          This can be either a function name or a lisp expression.
  74. ;;;       3. A string indicating a keyboard accelerator.  This string
  75. ;;;          will only be used if easymenu cannot find the accelerator
  76. ;;;          by examining the keymaps.  Use the symbol `t' if you
  77. ;;;          don't want to specify a keyboard accelerator.
  78. ;;;
  79. ;;; - Function: easy-menu-add MENU [ MAP ]
  80. ;;;     Add MENU to the current menubar, optionally adding keyboard
  81. ;;;     accelerators from MAP.
  82. ;;;
  83. ;;; - Function: easy-menu-remove MENU
  84. ;;;     Remove MENU from the current menubar.
  85. ;;;
  86. ;;; FSF Emacs 19 never uses `easy-menu-add' or `easy-menu-remove',
  87. ;;; menus automatically appear and disappear when the keymaps
  88. ;;; specified by the MAPS argument to `easy-menu-define' are
  89. ;;; activated.
  90. ;;;
  91. ;;; Lucid Emacs never uses the MAPS argument to `easy-menu-define',
  92. ;;; instead menus must explicitly be added and removed with
  93. ;;; `easy-menu-add' and `easy-menu-remove'.
  94. ;;;
  95. ;;; Lucid Emacs should be capable of adding the keyboard
  96. ;;; accelerators automatically, but sometimes it does not work.  This
  97. ;;; is a bug in Lucid Emacs.  To work around the bug, you must specify
  98. ;;; the MAP argument to `easy-menu-add', Easymenu will then add the
  99. ;;; keyboard accelerators.
  100.  
  101. ;;; @@ Mode specific macros
  102.  
  103. (put 'easy-iflemacs 'lisp-indent-hook 1)
  104. (defmacro easy-iflemacs (yy &rest nn)
  105.   "Evaluate first argument if running under Lucid Emacs.
  106. Otherwise evaluate remaining arguments."
  107.   (cond
  108.    ((string-match "Lucid" emacs-version) yy)    ; lemacs
  109.    ((null nn) ())
  110.    ((cdr nn) (cons 'progn nn))
  111.    (t (car nn))))
  112.  
  113. (put 'easy-if19 'lisp-indent-hook 1)
  114. (defmacro easy-if19 (yy &rest nn)
  115.   "Evaluate first argument if running under a flavour of Emacs 19 or later.
  116. Otherwise evaluate remaining arguments." 
  117.   (cond
  118.    ((> (string-to-int emacs-version) 18) yy) ; lemacs or emacs 19
  119.    ((null nn) ())
  120.    ((cdr nn) (cons 'progn nn))
  121.    (t (car nn))))
  122.  
  123. ;;; @@ FSF Emacs 19 Support
  124.  
  125. (easy-if19
  126.     (easy-iflemacs
  127.     (defun easy-menu-add-accelerator (menu map)
  128.       ;; Add keyboard accelerator information to MENU from MAP.
  129.       (let ((loop (cdr menu))
  130.         (max-length 0)
  131.         item spec)
  132.         (while loop
  133.           (setq item (car loop))
  134.           (setq max-length
  135.             (max max-length
  136.              (length (cond ((stringp item) item)
  137.                        ((consp item) (car item))
  138.                        ((vectorp item) (aref item 0))))))
  139.           (setq loop (cdr loop)))
  140.         (setq spec (format "%%-%ds%%s" max-length))
  141.         (cons (car menu)
  142.           (mapcar (function (lambda (item)
  143.                 (cond ((stringp item)
  144.                    item)
  145.                   ((consp item)
  146.                    (easy-menu-add-accelerator item map))
  147.                   ((vectorp item)
  148.                    (let* ((where (where-is-internal
  149.                           (aref item 1) map t))
  150.                       (key (cond (where
  151.                               (concat "  " (key-description where)))
  152.                              ((stringp (aref item 2))
  153.                               (aref item 2))
  154.                              (t nil)))
  155.                       (name (if key
  156.                             (format spec (aref item 0) key)
  157.                           (aref item 0))))
  158.                      (vector name
  159.                          (aref item 1)
  160.                          (aref item 2)))))))
  161.               (cdr menu)))))
  162.       (defun easy-menu-ignore ()
  163.     (interactive)
  164.     "Do nothing, interactively.")
  165.  
  166.       (defun easy-menu-create-keymaps (menu-name menu-items map)
  167.     (let ((menu (make-sparse-keymap menu-name))
  168.           (max-length 0)
  169.           format-spec item
  170.           (loop menu-items))
  171.       ;; Process items in reverse order,
  172.       ;; since the define-key loop reverses them again.
  173.       (setq menu-items (reverse menu-items))
  174.       (define-key menu [7] 'easy-menu-ignore)
  175.  
  176.       ;; Find longest item.
  177.       (while loop
  178.         (setq item (car loop))
  179.         (setq max-length
  180.           (max max-length
  181.                (length (cond ((stringp item) item)
  182.                      ((consp item) (car item))
  183.                      ((vectorp item) (aref item 0))))))
  184.         (setq loop (cdr loop)))
  185.       (setq format-spec (format "%%-%ds%%s" max-length))
  186.  
  187.       (while menu-items
  188.         (let* ((item (car menu-items))
  189.            (callback (if (vectorp item) (aref item 1)))
  190.            command name desc)
  191.           (cond ((stringp item)
  192.              (setq command nil)
  193.              (setq name item)
  194.              (setq desc ""))
  195.             ((consp item)
  196.              (setq command
  197.                (easy-menu-create-keymaps (car item)
  198.                                (cdr item) map))
  199.              (setq name (car item))
  200.              (setq desc "  >>"))
  201.             ((vectorp item)
  202.              (setq command 
  203.                (if (symbolp callback)
  204.                    callback
  205.                  (list 'lambda () '(interactive) callback)))
  206.              (setq name (aref item 0))
  207.              (setq desc (where-is-internal command map nil t))
  208.              (setq desc (cond (desc (concat "  "
  209.                             (key-description desc)))
  210.                       ((stringp (aref item 2)) (aref item 2))
  211.                       ("")))))
  212.           (if name 
  213.           (define-key menu (vector (intern name))
  214.             (cons (format format-spec name desc) command))))
  215.         (setq menu-items (cdr menu-items)))
  216.       menu))))
  217.  
  218. ;;; @@ Defining, adding, and removing menus
  219.  
  220. (put 'easy-menu-define 'lisp-indent-hook 3)
  221. (defmacro easy-menu-define (symbol maps doc menu)
  222.   "Define SYMBOL to be a menu for keymaps MAPS.
  223. DOC is the documentation string, and MENU is a Lucid style menu."
  224.   (easy-if19
  225.       (easy-iflemacs
  226.           (progn
  227.         (set symbol (eval menu))
  228.         (put symbol 'variable-documentation doc)
  229.         (fset symbol (list 'lambda '(e)
  230.                    '(interactive "@e")
  231.                    '(setq zmacs-region-stays 't)
  232.                    (list 'popup-menu symbol))))
  233.     (let ((maps (eval maps))
  234.           (menu (eval menu)))
  235.       (mapcar (function (lambda (map) 
  236.             (define-key map (vector 'menu-bar (intern (car menu)))
  237.               (cons (car menu)
  238.                 (easy-menu-create-keymaps (car menu)
  239.                             (cdr menu) map)))))
  240.           (if (keymapp maps) (list maps) maps))))) nil)
  241.  
  242. (easy-iflemacs
  243.     (defvar easy-menu-disable-lucid-accelerator nil
  244.       "*Set this to `t' to prevent adding accelerator keys to menus."))
  245.  
  246. (easy-if19
  247.     (easy-iflemacs
  248.     (defun easy-menu-add (menu &optional map)
  249.       "Add MENU to the current menu bar."
  250.       (if current-menubar
  251.           (if (assoc (car menu) current-menubar)
  252.           nil
  253.         (set-buffer-menubar (copy-sequence current-menubar))
  254.         (if (and map (not easy-menu-disable-lucid-accelerator))
  255.             (setq menu (easy-menu-add-accelerator menu map)))
  256.         (add-menu nil (car menu) (cdr menu)))))
  257.       (defmacro easy-menu-add (menu &optional map)))
  258.   (defmacro easy-menu-add (menu &optional map)))
  259.  
  260. (easy-if19
  261.     (easy-iflemacs
  262.     (defun easy-menu-remove (menu)
  263.       "Remove MENU from the current menu bar."
  264.           (if current-menubar
  265.               (if (assoc (car menu) current-menubar)
  266.               (delete-menu-item (list (car menu))))))
  267.           (defmacro easy-menu-remove (menu)))
  268.   (defmacro easy-menu-remove (menu)))
  269.  
  270. ;;; @@ Emacs
  271.  
  272. ;;; Local Variables:
  273. ;;; mode: emacs-lisp
  274. ;;; mode: outline-minor
  275. ;;; outline-regexp: ";;; @+\\|(......"
  276. ;;; eval: (put 'easy-menu-define 'lisp-indent-hook 3)
  277. ;;; eval: (put 'easy-iflemacs 'lisp-indent-hook 1)
  278. ;;; eval: (put 'easy-if19 'lisp-indent-hook 1)
  279. ;;; End:
  280.