--- 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%