src/base/asdf.lisp

   1 ;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
   2 ;;;
   3 ;;; --- ASDF component classes
   4 ;;;
   5
   6 (defpackage :iolib.asdf
   7   (:use :common-lisp)
   8   #+sb-package-locks
   9   (:lock t))
  10 (in-package :iolib.asdf)
  11
  12 (defclass :iolib-muffled-source-file (asdf:cl-source-file) ())
  13
  14 (macrolet ((with-muffled-output (&body body)
  15              `(handler-bind
  16                   (#+sbcl (sb-int:package-at-variance #'muffle-warning))
  17                 ,@body)))
  18   (defmethod asdf:perform :around ((o asdf:compile-op)
  19                                    (c :iolib-muffled-source-file))
  20     (with-muffled-output
  21       (with-standard-io-syntax
  22         (let (;; Compilation fails because of CFFI types that
  23               ;; can't be printed readably, so bind to NIL
  24               (*print-readably* nil)
  25               (*readtable* (copy-readtable)))
  26           (call-next-method)))))
  27
  28   (defmethod asdf:perform :around ((o asdf:load-op)
  29                                    (c :iolib-muffled-source-file))
  30     (with-muffled-output
  31       (with-standard-io-syntax
  32         (let (;; See above
  33               (*print-readably* nil)
  34               (*readtable* (copy-readtable)))
  35           (call-next-method)))))
  36
  37   (defmethod asdf:perform :around ((o asdf:load-source-op)
  38                                    (c :iolib-muffled-source-file))
  39     (with-muffled-output
  40       (with-standard-io-syntax
  41         (let (;;See above
  42               (*print-readably* nil)
  43               (*readtable* (copy-readtable)))
  44           (call-next-method))))))
  45
  46 #+scl
  47 (eval-when (:compile-toplevel :load-toplevel :execute)
  48   ;; SCL 1.3.9.1 doesn't allow superclasses to be keywords
  49   ;; Fix suggested by DTC
  50   (defun clos::legal-class-name-p (x) (and x (symbolp x))))
  51
  52 (defclass :iolib-source-file (:iolib-muffled-source-file)
  53   ()
  54   (:default-initargs :encoding :utf-8))