summaryrefslogtreecommitdiff
path: root/src/guile/skribilo/location.scm
diff options
context:
space:
mode:
Diffstat (limited to 'src/guile/skribilo/location.scm')
-rw-r--r--src/guile/skribilo/location.scm31
1 files changed, 17 insertions, 14 deletions
diff --git a/src/guile/skribilo/location.scm b/src/guile/skribilo/location.scm
index 888ea94..048082a 100644
--- a/src/guile/skribilo/location.scm
+++ b/src/guile/skribilo/location.scm
@@ -1,7 +1,7 @@
;;; location.scm -- Skribilo source location.
;;; -*- coding: iso-8859-1 -*-
;;;
-;;; Copyright 2005, 2007, 2009, 2010 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright 2005, 2007, 2009, 2010, 2012 Ludovic Courtès <ludo@gnu.org>
;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;
;;;
@@ -26,7 +26,8 @@
:autoload (srfi srfi-13) (string-prefix?)
:export (<location> location? ast-location
location-file location-line location-column
- invocation-location))
+ invocation-location
+ source-properties->location))
;;; Author: Ludovic Courtès
;;;
@@ -95,17 +96,19 @@
(stack (make-stack #t)))
(and stack
(< depth (stack-length stack))
- (let* ((frame (stack-ref stack depth))
- (source (frame-source frame)))
- (and source
- (let ((file (source-property source 'filename))
- (line (source-property source 'line))
- (col (source-property source 'column)))
- (and file
- (make <location> :file file
- :line (and line (+ line 1))
- :column col))))))))
-
-;;; arch-tag: d68fa45d-a200-465e-a3c2-eb2861907f83
+ (let ((frame (stack-ref stack depth)))
+ (source-properties->location (frame-source frame))))))
+
+(define (source-properties->location loc)
+ "Return a location object based on the info in LOC, an alist as returned
+by Guile's `source-properties', `frame-source', `current-source-location',
+etc."
+ (let ((file (assq-ref loc 'filename))
+ (line (assq-ref loc 'line))
+ (col (assq-ref loc 'column)))
+ (and file (make <location>
+ :file file
+ :line (and line (+ line 1))
+ :column (and col (+ col 1))))))
;;; location.scm ends here.