Changeset 14683


Ignore:
Timestamp:
Mar 19, 2011, 2:40:34 AM (8 years ago)
Author:
rme
Message:

Re-indent make-file-stream.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/level-1/l1-sysio.lisp

    r14662 r14683  
    762762      (if (or (memq element-type '(:default character base-char))
    763763              (subtypep element-type 'character))
    764         (if (eq element-type :default)(setq element-type 'character))
     764        (if (eq element-type :default) (setq element-type 'character))
    765765        (progn
    766766          (setq element-type (type-expand element-type))
     
    775775        (t (report-bad-arg direction '(member :input :output :io :probe))))
    776776      (check-pathname-not-wild filename) ;; probe-file-x misses wild versions....
    777       (multiple-value-bind (native-truename kind)(probe-file-x filename)
    778        (tagbody retry
    779         (if native-truename
    780           (if (eq kind :directory)
    781             (if (eq direction :probe)
    782               (return-from open nil)
    783               (signal-file-error (- #$EISDIR)  filename))
    784             (if (setq filename (if-exists if-exists filename "Open ..."))
    785               (progn
    786                 (multiple-value-setq (native-truename kind) (probe-file-x filename))
    787                 (cond
    788                   ((not native-truename)
    789                    (setq native-truename (%create-file filename)
    790                          created t))
    791                   ((memq direction '(:output :io))
    792                    (when (eq if-exists :supersede)
    793                      (let ((truename (native-to-pathname native-truename)))
    794                        (setq temp-name (gen-file-name truename))
    795                        (unix-rename native-truename (native-untranslated-namestring temp-name))
    796                        (%create-file native-truename))))))
    797               (return-from open nil)))
    798           (if (setq filename (if-does-not-exist if-does-not-exist filename))
    799             (progn
    800               (unless (setq native-truename (%create-file filename :if-exists (case if-exists
    801                                                                                 ;; Let %create file handle these cases
    802                                                                                 ((:error :overwrite) if-exists)
    803                                                                                 (t nil))))
    804                 ;; Somebody else created the file while we're trying to create it.
    805                 (when (null if-exists) (return-from open nil))
    806                 (multiple-value-setq (native-truename kind) (probe-file-x filename))
    807                 (unless native-truename ;; huh?  Perhaps it disappeared again?
    808                   (error "Attempt to create ~s failed unexpectedly" filename))
    809                 (go retry))
    810               (setq created t))
    811             (return-from open nil))))
     777      (multiple-value-bind (native-truename kind) (probe-file-x filename)
     778        (tagbody retry
     779           (if native-truename
     780             (if (eq kind :directory)
     781               (if (eq direction :probe)
     782                (return-from open nil)
     783                (signal-file-error (- #$EISDIR)  filename))
     784               (if (setq filename (if-exists if-exists filename "Open ..."))
     785                (progn
     786                   (multiple-value-setq (native-truename kind) (probe-file-x filename))
     787                   (cond
     788                     ((not native-truename)
     789                      (setq native-truename (%create-file filename)
     790                            created t))
     791                     ((memq direction '(:output :io))
     792                      (when (eq if-exists :supersede)
     793                        (let ((truename (native-to-pathname native-truename)))
     794                          (setq temp-name (gen-file-name truename))
     795                          (unix-rename native-truename (native-untranslated-namestring temp-name))
     796                          (%create-file native-truename))))))
     797                (return-from open nil)))
     798             (if (setq filename (if-does-not-exist if-does-not-exist filename))
     799               (progn
     800                (unless (setq native-truename (%create-file filename :if-exists (case if-exists
     801                                                                                   ;; Let %create file handle these cases
     802                                                                                   ((:error :overwrite) if-exists)
     803                                                                                   (t nil))))
     804                   ;; Somebody else created the file while we're trying to create it.
     805                   (when (null if-exists) (return-from open nil))
     806                   (multiple-value-setq (native-truename kind) (probe-file-x filename))
     807                   (unless native-truename ;; huh?  Perhaps it disappeared again?
     808                     (error "Attempt to create ~s failed unexpectedly" filename))
     809                   (go retry))
     810                (setq created t))
     811               (return-from open nil))))
    812812        (let* ((fd (fd-open native-truename (case direction
    813813                                              ((:probe :input) #$O_RDONLY)
     
    815815                                              (:io #$O_RDWR)))))
    816816          (when (< fd 0)  (signal-file-error fd filename))
    817           (let* ((fd-kind (%unix-fd-kind fd)))
    818             (if (not (eq fd-kind :file))
    819               (make-fd-stream fd :direction direction
    820                               :element-type element-type
    821                               :sharing sharing
    822                               :basic basic)
    823               (progn
    824                 (when basic
    825                   (setq class (map-to-basic-stream-class-name class))
    826                   (setq basic (subtypep (find-class class) 'basic-stream)))
     817          (let* ((fd-kind (%unix-fd-kind fd)))
     818            (if (not (eq fd-kind :file))
     819              (make-fd-stream fd :direction direction
     820                              :element-type element-type
     821                              :sharing sharing
     822                              :basic basic)
     823              (progn
     824                (when basic
     825                  (setq class (map-to-basic-stream-class-name class))
     826                  (setq basic (subtypep (find-class class) 'basic-stream)))
    827827                (let* ((in-p (member direction '(:io :input)))
    828828                       (out-p (member direction '(:io :output)))
     
    855855                                 :force-output-function
    856856                                 (if out-p (select-stream-force-output-function
    857                                            class direction))
     857                                            class direction))
    858858                                 :device fd
    859859                                 :encoding encoding
Note: See TracChangeset for help on using the changeset viewer.