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 ;;; Code:
  14
  15 (require 'font-lock)
  16 (require 'geiser-base)
  17
  18 \f
  19 ;;; Customization group:
  20
  21 (defgroup geiser nil
  22   "Geiser framework for Scheme-Emacs interaction."
  23   :group 'languages)
  24
  25 \f
  26 ;;; Faces:
  27
  28 (defgroup geiser-faces nil
  29   "Faces used by Geiser."
  30   :group 'geiser
  31   :group 'faces)
  32
  33 (defmacro geiser-custom--defface (face def group doc)
  34   (declare (doc-string 4))
  35   (let ((face (intern (format "geiser-font-lock-%s" face))))
  36     `(defface ,face (face-default-spec ,def)
  37        ,(format "Face for %s." doc)
  38        :group ',group
  39        :group 'geiser-faces)))
  40
  41 (put 'geiser-custom--defface 'lisp-indent-function 1)
  42
  43
  44 \f
  45 ;;; Reload support:
  46
  47 (defvar geiser-custom--memoized-vars nil)
  48
  49 (defun geiser-custom--memoize (name)
  50   (add-to-list 'geiser-custom--memoized-vars name))
  51
  52 (defmacro geiser-custom--defcustom (name &rest body)
  53   "Like `defcustom' but also put NAME on an internal list.
  54 That list is used by `geiser-reload' to preserve the values
  55 of the listed variables.  It is not used for anything else."
  56   ;; FIXME Remembering the value like this is not actually
  57   ;; necessary.  Evaluting `defcustom' always preserves the
  58   ;; existing value, if any.
  59   (declare (doc-string 3) (debug (name body)))
  60   `(progn
  61      (geiser-custom--memoize ',name)
  62      (defcustom ,name ,@body)))
  63
  64 (defun geiser-custom--memoized-state ()
  65   (let ((result))
  66     (dolist (name geiser-custom--memoized-vars result)
  67       (when (boundp name)
  68         (push (cons name (symbol-value name)) result)))))
  69
  70
  71 (put 'geiser-custom--defcustom 'lisp-indent-function 2)
  72
  73 \f
  74 (defconst geiser-custom-font-lock-keywords
  75   (eval-when-compile
  76     `((,(concat "(\\(geiser-custom--\\(?:defcustom\\|defface\\)\\)\\_>"
  77                 "[ \t'\(]*"
  78                 "\\(\\(?:\\sw\\|\\s_\\)+\\)?")
  79        (1 font-lock-keyword-face)
  80        (2 font-lock-variable-name-face nil t)))))
  81
  82 (font-lock-add-keywords 'emacs-lisp-mode geiser-custom-font-lock-keywords)
  83
  84 (provide 'geiser-custom)