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

Diff of /src/code/filesys.lisp

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

revision 1.107 by rtoy, Thu Jun 11 16:03:57 2009 UTC revision 1.107.14.1 by rtoy, Thu Feb 25 20:34:49 2010 UTC
# Line 18  Line 18 
18    
19  (in-package "LISP")  (in-package "LISP")
20    
21    (intl:textdomain "cmucl")
22    
23  (export '(truename probe-file user-homedir-pathname directory  (export '(truename probe-file user-homedir-pathname directory
24            rename-file delete-file file-write-date file-author))            rename-file delete-file file-write-date file-author))
25    
# Line 70  Line 72 
72  ;;;  ;;;
73    
74  (defun remove-backslashes (namestr start end)  (defun remove-backslashes (namestr start end)
75    "Remove any occurrences of \\ from the string because we've already    _N"Remove any occurrences of \\ from the string because we've already
76     checked for whatever may have been backslashed."     checked for whatever may have been backslashed."
77    (declare (type simple-base-string namestr)    (declare (type simple-base-string namestr)
78             (type index start end))             (type index start end))
# Line 92  Line 94 
94                        (incf dst)))))))                        (incf dst)))))))
95      (when quoted      (when quoted
96        (error 'namestring-parse-error        (error 'namestring-parse-error
97               :complaint "Backslash in bad place."               :complaint _"Backslash in bad place."
98               :namestring namestr               :namestring namestr
99               :offset (1- end)))               :offset (1- end)))
100      (shrink-vector result dst)))      (shrink-vector result dst)))
101    
102  (defvar *ignore-wildcards* nil  (defvar *ignore-wildcards* nil
103    "If non-NIL, Unix shell-style wildcards are ignored when parsing    _N"If non-NIL, Unix shell-style wildcards are ignored when parsing
104    pathname namestrings.  They are also ignored when computing    pathname namestrings.  They are also ignored when computing
105    namestrings for pathname objects.  Thus, *, ?, etc. are not    namestrings for pathname objects.  Thus, *, ?, etc. are not
106    wildcards when parsing a namestring, and are not escaped when    wildcards when parsing a namestring, and are not escaped when
# Line 150  Line 152 
152                                (position #\] namestr :start index :end end)))                                (position #\] namestr :start index :end end)))
153                           (unless close-bracket                           (unless close-bracket
154                             (error 'namestring-parse-error                             (error 'namestring-parse-error
155                                    :complaint "``['' with no corresponding ``]''"                                    :complaint _"``['' with no corresponding ``]''"
156                                    :namestring namestr                                    :namestring namestr
157                                    :offset index))                                    :offset index))
158                           (pattern (list :character-set                           (pattern (list :character-set
# Line 320  Line 322 
322                       ;; same, we can't allow the creation of one when                       ;; same, we can't allow the creation of one when
323                       ;; the other is defined.                       ;; the other is defined.
324                       (when (find-logical-host search-list nil)                       (when (find-logical-host search-list nil)
325                         (error "~A already names a logical host" search-list))                         (error _"~A already names a logical host" search-list))
326                       (setf absolute t)                       (setf absolute t)
327                       (setf (car first) new-start))                       (setf (car first) new-start))
328                     search-list)))))                     search-list)))))
# Line 457  Line 459 
459                 (strings (second piece))                 (strings (second piece))
460                 (strings "]"))                 (strings "]"))
461                (t                (t
462                 (error "Invalid pattern piece: ~S" piece))))))                 (error _"Invalid pattern piece: ~S" piece))))))
463         (apply #'concatenate         (apply #'concatenate
464                'simple-string                'simple-string
465                (strings))))))                (strings))))))
# Line 483  Line 485 
485            ((member :up)            ((member :up)
486             (pieces "../"))             (pieces "../"))
487            ((member :back)            ((member :back)
488             (error ":BACK cannot be represented in namestrings."))             (error _":BACK cannot be represented in namestrings."))
489            ((member :wild-inferiors)            ((member :wild-inferiors)
490             (pieces "**/"))             (pieces "**/"))
491            ((or simple-string pattern (eql :wild))            ((or simple-string pattern (eql :wild))
492             (pieces (unparse-unix-piece dir))             (pieces (unparse-unix-piece dir))
493             (pieces "/"))             (pieces "/"))
494            (t            (t
495             (error "Invalid directory component: ~S" dir)))))             (error _"Invalid directory component: ~S" dir)))))
496      (apply #'concatenate 'simple-string (pieces))))      (apply #'concatenate 'simple-string (pieces))))
497    
498  (defun unparse-unix-directory (pathname)  (defun unparse-unix-directory (pathname)
# Line 514  Line 516 
516        (when name        (when name
517          (when (stringp name)          (when (stringp name)
518            (when (find #\/ name)            (when (find #\/ name)
519              (error "Cannot specify a directory separator in a pathname name: ~S" name))              (error _"Cannot specify a directory separator in a pathname name: ~S" name))
520            (when (and (not type-supplied)            (when (and (not type-supplied)
521                       (find #\. name :start 1))                       (find #\. name :start 1))
522              ;; A single leading dot is ok.              ;; A single leading dot is ok.
523              (error "Cannot specify a dot in a pathname name without a pathname type: ~S" name))              (error _"Cannot specify a dot in a pathname name without a pathname type: ~S" name))
524            (when (or (and (string= ".." name)            (when (or (and (string= ".." name)
525                           (not type-supplied))                           (not type-supplied))
526                      (and (string= "." name)                      (and (string= "." name)
527                           (not type-supplied)))                           (not type-supplied)))
528              ;; Can't have a name of ".." or "." without a type.              ;; Can't have a name of ".." or "." without a type.
529              (error "Invalid value for a pathname name: ~S" name)))              (error _"Invalid value for a pathname name: ~S" name)))
530          (strings (unparse-unix-piece name)))          (strings (unparse-unix-piece name)))
531        (when type-supplied        (when type-supplied
532          (unless name          (unless name
533            (error "Cannot specify the type without a file: ~S" pathname))            (error _"Cannot specify the type without a file: ~S" pathname))
534          (when (stringp type)          (when (stringp type)
535            (when (find #\/ type)            (when (find #\/ type)
536              (error "Cannot specify a directory separator in a pathname type: ~S" type))              (error _"Cannot specify a directory separator in a pathname type: ~S" type))
537            (when (find #\. type)            (when (find #\. type)
538              (error "Cannot specify a dot in a pathname type: ~S" type)))              (error _"Cannot specify a dot in a pathname type: ~S" type)))
539          (strings ".")          (strings ".")
540          (strings (unparse-unix-piece type)))          (strings (unparse-unix-piece type)))
541        (when (and (not (member version '(nil :newest :unspecific)))        (when (and (not (member version '(nil :newest :unspecific)))
542                   (not name))                   (not name))
543          ;; We don't want version without a name, because when we try          ;; We don't want version without a name, because when we try
544          ;; to read #p".~*~" back, the name is "", not NIL.          ;; to read #p".~*~" back, the name is "", not NIL.
545          (error "Cannot specify a version without a file: ~S" pathname))          (error _"Cannot specify a version without a file: ~S" pathname))
546        (when version-supplied        (when version-supplied
547          (strings (if (eq version :wild)          (strings (if (eq version :wild)
548                       (if logical-p ".*" ".~*~")                       (if logical-p ".*" ".~*~")
# Line 557  Line 559 
559  (defun unparse-unix-enough (pathname defaults)  (defun unparse-unix-enough (pathname defaults)
560    (declare (type pathname pathname defaults))    (declare (type pathname pathname defaults))
561    (flet ((lose ()    (flet ((lose ()
562             (error "~S cannot be represented relative to ~S"             (error _"~S cannot be represented relative to ~S"
563                    pathname defaults)))                    pathname defaults)))
564      ;; Only the first path in a search-list is considered.      ;; Only the first path in a search-list is considered.
565      (enumerate-search-list (pathname pathname)      (enumerate-search-list (pathname pathname)
# Line 672  Line 674 
674  (defun %enumerate-matches (pathname verify-existance follow-links function)  (defun %enumerate-matches (pathname verify-existance follow-links function)
675    (when (pathname-type pathname)    (when (pathname-type pathname)
676      (unless (pathname-name pathname)      (unless (pathname-name pathname)
677        (error "Cannot supply a type without a name:~%  ~S" pathname)))        (error _"Cannot supply a type without a name:~%  ~S" pathname)))
678    (let ((directory (pathname-directory pathname)))    (let ((directory (pathname-directory pathname)))
679      (if directory      (if directory
680          (ecase (car directory)          (ecase (car directory)
# Line 852  Line 854 
854  ;;;; UNIX-NAMESTRING -- public  ;;;; UNIX-NAMESTRING -- public
855  ;;;  ;;;
856  (defun unix-namestring (pathname &optional (for-input t) executable-only)  (defun unix-namestring (pathname &optional (for-input t) executable-only)
857    "Convert PATHNAME into a string that can be used with UNIX system calls.    _N"Convert PATHNAME into a string that can be used with UNIX system calls.
858     Search-lists and wild-cards are expanded. If optional argument     Search-lists and wild-cards are expanded. If optional argument
859     FOR-INPUT is true and PATHNAME doesn't exist, NIL is returned.     FOR-INPUT is true and PATHNAME doesn't exist, NIL is returned.
860     If optional argument EXECUTABLE-ONLY is true, NIL is returned     If optional argument EXECUTABLE-ONLY is true, NIL is returned
# Line 876  Line 878 
878          (when names          (when names
879            (when (cdr names)            (when (cdr names)
880              (error 'simple-file-error              (error 'simple-file-error
881                     :format-control "~S is ambiguous:~{~%  ~A~}"                     :format-control _"~S is ambiguous:~{~%  ~A~}"
882                     :format-arguments (list pathname names)))                     :format-arguments (list pathname names)))
883            (return (car names))))))))            (return (car names))))))))
884    
# Line 888  Line 890 
890  ;;; Another silly file function trivially different from another function.  ;;; Another silly file function trivially different from another function.
891  ;;;  ;;;
892  (defun truename (pathname)  (defun truename (pathname)
893    "Return the pathname for the actual file described by the pathname    _N"Return the pathname for the actual file described by the pathname
894    An error of type file-error is signalled if no such file exists,    An error of type file-error is signalled if no such file exists,
895    or the pathname is wild."    or the pathname is wild."
896    (if (wild-pathname-p pathname)    (if (wild-pathname-p pathname)
897        (error 'simple-file-error        (error 'simple-file-error
898               :format-control "Bad place for a wild pathname."               :format-control _"Bad place for a wild pathname."
899               :pathname pathname)               :pathname pathname)
900        (let ((result (probe-file pathname)))        (let ((result (probe-file pathname)))
901          (unless result          (unless result
902            (error 'simple-file-error            (error 'simple-file-error
903                   :pathname pathname                   :pathname pathname
904                   :format-control "The file ~S does not exist."                   :format-control _"The file ~S does not exist."
905                   :format-arguments (list (namestring pathname))))                   :format-arguments (list (namestring pathname))))
906          result)))          result)))
907    
# Line 908  Line 910 
910  ;;; If PATHNAME exists, return its truename, otherwise NIL.  ;;; If PATHNAME exists, return its truename, otherwise NIL.
911  ;;;  ;;;
912  (defun probe-file (pathname)  (defun probe-file (pathname)
913    "Return a pathname which is the truename of the file if it exists, NIL    _N"Return a pathname which is the truename of the file if it exists, NIL
914    otherwise. An error of type file-error is signalled if pathname is wild."    otherwise. An error of type file-error is signalled if pathname is wild."
915    (if (wild-pathname-p pathname)    (if (wild-pathname-p pathname)
916        (error 'simple-file-error        (error 'simple-file-error
917               :pathname pathname               :pathname pathname
918               :format-control "Bad place for a wild pathname.")               :format-control _"Bad place for a wild pathname.")
919        (let ((namestring (unix-namestring (merge-pathnames pathname) t)))        (let ((namestring (unix-namestring (merge-pathnames pathname) t)))
920          (when (and namestring (unix:unix-file-kind namestring))          (when (and namestring (unix:unix-file-kind namestring))
921            (let ((truename (unix:unix-resolve-links            (let ((truename (unix:unix-resolve-links
# Line 929  Line 931 
931  ;;; Rename-File  --  Public  ;;; Rename-File  --  Public
932  ;;;  ;;;
933  (defun rename-file (file new-name)  (defun rename-file (file new-name)
934    "Rename File to have the specified New-Name.  If file is a stream open to a    _N"Rename File to have the specified New-Name.  If file is a stream open to a
935    file, then the associated file is renamed."    file, then the associated file is renamed."
936    (let* ((original (truename file))    (let* ((original (truename file))
937           (original-namestring (unix-namestring original t))           (original-namestring (unix-namestring original t))
# Line 938  Line 940 
940      (unless new-namestring      (unless new-namestring
941        (error 'simple-file-error        (error 'simple-file-error
942               :pathname new-name               :pathname new-name
943               :format-control "~S can't be created."               :format-control _"~S can't be created."
944               :format-arguments (list new-name)))               :format-arguments (list new-name)))
945      (multiple-value-bind (res error)      (multiple-value-bind (res error)
946                           (unix:unix-rename original-namestring                           (unix:unix-rename original-namestring
# Line 946  Line 948 
948        (unless res        (unless res
949          (error 'simple-file-error          (error 'simple-file-error
950                 :pathname new-name                 :pathname new-name
951                 :format-control "Failed to rename ~A to ~A: ~A"                 :format-control _"Failed to rename ~A to ~A: ~A"
952                 :format-arguments (list original new-name                 :format-arguments (list original new-name
953                                         (unix:get-unix-error-msg error))))                                         (unix:get-unix-error-msg error))))
954        (when (streamp file)        (when (streamp file)
# Line 958  Line 960 
960  ;;;    Delete the file, Man.  ;;;    Delete the file, Man.
961  ;;;  ;;;
962  (defun delete-file (file)  (defun delete-file (file)
963    "Delete the specified file."    _N"Delete the specified file."
964    (let ((namestring (unix-namestring file t)))    (let ((namestring (unix-namestring file t)))
965      (when (streamp file)      (when (streamp file)
966        ;; Close the file, but don't try to revert or anything.  We want        ;; Close the file, but don't try to revert or anything.  We want
# Line 967  Line 969 
969      (unless namestring      (unless namestring
970        (error 'simple-file-error        (error 'simple-file-error
971               :pathname file               :pathname file
972               :format-control "~S doesn't exist."               :format-control _"~S doesn't exist."
973               :format-arguments (list file)))               :format-arguments (list file)))
974    
975      (multiple-value-bind (res err) (unix:unix-unlink namestring)      (multiple-value-bind (res err) (unix:unix-unlink namestring)
976        (unless res        (unless res
977          (error 'simple-file-error          (error 'simple-file-error
978                 :pathname namestring                 :pathname namestring
979                 :format-control "Could not delete ~A: ~A."                 :format-control _"Could not delete ~A: ~A."
980                 :format-arguments (list namestring                 :format-arguments (list namestring
981                                         (unix:get-unix-error-msg err))))))                                         (unix:get-unix-error-msg err))))))
982    t)    t)
# Line 984  Line 986 
986  ;;;    Purge old file versions  ;;;    Purge old file versions
987  ;;;  ;;;
988  (defun purge-backup-files (pathname &optional (keep 0))  (defun purge-backup-files (pathname &optional (keep 0))
989    "Delete old versions of files matching the given Pathname,    _N"Delete old versions of files matching the given Pathname,
990  optionally keeping some of the most recent old versions."  optionally keeping some of the most recent old versions."
991    (declare (type (or pathname string stream) pathname)    (declare (type (or pathname string stream) pathname)
992             (type (integer 0 *) keep))             (type (integer 0 *) keep))
# Line 1019  optionally keeping some of the most rece Line 1021  optionally keeping some of the most rece
1021  ;;;    Return Home:, which is set up for us at initialization time.  ;;;    Return Home:, which is set up for us at initialization time.
1022  ;;;  ;;;
1023  (defun user-homedir-pathname (&optional host)  (defun user-homedir-pathname (&optional host)
1024    "Returns the home directory of the logged in user as a pathname.    _N"Returns the home directory of the logged in user as a pathname.
1025    This is obtained from the logical name \"home:\"."    This is obtained from the logical name \"home:\"."
1026    (declare (ignore host))    (declare (ignore host))
1027    #p"home:")    #p"home:")
# Line 1027  optionally keeping some of the most rece Line 1029  optionally keeping some of the most rece
1029  ;;; File-Write-Date  --  Public  ;;; File-Write-Date  --  Public
1030  ;;;  ;;;
1031  (defun file-write-date (file)  (defun file-write-date (file)
1032    "Return file's creation date, or NIL if it doesn't exist.    _N"Return file's creation date, or NIL if it doesn't exist.
1033   An error of type file-error is signalled if file is a wild pathname"   An error of type file-error is signalled if file is a wild pathname"
1034    (if (wild-pathname-p file)    (if (wild-pathname-p file)
1035        (error 'simple-file-error        (error 'simple-file-error
1036               :pathname file               :pathname file
1037               :format-control "Bad place for a wild pathname.")               :format-control _"Bad place for a wild pathname.")
1038        (let ((name (unix-namestring file t)))        (let ((name (unix-namestring file t)))
1039          (when name          (when name
1040            (multiple-value-bind            (multiple-value-bind
# Line 1045  optionally keeping some of the most rece Line 1047  optionally keeping some of the most rece
1047  ;;; File-Author  --  Public  ;;; File-Author  --  Public
1048  ;;;  ;;;
1049  (defun file-author (file)  (defun file-author (file)
1050    "Returns the file author as a string, or nil if the author cannot be    _N"Returns the file author as a string, or nil if the author cannot be
1051   determined.  Signals an error of type file-error if file doesn't exist,   determined.  Signals an error of type file-error if file doesn't exist,
1052   or file is a wild pathname."   or file is a wild pathname."
1053    (if (wild-pathname-p file)    (if (wild-pathname-p file)
1054        (error 'simple-file-error        (error 'simple-file-error
1055               :pathname file               :pathname file
1056               :format-control "Bad place for a wild pathname.")               :format-control _"Bad place for a wild pathname.")
1057        (let ((name (unix-namestring (pathname file) t)))        (let ((name (unix-namestring (pathname file) t)))
1058          (unless name          (unless name
1059            (error 'simple-file-error            (error 'simple-file-error
1060                   :pathname file                   :pathname file
1061                   :format-control "~S doesn't exist."                   :format-control _"~S doesn't exist."
1062                   :format-arguments (list file)))                   :format-arguments (list file)))
1063          (multiple-value-bind (winp dev ino mode nlink uid)          (multiple-value-bind (winp dev ino mode nlink uid)
1064                               (unix:unix-stat name)                               (unix:unix-stat name)
# Line 1073  optionally keeping some of the most rece Line 1075  optionally keeping some of the most rece
1075  ;;;  ;;;
1076  (defun directory (pathname &key (all t) (check-for-subdirs t)  (defun directory (pathname &key (all t) (check-for-subdirs t)
1077                    (truenamep t) (follow-links t))                    (truenamep t) (follow-links t))
1078    "Returns a list of pathnames, one for each file that matches the given    _N"Returns a list of pathnames, one for each file that matches the given
1079     pathname.  Supplying :ALL as nil causes this to ignore Unix dot files.  This     pathname.  Supplying :ALL as nil causes this to ignore Unix dot files.  This
1080     never includes Unix dot and dot-dot in the result.  If :TRUENAMEP is NIL,     never includes Unix dot and dot-dot in the result.  If :TRUENAMEP is NIL,
1081     then symbolic links in the result are not expanded, which is not the     then symbolic links in the result are not expanded, which is not the
# Line 1122  optionally keeping some of the most rece Line 1124  optionally keeping some of the most rece
1124  ;;; PRINT-DIRECTORY is exported from the EXTENSIONS package.  ;;; PRINT-DIRECTORY is exported from the EXTENSIONS package.
1125  ;;;  ;;;
1126  (defun print-directory (pathname &optional stream &key all verbose return-list)  (defun print-directory (pathname &optional stream &key all verbose return-list)
1127    "Like Directory, but prints a terse, multi-column directory listing    _N"Like Directory, but prints a terse, multi-column directory listing
1128     instead of returning a list of pathnames.  When :all is supplied and     instead of returning a list of pathnames.  When :all is supplied and
1129     non-nil, then Unix dot files are included too (as ls -a).  When :verbose     non-nil, then Unix dot files are included too (as ls -a).  When :verbose
1130     is supplied and non-nil, then a long listing of miscellaneous     is supplied and non-nil, then a long listing of miscellaneous
# Line 1137  optionally keeping some of the most rece Line 1139  optionally keeping some of the most rece
1139    (let ((contents (directory pathname :all all :check-for-subdirs nil    (let ((contents (directory pathname :all all :check-for-subdirs nil
1140                               :truenamep nil))                               :truenamep nil))
1141          (result nil))          (result nil))
1142      (format t "Directory of ~A:~%" (namestring pathname))      (format t _"Directory of ~A:~%" (namestring pathname))
1143      (dolist (file contents)      (dolist (file contents)
1144        (let* ((namestring (unix-namestring file))        (let* ((namestring (unix-namestring file))
1145               (tail (subseq namestring               (tail (subseq namestring
# Line 1186  optionally keeping some of the most rece Line 1188  optionally keeping some of the most rece
1188                             (decode-universal-time-for-files mtime year)                             (decode-universal-time-for-files mtime year)
1189                             tail                             tail
1190                             (= (logand mode unix:s-ifmt) unix:s-ifdir))))                             (= (logand mode unix:s-ifmt) unix:s-ifdir))))
1191                  (t (format t "Couldn't stat ~A -- ~A.~%"                  (t (format t _"Couldn't stat ~A -- ~A.~%"
1192                             tail                             tail
1193                             (unix:get-unix-error-msg dev-or-err))))                             (unix:get-unix-error-msg dev-or-err))))
1194            (when return-list            (when return-list
# Line 1241  optionally keeping some of the most rece Line 1243  optionally keeping some of the most rece
1243             (cols (max (truncate width col-width) 1))             (cols (max (truncate width col-width) 1))
1244             (lines (ceiling cnt cols)))             (lines (ceiling cnt cols)))
1245        (declare (fixnum cols lines))        (declare (fixnum cols lines))
1246        (format t "Directory of ~A:~%" (namestring pathname))        (format t _"Directory of ~A:~%" (namestring pathname))
1247        (dotimes (i lines)        (dotimes (i lines)
1248          (declare (fixnum i))          (declare (fixnum i))
1249          (dotimes (j cols)          (dotimes (j cols)
# Line 1329  optionally keeping some of the most rece Line 1331  optionally keeping some of the most rece
1331  ;;;  ;;;
1332  (defun ambiguous-files (pathname  (defun ambiguous-files (pathname
1333                          &optional (defaults *default-pathname-defaults*))                          &optional (defaults *default-pathname-defaults*))
1334    "Return a list of all files which are possible completions of Pathname.    _N"Return a list of all files which are possible completions of Pathname.
1335     We look in the directory specified by Defaults as well as looking down     We look in the directory specified by Defaults as well as looking down
1336     the search list."     the search list."
1337    (directory (complete-file-directory-arg pathname defaults)    (directory (complete-file-directory-arg pathname defaults)
# Line 1344  optionally keeping some of the most rece Line 1346  optionally keeping some of the most rece
1346  ;;;   can be written by the current task.  ;;;   can be written by the current task.
1347  ;;;  ;;;
1348  (defun file-writable (name)  (defun file-writable (name)
1349    "File-writable accepts a pathname and returns T if the current    _N"File-writable accepts a pathname and returns T if the current
1350    process can write it, and NIL otherwise."    process can write it, and NIL otherwise."
1351    (let ((name (unix-namestring name nil)))    (let ((name (unix-namestring name nil)))
1352      (cond ((null name)      (cond ((null name)
# Line 1379  optionally keeping some of the most rece Line 1381  optionally keeping some of the most rece
1381  ;;; Default-Directory  --  Public  ;;; Default-Directory  --  Public
1382  ;;;  ;;;
1383  (defun default-directory ()  (defun default-directory ()
1384    "Returns the pathname for the default directory.  This is the place where    _N"Returns the pathname for the default directory.  This is the place where
1385    a file will be written if no directory is specified.  This may be changed    a file will be written if no directory is specified.  This may be changed
1386    with setf."    with setf."
1387    (multiple-value-bind (gr dir-or-error)    (multiple-value-bind (gr dir-or-error)
# Line 1409  optionally keeping some of the most rece Line 1411  optionally keeping some of the most rece
1411  ;;; Seems like maybe it's fixed by changes made by Ray Toy to avoid heap corruption.  ;;; Seems like maybe it's fixed by changes made by Ray Toy to avoid heap corruption.
1412  #- (and)  #- (and)
1413  (defun default-directory ()  (defun default-directory ()
1414    "Returns the pathname for the default directory.  This is the place where    _N"Returns the pathname for the default directory.  This is the place where
1415    a file will be written if no directory is specified.  This may be changed    a file will be written if no directory is specified.  This may be changed
1416    with setf."    with setf."
1417    (multiple-value-bind (gr dir-or-error)    (multiple-value-bind (gr dir-or-error)
# Line 1430  optionally keeping some of the most rece Line 1432  optionally keeping some of the most rece
1432    (let ((namestring (unix-namestring new-val t)))    (let ((namestring (unix-namestring new-val t)))
1433      (unless namestring      (unless namestring
1434        (error 'simple-file-error        (error 'simple-file-error
1435               :format-control "~S doesn't exist."               :format-control _"~S doesn't exist."
1436               :format-arguments (list new-val)))               :format-arguments (list new-val)))
1437      (multiple-value-bind (gr error)      (multiple-value-bind (gr error)
1438                           (unix:unix-chdir namestring)                           (unix:unix-chdir namestring)
# Line 1453  optionally keeping some of the most rece Line 1455  optionally keeping some of the most rece
1455  ;;; Ensure-Directories-Exist  --  Public  ;;; Ensure-Directories-Exist  --  Public
1456  ;;;  ;;;
1457  (defun ensure-directories-exist (pathspec &key verbose (mode #o777))  (defun ensure-directories-exist (pathspec &key verbose (mode #o777))
1458    "Tests whether the directories containing the specified file    _N"Tests whether the directories containing the specified file
1459    actually exist, and attempts to create them if they do not.    actually exist, and attempts to create them if they do not.
1460    Portable programs should avoid using the :MODE keyword argument."    Portable programs should avoid using the :MODE keyword argument."
1461    (let* ((pathname (pathname pathspec))    (let* ((pathname (pathname pathspec))
# Line 1463  optionally keeping some of the most rece Line 1465  optionally keeping some of the most rece
1465           (created-p nil))           (created-p nil))
1466      (when (wild-pathname-p pathname)      (when (wild-pathname-p pathname)
1467        (error 'simple-file-error        (error 'simple-file-error
1468               :format-control "Bad place for a wild pathname."               :format-control _"Bad place for a wild pathname."
1469               :pathname pathspec))               :pathname pathspec))
1470      (enumerate-search-list (pathname pathname)      (enumerate-search-list (pathname pathname)
1471         (let ((dir (pathname-directory pathname)))         (let ((dir (pathname-directory pathname)))
# Line 1478  optionally keeping some of the most rece Line 1480  optionally keeping some of the most rece
1480                             (unless (probe-file newpath)                             (unless (probe-file newpath)
1481                               (let ((namestring (namestring newpath)))                               (let ((namestring (namestring newpath)))
1482                                 (when verbose                                 (when verbose
1483                                   (format *standard-output* "~&Creating directory: ~A~%"                                   (format *standard-output* _"~&Creating directory: ~A~%"
1484                                           namestring))                                           namestring))
1485                                 (unix:unix-mkdir namestring mode)                                 (unix:unix-mkdir namestring mode)
1486                                 (unless (probe-file namestring)                                 (unless (probe-file namestring)
1487                                   (error 'simple-file-error                                   (error 'simple-file-error
1488                                          :pathname pathspec                                          :pathname pathspec
1489                                          :format-control "Can't create directory ~A."                                          :format-control _"Can't create directory ~A."
1490                                          :format-arguments (list namestring)))                                          :format-arguments (list namestring)))
1491                                 (setf created-p t)))                                 (setf created-p t)))
1492                           (retry () :report "Try to create the directory again"                           (retry () :report "Try to create the directory again"

Legend:
Removed from v.1.107  
changed lines
  Added in v.1.107.14.1

  ViewVC Help
Powered by ViewVC 1.1.5