[Gcl-devel] gcl-04162.patch

[Michael Koehne]

Moin Guru's,

  www.copyleft.de/lisp/gcl-04162.patch is online - most important news
  are CMUCL like searchlists, e.g. :

  (setf (si::search-list "code:") '("/usr/local/lisp/code/" "/usr/lisp/code/")) 

  my current ~/.sys-translations.lisp looks like the following :

    (setf (si::virtual-pathname-searchlist "local")
          (list
            '("/bin/"      "/usr/local/bin/"      "/usr/bin/"    "/bin/")
            '("/sbin/"     "/usr/local/sbin/"     "/usr/sbin/"   "/sbin/")
            '("/lib/**/"   "/usr/local/lib/**/"   "/usr/lib/**/" "/lib/**/")
            '("/etc/**/"   "/usr/local/etc/**/"   "/usr/etc/**/" "/etc/**/")
            '("/man/**/"   "/usr/local/man/**/"   "/usr/man/**/")
            '("/info/**/"  "/usr/local/info/**/"  "/usr/info/**/")
            '("/share/**/" "/usr/local/share/**/" "/usr/share/**/")))

    (setf (logical-pathname-translations "sys")
          (list
             (list "gcl;**;*.*.*" (concatenate 'string  *lib-directory* 
"**/*.*"))
            '("clcs;*.*.*"      "sys:gcl;clcs;*.*.*")
            '("cmpnew;*.*.*"    "sys:gcl;cmpnew;*.*")
            '("gcl-tk;**;*.*.*" "sys:gcl;gcl-tk;**;*.*")
            '("h;*.*.*"         "sys:gcl;h;*.*")
            '("info;*.*.*"      "sys:gcl;info;*.*")
            '("lsp;*.*.*"       "sys:gcl;lsp;*.*")
            '("mod;*.*.*"       "sys:gcl;mod;*.*")
            '("pcl;*.*.*"       "sys:gcl;pcl;*.*")
            '("unixport;*.*.*"  "sys:gcl;unixport;*.*")
            '("lib;**;*.*.*"  "local:/lib/**/*.*")
            '("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")
              (let* ((str (si:getenv "PATH"))
                     (beg 0)
                     (end (length str))
                     (lst (cons nil nil)))
               (do ((pos (position #\: str :start beg)
                         (position #\: str :start beg)))
                   ((not pos) (nconc lst (list (concatenate 'string
                        (string-right-trim "/" (subseq str beg)) "/"))))
                    (nconc lst (list (concatenate 'string
                        (string-right-trim "/" (subseq str beg pos)) "/")))
                    (setq beg (+ pos 1)))
                (cdr lst)))

  so    (truename "sys:bin;gcl") -> #p"/usr/local/bin/gcl"
  while (truename "path:gcc")    -> #p"/usr/bin/gcl"
  like CMUCL users expect ;)

Bye Michael
-- 
  mailto:address@hidden             UNA:+.? 'CED+2+:::Linux:2.4.22'UNZ+1'
  http://www.xml-edifact.org/           CETERUM CENSEO WINDOWS ESSE DELENDAM