/misc/fuel/fuel-menu.el

  1;;; fuel-menu.el -- menu utilities
  2
  3;; Copyright (c) 2010 Jose Antonio Ortega Ruiz
  4;; See http://factorcode.org/license.txt for BSD license.
  5
  6;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
  7;; Keywords: languages, fuel, factor
  8;; Start date: Sat Jun 12, 2010 03:01
  9
 10
 11(require 'fuel-base)
 12
 13
 14;;; Top-level menu
 15
 16(defmacro fuel-menu--add-item (keymap map kd)
 17  (cond ((or (eq '-- kd) (eq 'line kd)) `(fuel-menu--add-line ,map))
 18        ((stringp (car kd)) `(fuel-menu--add-basic-item ,keymap ,map ,kd))
 19        ((eq 'menu (car kd)) `(fuel-menu--add-submenu ,(cadr kd)
 20                                ,keymap ,map ,(cddr kd)))
 21        ((eq 'custom (car kd)) `(fuel-menu--add-custom ,(nth 1 kd)
 22                                                         ,(nth 2 kd)
 23                                                         ,keymap
 24                                                         ,map))
 25        ((eq 'mode (car kd)) `(fuel-menu--mode-toggle ,(nth 1 kd)
 26                                                        ,(nth 2 kd)
 27                                                        ,(nth 3 kd)
 28                                                        ,keymap
 29                                                        ,map))
 30        (t (error "Bad item form: %s" kd))))
 31
 32(defmacro fuel-menu--add-basic-item (keymap map kd)
 33  (let* ((title (nth 0 kd))
 34         (binding (nth 1 kd))
 35         (cmd (nth 2 kd))
 36         (hlp (nth 3 kd))
 37         (item (make-symbol title))
 38         (hlp (and (stringp hlp) (list :help hlp)))
 39         (rest (or (and hlp (nthcdr 4 kd))
 40                   (nthcdr 3 kd)))
 41         (binding (if (listp binding)
 42                      binding
 43                    (list binding))))
 44    `(progn (define-key ,map [,item]
 45              '(menu-item ,title ,cmd ,@hlp ,@rest))
 46            ,@(and (car binding)
 47                   `((put ',cmd
 48                          :advertised-binding
 49                          ,(car binding))))
 50            ,@(mapcar (lambda (b)
 51                        `(define-key ,keymap ,b ',cmd))
 52                      binding))))
 53
 54(defmacro fuel-menu--add-items (keymap map keys)
 55  `(progn ,@(mapcar (lambda (k) (list 'fuel-menu--add-item keymap map k))
 56                    (reverse keys))))
 57
 58(defmacro fuel-menu--add-submenu (name keymap map keys)
 59  (let ((ev (make-symbol name))
 60        (map2 (make-symbol "map2")))
 61    `(progn
 62       (let ((,map2 (make-sparse-keymap ,name)))
 63         (define-key ,map [,ev] (cons ,name ,map2))
 64         (fuel-menu--add-items ,keymap ,map2 ,keys)))))
 65
 66(defvar fuel-menu--line-counter 0)
 67
 68(defun fuel-menu--add-line (&optional map)
 69  (let ((line (make-symbol (format "line%s"
 70                                   (setq fuel-menu--line-counter
 71                                         (1+ fuel-menu--line-counter))))))
 72    (define-key (or map global-map) `[,line]
 73      `(menu-item "--single-line"))))
 74
 75(defmacro fuel-menu--add-custom (title group keymap map)
 76  `(fuel-menu--add-item ,keymap ,map
 77     (,title nil (lambda () (interactive) (customize-group ',group)))))
 78
 79(defmacro fuel-menu--mode-toggle (title bindings mode keymap map)
 80  `(fuel-menu--add-item ,keymap ,map
 81     (,title ,bindings ,mode
 82             :button (:toggle . (and (boundp ',mode) ,mode)))))
 83
 84(defmacro fuel-menu--defmenu (name keymap &rest keys)
 85  (let ((mmap (make-symbol "mmap")))
 86    `(progn
 87       (let ((,mmap (make-sparse-keymap "FUEL")))
 88         (define-key ,keymap [menu-bar ,name] (cons "FUEL" ,mmap))
 89         (define-key ,mmap [customize]
 90           (cons "Customize FUEL"
 91                 `(lambda () (interactive) (customize-group 'fuel))))
 92         (fuel-menu--add-line ,mmap)
 93         (fuel-menu--add-items ,keymap ,mmap ,keys)
 94         ,mmap))))
 95
 96(put 'fuel-menu--defmenu 'lisp-indent-function 2)
 97
 98
 99
100(provide 'fuel-menu)
101;;; fuel-menu.el ends here
102