lispdoc: implemented the whole URI syntax; updated URIs in all docstrings to be writt...
[com-informatimago:com-informatimago.git] / susv3 / dirent.lisp
1 ;;;; -*- coding:utf-8 -*-
2 ;;;;****************************************************************************
3 ;;;;FILE:               dirent.lisp
4 ;;;;LANGUAGE:           Common-Lisp
5 ;;;;SYSTEM:             Common-Lisp
6 ;;;;USER-INTERFACE:     NONE
7 ;;;;DESCRIPTION
8 ;;;;    
9 ;;;;    SUSv3 dirent functions.
10 ;;;;    
11 ;;;;AUTHORS
12 ;;;;    <PJB> Pascal Bourguignon <pjb@informatimago.com>
13 ;;;;MODIFICATIONS
14 ;;;;    2005-04-04 <PJB> Created.
15 ;;;;BUGS
16 ;;;;LEGAL
17 ;;;;    AGPL3
18 ;;;;    
19 ;;;;    Copyright Pascal Bourguignon 2005 - 2012
20 ;;;;    
21 ;;;;    This program is free software: you can redistribute it and/or modify
22 ;;;;    it under the terms of the GNU Affero General Public License as published by
23 ;;;;    the Free Software Foundation, either version 3 of the License, or
24 ;;;;    (at your option) any later version.
25 ;;;;    
26 ;;;;    This program is distributed in the hope that it will be useful,
27 ;;;;    but WITHOUT ANY WARRANTY; without even the implied warranty of
28 ;;;;    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
29 ;;;;    GNU Affero General Public License for more details.
30 ;;;;    
31 ;;;;    You should have received a copy of the GNU Affero General Public License
32 ;;;;    along with this program.  If not, see <http://www.gnu.org/licenses/>
33 ;;;;****************************************************************************
34
35
36 (in-package "COMMON-LISP-USER")
37
38 (declaim (declaration also-use-packages)
39          (also-use-packages "FFI"))
40
41 ;; TODO: This nicknaming should be done outside of the sources.
42 (eval-when (:compile-toplevel :load-toplevel :execute)
43   (com.informatimago.common-lisp.cesarum.package:add-nickname
44    "COM.INFORMATIMAGO.CLISP.SUSV3"   "SUSV3")
45   (com.informatimago.common-lisp.cesarum.package:add-nickname
46      "COM.INFORMATIMAGO.CLISP.SUSV3-XSI" "SUSV3-XSI"))
47
48 (defpackage "COM.INFORMATIMAGO.SUSV3.DIRENT"
49   (:documentation 
50    "An API over SUSV3 and SUSV3-XSI dirent API.")
51   (:use "COMMON-LISP"
52         "COM.INFORMATIMAGO.CLISP.RAW-MEMORY"
53         "COM.INFORMATIMAGO.SUSV3.TOOLS"
54         "FFI")
55   (:import-from "COM.INFORMATIMAGO.CLISP.SUSV3"
56                 "CHECK-ERRNO"  "CHECK-POINTER")
57   (:export "DIR" "DIRENT" "DIRENT-INO" "DIRENT-NAME"
58            "OPENDIR" "CLOSEDIR" "READDIR" "REWINDDIR" 
59            ;; XSI:
60            "SEEKDIR" "TELLDIR" ))
61 (in-package "COM.INFORMATIMAGO.SUSV3.DIRENT")
62
63
64 (deftype dir () 
65   "A type representing a directory stream."
66   `t)
67
68
69 (defstruct dirent 
70   (ino  0  :type integer) ;; File serial number
71   (name "" :type string)) ;; Name of entry [NAME-MAX]
72
73
74
75 (declaim
76  (ftype (function (dir)         integer)          closedir)
77  (ftype (function (string)      (or null dir))    opendir)
78  (ftype (function (dir)         (or null dirent)) readdir)
79  (ftype (function (dir)         nil)              rewinddir))
80
81 (declaim ;; XSI
82  (ftype (function (dir integer) nil)         seekdir)
83  (ftype (function (dir)         integer)     telldir))
84
85
86 (define-ffi-copiers (dirent susv3:dirent dirent->c-dirent c-dirent->dirent)
87     (dirent-ino    susv3::dirent-d_ino)
88   (dirent-name   susv3::dirent-d_name))
89
90
91
92 (defun opendir  (path)        (check-pointer (susv3:opendir path)
93                                              :function  'susv3:opendir
94                                              :arguments (list path)
95                                              :caller    'opendir))
96
97 (defun closedir (dir-stream)  (check-errno   (susv3:closedir dir-stream)
98                                              :function  'susv3:closedir
99                                              :arguments (list dir-stream)
100                                              :caller    'closedir))
101
102 (defun readdir (dir-stream)
103   (setf susv3:errno 0)
104   (let ((c-dirent (check-pointer (susv3:readdir dir-stream)
105                                  :function  'susv3:readdir
106                                  :arguments (list dir-stream)
107                                  :caller    'readdir)))
108     ;; :no-error (list susv3:ENOENT))))
109     (unless (zerop c-dirent)
110       (let* ((ino   (peek-uint32 c-dirent))
111              (name  (coerce (loop for i from 0 
112                                for a from (+ c-dirent 11)
113                                until (zerop (peek-uint8 a))
114                                collect (code-char (peek-uint8 a))) 'string)))
115         (make-dirent :ino ino :name name)))))
116
117
118 (defun rewinddir (dir-stream) (susv3:rewinddir dir-stream))
119
120
121 (defun seekdir (dir-stream position)
122   (check-errno (susv3:seekdir dir-stream position)
123                :function  'susv3:seekdir
124                :arguments (list dir-stream position)
125                :caller    'seekdir))
126                                            
127  
128 (defun telldir (dir-stream)
129   (check-errno (susv3:telldir dir-stream)
130                :function  'susv3:telldir
131                :arguments (list dir-stream)
132                :caller    'telldir))
133
134
135 (defun dirent-test ()
136   (do* ((dir-stream (opendir "/tmp"))
137         (entry (readdir dir-stream) (readdir dir-stream)))
138        ((null entry))
139     (format t "entry: ~8D ~S~%" (dirent-ino entry) (dirent-name entry))))
140
141
142 ;;;; THE END ;;;;