/[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.109 by rtoy, Mon Apr 19 02:18:03 2010 UTC revision 1.110 by rtoy, Tue Apr 20 17:57:44 2010 UTC
# Line 94  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 (intl:gettext "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)))
# Line 152  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 (intl:gettext "``['' with no corresponding ``]''")
156                                    :namestring namestr                                    :namestring namestr
157                                    :offset index))                                    :offset index))
158                           (pattern (list :character-set                           (pattern (list :character-set
# Line 322  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 (intl:gettext "~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 459  Line 459 
459                 (strings (second piece))                 (strings (second piece))
460                 (strings "]"))                 (strings "]"))
461                (t                (t
462                 (error _"Invalid pattern piece: ~S" piece))))))                 (error (intl:gettext "Invalid pattern piece: ~S") piece))))))
463         (apply #'concatenate         (apply #'concatenate
464                'simple-string                'simple-string
465                (strings))))))                (strings))))))
# Line 485  Line 485 
485            ((member :up)            ((member :up)
486             (pieces "../"))             (pieces "../"))
487            ((member :back)            ((member :back)
488             (error _":BACK cannot be represented in namestrings."))             (error (intl:gettext ":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 (intl:gettext "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 516  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 (intl:gettext "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 (intl:gettext "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 (intl:gettext "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 (intl:gettext "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 (intl:gettext "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 (intl:gettext "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 (intl:gettext "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 559  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 (intl:gettext "~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 674  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 (intl:gettext "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 878  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 (intl:gettext "~S is ambiguous:~{~%  ~A~}")
882                     :format-arguments (list pathname names)))                     :format-arguments (list pathname names)))
883            (return (car names))))))))            (return (car names))))))))
884    
# Line 895  Line 895 
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 (intl:gettext "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 (intl:gettext "The file ~S does not exist.")
905                   :format-arguments (list (namestring pathname))))                   :format-arguments (list (namestring pathname))))
906          result)))          result)))
907    
# Line 915  Line 915 
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 (intl:gettext "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 940  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 (intl:gettext "~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 948  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 (intl:gettext "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 969  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 (intl:gettext "~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 (intl:gettext "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 1034  optionally keeping some of the most rece Line 1034  optionally keeping some of the most rece
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 (intl:gettext "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 1053  optionally keeping some of the most rece Line 1053  optionally keeping some of the most rece
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 (intl:gettext "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 (intl:gettext "~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 1139  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 (intl:gettext "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 1188  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 (intl:gettext "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 1243  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 (intl:gettext "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 1432  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 (intl:gettext "~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 1465  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 (intl:gettext "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 1480  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* (intl:gettext "~&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 (intl:gettext "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.109  
changed lines
  Added in v.1.110

  ViewVC Help
Powered by ViewVC 1.1.5