scm/safe-utility-defs.scm

   1 ;;;; This file is part of LilyPond, the GNU music typesetter.
   2 ;;;;
   3 ;;;; Copyright (C) 1998--2015 Jan Nieuwenhuizen <janneke@gnu.org>
   4 ;;;; Han-Wen Nienhuys <hanwen@xs4all.nl>
   5 ;;;;
   6 ;;;; LilyPond is free software: you can redistribute it and/or modify
   7 ;;;; it under the terms of the GNU General Public License as published by
   8 ;;;; the Free Software Foundation, either version 3 of the License, or
   9 ;;;; (at your option) any later version.
  10 ;;;;
  11 ;;;; LilyPond is distributed in the hope that it will be useful,
  12 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;;; GNU General Public License for more details.
  15 ;;;;
  16 ;;;; You should have received a copy of the GNU General Public License
  17 ;;;; along with LilyPond.  If not, see <http://www.gnu.org/licenses/>.
  18 ;;;
  19 ;;;      Author Ian Hulin
  20 ;;;      Date   16 October 2011
  21 ;;;
  22
  23 (define-module (scm safe-utility-defs)
  24   #:use-module (ice-9 optargs)
  25   #:export (safe-objects)
  26   #:export-syntax (define-safe-public)
  27   #:re-export-syntax (define*-public))
  28
  29 (if (string>? (version) "1.9.10")
  30     (use-modules (ice-9 curried-definitions)))
  31
  32
  33 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  34 ;; Safe definitions utility
  35
  36 (define safe-objects
  37   (list))
  38
  39 (define (get-symbol arg)
  40   (if (pair? arg)
  41       (get-symbol (car arg))
  42       arg))
  43
  44
  45 (define-macro (define-safe-public arglist . body)
  46   "Define a variable, export it, and mark it as safe, i.e. usable in
  47 LilyPond safe mode.  The syntax is the same as `define*-public'."
  48
  49   (let ((safe-symbol (get-symbol arglist)))
  50     `(begin
  51        (define* ,arglist
  52          ,@body)
  53        (set! safe-objects (cons (cons ',safe-symbol ,safe-symbol)
  54                                 safe-objects))
  55        (export ,safe-symbol)
  56        ,safe-symbol)))