/[cmucl]/src/code/pathname.lisp
ViewVC logotype

Diff of /src/code/pathname.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.10 by wlott, Fri May 15 17:51:47 1992 UTC revision 1.11 by ram, Mon Jun 1 16:24:22 1992 UTC
# Line 412  Line 412 
412         ,(maybe-diddle-case (coerce directory 'simple-string)         ,(maybe-diddle-case (coerce directory 'simple-string)
413                             diddle-case)))))                             diddle-case)))))
414    
415  (defun make-pathname (&key host device directory name type version  (defun make-pathname (&key (host nil hostp)
416                               (device nil devp)
417                               (directory nil dirp)
418                               (name nil namep)
419                               (type nil typep)
420                               (version nil versionp)
421                             defaults (case :local))                             defaults (case :local))
422    (declare (type (or host null) host)    (declare (type (or host null) host)
423             (type (member nil :unspecific) device)             (type (member nil :unspecific) device)
# Line 427  Line 432 
432           (default-host (if defaults           (default-host (if defaults
433                             (%pathname-host defaults)                             (%pathname-host defaults)
434                             (pathname-host *default-pathname-defaults*)))                             (pathname-host *default-pathname-defaults*)))
435           (host (or host default-host))           (host (if hostp host default-host))
436           (diddle-args (and (eq case :common)           (diddle-args (and (eq case :common)
437                             (eq (host-customary-case host) :lower)))                             (eq (host-customary-case host) :lower)))
438           (diddle-defaults           (diddle-defaults
439            (not (eq (host-customary-case host)            (not (eq (host-customary-case host)
440                     (host-customary-case default-host)))))                     (host-customary-case default-host)))))
441      (macrolet ((pick (var field)      (macrolet ((pick (var varp field)
442                   `(cond ((eq ,var :wild)                   `(cond ((eq ,var :wild)
443                           (make-pattern (list :multi-char-wild)))                           (make-pattern (list :multi-char-wild)))
444                          ((or (simple-string-p ,var)                          ((or (simple-string-p ,var)
# Line 442  Line 447 
447                          ((stringp ,var)                          ((stringp ,var)
448                           (maybe-diddle-case (coerce ,var 'simple-string)                           (maybe-diddle-case (coerce ,var 'simple-string)
449                                              diddle-args))                                              diddle-args))
450                          (,var                          (,varp
451                           (maybe-diddle-case ,var diddle-args))                           (maybe-diddle-case ,var diddle-args))
452                          (defaults                          (defaults
453                           (maybe-diddle-case (,field defaults)                           (maybe-diddle-case (,field defaults)
# Line 451  Line 456 
456                           nil))))                           nil))))
457        (%make-pathname        (%make-pathname
458         host         host
459         (or device (if defaults (%pathname-device defaults)))         (if devp device (if defaults (%pathname-device defaults)))
460         (let ((dir (import-directory directory diddle-args)))         (let ((dir (import-directory directory diddle-args)))
461           (if defaults           (if (and defaults (not dirp))
462               (merge-directories dir               (merge-directories dir
463                                  (%pathname-directory defaults)                                  (%pathname-directory defaults)
464                                  diddle-defaults)                                  diddle-defaults)
465               dir))               dir))
466         (pick name %pathname-name)         (pick name namep %pathname-name)
467         (pick type %pathname-type)         (pick type typep %pathname-type)
468         (cond         (cond
469             (version version)           (versionp version)
470             (defaults (%pathname-version defaults))           (defaults (%pathname-version defaults))
471             (t nil))))))           (t nil))))))
472    
473  (defun pathname-host (pathname &key (case :local))  (defun pathname-host (pathname &key (case :local))
474    (declare (type pathnamelike pathname)    (declare (type pathnamelike pathname)

Legend:
Removed from v.1.10  
changed lines
  Added in v.1.11

  ViewVC Help
Powered by ViewVC 1.1.5