`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.

2 files changed, 31 insertions, 37 deletions

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))