Restore Distribution

[RWK@fuji.ila.com (Robert W. Kerns)]

    Date: Mon, 22 Oct 90 15:36 EDT
    From: barmar@think.com (Barry Margolin)
    One thing I realized about the above use of the NULL: host is that the
    logical pathname facility doesn't like more than one logical path to
    translate to the same physical path.  So if you define "SYS:**;*.IBIN.*"
    to translate to "NULL:" then you'll get lots of complaints about
    duplication when you restore the distribution.

						    barmar

If I hadn't defined away the DIRECTORY, NAME, TYPE, and VERSION
components of NULL, this wouldn't be a problem.  So here's a revised,
slightly shorter version, that uses LMFS syntax, but of course,
doesn't CARE what the names of the "files" referenced are, or even
if you supply a name.  So now you can translate SYS:**;*.IBIN to
NULL:**;*.IBIN.

;;; -*- Mode: LISP; Syntax: Common-Lisp; Base: 10; Package: FILE-SYSTEM; Lowercase: T -*-


(defflavor null-pathname () (lmfs-pathname-mixin pathname))

(defmethod (:fully-merged-p null-pathname) ()
  t)

;;; We just use the pathname itself as the access path.  Why not,
;;; it doesn't have to DO anything...

(defmethod (pathname-file-access-path null-pathname) (operation)
  (declare (ignore operation))
  self)

(macrolet ((define-methods (name arglist method-body &body methods)
	     (declare (ignore name))
	     (let ((defs ()))
	       (dolist (m methods)
		 (push `(defmethod (,m null-pathname) (,@arglist &rest ignore)
			  ,method-body)
		       defs))
	       `(progn ,@(reverse defs)))))
  (define-methods homedir-methods (&optional (pathname (fs:default-pathname)) care-a-lot-p)
		    (send (send pathname :new-default-pathname :host net:*local-host*)
			  :homedir care-a-lot-p)
   :homedir :quiet-homedir)
  (define-methods null-methods () nil
   :all-directories :delete :directory-list
   :expunge :multiple-file-plists :properties)
  (define-methods error-methods () (error "You can't do that on a null host.")
   :change-properties :rename :undelete))

(defmethod (:complete-string null-pathname) (default-pathname string options)
  (declare (ignore default-pathname options))
  string)

;;; This seems to not be used.
(defmethod (:open null-pathname) (pathname &key &allow-other-keys)
  (declare (ignore pathname))
  'si:null-stream)

(defmethod (file-access-path-open null-pathname) (&key &allow-other-keys)
  'si:null-stream)

(defflavor null-host () (host-null-mixin net:no-device-host-mixin
			 active-pathname-host net:basic-host))

(defflavor host-null-mixin () (net:pathname-host-mixin)
  (:required-flavors net:basic-host))

(defmethod (:pathname-flavor null-host) ()
  'null-pathname)

(defmethod (:name null-host) ()
  "NULL")

(defmethod (:system-type null-host) ()
  :null)

(defvar *null-host* (make-instance 'null-host))

(unless (member *null-host* *pathname-host-list*)
  (push *null-host* *pathname-host-list*))

(unless (assoc *null-host* *default-pathname-defaults*)
  (let ((default (default-pathname)))
    (set-default-pathname *null-pathname*)
    (set-default-pathname default)))