[armedbear-cvs] r14230 - trunk/abcl/src/org/armedbear/lisp
mevenson at common-lisp.net
mevenson at common-lisp.net
Fri Nov 2 11:13:16 UTC 2012
Author: mevenson
Date: Fri Nov 2 04:13:16 2012
New Revision: 14230
Log:
Upgrade to asdf-2.26 with ABCL specific JAR patches.
Need to get ABCL differences back upstream.
Modified:
trunk/abcl/src/org/armedbear/lisp/asdf.lisp
Modified: trunk/abcl/src/org/armedbear/lisp/asdf.lisp
==============================================================================
--- trunk/abcl/src/org/armedbear/lisp/asdf.lisp Fri Nov 2 02:53:03 2012 (r14229)
+++ trunk/abcl/src/org/armedbear/lisp/asdf.lisp Fri Nov 2 04:13:16 2012 (r14230)
@@ -1,5 +1,5 @@
;;; -*- mode: Common-Lisp; Base: 10 ; Syntax: ANSI-Common-Lisp ; coding: utf-8 -*-
-;;; This is ASDF 2.25: Another System Definition Facility.
+;;; This is ASDF 2.26: Another System Definition Facility.
;;;
;;; Feedback, bug reports, and patches are all welcome:
;;; please mail to <asdf-devel at common-lisp.net>.
@@ -118,7 +118,7 @@
;; "2.345.6" would be a development version in the official upstream
;; "2.345.0.7" would be your seventh local modification of official release 2.345
;; "2.345.6.7" would be your seventh local modification of development version 2.345.6
- (asdf-version "2.25")
+ (asdf-version "2.26")
(existing-asdf (find-class 'component nil))
(existing-version *asdf-version*)
(already-there (equal asdf-version existing-version)))
@@ -230,7 +230,6 @@
:redefined-functions ',redefined-functions)))
(pkgdcl
:asdf
- :nicknames (:asdf-utilities) ;; DEPRECATED! Do not use, for backward compatibility only.
:use (:common-lisp)
:redefined-functions
(#:perform #:explain #:output-files #:operation-done-p
@@ -3350,6 +3349,15 @@
(defun* getenv-absolute-directories (x)
(getenv-pathnames x :want-absolute t :want-directory t))
+(defun* get-folder-path (folder)
+ (or ;; this semi-portably implements a subset of the functionality of lispworks' sys:get-folder-path
+ #+(and lispworks mswindows) (sys:get-folder-path folder)
+ ;; read-windows-registry HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\AppData
+ (ecase folder
+ (:local-appdata (getenv-absolute-directory "LOCALAPPDATA"))
+ (:appdata (getenv-absolute-directory "APPDATA"))
+ (:common-appdata (or (getenv-absolute-directory "ALLUSERSAPPDATA")
+ (subpathname* (getenv-absolute-directory "ALLUSERSPROFILE") "Application Data/"))))))
(defun* user-configuration-directories ()
(let ((dirs
@@ -3359,15 +3367,8 @@
(loop :for dir :in (getenv-absolute-directories "XDG_CONFIG_DIRS")
:collect (subpathname* dir "common-lisp/"))))
,@(when (os-windows-p)
- `(,(subpathname* (or #+(and lispworks (not lispworks-personal-edition))
- (sys:get-folder-path :local-appdata)
- (getenv-absolute-directory "LOCALAPPDATA"))
- "common-lisp/config/")
- ;; read-windows-registry HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\AppData
- ,(subpathname* (or #+(and lispworks (not lispworks-personal-edition))
- (sys:get-folder-path :appdata)
- (getenv-absolute-directory "APPDATA"))
- "common-lisp/config/")))
+ `(,(subpathname* (get-folder-path :local-appdata) "common-lisp/config/")
+ ,(subpathname* (get-folder-path :appdata) "common-lisp/config/")))
,(subpathname (user-homedir) ".config/common-lisp/"))))
(remove-duplicates (remove-if-not #'absolute-pathname-p dirs)
:from-end t :test 'equal)))
@@ -3378,11 +3379,7 @@
((os-windows-p)
(aif
;; read-windows-registry HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Explorer\User Shell Folders\Common AppData
- (subpathname* (or #+(and lispworks (not lispworks-personal-edition))
- (sys:get-folder-path :common-appdata)
- (getenv-absolute-directory "ALLUSERSAPPDATA")
- (subpathname* (getenv-absolute-directory "ALLUSERSPROFILE") "Application Data/"))
- "common-lisp/config/")
+ (subpathname* (get-folder-path :common-appdata) "common-lisp/config/")
(list it)))))
(defun* in-first-directory (dirs x &key (direction :input))
@@ -3507,12 +3504,8 @@
(or
(try (getenv-absolute-directory "XDG_CACHE_HOME") "common-lisp" :implementation)
(when (os-windows-p)
- (try (or #+(and lispworks (not lispworks-personal-edition))
- (sys:get-folder-path :local-appdata)
- (getenv-absolute-directory "LOCALAPPDATA")
- #+(and lispworks (not lispworks-personal-edition))
- (sys:get-folder-path :appdata)
- (getenv-absolute-directory "APPDATA"))
+ (try (or (get-folder-path :local-appdata)
+ (get-folder-path :appdata))
"common-lisp" "cache" :implementation))
'(:home ".cache" "common-lisp" :implementation))))
@@ -3917,11 +3910,12 @@
(if (absolute-pathname-p output-file)
;; what cfp should be doing, w/ mp* instead of mp
(let* ((type (pathname-type (apply 'compile-file-pathname "x.lisp" keys)))
- (defaults (make-pathname
- :type type :defaults (merge-pathnames* input-file))))
- (merge-pathnames* output-file defaults))
+ (defaults (make-pathname
+ :type type :defaults (merge-pathnames* input-file))))
+ (merge-pathnames* output-file defaults))
(apply-output-translations
- (apply 'compile-file-pathname input-file keys))))
+ (apply 'compile-file-pathname input-file
+ (if output-file keys (remove-keyword :output-file keys))))))
(defun* tmpize-pathname (x)
(make-pathname
@@ -4255,6 +4249,7 @@
(defun* wrapping-source-registry ()
`(:source-registry
+ #+ecl (:tree ,(translate-logical-pathname "SYS:"))
#+mkcl (:tree ,(translate-logical-pathname "CONTRIB:"))
#+sbcl (:tree ,(truenamize (getenv-pathname "SBCL_HOME" :want-directory t)))
:inherit-configuration
@@ -4271,16 +4266,7 @@
,@(or (getenv-absolute-directories "XDG_DATA_DIRS")
'("/usr/local/share" "/usr/share"))))
,@(when (os-windows-p)
- `(,(or #+(and lispworks (not lispworks-personal-edition))
- (sys:get-folder-path :local-appdata)
- (getenv-absolute-directory "LOCALAPPDATA"))
- ,(or #+(and lispworks (not lispworks-personal-edition))
- (sys:get-folder-path :appdata)
- (getenv-absolute-directory "APPDATA"))
- ,(or #+(and lispworks (not lispworks-personal-edition))
- (sys:get-folder-path :common-appdata)
- (getenv-absolute-directory "ALLUSERSAPPDATA")
- (subpathname* (getenv-absolute-directory "ALLUSERSPROFILE") "Application Data/")))))
+ (mapcar 'get-folder-path '(:local-appdata :appdata :common-appdata))))
:collect `(:directory ,(subpathname* dir "common-lisp/systems/"))
:collect `(:tree ,(subpathname* dir "common-lisp/source/")))
:inherit-configuration))
More information about the armedbear-cvs
mailing list