--- title: Gaucheでスクリプトのあるディレクトリを取得する author: kazu634 date: 2010-11-03 wordtwit_post_info: - 'O:8:"stdClass":13:{s:6:"manual";b:0;s:11:"tweet_times";i:1;s:5:"delay";i:0;s:7:"enabled";i:1;s:10:"separation";s:2:"60";s:7:"version";s:3:"3.7";s:14:"tweet_template";b:0;s:6:"status";i:2;s:6:"result";a:0:{}s:13:"tweet_counter";i:2;s:13:"tweet_log_ids";a:1:{i:0;i:5375;}s:9:"hash_tags";a:0:{}s:8:"accounts";a:1:{i:0;s:7:"kazu634";}}' categories: - gauche - Lisp ---

実行しているスクリプトファイルがあるディレクトリを取得しようとしたのだが、探し方が悪いのかそのものずばりの組み込み関数を見つけられず。手作りしてみました。こんな感じになるのかな?

ソース

(use file.util)
;; (car *argv*)にスクリプトファイルが束縛されるけど、
;; スクリプトファイルの存在するディレクトリでスクリプトを起動すると、
;; 「スクリプトファイル名.scm」となる。
;; スクリプトファイルの存在するディレクトリ以外の場所で
;; スクリプトを起動すると、(car *argv*)はフルパス表記になる
;; そこを区別する。
(define (is-executed-at-script-directory? script-file)
(receive (path . rest)
(decompose-path script-file)
(if (equal? "."  path)
#t
#f)))
;; スクリプトファイルの存在するディレクトリでスクリプトを起動された場合、
;; カレントディレクトリがスクリプトが存在するディレクトリ
;; スクリプトファイルの存在するディレクトリ以外の場所で起動した場合、
;; (car *argv*)のディレクトリ部分だけを取得する
(define (main *argv*)
(if (is-executed-at-script-directory? (car *argv*))
(display (current-directory))
(receive (path . rest)
(decompose-path (car *argv*))
(display path))))

実行例

こんな感じです:

kazu634@kazu634% ll                                                                   ~/junk [3503]
total 96
-rwxr-xr-x  1 kazu634  staff   1.4K  8 21 22:49 2010-08-21-120641.scm
-rw-r--r--  1 kazu634  staff   975B  8 21 13:43 2010-08-21-134109.el
-rw-r--r--  1 kazu634  staff   1.1K  8 21 13:43 2010-08-21-134109.elc
-rwxr-xr-x  1 kazu634  staff   829B  8 22 16:15 2010-08-22-130237.sh
-rw-r--r--  1 kazu634  staff   977B  8 29 21:05 2010-08-29-202329.scm
-rw-r--r--  1 kazu634  staff   671B  9  3 22:58 2010-09-01-231839.scm
-rw-r--r--  1 kazu634  staff   1.0K  9  3 23:21 2010-09-03-232020.txt
-rw-r--r--  1 kazu634  staff   1.3K  9  5 22:48 2010-09-05-212342.scm
-rw-r--r--  1 kazu634  staff    84B  9 11 22:23 2010-09-11-222030.txt
-rw-r--r--  1 kazu634  staff   1.0K 10 24 15:24 2010-09-12-224720.scm
-rw-r--r--  1 kazu634  staff   3.6K  9 30 23:15 2010-09-16-201912.scm
-rwxr-xr-x  1 kazu634  staff   1.0K 11  3 22:45 2010-11-01-225103.scm
drwxr-xr-x  5 kazu634  staff   170B  9 16 20:10 source
drwxr-xr-x  4 kazu634  staff   136B  9 16 20:57 test
-rw-r--r--  1 kazu634  staff     0B 11  3 22:45 test.log
kazu634@kazu634% gosh 2010-11-01-225103.scm                                           ~/junk [3504]
/Users/kazu634/junk%
kazu634@kazu634% cd ..                                                                ~/junk [3505]
kazu634@kazu634% gosh ~/junk/2010-11-01-225103.scm                                         ~ [3506]
/Users/kazu634/junk%