From 7b652d03f927a823c01446dd025b87398270491a Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Tue, 28 May 1991 17:50:35 +0000 Subject: [PATCH] Changed exported funs not to assign their arguments. --- code/filesys.lisp | 89 ++++++++++++++++++++++------------------------- 1 file changed, 42 insertions(+), 47 deletions(-) diff --git a/code/filesys.lisp b/code/filesys.lisp index f6abf2845..ea1503077 100644 --- a/code/filesys.lisp +++ b/code/filesys.lisp @@ -7,7 +7,7 @@ ;;; Scott Fahlman or slisp-group@cs.cmu.edu. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.9 1991/04/25 13:25:48 ram Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/code/filesys.lisp,v 1.10 1991/05/28 17:50:35 ram Exp $") ;;; ;;; ********************************************************************** ;;; @@ -82,32 +82,27 @@ "Create a pathname from :host, :device, :directory, :name, :type and :version. If any field is ommitted, it is obtained from :defaults as though by merge-pathnames." + (flet ((make-it (host device directory name type version) + (%make-pathname + (if host + (if (stringp host) (coerce host 'simple-string) host) + (%pathname-host *default-pathname-defaults*)) + (if (stringp device) (coerce device 'simple-string) device) + (if (stringp directory) + (%pathname-directory (parse-namestring directory)) + directory) + (if (stringp name) (coerce name 'simple-string) name) + (if (stringp type) (coerce type 'simple-string) type) + version))) (if defaults (let ((defaults (pathname defaults))) - (unless hostp - (setq host (%pathname-host defaults))) - (unless devicep - (setq device (%pathname-device defaults))) - (unless directoryp - (setq directory (%pathname-directory defaults))) - (unless namep - (setq name (%pathname-name defaults))) - (unless typep - (setq type (%pathname-type defaults))) - (unless versionp - (setq version (%pathname-version defaults)))) - (unless hostp - (setq host (%pathname-host *default-pathname-defaults*)))) - - (when (stringp directory) - (setq directory (%pathname-directory (parse-namestring directory)))) - (%make-pathname - (if (stringp host) (coerce host 'simple-string) host) - (if (stringp device) (coerce device 'simple-string) device) - directory - (if (stringp name) (coerce name 'simple-string) name) - (if (stringp type) (coerce type 'simple-string) type) - version)) + (make-it (if hostp host (%pathname-host defaults)) + (if devicep device (%pathname-device defaults)) + (if directoryp directory (%pathname-directory defaults)) + (if namep name (%pathname-name defaults)) + (if typep type (%pathname-type defaults)) + (if versionp version (%pathname-version defaults)))) + (make-it host device directory name type version)))) ;;; These can not be done by the accessors because the pathname arg may be @@ -228,10 +223,8 @@ :name name :type type)))) (pathname - (setf end start) thing) (stream - (setf end start) (pathname (file-name thing)))))) (unless (or (null host) (null (pathname-host pathname)) @@ -241,7 +234,9 @@ 'parse-namestring (pathname-host pathname) host)) - (values pathname end))) + ;; + ;; ### ??? what should the second value be??? + (values pathname (or end start)))) (defun pathname (thing) @@ -265,22 +260,22 @@ gets it from Default-Version." ;; ;; finish hairy argument defaulting - (setq pathname (pathname pathname)) - (setq defaults (pathname defaults)) - ;; - ;; make a new pathname - (let ((name (%pathname-name pathname)) - (device (%pathname-device pathname))) - (%make-pathname - (or (%pathname-host pathname) (%pathname-host defaults)) - (or device (%pathname-device defaults)) - (or (%pathname-directory pathname) (%pathname-directory defaults)) - (or name (%pathname-name defaults)) - (or (%pathname-type pathname) (%pathname-type defaults)) - (or (%pathname-version pathname) - (if name - default-version - (or (%pathname-version defaults) default-version)))))) + (let ((pathname (pathname pathname)) + (defaults (pathname defaults))) + ;; + ;; make a new pathname + (let ((name (%pathname-name pathname)) + (device (%pathname-device pathname))) + (%make-pathname + (or (%pathname-host pathname) (%pathname-host defaults)) + (or device (%pathname-device defaults)) + (or (%pathname-directory pathname) (%pathname-directory defaults)) + (or name (%pathname-name defaults)) + (or (%pathname-type pathname) (%pathname-type defaults)) + (or (%pathname-version pathname) + (if name + default-version + (or (%pathname-version defaults) default-version))))))) ;;;; NAMESTRING and other stringification stuff. @@ -450,9 +445,9 @@ (defun enough-namestring (pathname &optional (defaults *default-pathname-defaults*)) "Returns a string which uniquely identifies PATHNAME w.r.t. DEFAULTS." - (setq pathname (pathname pathname)) - (setq defaults (pathname defaults)) - (let* ((device (%pathname-device pathname)) + (let* ((pathname (pathname pathname)) + (defaults (pathname defaults)) + (device (%pathname-device pathname)) (directory (%pathname-directory pathname)) (name (%pathname-name pathname)) (type (%pathname-type pathname)) -- GitLab