>From 2bfaabac15066834671d4121052ffeff1296e126 Mon Sep 17 00:00:00 2001 From: Evan Hanson Date: Fri, 1 Sep 2017 16:09:04 -0400 Subject: [PATCH] Make `current-directory` a pure getter with associated setter This adds a SRFI-17 setter for `current-directory` and drops the optional argument that could previously be passed to cause it to change directories. This makes it behave more like the other procedures in the posix unit, and makes for a better API since the current directory is a process-level variable and not a SRFI-39 parameter object (and it can't be made into one, since the CWD is not thread-local). --- posix-common.scm | 27 +++++++++++++++------------ types.db | 3 +-- 2 files changed, 16 insertions(+), 14 deletions(-) diff --git a/posix-common.scm b/posix-common.scm index e07dd5af..b0a8b5be 100644 --- a/posix-common.scm +++ b/posix-common.scm @@ -508,18 +508,21 @@ EOF (posix-error #:file-error 'change-directory* "cannot change current directory" fd)) fd) -(define (current-directory #!optional dir) - (if dir - (change-directory dir) - (let* ((buffer (make-string 1024)) - (len (##core#inline "C_curdir" buffer)) ) - #+(or unix cygwin) - (##sys#update-errno) - (if len - (##sys#substring buffer 0 len) - (##sys#signal-hook - #:file-error - 'current-directory "cannot retrieve current directory") ) ) ) ) +(define current-directory + (getter-with-setter + (lambda () + (let* ((buffer (make-string 1024)) + (len (##core#inline "C_curdir" buffer))) + #+(or unix cygwin) + (##sys#update-errno) + (if len + (##sys#substring buffer 0 len) + (##sys#signal-hook + #:file-error + 'current-directory "cannot retrieve current directory")))) + (lambda (dir) + ((if (fixnum? dir) change-directory* change-directory) dir)) + "(current-directory)")) (define directory (lambda (#!optional (spec (current-directory)) show-dotfiles?) diff --git a/types.db b/types.db index 0fb983f8..ab17cb9b 100644 --- a/types.db +++ b/types.db @@ -1903,8 +1903,7 @@ (chicken.posix#create-session (#(procedure #:clean) chicken.posix#create-session () fixnum)) (chicken.posix#create-symbolic-link (#(procedure #:clean #:enforce) chicken.posix#create-symbolic-link (string string) undefined)) -;; extra arg for "parameterize" - ugh, what a hack... -(chicken.posix#current-directory (#(procedure #:clean #:enforce) chicken.posix#current-directory (#!optional string *) string)) +(chicken.posix#current-directory (#(procedure #:clean #:enforce) chicken.posix#current-directory () string)) (chicken.posix#current-effective-group-id (#(procedure #:clean) chicken.posix#current-effective-group-id () fixnum)) (chicken.posix#current-effective-user-id (#(procedure #:clean) chicken.posix#current-effective-user-id () fixnum)) -- 2.11.0