Report errors in the member file.

brmsaptool.scm

@@ -82,6 +82,8 @@
 	 (-fname- fname))
  (-month (month) "Specify current month"
 	 (*current-month* (string->month month)))
+ (-print () "Print given member file"
+	 (-action- 'print-member-file))
  )
 
 ;; Load the members database (required for everything anyway)
@@ -110,4 +112,10 @@
    (parameterize ((current-output-port (open-output-file (-fname-))))
      (print-members-base-stats
       (members-base-stats MB))))
+  ((print-member-file)
+   (cond (mr
+	  (newline)
+	  (print-member-source mr))
+	 (else
+	  (print "No member specified!"))))
   )

listing.scm

@@ -26,7 +26,11 @@
 (declare (unit listing))
 
 (module
- listing (print-source-listing listing-tests!)
+ listing
+ (
+  print-source-listing
+  listing-tests!
+  )
 
  (import scheme
 	 testing
@@ -59,18 +63,34 @@
 
  ;; Returns true if given line is near the target line.
  (define (line-near-target? line target context)
+   (let ((target-line (if (list? target)
+			  (car target)
+			  target)))
      (or (< context 0)
-       (<= (abs (- line target)) context)))
+	 (<= (abs (- line target-line)) context))))
 
  ;; Returns true if given line is near one of the target lines given.
  (define (line-near-targets? line targets context)
    (let loop ((targets targets))
      (if (null? targets)
-	 #f
+	 (< context 0)
 	 (if (line-near-target? line (car targets) context)
 	     #t
 	     (loop (cdr targets))))))
 
+ ;; Returns true if given number is in highlights.
+ (define (in-highlights? number highlights)
+   (let loop ((highlights highlights))
+     (if (null? highlights)
+	 #f
+	 (let* ((highlight (car highlights))
+		(line-number (if (list? highlight)
+				 (car highlight)
+				 highlight)))
+	   (if (= number line-number)
+	       #t
+	       (loop (cdr highlights)))))))
+
  ;; Prints and highlights a selection of source listing lines and
  ;; their optional context.
  (define (print-source-listing lines highlights context hl-pre hl-post ctx-pre ctx-post ellipsis)
@@ -80,7 +100,7 @@
 		(printed-something #f)
 		(was-printing #f))
        (when (not (null? lines))
-	 (let* ((content? (if (member number highlights) #t #f))
+	 (let* ((content? (in-highlights? number highlights))
 		(context? (and (not content?)
 			       (line-near-targets? number highlights context)))
 		(print? (or content? context?)))

member-file.scm

@@ -258,14 +258,23 @@
 	 (dict-set m k (string->month v))
 	 m)))
 
- ;; All conversions in one place
+ ;; Adds file-name and lines information to the error key.
- (define (convert-member-keys m)
+ (define (convert-member-key:error m esym lines file-name)
+   (dict-set m esym
+	     (cons file-name
+		   (cons lines
+			 (dict-ref m esym '())))))
+
+ ;; All conversions in one place, including error reporting.
+ (define (convert-member-keys m lines file-name)
+   (convert-member-key:error
     (convert-member-key:month
      (convert-member-keys:card
       (convert-member-key:credit
        (convert-member-keys:markers->periods m 'suspend 'student))
       'card 'desfire)
-    'joined))
+     'joined)
+    member-file-error-symbol lines file-name))
 
  ;; Fills-in the defaults
  (define (make-default-member-info)
@@ -281,7 +290,7 @@
 	      (r (make-default-member-info))
 	      (line-number 1))
      (if (null? ls)
-	 (convert-member-keys r)
+	 (convert-member-keys r lines file-name)
 	 (let ((p (split-member-line (car ls) file-name lines line-number)))
 	   (loop (cdr ls)
 		 (if p

member-record.scm

@@ -39,6 +39,8 @@
   member-existing?
   member-format
   member-suspended-months
+  member-source
+  print-member-source
   member-record-tests!
   )
 
@@ -50,7 +52,9 @@
 	 period
 	 testing
 	 month
-	 member-file)
+	 member-file
+	 listing
+	 ansi)
 
  ;; Prints human-readable information
  (define (print-member-record-info mr)
@@ -170,6 +174,26 @@
 	     0))
        0))
 
+ ;; Returns source (including error) information
+ (define (member-source mr)
+   (mr-ref mr member-file-error-symbol))
+
+ ;; Nicely prints the member source with any errors recorded.
+ (define (print-member-source mr)
+   (let* ((ms (member-source mr))
+	  (file-name (car ms))
+	  (lines (cadr ms))
+	  (hls (cddr ms)))
+     (print file-name ":")
+     (print-source-listing
+      lines
+      hls
+      -1
+      a:error a:default
+      "" "" ; Not used
+      "..." ; Not used
+      )))
+
  ;; Performs module self-tests.
  (define (member-record-tests!)
    (run-tests