diff options
Diffstat (limited to 'src/guile/skribilo/lib.scm')
| -rw-r--r-- | src/guile/skribilo/lib.scm | 92 |
1 files changed, 38 insertions, 54 deletions
diff --git a/src/guile/skribilo/lib.scm b/src/guile/skribilo/lib.scm index 5543644..ef18bda 100644 --- a/src/guile/skribilo/lib.scm +++ b/src/guile/skribilo/lib.scm @@ -1,6 +1,6 @@ ;;; lib.scm -- Utilities. -*- coding: iso-8859-1 -*- ;;; -;;; Copyright 2005, 2007, 2009, 2012, 2013, 2016 Ludovic Courtès <ludo@gnu.org> +;;; Copyright 2005, 2007, 2009, 2012, 2013, 2016, 2020 Ludovic Courtès <ludo@gnu.org> ;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> ;;; ;;; @@ -109,60 +109,44 @@ ;; keyword style, and a couple other differences handled by ;; `dsssl->guile-formals'. -(cond-expand - (guile-2 - ;; On Guile 2.0, `define-markup' generates a macro for the markup, such - ;; that the macro captures its invocation source location using - ;; `current-source-location'. - - (define-syntax-parameter &invocation-location - (identifier-syntax #f)) - - (define-syntax define-markup - (lambda (s) - (syntax-case s () - ;; Note: Use a dotted pair for formals, to allow for dotted forms - ;; like: `(define-markup (foo x . rest) ...)'. - ((_ (name . formals) body ...) - (let ((formals (map (lambda (s) - (datum->syntax #'formals s)) - (dsssl->guile-formals (syntax->datum #'formals)))) - (internal (symbol-append '% (syntax->datum #'name) - '-internal))) - (with-syntax ((internal/loc (datum->syntax #'name internal))) - #`(begin - (define* (internal/loc loc #,@formals) - (syntax-parameterize ((&invocation-location - (identifier-syntax loc))) - body ...)) - (define-syntax name - (lambda (s) - (syntax-case s () - ((_ . args) - #'(let ((loc (source-properties->location +;; On Guile 2.0, `define-markup' generates a macro for the markup, such +;; that the macro captures its invocation source location using +;; `current-source-location'. + +(define-syntax-parameter &invocation-location + (identifier-syntax #f)) + +(define-syntax define-markup + (lambda (s) + (syntax-case s () + ;; Note: Use a dotted pair for formals, to allow for dotted forms + ;; like: `(define-markup (foo x . rest) ...)'. + ((_ (name . formals) body ...) + (let ((formals (map (lambda (s) + (datum->syntax #'formals s)) + (dsssl->guile-formals (syntax->datum #'formals)))) + (internal (symbol-append '% (syntax->datum #'name) + '-internal))) + (with-syntax ((internal/loc (datum->syntax #'name internal))) + #`(begin + (define* (internal/loc loc #,@formals) + (syntax-parameterize ((&invocation-location + (identifier-syntax loc))) + body ...)) + (define-syntax name + (lambda (s) + (syntax-case s () + ((_ . args) + #'(let ((loc (source-properties->location + (current-source-location)))) + (internal/loc loc . args))) + (_ + #'(lambda args + (let ((loc (source-properties->location (current-source-location)))) - (internal/loc loc . args))) - (_ - #'(lambda args - (let ((loc (source-properties->location - (current-source-location)))) - (apply internal/loc loc args))))))) - internal/loc ; mark it as used - (export name))))))))) - - (else ; Guile 1.8 - ;; On Guile 1.8, a markup is a procedure. Its invocation source location - ;; is captured by walking the stack, which is fragile. - - (define-macro (define-markup bindings . body) - (let ((name (car bindings)) - (opts (cdr bindings))) - `(define*-public ,(cons name (dsssl->guile-formals opts)) - ;; Memorize the invocation location. Note: the invocation depth - ;; passed to `invocation-location' was determined experimentally and - ;; may change as Guile changes (XXX). - (let ((&invocation-location (invocation-location 3))) - ,@body)))))) + (apply internal/loc loc args))))))) + internal/loc ; mark it as used + (export name)))))))) ;;; |