Hatena::Groupcadr

わだばLisperになる このページをアンテナに追加 RSSフィード

2004 | 12 |
2005 | 01 | 02 | 07 | 10 | 11 |
2006 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2007 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2008 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2009 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2010 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 08 | 09 | 10 | 11 | 12 |
2011 | 01 | 02 | 03 | 04 | 05 | 06 | 07 | 11 |

2010-08-13

KMRCLを眺める(186) CWD

| 23:09 | KMRCLを眺める(186) CWD - わだばLisperになる を含むブックマーク はてなブックマーク - KMRCLを眺める(186) CWD - わだばLisperになる

今回は、KMRCLのimpl.lispからCWDです。

CWDはUNIXのcurrent working directoryのことだと思われ、現在位置しているディレクトリを返すもののようですが、現在位置を返すだけではなくディレクトリも指定した場所に移動するようです。

例のごとく処理系依存の切り分けが定義の殆どを占めています。

(defun cwd (&optional dir)
  "Change directory and set default pathname"
  (cond
   ((not (null dir))
    (when (and (typep dir 'logical-pathname)
               (translate-logical-pathname dir))
      (setq dir (translate-logical-pathname dir)))
    (when (stringp dir)
      (setq dir (parse-namestring dir)))
    #+allegro (excl:chdir dir)
    #+clisp (#+lisp=cl ext:cd #-lisp=cl lisp:cd dir)
    #+(or cmu scl) (setf (ext:default-directory) dir)
    #+cormanlisp (ccl:set-current-directory dir)
    #+(and mcl (not openmcl)) (ccl:set-mac-default-directory dir)
    #+openmcl (ccl:cwd dir)
    #+gcl (si:chdir dir)
    #+lispworks (hcl:change-directory dir)
    (setq cl:*default-pathname-defaults* dir))
   (t
    (let ((dir
           #+allegro (excl:current-directory)
           #+clisp (#+lisp=cl ext:default-directory #-lisp=cl lisp:default-directory)
           #+(or cmu scl) (ext:default-directory)
           #+sbcl (sb-unix:posix-getcwd/)
           #+cormanlisp (ccl:get-current-directory)
           #+lispworks (hcl:get-working-directory)
           #+mcl (ccl:mac-default-directory)
           #-(or allegro clisp cmu scl cormanlisp mcl sbcl lispworks) (truename ".")))
      (when (stringp dir)
        (setq dir (parse-namestring dir)))
      dir))))

動作ですが、普通のパスはもとより

(KL:CWD "/tmp")

(DIRECTORY ".")
;⇒ (#P"/tmp/")

論理パスも扱えるようになっています。

(SETF (LOGICAL-PATHNAME-TRANSLATIONS "var")
      '(("tmp;**;*.*.*" "/var/tmp/**/*.*")))

(KL:CWD "var:tmp;")

(DIRECTORY "var:tmp;*")
;⇒ (#P"/usr/local/var/tmp/.fasls/"
     ...)