X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/fbd5be649c2cddfdcf0557bf7321b1d1bbaa39e4..refs/heads/master:/src/module-impl.lisp diff --git a/src/module-impl.lisp b/src/module-impl.lisp index 44aa0b8..fc068d3 100644 --- a/src/module-impl.lisp +++ b/src/module-impl.lisp @@ -25,6 +25,56 @@ (cl:in-package #:sod) +;; Establish a standard environment within the body of a module. This is an +;; attempt -- but not a wholly successful one -- to present the same +;; environment to a module independent of the context in which we imported +;; it. + +;;;-------------------------------------------------------------------------- +;;; Module variables. + +(eval-when (:load-toplevel :execute) + (macrolet ((fix (var &optional (value var)) + (once-only (value) + `(add-module-binding ',var (lambda () ,value))))) + + ;; Use `sod-user' package by default. This seems the most useful. Alas, + ;; some tenants might not keep it as tidy as we'd like, but there are + ;; probably useful ways to side-effect the package too. + (fix *package* (find-package "SOD-USER")) + + ;; Stream bindings. Hope that the values we find at load time are + ;; sufficiently sensible. + (fix *debug-io*) + (fix *error-output*) + (fix *query-io*) + (fix *standard-input*) + (fix *standard-output*) + (fix *terminal-io*) + (fix *trace-output*) + + ;; Print state. + (fix *print-array* t) + (fix *print-base* 10) + (fix *print-case* :upcase) + (fix *print-circle* nil) + (fix *print-escape* t) + (fix *print-gensym* t) + (fix *print-length* nil) + (fix *print-level* nil) + (fix *print-lines* nil) + (fix *print-miser-width*) + (fix *print-pretty* t) + (fix *print-radix* nil) + (fix *print-readably* nil) + (fix *print-right-margin*) + + ;; Read state. + (fix *read-base* 10) + (fix *read-eval* t) + (fix *read-suppress* nil) + (fix *readtable* (copy-readtable nil)))) + ;;;-------------------------------------------------------------------------- ;;; Module basics. @@ -195,7 +245,10 @@ (prin1 (subseq text 0 37) stream) (write-string "..." stream)))) (output-c-excursion stream location - (lambda (stream) (write-string text stream)))))) + (lambda (stream) + (awhen (file-location-column location) + (dotimes (i it) (write-char #\space stream))) + (write-string text stream)))))) (defmethod make-load-form ((fragment c-fragment) &optional environment) (make-load-form-saving-slots fragment :environment environment))