/misc/fuel/fuel-menu.el

http://github.com/abeaumont/factor · Emacs Lisp · 102 lines · 77 code · 17 blank · 8 comment · 0 complexity · 4aced89bb283cb241fa660df14140ec8 MD5 · raw file

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