diff options
author | Ludovic Court`es | 2007-04-03 09:27:59 +0000 |
---|---|---|
committer | Ludovic Court`es | 2007-04-03 09:27:59 +0000 |
commit | ffd41b153e703042c117e9a491066f799608a425 (patch) | |
tree | 015932f20209f791d255384559127fe6b2e36c28 /src/guile/skribilo/lib.scm | |
parent | e6ba379fa65ff756d47cde9f545ceb285d355a16 (diff) | |
download | skribilo-ffd41b153e703042c117e9a491066f799608a425.tar.gz skribilo-ffd41b153e703042c117e9a491066f799608a425.tar.lz skribilo-ffd41b153e703042c117e9a491066f799608a425.zip |
Added support for source location tracking.
* src/guile/skribilo/ast.scm (<ast>): Added the `:loc' init-keyword.
* src/guile/skribilo/lib.scm: Re-export `invocation-location'.
(define-markup): Locally define `&invocation-location' for use by
markups.
(define-simple-markup): Initialize `loc'.
(define-simple-container): Likewise.
(%skribe-warn): New `col'. parameter.
(skribe-warning): Updated.
(skribe-warning/ast): Likewise.
* src/guile/skribilo/location.scm (<location>): Removed slot `pos'.
Added slot `column'. Export `location-column'.
(location-pos): Kept for compatibility.
(write): New method.
(invocation-location): New function.
git-archimport-id: lcourtes@laas.fr--2006-libre/skribilo--devo--1.2--patch-38
Diffstat (limited to 'src/guile/skribilo/lib.scm')
-rw-r--r-- | src/guile/skribilo/lib.scm | 39 |
1 files changed, 21 insertions, 18 deletions
diff --git a/src/guile/skribilo/lib.scm b/src/guile/skribilo/lib.scm index 21b2a4d..1bac503 100644 --- a/src/guile/skribilo/lib.scm +++ b/src/guile/skribilo/lib.scm @@ -1,8 +1,7 @@ +;;; lib.scm -- Utilities. ;;; -;;; lib.scm -- Utilities -;;; -;;; Copyright © 2003-2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> -;;; Copyright © 2005 Ludovic Courtès <ludovic.courtes@laas.fr> +;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr> +;;; Copyright 2005, 2007 Ludovic Courtès <ludovic.courtes@laas.fr> ;;; ;;; ;;; This program is free software; you can redistribute it and/or modify @@ -32,6 +31,9 @@ :export-syntax (new define-markup define-simple-markup define-simple-container define-processor-markup) + ;; Re-exported because used in `define-markup'. + :re-export (invocation-location) + :use-module (skribilo config) :use-module (skribilo ast) @@ -100,7 +102,12 @@ (let ((name (car bindings)) (opts (cdr bindings))) - `(define*-public ,(cons name (fix-rest-arg opts)) ,@body))) + `(define*-public ,(cons name (fix-rest-arg 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 6))) + ,@body)))) ;;; @@ -112,7 +119,7 @@ (markup ',markup) (ident (or ident (symbol->string (gensym ',(symbol->string markup))))) - (loc loc) + (loc (or loc &invocation-location)) (class class) (required-options '()) (options (the-options opts :ident :class :loc)) @@ -128,7 +135,7 @@ (markup ',markup) (ident (or ident (symbol->string (gensym ',(symbol->string markup))))) - (loc loc) + (loc (or loc &invocation-location)) (class class) (required-options '()) (options (the-options opts :ident :class :loc)) @@ -196,15 +203,10 @@ ;;; ;;; SKRIBE-WARNING & SKRIBE-WARNING/AST ;;; -(define (%skribe-warn level file line lst) +(define (%skribe-warn level file line col lst) (let ((port (current-error-port))) - (if (or (not file) (not line)) - (begin - ;; XXX: This is a bit hackish, but it proves to be quite useful. - (set! file (port-filename (current-input-port))) - (set! line (port-line (current-input-port))))) - (when (and file line) - (format port "~a:~a: " file line)) + (when (and file line col) + (format port "~a:~a:~a: " file line col)) (format port "warning: ") (for-each (lambda (x) (format port "~a " x)) lst) (newline port))) @@ -212,15 +214,16 @@ (define (skribe-warning level . obj) (if (>= (*warning*) level) - (%skribe-warn level #f #f obj))) + (%skribe-warn level #f #f #f obj))) (define (skribe-warning/ast level ast . obj) (if (>= (*warning*) level) (let ((l (ast-loc ast))) (if (location? l) - (%skribe-warn level (location-file l) (location-line l) obj) - (%skribe-warn level #f #f obj))))) + (%skribe-warn level (location-file l) (location-line l) + (location-column l) obj) + (%skribe-warn level #f #f #f obj))))) ;;; ;;; SKRIBE-MESSAGE |