[Gcl-devel] Re: CLC post pathnames ...

[Michael Koehne]

Moin Dennis,

> In ANSI the directory component (a list) must start with either
> the symbol RELATIVE or the symbol ABSOLUTE. From there only
> strings and the symbols UP or BACK are allowed. The difference
> between the latter and the former is a matter of syntactic or
> semantic behaviour.
  
  In short some differences :

  The :relative keyword might be ommited in new GCL. The :root,
  :current and :parent keywords are still recocnised, but :parent
  is deprecated and I introduced the experimental :home keyword
  to map the "~" directory component.

  The "*" and "**" are tokenised as :WILD and :WILD-INFERIORS while
  strings containing #\? or #\* are recocnised by wild-pathname-p,
  pathname-match-p and translate-pathname in a non-greedy manner.

  Parse-Namestring will produce ansi pathnames most of the time,
  so it prefers the ansi :absolute and :up over :root and :parent,
  but #p"~/foo/" and #p"./bar/" result in a directory with :home or
  :current as start, to make merge-pathnames reliable.

  Superfluous :current "." and :back "..." components are resolved by
  si:wrap-pathname which is called by si:search-local-pathname and
  merge-pathname, but only by make-pathname, if merging an explicit
  :defaults pathname.

> I haven't looked at logical pathnames which is whole topic
> itself.

  I tried to make not only ANSI but also applications happy. The
  following dribble is from my current GCL and extends a bit into
  explaining si:wrap-pathname, si:search-local-pathname and
  logical-pathname-translations. You may note, that creating a
  logical pathname with :back resulting in an error, and that
  my "sys:bin;" is pointing to a cmucl like search-list.

  The usage of my logical "sys" host is experimental! To be precise,
  #p"sys:lsp;gcl_export.lsp" and #p"sys:gcl-tk;demos;mkVScale.lisp"
  wont be valid ANSI logical hosts. Those files are only processed
  in a deprecated manner, if :ANSI is not in si:*pathname-resolve*.

  They should be moved to ANSI compilant names, or translations of
  "sys" as a logical host might become much harder.

;;;; begin pathnames.dribble
Starts dribbling to pathnames.dribble (2004/6/18, 20:45:20).
NIL

>
(make-pathname :directory '(:relative "a" "b" "c"))
#P"a/b/c/"

>
(make-pathname :directory '(:absolute "a" "b" "c"))
#P"/a/b/c/"

>
(make-pathname :directory '(:absolute "a" "b" :up "c"))
#P"/a/b/../c/"

>
(make-pathname :directory '(:absolute "a" "b" :back "c"))
#P"/a/b/.../c/"

>
(pathname-directory (make-pathname :directory '(:absolute "a" "b" :back "c")))
(:ABSOLUTE "a" "b" :BACK "c")

>
(pathname-directory #P"/a/b/../c/")
(:ABSOLUTE "a" "b" :UP "c")

>
(pathname-directory #P"/a/b/c/")
(:ABSOLUTE "a" "b" "c")

>
(pathname-directory #P"/a/b/c")
(:ABSOLUTE "a" "b")

>
(make-pathname :directory '("a" "b" "c"))
#P"a/b/c/"

>
(make-pathname :directory '(:relative "a" "b" "c"))
#P"a/b/c/"

>
(make-pathname :directory '(:relative "a" "b" :parent "c"))
#P"a/b/../c/"

>
(pathname-directory (make-pathname :directory '(:relative "a" "b" :parent "c")))
(:RELATIVE "a" "b" :PARENT "c")

>
(pathname-directory (si:wrap-pathname (make-pathname :directory '(:relative "a" 
"b" :parent "c"))))
(:RELATIVE "a" "b" :UP "c")

>
(make-pathname :directory '(:relative "a" "b" :current "c"))
#P"a/b/./c/"

>
(pathname-directory #P"../../")
(:UP :UP)

>
(pathname-directory (parse-namestring "/a/b/../c/"))
(:ABSOLUTE "a" "b" :UP "c")

>
(si:wrap-pathname #p"./foo/bar/./.../baz")
#P"./foo/baz"

>
(si:wrap-pathname #p"./foo/bar/./.../baz/")
#P"./foo/baz/"

>
(si:wrap-pathname #p"./foo/bar/./.../baz/.../gaz/./nok/")
#P"./foo/gaz/nok/"

>
(si:wrap-pathname #p"./.../foo/bar/./.../baz/.../gaz/./nok/")
#P"./../foo/gaz/nok/"

>
(pathname-directory (si:wrap-pathname 
#p"./.../foo/bar/./.../baz/.../gaz/./nok/"))
(:CURRENT :UP "foo" "gaz" "nok")

>
(pathname-directory (si:wrap-pathname #p".../foo/bar/./.../baz/.../gaz/./nok/"))
(:UP "foo" "gaz" "nok")

>
(merge-pathnames ".../someoneelse/foo/bar.lisp" (user-homedir-pathname))
#P"/home/someoneelse/foo/bar.lisp"

>
(make-pathname :directory '(:relative :back "someoneelse" "foo") :name "bar" 
:type "lisp" :defaults (user-homedir-pathname))
#P"/home/someoneelse/foo/bar.lisp"

>
(let ((*DEFAULT-PATHNAME-DEFAULTS* (user-homedir-pathname))) (make-pathname 
:directory '(:relative :back "someoneelse" "foo") :name "bar" :type "lisp")
)
#P".../someoneelse/foo/bar.lisp"

>
(LOAD-LOGICAL-PATHNAME-TRANSLATIONS "sys")
T

>
(make-pathname :directory '(:relative :back "someoneelse" "foo") :name "bar" 
:type "lisp" :defaults (make-pathname :host "sys" :directory 
(pathname-directory (user-homedir-pathname))))
Error in MAKE-PATHNAME [or a callee]:
  Invalid directory in pathname #P(:DEVICE :UNSPECIFIC :HOST "sys"
                                           :DIRECTORY
                                           (:ABSOLUTE "home" "kraehe"
                                            :BACK "someoneelse" "foo")
                                           :NAME "bar" :TYPE "lisp").

Fast links are on: do (use-fast-links nil) for debugging
Broken at MAKE-PATHNAME.  Type :H for Help.
 1 (Continue) Return to top level.
dbl:>>
1

Top level.
>(make-pathname :directory '(:relative :back "someoneelse" "foo") :name "bar" 
>:type "lisp" :defaults (make-pathname :host "localhost" :directory 
>(pathname-directory (user-homedir-pathname))))
#P"localhost:/home/someoneelse/foo/bar.lisp"

>
(translate-logical-pathname "sys:lsp;sys-proclaim.lisp")
#P"/usr/local/lib/gcl-2.7.0/lsp/sys-proclaim.lisp"

>
(translate-logical-pathname "sys:bin;gcl")
#P"local:/bin/gcl"

>
(si:search-local-pathname "local:/bin/gcl")
#P"/usr/local/bin/gcl"

>
(setf (si::search-list "bin") '("/bin/" "/usr/bin/" "/usr/local/bin/"))
((#P"bin:/**/" #P"/bin/**/" #P"/usr/bin/**/" #P"/usr/local/bin/**/"))

>
(si:search-local-pathname "bin:gcl")
#P"/usr/local/bin/gcl"

>
(dribble)

;;;; sys:lsp;sys-translations.lisp
;;
;;; this file might be found in ./sys-translations.lisp or
;;; ~/.sys-translations.lisp or sys:lsp;sys-translations.lisp
;;

(defun map-unix-searchlist (name default &key (wild nil))
  (let* ((str (si:getenv name))
         (beg 0)
         (end (length str))
         (lst (cons nil nil)))
   (if str (progn
       (do ((pos (position #\: str :start beg)
                 (position #\: str :start beg)))
           ((not pos) (nconc lst (list (concatenate 'string
                (string-right-trim "/" (subseq str beg))
                        (if wild "/**/" "/")))))
            (nconc lst (list (concatenate 'string
                (string-right-trim "/" (subseq str beg pos))
                        (if wild "/**/" "/"))))
            (setq beg (+ pos 1)))
        (cdr lst))
     default)))

(setf (si::virtual-pathname-searchlist "local")
      (list
        `("/bin/" ,@(map-unix-searchlist "PATH"
                        '("/usr/local/bin/" "/usr/bin/" "/bin/")))
        `("/man/**/" ,@(map-unix-searchlist "MAN"
                        '("/usr/share/local/man/**/" "/usr/local/man/**/"
                          "/usr/share/man/**/" "/usr/man/**/") :wild t))
        `("/info/**/" ,(merge-pathnames "info/**/" *lib-directory*)
                        ,@(map-unix-searchlist "INFO"
                        '("/usr/share/info/**/"  "/usr/info/**/") :wild t))
        '("/sbin/"     "/usr/local/sbin/"     "/usr/sbin/"   "/sbin/")
        '("/lib/**/"   "/usr/local/lib/**/"   "/usr/lib/**/" "/lib/**/")
        '("/etc/**/"   "/usr/local/etc/**/"   "/usr/etc/**/" "/etc/**/")
        '("/share/**/" "/usr/local/share/**/" "/usr/share/**/")))

(setf (logical-pathname-translations "sys")
      (list
         (list "gcl;**;*.*.*" (merge-pathnames "**/*.*" *lib-directory*))
        '("clcs;*.*.*"      "sys:gcl;clcs;*.*.*")
        '("cmpnew;*.*.*"    "sys:gcl;cmpnew;*.*")
        '("gcl-tk;**;*.*.*" "sys:gcl;gcl-tk;**;*.*")
        '("h;*.*.*"         "sys:gcl;h;*.*")
        '("lsp;*.*.*"       "sys:gcl;lsp;*.*")
        '("mod;*.*.*"       "sys:gcl;mod;*.*")
        '("pcl;*.*.*"       "sys:gcl;pcl;*.*")
        '("unixport;*.*.*"  "sys:gcl;unixport;*.*")
        '("lib;**;*.*.*"  "local:/lib/**/*.*")
        '("man;**;*.*.*"  "local:/man/**/*.*")
        '("info;*.*.*"    "local:/info/*.*")
        '("bin;*.*.*"     "local:/bin/*.*")))

(setf (si::search-list "home")
  (list (user-homedir-pathname)))
(setf (si::search-list "library")
  (list *lib-directory*))
(setf (si::search-list "target")
  (list *lib-directory*))
(setf (si::search-list "path")
  (map-unix-searchlist "PATH" '("/usr/local/bin/" "/usr/bin/" "/bin/")))
-- 
  mailto:address@hidden             UNA:+.? 'CED+2+:::Linux:2.4.22'UNZ+1'
  http://www.xml-edifact.org/           CETERUM CENSEO WINDOWS ESSE DELENDAM