1 (in-package #:portaCL)
 2 
 3 (defclass port-mixin ()
 4   ((format-name :initform ""
 5                 :initarg :format-name
 6                 :accessor format-name)
 7    (alternate-file :initform nil
 8                    :initarg :alternate-file
 9                    :accessor alternate-file)
10    (not-found-condition :initform 'not-implemented
11                         :initarg :not-found-condition
12                         :accessor not-found-condition))
13   (:documentation "Like cl-source-file, but offers the ability to splice the
14   implementation type into the name."))
15 
16 (defclass port-file (port-mixin asdf:cl-source-file) ())
17 (defclass port-module (port-mixin asdf:module) ())
18 
19 ;; ASDF does instantiation kinda funky.
20 (defmethod reinitialize-instance :after ((port-component port-mixin) &key name alternate-file &allow-other-keys)
21   (when name
22     (setf (format-name port-component)
23           name))
24   (when alternate-file
25     (setf (alternate-file port-component)
26           (merge-pathnames alternate-file (asdf::component-parent-pathname port-component)))))
27 
28 ;; SPOOKY!  component-pathname defaults to using the component-name.  We take
29 ;; advantage of that to provide an implementation-dependent pathname while
30 ;; leaving the component name as the original format string.
31 (defmethod asdf:component-name ((port port-mixin))
32   (if *implementation*
33       (format nil (format-name port) *implementation*)
34       (format-name port)))
35 
36 ;; Beware the nearly duplicate code in the following two methods.  It's not
37 ;; really worth factoring out, so be sure to make changes in both.
38 (defmethod asdf:component-pathname ((port port-module))
39   (or (first (some #'directory
40                    (loop :for *implementation* :in (lisp-implementation-names)
41                          :collect (call-next-method))))
42       (and (alternate-file port)
43            (directory (alternate-file port)))
44       (error (not-found-condition port))))
45 
46 (defmethod asdf:component-pathname ((port port-file))
47   (or (some #'probe-file
48             (loop :for *implementation* :in (lisp-implementation-names)
49                   :collect (call-next-method)))
50       (and (alternate-file port)
51            (probe-file (alternate-file port)))
52       (error (not-found-condition port))))
53 
54 ;; If the component is unnecessary, then no worries mate.  And yes, both of
55 ;; these methods are necessary.
56 (defmethod asdf:operation-done-p :around ((o asdf:operation) (component port-mixin))
57   (handler-case (call-next-method)
58     (not-necessary () t)))
59 (defmethod asdf:perform :around ((operation asdf:operation) (component port-mixin))
60   (handler-case (call-next-method)
61     (not-necessary () t)))
62 
63 ;; Make :port-file work in system definitions
64 (eval-when (:compile-toplevel :load-toplevel :execute)
65   (import 'port-file :asdf)
66   (import 'port-module :asdf))
67 
68 ;; testing examples
69 #+nil (pushnew #p"l:/clbuild/source/portaCL/examples/" asdf::*subdir-search-registry*)