Commits

evhan committed 4f20eb4

Support user-specified lispwords file for indentation rules

  • Participants
  • Parent commits 09c8921

Comments (0)

Files changed (2)

File schematic-format.1.md

-% SCHEMATIC-FORMAT(1) Schematic User Manuals | Version 0.1.1
+% SCHEMATIC-FORMAT(1) Schematic User Manuals | Version 0.1.2
 % Evan Hanson <evhan@foldling.org>
 % December 2013
 

File schematic-format.scm

 
 (cond-expand
   (chicken ; R7RS shims.
-   (require-extension (only extras read-line))
+   (use (only extras read-line) (only srfi-1 member))
    (define string-copy substring)
    (define (bytevector? o) #f)
    (define (close-port p)
      ((if (output-port? p) close-output-port close-input-port) p))
    (define (call-with-port p f)
      (let ((r (f p))) (close-port p) r))
+   (define error-object-message
+     (condition-property-accessor 'exn 'message))
+   (define error-object-irritants
+     (condition-property-accessor 'exn 'arguments))
    (define-syntax guard
      (syntax-rules ()
        ((_ (e . c) . b)
    (import (scheme base)
            (scheme case-lambda)
            (scheme char)
+           (scheme file)
            (scheme process-context)
            (scheme read)
            (scheme write))))
 
-(define program-version "0.1.1")
+(define program-version "0.1.2")
 
 ;; Perform body `b`, returning the result of `e` on _any_ error.
 (define-syntax guard/value
   (syntax-rules ()
     ((_ e . b) (let ((v e)) (guard (_ (else v)) . b)))))
 
+;; XXX Drops the error's irritants' tail.
+(define (prefix-error e msg)
+  (error (string-append msg ": " (error-object-message e))
+         (car (error-object-irritants e))))
+
+(define (error-exit e)
+  (parameterize ((current-output-port (current-error-port)))
+    (display "Error: ")
+    (display (error-object-message e))
+    (let ((args (error-object-irritants e)))
+      (unless (null? args)
+        (display ": ")
+        (display (car args))))
+    (newline)
+    (exit 1)))
+
 (define (call-with-input-string s f)
   (call-with-port (open-input-string s) f))
 
 (define (constant? o) ; Except `symbol?`.
   (or (boolean? o) (char? o) (number? o) (string? o) (vector? o) (bytevector? o)))
 
+(define (every? pred? lst)
+  (not (member #f lst (lambda (_ e) (not (pred? e))))))
+
 ;; Trim `char-whitespace?` from the front (i.e. left) of `str`.
 (define (string-trim str)
   (let ((len (string-length str)))
     ((with-input-from-file call-with-input-file) 0)
     (else #f)))
 
+;; The default behavior for keywords is to use the offset given by
+;; `keyword-indentation-offset`, but that may be overridden by a
+;; user-specified file containing custom indentation rules.
+(define keyword-indentation-function
+  (make-parameter keyword-indentation-offset))
+
 ;; Reformat the Scheme code on `input` into `output`.
 (define format-scheme
   (case-lambda
     (()
-     (format-scheme (current-input-port) (current-output-port)))
+     (format-scheme (current-input-port) (current-output-port) keyword-indentation-offset))
     ((input)
-     (format-scheme input (current-output-port)))
+     (format-scheme input (current-output-port) keyword-indentation-offset))
     ((input output)
+     (format-scheme input output keyword-indentation-offset))
+    ((input output custom-keyword-indentation-offset)
      (let loop ((forms (list (read-indent input))))
        (let ((line (read-line input)))
          (unless (eof-object? line)
                                     (cond
                                       ((constant? a)
                                        (scan (cons (+ i indent) f) i))
-                                      ((keyword-indentation-offset a (not k))
+                                      ((custom-keyword-indentation-offset a (not k))
                                        => (lambda (offset)
                                             (scan (if (number? offset)
                                                       (cons (+ i offset indent) f)
                            (else  (scan f (or (string-nth-read-index line 1 i len)
                                               (+ i 1)))))))))))))))))))
 
+;;
+;; An indentation file contains a single S-expression, which should be a
+;; list of indentation rules where each rule is one of the following
+;; forms:
+;;
+;;    (keyword . integer)
+;;    (keyword integer ...)
+;;
+(define read-indentation-file
+  (let ((valid-indentation-rule?
+         (lambda (p)
+           (or (and (list? p) (every? integer? (cdr p)))
+               (and (pair? p) (integer? (cdr p)))))))
+    (lambda (path)
+      (guard (e ((prefix-error e "Unable to read indentation file")))
+        (map (lambda (p)
+               (cond ((valid-indentation-rule? p) p)
+                     ((error "Invalid indentation rule" p))))
+             (let ((forms (with-input-from-file path read)))
+               (cond ((list? forms) forms)
+                     ((error "Not an alist" path)))))))))
+
 (for-each
  (lambda (option)
    (cond
       (for-each display (list program-version #\newline))
       (exit))
      ((member option '("-h" "--help"))
-      (for-each display (list "Usage: " (car (command-line)) #\newline))
+      (for-each display (list "Usage: " (car (command-line)) " [indent-file]" #\newline))
       (exit))
      (else
-      (parameterize ((current-output-port (current-error-port)))
-        (for-each display (list "Unrecognized command line option: " option #\newline))
-        (exit 1)))))
+      (with-exception-handler error-exit
+       (lambda ()
+         (let ((rules (read-indentation-file option)))
+           (keyword-indentation-function
+            (lambda (keyword eol?)
+              (cond ((assq keyword rules) => cdr)
+                    ((keyword-indentation-offset keyword eol?))
+                    (else #f))))))))))
  (cdr (command-line)))
 
 (format-scheme
  (current-input-port)
- (current-output-port))
+ (current-output-port)
+ (keyword-indentation-function))