;;;; -*- coding:utf-8 -*-
;;;;****************************************************************************
;;;;FILE:               dirent.lisp
;;;;LANGUAGE:           Common-Lisp
;;;;SYSTEM:             Common-Lisp
;;;;USER-INTERFACE:     NONE
;;;;DESCRIPTION
;;;;    
;;;;    SUSv3 dirent functions.
;;;;    
;;;;AUTHORS
;;;;    <PJB> Pascal Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;;    2005-04-04 <PJB> Created.
;;;;BUGS
;;;;LEGAL
;;;;    GPL
;;;;    
;;;;    Copyright Pascal Bourguignon 2005 - 2005
;;;;    
;;;;    This program is free software; you can redistribute it and/or
;;;;    modify it under the terms of the GNU General Public License
;;;;    as published by the Free Software Foundation; either version
;;;;    2 of the License, or (at your option) any later version.
;;;;    
;;;;    This program is distributed in the hope that it will be
;;;;    useful, but WITHOUT ANY WARRANTY; without even the implied
;;;;    warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
;;;;    PURPOSE.  See the GNU General Public License for more details.
;;;;    
;;;;    You should have received a copy of the GNU General Public
;;;;    License along with this program; if not, write to the Free
;;;;    Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;;    Boston, MA 02111-1307 USA
;;;;****************************************************************************


(cl:in-package "COMMON-LISP-USER")
(DECLAIM (DECLARATION ALSO-USE-PACKAGES)
         (ALSO-USE-PACKAGES "FFI"))
(EVAL-WHEN (:COMPILE-TOPLEVEL :LOAD-TOPLEVEL :EXECUTE)
  (COM.INFORMATIMAGO.COMMON-LISP.PACKAGE:ADD-NICKNAME
   "COM.INFORMATIMAGO.CLISP.SUSV3"   "SUSV3")
  (COM.INFORMATIMAGO.COMMON-LISP.PACKAGE:ADD-NICKNAME
     "COM.INFORMATIMAGO.CLISP.SUSV3-XSI" "SUSV3-XSI"))
(DEFPACKAGE "COM.INFORMATIMAGO.SUSV3.DIRENT"
  (:DOCUMENTATION 
   "An API over SUSV3 and SUSV3-XSI dirent API.")
  (:USE "COMMON-LISP"
        "COM.INFORMATIMAGO.CLISP.RAW-MEMORY"
        "COM.INFORMATIMAGO.SUSV3.TOOLS"
        "FFI")
  (:import-from "COM.INFORMATIMAGO.CLISP.SUSV3"
                "CHECK-ERRNO"  "CHECK-POINTER")
  (:EXPORT "DIR" "DIRENT" "DIRENT-INO" "DIRENT-NAME"
           "OPENDIR" "CLOSEDIR" "READDIR" "REWINDDIR" 
           ;; XSI:
           "SEEKDIR" "TELLDIR" ))


(DEFTYPE DIR () 
  "A type representing a directory stream."
  `T)


(DEFSTRUCT DIRENT 
  (INO  0  :TYPE integer) ;; File serial number
  (NAME "" :TYPE string)) ;; Name of entry [NAME-MAX]



(DECLAIM
 (FTYPE (FUNCTION (DIR)         INTEGER)          CLOSEDIR)
 (FTYPE (FUNCTION (STRING)      (OR NULL DIR))    OPENDIR)
 (FTYPE (FUNCTION (DIR)         (OR NULL DIRENT)) READDIR)
 (FTYPE (FUNCTION (DIR)         NIL)              REWINDDIR))

(DECLAIM ;; XSI
 (FTYPE (FUNCTION (DIR INTEGER) NIL)         SEEKDIR)
 (FTYPE (FUNCTION (DIR)         INTEGER)     TELLDIR))


(define-ffi-copiers (dirent susv3:dirent dirent->c-dirent c-dirent->dirent)
    (dirent-ino    susv3::dirent-d_ino)
  (dirent-name   susv3::dirent-d_name))



(DEFUN OPENDIR  (PATH)        (check-pointer (susv3:opendir path)
                                             :function  'susv3:opendir
                                             :arguments (list path)
                                             :caller    'opendir))

(DEFUN CLOSEDIR (DIR-STREAM)  (check-errno   (susv3:closedir dir-stream)
                                             :function  'susv3:closedir
                                             :arguments (list dir-stream)
                                             :caller    'closedir))

(DEFUN READDIR (DIR-STREAM)
  (setf susv3:errno 0)
  (let ((c-dirent (check-pointer (susv3:readdir DIR-STREAM)
                                 :function  'susv3:readdir
                                 :arguments (list DIR-STREAM)
                                 :caller    'readdir)))
    ;; :no-error (list susv3:ENOENT))))
    (unless (zerop c-dirent)
      (let* ((ino   (peek-uint32 c-dirent))
             (name  (coerce (loop for i from 0 
                               for a from (+ c-dirent 11)
                               until (zerop (peek-uint8 a))
                               collect (code-char (peek-uint8 a))) 'string)))
        (make-dirent :ino ino :name name)))))


(DEFUN REWINDDIR (DIR-STREAM) (susv3:rewinddir DIR-STREAM))


(DEFUN SEEKDIR (DIR-STREAM POSITION)
  (CHECK-ERRNO (susv3:seekdir DIR-STREAM POSITION)
               :function  'susv3:seekdir
               :arguments (list DIR-STREAM position)
               :caller    'seekdir))
                                           
 
(DEFUN TELLDIR (DIR-STREAM)
  (CHECK-ERRNO (susv3:telldir DIR-STREAM)
               :function  'susv3:telldir
               :arguments (list DIR-STREAM)
               :caller    'telldir))


(DEFUN DIRENT-TEST ()
  (DO* ((DIR-STREAM (OPENDIR "/tmp"))
        (ENTRY (READDIR DIR-STREAM) (READDIR DIR-STREAM)))
       ((NULL ENTRY))
    (FORMAT T "entry: ~8D ~S~%" (DIRENT-INO ENTRY) (DIRENT-NAME ENTRY))))