Commits

Moritz Heidkamp committed 630efd8

Initial commit

Comments (0)

Files changed (5)

+*.so
+*.c
+*.import.*

xdg-basedir-impl.scm

+;;; Implementation of the XDG Base Directory Specification 0.8
+;;; http://standards.freedesktop.org/basedir-spec/basedir-spec-0.8.html
+
+(import chicken scheme)
+(use files data-structures srfi-1 posix)
+
+(define current-application
+  (make-parameter #f))
+
+
+;;; Internal helper functions
+
+(define (application)
+  (or (current-application)
+      (error "Parameter current-application is not set")))
+
+(define (home)
+  (get-environment-variable "HOME"))
+
+(define (blank? x)
+  (or (not x) (zero? (string-length x))))
+
+(define ((base-dir-from-env-var-or-home-path env-var home-path))
+  (let ((dir (get-environment-variable env-var)))
+    (cond ((blank? dir)
+           (make-pathname (home) home-path))
+          ((not (absolute-pathname? dir))
+           (error (string-append env-var " must not be a relative path") dir))
+          (else dir))))
+
+(define ((dirs-from-env-var/default env-var default))
+  (let ((dirs (get-environment-variable env-var)))
+    (if (blank? dirs)
+        default
+        (filter absolute-pathname? (string-split dirs ":")))))
+
+(define ((find-file get-home-base-dir get-base-dirs) path)
+  (let ((app-path (make-pathname (application) path)))
+    (let find ((base-dirs (cons (get-home-base-dir) (get-base-dirs))))
+      (and (not (null? base-dirs))
+           (or (file-exists? (make-pathname (car base-dirs) app-path))
+               (find (cdr base-dirs)))))))
+
+(define parent-directory-creation-mode
+  (string->number "077" 8))
+
+(define ((home-dir get-home-base-dir) path)
+  (let* ((app-home  (make-pathname (get-home-base-dir) (application)))
+         (full-path (make-pathname app-home path)))
+    (parameterize ((file-creation-mode parent-directory-creation-mode))
+      (create-directory full-path #t))))
+
+(define ((home-file make-home-dir) path)
+  (make-pathname (make-home-dir (pathname-directory path))
+                 (pathname-strip-directory path)))
+
+
+
+;;; XDG_DATA_HOME, XDG_DATA_DIRS
+
+(define data-home
+  (base-dir-from-env-var-or-home-path "XDG_DATA_HOME" ".local/share"))
+
+(define data-directories
+  (dirs-from-env-var/default "XDG_DATA_DIRS" '("/usr/local/share/" "/usr/share/")))
+
+(define find-data-file
+  (find-file data-home data-directories))
+
+(define data-directory
+  (home-dir data-home))
+
+(define data-file
+  (home-file data-directory))
+
+
+;;; XDG_CONFIG_HOME, XDG_CONFIG_DIRS
+
+(define config-home
+  (base-dir-from-env-var-or-home-path "XDG_CONFIG_HOME" ".config"))
+
+(define config-directories
+  (dirs-from-env-var/default "XDG_CONFIG_DIRS" '("/etc/xdg")))
+
+(define find-config-file
+  (find-file config-home config-directories))
+
+(define config-directory
+  (home-dir config-home))
+
+(define config-file
+  (home-file config-directory))
+
+
+;;; XDG_CACHE_HOME
+
+(define cache-home
+  (base-dir-from-env-var-or-home-path "XDG_CACHE_HOME" ".cache"))
+
+(define cache-directory
+  (home-dir config-home))
+
+(define cache-file
+  (home-file cache-directory))
+
+
+;;; XDG_RUNTIME_DIR
+;;
+;; TODO: Implement fall back to a replacement directory if not set
+
+(define (runtime-home)
+  (get-environment-variable "XDG_RUNTIME_DIR"))
+
+(define runtime-directory
+  (home-dir runtime-home))
+
+(define runtime-file
+  (home-file runtime-directory))
+((synopsis "Implementation of the XDG Base Directory Specification 0.8")
+ (author "Moritz Heidkamp")
+ (category os)
+ (license "BSD"))
+(module xdg-basedir
+
+(current-application
+
+ data-home
+ data-directories
+ find-data-file
+ data-directory
+ data-file
+
+ config-home
+ config-directories
+ find-config-file
+ config-directory
+ config-file
+
+ cache-home
+ cache-directory
+ cache-file
+
+ runtime-home
+ runtime-directory
+ runtime-file)
+
+"xdg-basedir-impl.scm"
+
+)

xdg-basedir.setup

+(compile -d0 -O3 -J -s xdg-basedir.scm)
+(compile -d0 -O3 -s xdg-basedir.import.scm)
+
+(install-extension
+ 'xdg-basedir
+ '("xdg-basedir.so" "xdg-basedir.import.so"))
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.