From d2ee959dbc0a209b82e881d630573639f3274d12 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès
Date: Mon, 18 Mar 2013 00:12:54 +0100
Subject: `base' package: Always show the location of erroneous `ref' calls.
* src/guile/skribilo/lib.scm (warning/loc): New procedure.
(skribe-warning/ast): Use it.
* src/guile/skribilo/package/base.scm (ref)[unref]: Use `warning/loc',
and use `&invocation-location' as the location. Remove the `ast'
parameter; adjust callers accordingly.
---
src/guile/skribilo/lib.scm | 22 +++++++++++-------
src/guile/skribilo/package/base.scm | 46 ++++++++++++++-----------------------
2 files changed, 31 insertions(+), 37 deletions(-)
(limited to 'src/guile')
diff --git a/src/guile/skribilo/lib.scm b/src/guile/skribilo/lib.scm
index 96bf483..ab39261 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 Ludovic Court�s <ludo@gnu.org>
+;;; Copyright 2005, 2007, 2009, 2012, 2013 Ludovic Court�s <ludo@gnu.org>
;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;
;;;
@@ -23,7 +23,9 @@
:use-module (skribilo utils syntax)
:export (skribe-ast-error skribe-error
skribe-type-error
- skribe-warning skribe-warning/ast
+ warning/loc
+ skribe-warning
+ skribe-warning/ast
skribe-message
type-name
@@ -258,13 +260,17 @@
(%skribe-warn level #f #f #f obj)))
-(define (skribe-warning/ast level ast . obj)
+(define (warning/loc level loc . obj)
(if (>= (*warning*) level)
- (let ((l (ast-loc ast)))
- (if (location? l)
- (%skribe-warn level (location-file l) (location-line l)
- (location-column l) obj)
- (%skribe-warn level #f #f #f obj)))))
+ (if (location? loc)
+ (%skribe-warn level (location-file loc) (location-line loc)
+ (location-column loc) obj)
+ (%skribe-warn level #f #f #f obj))))
+
+(define (skribe-warning/ast level ast . obj)
+ (apply warning/loc level
+ (and (ast? ast) (ast-location ast))
+ obj))
;;;
;;; SKRIBE-MESSAGE
diff --git a/src/guile/skribilo/package/base.scm b/src/guile/skribilo/package/base.scm
index 60eccb1..ea34308 100644
--- a/src/guile/skribilo/package/base.scm
+++ b/src/guile/skribilo/package/base.scm
@@ -1,7 +1,7 @@
;;; base.scm -- The base markup package of Skribe/Skribilo.
;;; -*- coding: iso-8859-1 -*-
;;;
-;;; Copyright 2005, 2006, 2007, 2008, 2009 Ludovic Court�s <ludo@gnu.org>
+;;; Copyright 2005, 2006, 2007, 2008, 2009, 2013 Ludovic Court�s <ludo@gnu.org>
;;; Copyright 2003, 2004 Manuel Serrano
;;;
;;;
@@ -27,6 +27,7 @@
:use-module (skribilo ast)
:use-module (skribilo resolve)
+ :use-module (skribilo location)
:use-module (skribilo utils keywords)
:autoload (srfi srfi-1) (every any filter)
:autoload (skribilo evaluator) (include-document)
@@ -1065,36 +1066,24 @@
(skribe #f)
(page #f)
(sort-bib-refs bib-sort-refs/number))
- (define (unref ast text kind)
+ (define (unref text kind)
(let ((msg (format #f "can't find `~a': " kind)))
- (if (ast? ast)
- (begin
- (skribe-warning/ast 1 ast 'ref msg text)
- (new markup
- (markup 'unref)
- (ident (symbol->string (gensym "unref")))
- (class class)
- (loc &invocation-location)
- (required-options '(:text))
- (options `((kind ,kind) ,@(the-options opts :ident :class)))
- (body (list text ": " (ast->file-location ast)))))
- (begin
- (skribe-warning 1 'ref msg text)
- (new markup
- (markup 'unref)
- (ident (symbol->string (gensym "unref")))
- (class class)
- (loc &invocation-location)
- (required-options '(:text))
- (options `((kind ,kind) ,@(the-options opts :ident :class)))
- (body text))))))
+ (warning/loc 1 &invocation-location 'ref msg text)
+ (new markup
+ (markup 'unref)
+ (ident (symbol->string (gensym "unref")))
+ (class class)
+ (loc &invocation-location)
+ (required-options '(:text))
+ (options `((kind ,kind) ,@(the-options opts :ident :class)))
+ (body (list text ": " (location->string &invocation-location))))))
(define (skribe-ref skribe)
(let* ((sui (load-sui skribe))
(os (the-options opts :skribe :class :text))
(u (sui-ref->url (dirname (search-path (*sui-path*) skribe))
sui ident os)))
(if (not u)
- (unref #f os 'sui-ref)
+ (unref os 'sui-ref)
(ref :url u :text text :class class))))
(define (handle-ref text)
(new markup
@@ -1130,7 +1119,7 @@
,@(the-options opts :ident :class)))
(body (new handle
(ast s))))
- (unref n title (or kind 'title)))))))))
+ (unref title (or kind 'title)))))))))
(define (do-ident-ref text kind)
(if (not (string? text))
(skribe-type-error 'ref "Illegal reference" text "string")
@@ -1150,7 +1139,7 @@
,@(the-options opts :ident :class)))
(body (new handle
(ast s))))
- (unref n text (or kind 'ident)))))))))
+ (unref text (or kind 'ident)))))))))
(define (mark-ref mark)
(do-ident-ref mark 'mark))
(define (make-bib-ref v)
@@ -1169,8 +1158,7 @@
(o (markup-option s 'used)))
(markup-option-add! s 'used (if (pair? o) (cons h o) (list h)))
n)
- (unref #f v 'bib)))) ; FIXME: This prevents source location info
- ; from being provided in the warning msg
+ (unref v 'bib))))
(define (bib-ref text)
(if (pair? text)
(new markup
@@ -1205,7 +1193,7 @@
,@(the-options opts :ident :class)))
(body (new handle
(ast l))))
- (unref n line 'line)))))))
+ (unref line 'line)))))))
(let ((b (the-body opts)))
(if (not (null? b))
(skribe-warning 1 'ref "Arguments ignored " b))
--
cgit v1.2.3