Add glob routine.

2 files changed, 52 insertions, 15 deletions

diff --git a/module/config.scm b/module/config.scm
index d62b05db..e1000641 100644
--- a/module/config.scm
+++ b/module/config.scm
@@ -8,22 +8,10 @@
              (srfi srfi-88)
              (ice-9 ftw)
              (ice-9 regex)
-             (ice-9 rdelim))
+             (ice-9 rdelim)
+             (glob))
 
-(define (p str)
-  "Pathify string."
-  (regexp-substitute/global
-   #f "~[^/]*" str
-   'pre (lambda (_) (getenv "HOME")) 'post))
-
-(define (filename-hidden? str)
-  (char=? #\. (string-ref str 0)))
-
-(calendar-files
- (let ((path #; "/mnt/arch/home/hugo/.calendars/"
-        (p "~/.calendars/")))
-   (map (cut string-append path <>)
-        (scandir path (negate filename-hidden?)))))
+(calendar-files (glob "~/.calendars/*"))
 
 ;;; TODO possibly replace with propper lookup
 (define my-courses
diff --git a/module/glob.scm b/module/glob.scm
new file mode 100644
index 00000000..d4cd68a5
--- /dev/null
+++ b/module/glob.scm
@@ -0,0 +1,49 @@
+(define-module (glob)
+  :use-module (system foreign)
+  :use-module (rnrs bytevectors)
+  :export (glob))
+
+
+(define (glob-err epath eerrno)
+  (error "Glob errored on ~s with errno = ~a"
+         (pointer->string epath) eerrno))
+
+(eval-when (expand)
+ (read-enable 'curly-infix))
+(define << ash)
+
+(define	GLOB_ERR	{1 << 0})#| Return on read errors.  |#
+(define	GLOB_MARK	{1 << 1})#| Append a slash to each name.  |#
+(define	GLOB_NOSORT	{1 << 2})#| Don't sort the names.  |#
+(define	GLOB_DOOFFS	{1 << 3})#| Insert PGLOB->gl_offs NULLs.  |#
+(define	GLOB_NOCHECK	{1 << 4})#| If nothing matches, return the pattern.  |#
+(define	GLOB_APPEND	{1 << 5})#| Append to results of a previous call.  |#
+(define	GLOB_NOESCAPE	{1 << 6})#| Backslashes don't quote metacharacters.  |#
+(define	GLOB_PERIOD	{1 << 7})#| Leading `.' can be matched by metachars.  |#
+
+(define GLOB_MAGCHAR	 {1 <<  8})#| Set in gl_flags if any metachars seen.  |#
+(define GLOB_ALTDIRFUNC  {1 <<  9})#| Use gl_opendir et al functions.  |#
+(define GLOB_BRACE	 {1 << 10})#| Expand "{a,b}" to "a" "b".  |#
+(define GLOB_NOMAGIC	 {1 << 11})#| If no magic chars, return the pattern.  |#
+(define GLOB_TILDE	 {1 << 12})#| Expand ~user and ~ to home directories. |#
+(define GLOB_ONLYDIR	 {1 << 13})#| Match only directories.  |#
+(define GLOB_TILDE_CHECK {1 << 14})#| Like GLOB_TILDE but return an error
+				      if the user name is not available.  |#
+
+(define glob%
+  (let ((this (dynamic-link)))
+   (pointer->procedure
+    int (dynamic-func "glob" this) `(* ,int * *))))
+
+(define (glob str)
+  (let ((bv (make-bytevector 100)))
+    (let*  ((globptr (glob% (string->pointer str)
+                            (logior GLOB_MARK GLOB_BRACE GLOB_TILDE_CHECK)
+                            (procedure->pointer int glob-err (list '* int))
+                            (bytevector->pointer bv)))
+            (globstr (parse-c-struct (bytevector->pointer bv) (list size_t '* size_t))))
+
+      ;; TODO the 'u64 requires that the system has 64 bit wide pointers...
+      (let ((strvec (pointer->bytevector (cadr globstr) (car globstr) 0 'u64)))
+        (map (compose pointer->string make-pointer)
+             (bytevector->uint-list strvec (native-endianness) (sizeof '*)))))))