elisp/geiser-custom.el

   1 ;;; geiser-custom.el -- customization utilities
   2
   3 ;; Copyright (C) 2009, 2010, 2012 Jose Antonio Ortega Ruiz
   4
   5 ;; This program is free software; you can redistribute it and/or
   6 ;; modify it under the terms of the Modified BSD License. You should
   7 ;; have received a copy of the license along with this program. If
   8 ;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>.
   9
  10 ;; Start date: Sat Feb 14, 2009 21:49
  11
  12 \f
  13
  14 (require 'font-lock)
  15 (require 'geiser-base)
  16
  17 \f
  18 ;;; Customization group:
  19
  20 (defgroup geiser nil
  21   "Geiser framework for Scheme-Emacs interaction."
  22   :group 'languages)
  23
  24 \f
  25 ;;; Faces:
  26
  27 (defgroup geiser-faces nil
  28   "Faces used by Geiser."
  29   :group 'geiser
  30   :group 'faces)
  31
  32 (defmacro geiser-custom--defface (face def group doc)
  33   (declare (doc-string 4))
  34   (let ((face (intern (format "geiser-font-lock-%s" face))))
  35     `(defface ,face (face-default-spec ,def)
  36        ,(format "Face for %s." doc)
  37        :group ',group
  38        :group 'geiser-faces)))
  39
  40 (put 'geiser-custom--defface 'lisp-indent-function 1)
  41
  42
  43 \f
  44 ;;; Reload support:
  45
  46 (defvar geiser-custom--memoized-vars nil)
  47
  48 (defun geiser-custom--memoize (name)
  49   (add-to-list 'geiser-custom--memoized-vars name))
  50
  51 (defmacro geiser-custom--defcustom (name &rest body)
  52   (declare (doc-string 3) (debug (name body)))
  53   `(progn
  54      (geiser-custom--memoize ',name)
  55      (defcustom ,name ,@body)))
  56
  57 (defun geiser-custom--memoized-state ()
  58   (let ((result))
  59     (dolist (name geiser-custom--memoized-vars result)
  60       (when (boundp name)
  61         (push (cons name (symbol-value name)) result)))))
  62
  63
  64 (put 'geiser-custom--defcustom 'lisp-indent-function 2)
  65
  66 \f
  67 (defconst geiser-custom-font-lock-keywords
  68   (eval-when-compile
  69     `((,(concat "(\\(geiser-custom--\\(?:defcustom\\|defface\\)\\)\\_>"
  70                 "[ \t'\(]*"
  71                 "\\(\\(?:\\sw\\|\\s_\\)+\\)?")
  72        (1 font-lock-keyword-face)
  73        (2 font-lock-variable-name-face nil t)))))
  74
  75 (font-lock-add-keywords 'emacs-lisp-mode geiser-custom-font-lock-keywords)
  76
  77 (provide 'geiser-custom)