X-Git-Url: https://git.distorted.org.uk/~mdw/sod/blobdiff_plain/6c3c2dd3e236da72ce43b923e4eeac7d33eb5cbd..c3e28c92f639126436db713381309200eaba3ba2:/src/module-impl.lisp?ds=sidebyside diff --git a/src/module-impl.lisp b/src/module-impl.lisp index 268f4bc..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)) @@ -228,10 +281,10 @@ See `find-file' for the grubby details.") (export 'find-file) -(defun find-file (scanner name what thunk) +(defun find-file (home name what thunk) "Find a file called NAME on the module search path, and call THUNK on it. - The file is searched for relative to the SCANNER's current file, and also + The file is searched for relative to the HOME file or directory, and also in the directories mentioned in the `*module-dirs*' list. If the file is found, then THUNK is invoked with two arguments: the name we used to find it (which might be relative to the starting directory) and the truename @@ -245,8 +298,7 @@ THUNK is not invoked with any additional handlers defined." (handler-case - (dolist (dir (cons (pathname (scanner-filename scanner)) *module-dirs*) - (values nil nil)) + (dolist (dir (cons home *module-dirs*) (values nil nil)) (let* ((path (merge-pathnames name dir)) (probe (probe-file path))) (when probe