summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/guile/skribilo/lib.scm22
-rw-r--r--src/guile/skribilo/types.scm12
2 files changed, 22 insertions, 12 deletions
diff --git a/src/guile/skribilo/lib.scm b/src/guile/skribilo/lib.scm
index aaf1a8f..8667f7e 100644
--- a/src/guile/skribilo/lib.scm
+++ b/src/guile/skribilo/lib.scm
@@ -28,7 +28,7 @@
(define-module (skribilo lib)
:export (skribe-eval-location skribe-ast-error skribe-error
- skribe-type-error skribe-line-error
+ skribe-type-error
skribe-warning skribe-warning/ast
skribe-message
@@ -167,13 +167,14 @@
(let ((l (ast-loc obj))
(shape (if (markup? obj) (markup-markup obj) obj)))
(if (location? l)
- (error "~a:~a: ~a: ~a ~s" (location-file l) (location-pos l) proc msg shape)
- (error "~a: ~a ~s " proc msg shape))))
+ (error (format #f "~a:~a: ~a: ~a ~s" (location-file l)
+ (location-line l) proc msg shape))
+ (error (format #f "~a: ~a ~s " proc msg shape)))))
(define (skribe-error proc msg obj)
(if (ast? obj)
(skribe-ast-error proc msg obj)
- (error proc msg obj)))
+ (error (format #f "~a: ~a ~s" proc msg obj))))
;;;
@@ -183,17 +184,16 @@
(skribe-error proc (format "~a ~s (~a expected)" msg obj etype) #f))
-
-;;; FIXME: Peut-être virée maintenant
-(define (skribe-line-error file line proc msg obj)
- (error (format "%a:%a: ~a:~a ~S" file line proc msg obj)))
-
-
;;;
;;; SKRIBE-WARNING & SKRIBE-WARNING/AST
;;;
(define (%skribe-warn level file line 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))
(format port "warning: ")
@@ -210,7 +210,7 @@
(if (>= *skribe-warning* level)
(let ((l (ast-loc ast)))
(if (location? l)
- (%skribe-warn level (location-file l) (location-pos l) obj)
+ (%skribe-warn level (location-file l) (location-line l) obj)
(%skribe-warn level #f #f obj)))))
;;;
diff --git a/src/guile/skribilo/types.scm b/src/guile/skribilo/types.scm
index 8d51c8c..4b3729c 100644
--- a/src/guile/skribilo/types.scm
+++ b/src/guile/skribilo/types.scm
@@ -45,6 +45,7 @@
document-options document-end
<language> language?
<location> location? ast-location
+ location-file location-line location-pos
*node-table*)
:use-module (oop goops))
@@ -65,6 +66,15 @@
(parent :accessor ast-parent :init-keyword :parent :init-value 'unspecified)
(loc :init-value #f))
+(define-method (initialize (ast <ast>) . args)
+ (next-method)
+ (let ((file (port-filename (current-input-port)))
+ (line (port-line (current-input-port)))
+ (column (port-column (current-input-port))))
+ (slot-set! ast 'loc
+ (make <location>
+ :file file :line line :pos (* line column)))))
+
(define (ast? obj) (is-a? obj <ast>))
(define (ast-loc obj) (slot-ref obj 'loc))
(define (ast-loc-set! obj v) (slot-set! obj 'loc v))
@@ -313,5 +323,5 @@
(> lenf len))
(substring fname len (+ 1 (string-length fname)))
fname)))
- (format "~a, line ~a" file line))
+ (format #f "~a, line ~a" file line))
"no source location")))