geiser-custom.el (2462B)
1 ;;; geiser-custom.el -- customization utilities -*- lexical-binding: t; -*- 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 13 ;;; Code: 14 15 (require 'font-lock) 16 (require 'geiser-base) 17 18 19 ;;; Customization group: 20 21 (defgroup geiser nil 22 "Geiser framework for Scheme-Emacs interaction." 23 :group 'languages) 24 25 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) (indent 1)) 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 ;;; Reload support: 42 43 (defvar geiser-custom--memoized-vars nil) 44 45 (defun geiser-custom--memoize (name) 46 ;; FIXME: Why not build this list with mapatoms, filtering on a "\\`'geiser-" 47 ;; prefix and checking that it's a `defcustom', so we don't need 48 ;; `geiser-custom--defcustom'? 49 (add-to-list 'geiser-custom--memoized-vars name)) 50 51 (defmacro geiser-custom--defcustom (name &rest body) 52 "Like `defcustom' but also put NAME on an internal list. 53 That list is used by `geiser-reload' to preserve the values 54 of the listed variables. It is not used for anything else." 55 ;; FIXME Remembering the value like this is not actually 56 ;; necessary. Evaluting `defcustom' always preserves the 57 ;; existing value, if any. 58 (declare (doc-string 3) (debug (name body)) (indent 2)) 59 `(progn 60 (geiser-custom--memoize ',name) 61 (defcustom ,name ,@body))) 62 63 (defun geiser-custom--memoized-state () 64 (let ((result)) 65 (dolist (name geiser-custom--memoized-vars result) 66 (when (boundp name) 67 (push (cons name (symbol-value name)) result))))) 68 69 70 (defconst geiser-custom-font-lock-keywords 71 (eval-when-compile 72 `((,(concat "(\\(geiser-custom--\\(?:defcustom\\|defface\\)\\)\\_>" 73 "[ \t'\(]*" 74 "\\(\\(?:\\sw\\|\\s_\\)+\\)?") 75 (1 font-lock-keyword-face) 76 (2 font-lock-variable-name-face nil t))))) 77 78 (font-lock-add-keywords 'emacs-lisp-mode geiser-custom-font-lock-keywords) 79 80 (provide 'geiser-custom)