Changeset 11859
- Timestamp:
- Mar 29, 2009, 5:41:14 PM (11 years ago)
- Location:
- trunk/source/level-1
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/source/level-1/l1-files.lisp
r11756 r11859 499 499 (when path (pathname path))) 500 500 501 (defun get-pathname-sstring (string &optional (start 0) (end (length string))) 502 #-windows-target 503 (get-sstring string start end) 504 #+windows-target 505 (multiple-value-bind (sstr start end) 506 (get-sstring string start end) 507 (declare (fixnum start end) 508 (simple-string sstr)) 509 (if (do* ((i start (1+ i))) 510 ((= i end)) 511 (declare (fixnum i)) 512 (when (eql (schar sstr i) #\\) 513 (return t))) 514 (let* ((len (- end start)) 515 (new (make-string len))) 516 (declare (fixnum len) (simple-string new)) 517 (dotimes (i len) 518 (let* ((ch (schar sstr start))) 519 (if (eql ch #\\) 520 (setf (schar new i) #\/) 521 (setf (schar new i) ch))) 522 (incf start)) 523 (values new 0 len)) 524 (values sstr start end)))) 525 501 526 (defun string-to-pathname (string &optional (start 0) (end (length string)) 502 527 (reference-host nil) 503 528 (defaults *default-pathname-defaults*)) 504 529 (require-type reference-host '(or null string)) 505 (multiple-value-bind (sstr start end) (get- sstring string start end)530 (multiple-value-bind (sstr start end) (get-pathname-sstring string start end) 506 531 #-windows-target 507 532 (if (and (> end start) … … 745 770 (logical-pathname (%logical-pathname-host thing)) 746 771 (pathname :unspecific) 747 (string (multiple-value-bind (sstr start end) (get- sstring thing)772 (string (multiple-value-bind (sstr start end) (get-pathname-sstring thing) 748 773 (pathname-host-sstr sstr start end))) 749 774 (t (report-bad-arg thing pathname-arg-type))))) … … 795 820 (pathname (%pathname-directory path)) 796 821 (string 797 (multiple-value-bind (sstr start end) (get-sstring path) 798 #+no 799 (if (and (> end start) 800 (eql (schar sstr start) #\~)) 801 (setq sstr (tilde-expand (subseq sstr start end)) 802 start 0 803 end (length sstr))) 822 (multiple-value-bind (sstr start end) (get-pathname-sstring path) 804 823 (multiple-value-bind (host pos2) (pathname-host-sstr sstr start end) 805 824 (unless (eq host :unspecific) (setq logical-p t)) … … 881 900 (pathname (%physical-pathname-version path)) 882 901 (string 883 (multiple-value-bind (sstr start end) (get- sstring path)902 (multiple-value-bind (sstr start end) (get-pathname-sstring path) 884 903 (multiple-value-bind (newstart host) (pathname-directory-end sstr start end) 885 904 (if (eq host :unspecific) … … 916 935 (pathname (%pathname-name path)) 917 936 (string 918 (multiple-value-bind (sstr start end) (get- sstring path)937 (multiple-value-bind (sstr start end) (get-pathname-sstring path) 919 938 (multiple-value-bind (newstart host) (pathname-directory-end sstr start end) 920 939 (setq start newstart) … … 952 971 (pathname (%pathname-type path)) 953 972 (string 954 (multiple-value-bind (sstr start end) (get- sstring path)973 (multiple-value-bind (sstr start end) (get-pathname-sstring path) 955 974 (multiple-value-bind (newstart host) (pathname-directory-end sstr start end) 956 975 (setq start newstart) -
trunk/source/level-1/l1-pathnames.lisp
r11639 r11859 361 361 362 362 (defun logical-pathname-namestring-p (string) 363 (multiple-value-bind (sstr start end) (get- sstring string)363 (multiple-value-bind (sstr start end) (get-pathname-sstring string) 364 364 (let ((host (pathname-host-sstr sstr start end t))) 365 365 (and host (not (eq host :unspecific))))))
Note: See TracChangeset
for help on using the changeset viewer.