Testimonials

From mevenson at common-lisp.net Fri Nov 2 11:13:16 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Fri, 02 Nov 2012 04:13:16 -0700 Subject: [armedbear-cvs] r14230 - trunk/abcl/src/org/armedbear/lisp Message-ID: 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 . @@ -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)) From mevenson at common-lisp.net Fri Nov 2 12:48:20 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Fri, 02 Nov 2012 05:48:20 -0700 Subject: [armedbear-cvs] r14231 - trunk/abcl/examples/misc Message-ID: Author: mevenson Date: Fri Nov 2 05:48:20 2012 New Revision: 14231 Log: Add common (for me) customizations of ABCL output. Modified: trunk/abcl/examples/misc/dotabclrc Modified: trunk/abcl/examples/misc/dotabclrc ============================================================================== --- trunk/abcl/examples/misc/dotabclrc Fri Nov 2 04:13:16 2012 (r14230) +++ trunk/abcl/examples/misc/dotabclrc Fri Nov 2 05:48:20 2012 (r14231) @@ -1,6 +1,28 @@ ;;; -*- Mode: Lisp -*- -;;; Possible code for inclusion in the Armed Bear startup file #p"~/.abclrc" +;;; Possible code for inclusion in the Armed Bear startup file +;;; #p"~/.abclrc" + + +;;; Some commonly useful customizations to ABCL output +(setf + ;; Truncate the output of java.lang.String object after this many + ;; characters, outputing "...." afterwards. + ;; The default is 32. Is this too small? + *java-object-to-string-length* 8192 + + ;; Show what is being loaded and the loading time. + ;; Helpful on slower systems to figure out what is taking the time. + *load-verbose* t + + ;; Emit warnings from debug code + sys:*debug-warn* t + + ;; Bring some order to the forms output by the REPL + ;; Not currently the default, but it probably should be after we + ;; rework the pretty printer and/or streams to properly work with + ;; GRAY-STREAMS: + *print-pretty* t) #-quicklisp (let ((quicklisp-local #P"~/quicklisp/setup.lisp") From mevenson at common-lisp.net Wed Nov 7 18:00:30 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Wed, 07 Nov 2012 10:00:30 -0800 Subject: [armedbear-cvs] r14232 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: mevenson Date: Wed Nov 7 10:00:29 2012 New Revision: 14232 Log: Fixes #261: ABCL-CONTRIB finding logic widened to Debian packaging conventions. Thanks for Christoph. Modified: trunk/abcl/src/org/armedbear/lisp/abcl-contrib.lisp Modified: trunk/abcl/src/org/armedbear/lisp/abcl-contrib.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/abcl-contrib.lisp Fri Nov 2 05:48:20 2012 (r14231) +++ trunk/abcl/src/org/armedbear/lisp/abcl-contrib.lisp Wed Nov 7 10:00:29 2012 (r14232) @@ -10,7 +10,7 @@ (equal (pathname-type p) "jar") (java:jstatic "matches" "java.util.regex.Pattern" - "abcl(-[0-9]\\.[0-9]\\.[0-9](-.+)?)?" + "abcl(-[0-9]\\.[0-9]\\.[0-9]([+~-].+)?)?" (pathname-name p)) p))) (dolist (loader (java:dump-classpath)) From mevenson at common-lisp.net Fri Nov 9 14:43:34 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Fri, 09 Nov 2012 06:43:34 -0800 Subject: [armedbear-cvs] r14233 - trunk/abcl/contrib/abcl-asdf Message-ID: Author: mevenson Date: Fri Nov 9 06:42:42 2012 New Revision: 14233 Log: Re #262 in abcl-asdf: use first matching line if the first line doesn't work out. Further work needed as something more meaningful should be returned other than "The value NIL is not of type REAL" when abcl-asdf can't parse the Maven version string. Initial patch by Christoph. Modified: trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd trunk/abcl/contrib/abcl-asdf/maven-embedder.lisp Modified: trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd ============================================================================== --- trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd Wed Nov 7 10:00:29 2012 (r14232) +++ trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd Fri Nov 9 06:42:42 2012 (r14233) @@ -2,7 +2,7 @@ (asdf:defsystem :abcl-asdf :author "Mark Evenson" - :version "0.9.0" + :version "0.9.1" :depends-on (jss) :components ((:module packages :pathname "" @@ -19,12 +19,11 @@ (asdf:defsystem :abcl-asdf-test :author "Mark Evenson" - :defsystem-depends-on (abcl-asdf) - :components - ((:module tests :serial t :components - ((:file "example") - (:file "maven") - (:file "test"))))) + :defsystem-depends-on (abcl abcl-test-lisp abcl-asdf) + :components ((:module tests :serial t + :components ((:file "example") + (:file "maven") + (:file "test"))))) #| (defmethod perform ((o test-op) (c (eql (find-system 'abcl-asdf-test)))) Modified: trunk/abcl/contrib/abcl-asdf/maven-embedder.lisp ============================================================================== --- trunk/abcl/contrib/abcl-asdf/maven-embedder.lisp Wed Nov 7 10:00:29 2012 (r14232) +++ trunk/abcl/contrib/abcl-asdf/maven-embedder.lisp Fri Nov 9 06:42:42 2012 (r14233) @@ -114,21 +114,24 @@ (defun mvn-version () "Return the Maven version used by the Aether connector." - (let* ((line - (read-line (sys::process-output - (sys::run-program - (namestring (find-mvn)) '("-version"))))) - (pattern (#"compile" - 'regex.Pattern - "Apache Maven ([0-9]+)\\.([0-9]+)\\.([0-9]+)")) - (matcher (#"matcher" pattern line)) - (found (#"find" matcher))) - (unless found - (return-from mvn-version nil)) - (mapcar #'parse-integer - `(,(#"group" matcher 1) - ,(#"group" matcher 2) - ,(#"group" matcher 3))))) + (let ((stream (sys::process-output + (sys::run-program (truename (find-mvn)) '("-version")))) + (pattern (#"compile" + 'regex.Pattern + "Apache Maven ([0-9]+)\\.([0-9]+)\\.([0-9]+)"))) + (do ((line (read-line stream nil :eof) + (read-line stream nil :eof))) + ((or (not line) (eq line :eof)) nil) + (let ((matcher (#"matcher" pattern line))) + (when (#"find" matcher) + (return-from mvn-version + (handler-case + (mapcar #'parse-integer + `(,(#"group" matcher 1) + ,(#"group" matcher 2) + ,(#"group" matcher 3))) + (t (e) + (error "Failed to parse Maven version from ~A because~&~A." line e))))))))) (defun ensure-mvn-version () "Return t if Maven version is 3.0.3 or greater." From mevenson at common-lisp.net Fri Nov 9 14:44:28 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Fri, 09 Nov 2012 06:44:28 -0800 Subject: [armedbear-cvs] r14235 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: mevenson Date: Fri Nov 9 06:43:24 2012 New Revision: 14235 Log: RUN-PROGRAM: refactor symbols and improve docstring. Modified: trunk/abcl/src/org/armedbear/lisp/run-program.lisp Modified: trunk/abcl/src/org/armedbear/lisp/run-program.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/run-program.lisp Fri Nov 9 06:43:09 2012 (r14234) +++ trunk/abcl/src/org/armedbear/lisp/run-program.lisp Fri Nov 9 06:43:24 2012 (r14235) @@ -44,18 +44,24 @@ ;;; This implementation uses the JVM facilities for running external ;;; processes. ;;; . -(defun run-program (program args &key environment (wait t) clear-env) +(defun run-program (program args &key environment (wait t) clear-environment) + "Run PROGRAM with ARGS in with ENVIRONMENT variables. +Possibly WAIT for subprocess to exit. + +Optionally CLEAR-ENVIRONMENT of the subprocess of any non specified values." ;;For documentation, see below. - (let ((pb (%make-process-builder program args))) - (let ((env-map (%process-builder-environment pb))) - (when clear-env + (let* ((program-namestring (namestring (pathname program))) + + (process-builder (%make-process-builder program-namestring args))) + (let ((env-map (%process-builder-environment process-builder))) + (when clear-environment (%process-builder-env-clear env-map)) (when environment (dolist (entry environment) (%process-builder-env-put env-map (princ-to-string (car entry)) (princ-to-string (cdr entry)))))) - (let ((process (make-process (%process-builder-start pb)))) + (let ((process (make-process (%process-builder-start process-builder)))) (when wait (process-wait process)) process))) @@ -171,4 +177,4 @@ (ignore-errors (java:jcall "exitValue" jprocess))) (defun %process-kill (jprocess) - (java:jcall "destroy" jprocess)) \ No newline at end of file + (java:jcall "destroy" jprocess)) From mevenson at common-lisp.net Fri Nov 9 14:44:59 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Fri, 09 Nov 2012 06:44:59 -0800 Subject: [armedbear-cvs] r14234 - trunk/abcl/contrib/jss Message-ID: Author: mevenson Date: Fri Nov 9 06:43:09 2012 New Revision: 14234 Log: Fixes #263: ABCL-CONTRIB now loads with wildcards in CLASSPATH. Modified: trunk/abcl/contrib/jss/invoke.lisp trunk/abcl/contrib/jss/jss.asd Modified: trunk/abcl/contrib/jss/invoke.lisp ============================================================================== --- trunk/abcl/contrib/jss/invoke.lisp Fri Nov 9 06:42:42 2012 (r14233) +++ trunk/abcl/contrib/jss/invoke.lisp Fri Nov 9 06:43:09 2012 (r14234) @@ -377,22 +377,34 @@ (format stream "method ~a" (#"toString" obj)))) (defun do-auto-imports () - (flet ((import-class-path (cp) - (map nil - (lambda(s) - (setq s (jcall "toString" s)) + (labels ((expand-paths (cp) + (loop :for s :in cp + :appending (loop :for entry + :in (let ((p (pathname s))) + (if (wild-pathname-p p) + (directory p) + (list p))) + :collecting entry))) + (import-classpath (cp) + (mapcar + (lambda (p) (when *load-verbose* - (format t ";Importing ~a~%" s)) + (format t ";; Importing ~A~%" p)) (cond - ((file-directory-p s) ) - ((equal (pathname-type s) "jar") - (jar-import (merge-pathnames (jcall "toString" s) + ((file-directory-p p) ) + ((equal (pathname-type p) "jar") + (jar-import (merge-pathnames p (format nil "~a/" (jstatic "getProperty" "java.lang.System" "user.dir"))))))) - (jcall "split" cp - (string (jfield (jclass "java.io.File") "pathSeparatorChar")))))) - (import-class-path (jcall "getClassPath" (jstatic "getRuntimeMXBean" '|java.lang.management.ManagementFactory|))) - (import-class-path (jcall "getBootClassPath" (jstatic "getRuntimeMXBean" '|java.lang.management.ManagementFactory|))) - )) + cp)) + (split-classpath (cp) + (coerce + (jcall "split" cp + (string (jfield (jclass "java.io.File") "pathSeparatorChar"))) + 'cons)) + (do-imports (cp) + (import-classpath (expand-paths (split-classpath cp))))) + (do-imports (jcall "getClassPath" (jstatic "getRuntimeMXBean" '|java.lang.management.ManagementFactory|))) + (do-imports (jcall "getBootClassPath" (jstatic "getRuntimeMXBean" '|java.lang.management.ManagementFactory|))))) (eval-when (:load-toplevel :execute) (when *do-auto-imports* Modified: trunk/abcl/contrib/jss/jss.asd ============================================================================== --- trunk/abcl/contrib/jss/jss.asd Fri Nov 9 06:42:42 2012 (r14233) +++ trunk/abcl/contrib/jss/jss.asd Fri Nov 9 06:43:09 2012 (r14234) @@ -1,7 +1,7 @@ ;;;; -*- Mode: LISP -*- (asdf:defsystem :jss :author "Alan Ruttenberg, Mark Evenson" - :version "3.0.3" + :version "3.0.4" :components ((:module base :pathname "" :serial t From mevenson at common-lisp.net Fri Nov 9 14:45:18 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Fri, 09 Nov 2012 06:45:18 -0800 Subject: [armedbear-cvs] r14236 - in trunk/abcl/contrib: abcl-asdf mvn Message-ID: Author: mevenson Date: Fri Nov 9 06:44:33 2012 New Revision: 14236 Log: abcl-asdf: Enable bypassing of loading from network if a given class already exists. An ASDF:MVN component can now optionally specify a CLASSNAME that if able to be found in the current jvm process, inhbits further loading from the network. An ASDF:MVN component may also optionally specify an ALTERNATE-URI that will be added to the current jvm classpath if Maven cannot be invoked. Most jvm implementations won't access such jar archives from the network by default, so this is an intermediate step before actually writing the code to download the jar to the local filesystem to then be added. Refresh documentation in README.markdown. Modified: trunk/abcl/contrib/abcl-asdf/README.markdown trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd trunk/abcl/contrib/abcl-asdf/abcl-asdf.lisp trunk/abcl/contrib/mvn/jna.asd Modified: trunk/abcl/contrib/abcl-asdf/README.markdown ============================================================================== --- trunk/abcl/contrib/abcl-asdf/README.markdown Fri Nov 9 06:43:24 2012 (r14235) +++ trunk/abcl/contrib/abcl-asdf/README.markdown Fri Nov 9 06:44:33 2012 (r14236) @@ -46,9 +46,35 @@ that have a currently valid pathname representation (i.e. they exist on the local filesystem). -And we define MVN and IRI classes descend from ASDF-COMPONENT, but do not +The MVN and IRI classes descend from ASDF-COMPONENT, but do not directly have a filesystem location. +The IRI component is currently unused, but serves as a point to base +the inheritance of the MVN component while allowing other forms of +uri-like resources to be encapsulated in the future. + +The MVN component should specifiy a [Maven URI][1] as its PATH. A +Maven URI has the form "GROUP-ID/ARTIFACT-ID/VERSION" which specifies +the dependency to be satisfied for this component by resolution +through the Maven distributed dependency graph. The scheme (the +initial "mvn://") is implied, usually omitted for brevity. If a +VERSION is not specified (i.e. by a form like "GROUP-ID/ARTIFACT-ID"), +then the latest available version of the artifact will be retrieved +from the network. + +[1]: http://team.ops4j.org/wiki/display/paxurl/Mvn+Protocol + +The MVN component may specify a CLASSNAME which if present in the +current jvm, inhibits further loading from the network. This may be +used to bypass the invocation of Maven. Since classnames are not +unique to jar archives, this mechanism may not have the desired result +in all cases, but it is surpisingly, like the rest of Java, "good +enough" for everyday use. + +The MVN component may specify an ALTERNATE-URI which will be added to +the jvm classpath if Maven cannot be located. Since a Maven URI may +refer to more than one binary artifact, this may not work in all cases. + For use outside of ASDF, we currently define the generic function ABCL-ASDF:RESOLVE which locates, downloads, caches, and then loads into the currently executing JVM process all recursive dependencies @@ -136,6 +162,11 @@ Releases -------- +### 9.9.2 2012-11-09 + + + + ### 0.7.0 2012-02-05 Plausibly work under MSFT operating systems. @@ -168,5 +199,5 @@ Mark Created: 2011-01-01 - Revised: 2012-02-06 + Revised: 2012-11-09 Modified: trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd ============================================================================== --- trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd Fri Nov 9 06:43:24 2012 (r14235) +++ trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd Fri Nov 9 06:44:33 2012 (r14236) @@ -2,7 +2,7 @@ (asdf:defsystem :abcl-asdf :author "Mark Evenson" - :version "0.9.1" + :version "0.9.2" :depends-on (jss) :components ((:module packages :pathname "" Modified: trunk/abcl/contrib/abcl-asdf/abcl-asdf.lisp ============================================================================== --- trunk/abcl/contrib/abcl-asdf/abcl-asdf.lisp Fri Nov 9 06:43:24 2012 (r14235) +++ trunk/abcl/contrib/abcl-asdf/abcl-asdf.lisp Fri Nov 9 06:44:33 2012 (r14236) @@ -1,4 +1,4 @@ -;;;; The ABCL specific overrides in ASDF. +s;;;; The ABCL specific overrides in ASDF. ;;;; ;;;; Done separate from asdf.lisp for stability. (require :asdf) @@ -15,6 +15,8 @@ ((group-id :initarg :group-id :initform nil) (artifact-id :initarg :artifact-id :initform nil) (repository :initform "http://repo1.maven.org/maven2/") ;;; XXX unimplmented + (classname :initarg :classname :initform nil) + (alternate-uri :initarg :alternate-uri :initform nil) ;; inherited from ASDF:COMPONENT ??? what are the CL semantics on overriding -- ME 2012-04-01 #+nil (version :initform nil))) @@ -29,10 +31,10 @@ (ensure-parsed-mvn c))) (defmethod perform ((operation load-op) (c mvn)) - (java:add-to-classpath - (abcl-asdf:as-classpath - (abcl-asdf:resolve - (ensure-parsed-mvn c))))) + (let ((resolved-path + (abcl-asdf:resolve (ensure-parsed-mvn c)))) + (when (stringp resolved-path) + (java:add-to-classpath (abcl-asdf:as-classpath resolved-path))))) ;;; A Maven URI has the form "mvn:group-id/artifact-id/version" ;;; @@ -100,9 +102,10 @@ (defmethod resolve ((mvn-component asdf::mvn)) "Resolve all runtime dependencies of MVN-COMPONENT. -Returns a string in JVM CLASSPATH format as entries delimited by -classpath separator string. Can possibly be a single entry denoting a -remote binary artifact." +Returns either a string in jvm classpath format as entries delimited +by classpath separator string or T. If the value T is returned, it +denotes that current JVM already has already loaded a given class. Can possibly be a +single entry denoting a remote binary artifact." (macrolet ((aif (something consequence alternative)) `(let ((it ,(something))) (if it @@ -111,20 +114,30 @@ (let ((name (slot-value mvn-component 'asdf::name)) (group-id (slot-value mvn-component 'asdf::group-id)) (artifact-id (slot-value mvn-component 'asdf::artifact-id)) + (classname (slot-value mvn-component 'asdf::classname)) + (alternate-uri (slot-value mvn-component 'asdf::alternate-uri)) (version (let ((it (slot-value mvn-component 'asdf::version))) (cond ((not it) it) (t "LATEST"))))) - (if (find-mvn) - (resolve-dependencies group-id artifact-id version) - (cond - ((string= name "net.java.dev.jna/jna/3.4.0") - (let ((uri #p"http://repo1.maven.org/maven2/net/java/dev/jna/jna/3.4.0/jna-3.4.0.jar"))) - (values (namestring uri) uri)) - (t - (error "Failed to resolve MVN component name ~A." name))))))) + (handler-case + (when (and classname + (jss:find-java-class classname)) + (warn "Not loading ~A from the network because ~A is present in classpath." + name classname) + (return-from resolve t)) + (java:java-exception (e) + (unless (java:jinstance-of-p (java:java-exception-cause e) + "java.lang.ClassNotFoundException") + (error "Unexpected Java exception~&~A.~&" e)) + (if (find-mvn) + (resolve-dependencies group-id artifact-id version) + (if alternate-uri + (values (namestring alternate-uri) alternate-uri) + (t + (error "Failed to resolve MVN component name ~A." name))))))))) (defun as-classpath (classpath) "Break apart the JVM CLASSPATH string into a list of its consituents." Modified: trunk/abcl/contrib/mvn/jna.asd ============================================================================== --- trunk/abcl/contrib/mvn/jna.asd Fri Nov 9 06:43:24 2012 (r14235) +++ trunk/abcl/contrib/mvn/jna.asd Fri Nov 9 06:44:33 2012 (r14236) @@ -1,33 +1,17 @@ ;;;; -*- Mode: LISP -*- -;;;; Need to have jna.jar present for CFFI to have a chance of working. +;;;; Need to have jna.jar present for CFFI to work. (asdf:defsystem :jna :version "3.5.1" :defsystem-depends-on (jss abcl-asdf) ;; FIXME: always seems to be resolving the LATEST maven artifact. - :components ((:mvn "net.java.dev.jna/jna/3.5.1"))) + :components ((:mvn "net.java.dev.jna/jna/3.5.1" + :alternate-uri "http://repo1.maven.org/maven2/net/java/dev/jna/jna/3.5.1/jna-3.5.1.jar" + :classname "com.sun.jna.Native"))) (in-package :asdf) (defmethod perform :after ((o load-op) (c (eql (find-system :jna)))) (when (jss:find-java-class "com.sun.jna.Native") (provide :jna))) -;;; After ASDF performs COMPILE-OP, one expects that the JNA Java -;;; classes can be instantiated. If not, execute various loading strategies. -(defmethod perform ((o compile-op) (c (eql (find-system :jna)))) - ;; Theoretically this should be the same thing as the MVN component. - (format *debug-io* "~&Attemping to locate jvm binary artifacts for JNA...~&") - (handler-case - (jss:find-java-class "com.sun.jna.Native") - (java:java-exception (e) - (unless - (java:add-to-classpath (abcl-asdf:resolve "net.java.dev.jna:jna:3.5.1")) - (unless - ;; Might want to download to local filesystem, then place in classpath - (java:add-to-classpath #p"http://repo1.maven.org/maven2/net/java/dev/jna/jna/3.5.1/jna-3.5.1.jar") - (error "Failed to load jna-3.5.0.jar from the network via URI.")) - (error "Failed to load jna.jar via ABCL-ASDF."))) - (t (e) - (error "Failed to resolve 'jna.jar' because~&~A.~&" e)))) - From mevenson at common-lisp.net Fri Nov 9 15:15:07 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Fri, 09 Nov 2012 07:15:07 -0800 Subject: [armedbear-cvs] r14237 - trunk/abcl/contrib/abcl-asdf Message-ID: Author: mevenson Date: Fri Nov 9 07:15:03 2012 New Revision: 14237 Log: abcl-asdf: fix compilation by removing stray character. Modified: trunk/abcl/contrib/abcl-asdf/abcl-asdf.lisp Modified: trunk/abcl/contrib/abcl-asdf/abcl-asdf.lisp ============================================================================== --- trunk/abcl/contrib/abcl-asdf/abcl-asdf.lisp Fri Nov 9 06:44:33 2012 (r14236) +++ trunk/abcl/contrib/abcl-asdf/abcl-asdf.lisp Fri Nov 9 07:15:03 2012 (r14237) @@ -1,4 +1,4 @@ -s;;;; The ABCL specific overrides in ASDF. +;;;; The ABCL specific overrides in ASDF. ;;;; ;;;; Done separate from asdf.lisp for stability. (require :asdf) From mevenson at common-lisp.net Fri Nov 9 16:07:09 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Fri, 09 Nov 2012 08:07:09 -0800 Subject: [armedbear-cvs] r14238 - in trunk/abcl: src/org/armedbear/lisp test/lisp/abcl Message-ID: Author: mevenson Date: Fri Nov 9 08:07:08 2012 New Revision: 14238 Log: Fixes #243: MAKE-PATHNAME with a DEVICE string. We allow DEVICE lists to contain a string value as constructed by MAKE-PATHNAME, but the result can never actually be resolvable by TRUENAME. Instead of trying to figure out the proper use of Java labels, just use the private static Pathname.doTruenameExit() as the common point for all exits from the TRUENAME implementation. Modified: trunk/abcl/src/org/armedbear/lisp/Pathname.java trunk/abcl/test/lisp/abcl/bugs.lisp Modified: trunk/abcl/src/org/armedbear/lisp/Pathname.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/Pathname.java Fri Nov 9 07:15:03 2012 (r14237) +++ trunk/abcl/src/org/armedbear/lisp/Pathname.java Fri Nov 9 08:07:08 2012 (r14238) @@ -654,11 +654,15 @@ StringBuilder prefix = new StringBuilder(); for (int i = 0; i < jars.length; i++) { prefix.append("jar:"); - if (!((Pathname)jars[i]).isURL() && i == 0) { + LispObject component = jars[i]; + if (!(component instanceof Pathname)) { + return null; // If DEVICE is a CONS, it should only contain Pathname + } + if (! ((Pathname)component).isURL() && i == 0) { sb.append("file:"); uriEncoded = true; } - Pathname jar = (Pathname) jars[i]; + Pathname jar = (Pathname) component; String encodedNamestring; if (uriEncoded) { encodedNamestring = uriEncode(jar.getNamestring()); @@ -2152,14 +2156,8 @@ public static final LispObject truename(Pathname pathname, boolean errorIfDoesNotExist) { - if (pathname == null || pathname.equals(NIL)) { // XXX duplicates code at the end of this longish function: figure out proper nesting of labels. - if (errorIfDoesNotExist) { - StringBuilder sb = new StringBuilder("The file "); - sb.append(pathname.princToString()); - sb.append(" does not exist."); - return error(new FileError(sb.toString(), pathname)); - } - return NIL; + if (pathname == null || pathname.equals(NIL)) { + return doTruenameExit(pathname, errorIfDoesNotExist); } if (pathname instanceof LogicalPathname) { pathname = LogicalPathname.translateLogicalPathname((LogicalPathname) pathname); @@ -2209,6 +2207,9 @@ // Possibly canonicalize jar file directory Cons jars = (Cons) pathname.device; LispObject o = jars.car(); + if (!(o instanceof Pathname)) { + return doTruenameExit(pathname, errorIfDoesNotExist); + } if (o instanceof Pathname && !(((Pathname)o).isURL()) // XXX Silently fail to call truename() if the default @@ -2286,6 +2287,10 @@ } } error: + return doTruenameExit(pathname, errorIfDoesNotExist); + } + + static private LispObject doTruenameExit(Pathname pathname, boolean errorIfDoesNotExist) { if (errorIfDoesNotExist) { StringBuilder sb = new StringBuilder("The file "); sb.append(pathname.princToString()); Modified: trunk/abcl/test/lisp/abcl/bugs.lisp ============================================================================== --- trunk/abcl/test/lisp/abcl/bugs.lisp Fri Nov 9 07:15:03 2012 (r14237) +++ trunk/abcl/test/lisp/abcl/bugs.lisp Fri Nov 9 08:07:08 2012 (r14238) @@ -111,3 +111,14 @@ 2) 3) +;;; http://trac.common-lisp.net/armedbear/ticket/243 +(deftest bugs.pathname.make-pathname.1 + (signals-error + (make-pathname :device (list "foo")) + 'error) +t) + + +(deftest bugs.pathname.make-pathname.2 + (probe-file (make-pathname :device (list "foo"))) +nil) From mevenson at common-lisp.net Fri Nov 9 17:28:13 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Fri, 09 Nov 2012 09:28:13 -0800 Subject: [armedbear-cvs] r14239 - in trunk/abcl: contrib/jss src/org/armedbear/lisp Message-ID: Author: mevenson Date: Fri Nov 9 09:28:12 2012 New Revision: 14239 Log: Fixes #229 so that JCALL works with static member classes. Added non-working test to putative JSS test suite. Modified: trunk/abcl/contrib/jss/jss.asd trunk/abcl/contrib/jss/tests.lisp trunk/abcl/src/org/armedbear/lisp/Java.java Modified: trunk/abcl/contrib/jss/jss.asd ============================================================================== --- trunk/abcl/contrib/jss/jss.asd Fri Nov 9 08:07:08 2012 (r14238) +++ trunk/abcl/contrib/jss/jss.asd Fri Nov 9 09:28:12 2012 (r14239) @@ -1,14 +1,20 @@ ;;;; -*- Mode: LISP -*- (asdf:defsystem :jss :author "Alan Ruttenberg, Mark Evenson" - :version "3.0.4" - :components - ((:module base - :pathname "" :serial t - :components ((:file "packages") - (:file "invoke") - (:file "classpath") - (:file "compat"))))) + :version "3.0.5" + :components ((:module base + :pathname "" :serial t + :components ((:file "packages") + (:file "invoke") + (:file "classpath") + (:file "compat"))))) + +#+nil FIXME +(asdf:defsystem :jss-tests + :depends-on (jss abcl abcl-test-lisp) + :components ((:module tests + :pathname "" + :components ((:file "tests"))))) Modified: trunk/abcl/contrib/jss/tests.lisp ============================================================================== --- trunk/abcl/contrib/jss/tests.lisp Fri Nov 9 08:07:08 2012 (r14238) +++ trunk/abcl/contrib/jss/tests.lisp Fri Nov 9 09:28:12 2012 (r14239) @@ -12,4 +12,16 @@ (substring "01234" 2))) "234") +;;; http://trac.common-lisp.net/armedbear/ticket/229 +(deftest jss.jcall.1 + (let* ((headers (#"getHeaderFields" + (#"openConnection" + (jss::new 'java.net.url "http://google.com")))) + + (second-header (#"get" *headers* + (second (jss::set-to-list (#"keySet" + *headers*)))))) + (#"size" *ural*)) +-1) + Modified: trunk/abcl/src/org/armedbear/lisp/Java.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/Java.java Fri Nov 9 08:07:08 2012 (r14238) +++ trunk/abcl/src/org/armedbear/lisp/Java.java Fri Nov 9 09:28:12 2012 (r14239) @@ -888,6 +888,12 @@ else methodArgs[i-2] = arg.javaInstance(argTypes[i-2]); } + if (!method.isAccessible()) { + // Possible for static member classes: see #229 + if (Modifier.isPublic(method.getModifiers())) { + method.setAccessible(true); + } + } return JavaObject.getInstance(method.invoke(instance, methodArgs), translate, method.getReturnType()); @@ -961,13 +967,27 @@ Class actualClass = null; if(method == null) { actualClass = instance.getClass(); - if(intendedClass != actualClass && - Modifier.isPublic(actualClass.getModifiers())) { + if(intendedClass != actualClass) { method = findMethod(actualClass, methodName, methodArgs); + if (method != null) { + if (isMethodCallableOnInstance(actualClass, method)) { + return method; + } + } } } return method; } + + private static boolean isMethodCallableOnInstance(Class instance, Method method) { + if (Modifier.isPublic(method.getModifiers())) { + return true; + } + if (instance.isMemberClass()) { + return isMethodCallableOnInstance(instance.getEnclosingClass(), method); + } + return false; + } private static Method findMethod(Class c, String methodName, Object[] javaArgs) { Method[] methods = c.getMethods(); From mevenson at common-lisp.net Sat Nov 10 06:15:17 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Fri, 09 Nov 2012 22:15:17 -0800 Subject: [armedbear-cvs] r14240 - trunk/abcl/contrib/abcl-asdf Message-ID: Author: mevenson Date: Fri Nov 9 22:15:15 2012 New Revision: 14240 Log: ABCL-ASDF loads again which fixes #264. DEFSYSTEM-DEPENDS-ON loads its requirements before the system definition is evaluated which is not needed in this case. The abcl-test-lisp ASDF definition is contained in the toplevel "abcl.asdf" file, which I usually have symlinked into ~/.asdf-install-dir/systems/ for convenience. Modified: trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd Modified: trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd ============================================================================== --- trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd Fri Nov 9 09:28:12 2012 (r14239) +++ trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd Fri Nov 9 22:15:15 2012 (r14240) @@ -19,7 +19,7 @@ (asdf:defsystem :abcl-asdf-test :author "Mark Evenson" - :defsystem-depends-on (abcl abcl-test-lisp abcl-asdf) + :depends-on (abcl abcl-test-lisp abcl-asdf) :components ((:module tests :serial t :components ((:file "example") (:file "maven") From mevenson at common-lisp.net Sat Nov 10 22:44:43 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Sat, 10 Nov 2012 14:44:43 -0800 Subject: [armedbear-cvs] r14241 - trunk/abcl Message-ID: Author: mevenson Date: Sat Nov 10 14:44:42 2012 New Revision: 14241 Log: Upstream $NetBSD$ build patch which fixes #232. Go Devils! Modified: trunk/abcl/build.xml Modified: trunk/abcl/build.xml ============================================================================== --- trunk/abcl/build.xml Fri Nov 9 22:15:15 2012 (r14240) +++ trunk/abcl/build.xml Sat Nov 10 14:44:42 2012 (r14241) @@ -43,6 +43,9 @@ + + @@ -478,7 +481,7 @@ - + From mevenson at common-lisp.net Sun Nov 11 06:52:23 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Sat, 10 Nov 2012 22:52:23 -0800 Subject: [armedbear-cvs] r14242 - trunk/abcl Message-ID: Author: mevenson Date: Sat Nov 10 22:52:22 2012 New Revision: 14242 Log: release: CHANGES for abcl-1.1.0. Modified: trunk/abcl/CHANGES Modified: trunk/abcl/CHANGES ============================================================================== --- trunk/abcl/CHANGES Sat Nov 10 14:44:42 2012 (r14241) +++ trunk/abcl/CHANGES Sat Nov 10 22:52:22 2012 (r14242) @@ -1,7 +1,45 @@ Version 1.1.0 ============= svn.uri=:"http//common-lisp.net/project/armedbear/svn/trunk/abcl/" -(unreleased) +(15 November 2012) + +Features +-------- + + * A functioning (A)MOP implementation through the hard work of Rudi Schlatte + + * The implementation can be used across many more Quicklisp systems + because the two top blockers have been fixed: + + Nota bene: all of the following systems need patches to work as + of the 2012-10-13 Quicklisp. All patches have been accepted in + at least an initial form by the upstream maintainers. + + ** CLOSER-MOP + ** CFFI + ** HUNCHENTOOT + + * Java 5 bytecode Compiler + + The internal Lisp-to-Java bytecode compiler has been hardened by + regression testing across Quicklisp libraries. + + ** large objects (???) + ** (??) + + * ABCL-ASDF Network installation of binary artifacts named by Maven POM uris. + + ** based on stock ASDF-2.26 + + ** checks at runtime if a given class is present in the accessible classloaders + + ** If the check for the presence of a class fails, find a + maven-3.0.4 binary locally, execute its Aether connector to + retrieve its transitive dependencies from the network. + + * JSS Java Syntax Sucks + + ** extensive bugfixing Changes ------- From mevenson at common-lisp.net Thu Nov 15 11:44:36 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 15 Nov 2012 03:44:36 -0800 Subject: [armedbear-cvs] r14243 - trunk/abcl Message-ID: Author: mevenson Date: Thu Nov 15 03:44:35 2012 New Revision: 14243 Log: Always build abcl-contrib.jar when building abcl.jar. Modified: trunk/abcl/build.xml Modified: trunk/abcl/build.xml ============================================================================== --- trunk/abcl/build.xml Sat Nov 10 22:52:22 2012 (r14242) +++ trunk/abcl/build.xml Thu Nov 15 03:44:35 2012 (r14243) @@ -447,7 +447,7 @@ - Author: mevenson Date: Thu Nov 15 04:32:58 2012 New Revision: 14244 Log: Correct ENSURE-DIRECTORIES-EXIST.1 test logic. ABCL fills in DEVICE as :UNSPECIFIC when resolving filesystem paths on non-M$DOG meaning that an unresolved pathname is not always equivalent to its resolved version. Modified: trunk/abcl/test/lisp/abcl/file-system-tests.lisp Modified: trunk/abcl/test/lisp/abcl/file-system-tests.lisp ============================================================================== --- trunk/abcl/test/lisp/abcl/file-system-tests.lisp Thu Nov 15 03:44:35 2012 (r14243) +++ trunk/abcl/test/lisp/abcl/file-system-tests.lisp Thu Nov 15 04:32:58 2012 (r14244) @@ -459,7 +459,11 @@ #+clisp ;; CLISP's PROBE-DIRECTORY just returns T. (ext:probe-directory directory-namestring) - #-clisp + ;; ABCL fills in DEVICE as :UNSPECIFIC when resolving + ;; filesystem paths on non-M$DOG + #+abcl + (not (null (truename directory-namestring))) + #-(or clisp abcl) (pathnames-equal-p (probe-file directory-namestring) (pathname directory-namestring)) ;; 4. Delete the directory. From mevenson at common-lisp.net Thu Nov 15 12:33:01 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 15 Nov 2012 04:33:01 -0800 Subject: [armedbear-cvs] r14245 - trunk/abcl/test/lisp/abcl Message-ID: Author: mevenson Date: Thu Nov 15 04:33:00 2012 New Revision: 14245 Log: abcl-test: Restore original *PRINT-CASE*. Also seemingly "fixes" about four failing tests. Modified: trunk/abcl/test/lisp/abcl/compiler-tests.lisp Modified: trunk/abcl/test/lisp/abcl/compiler-tests.lisp ============================================================================== --- trunk/abcl/test/lisp/abcl/compiler-tests.lisp Thu Nov 15 04:32:58 2012 (r14244) +++ trunk/abcl/test/lisp/abcl/compiler-tests.lisp Thu Nov 15 04:33:00 2012 (r14245) @@ -447,15 +447,17 @@ #+abcl (deftest compiler.1 (let ((tmpfile (ext::make-temp-file)) + (original-print-case *print-case*) (forms `((in-package :cl-user) - (eval-when (:compile-toplevel :load-toplevel :execute) - (setf *print-case* ':downcase)) - (defstruct rec a b)))) + (eval-when (:compile-toplevel :load-toplevel :execute) + (setf *print-case* ':downcase)) + (defstruct rec a b)))) (with-open-file (s tmpfile :direction :output) (dolist (form forms) (write form :stream s))) (let ((result (compile-file tmpfile))) (delete-file tmpfile) + (setf *print-case* original-print-case) (not (null result)))) t) @@ -498,4 +500,4 @@ (ignore-errors (compile nil '(lambda (&key args &optional x)))) (typep error 'program-error)) - t) \ No newline at end of file + t) From mevenson at common-lisp.net Thu Nov 15 12:33:03 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 15 Nov 2012 04:33:03 -0800 Subject: [armedbear-cvs] r14246 - trunk/abcl/test/lisp/abcl Message-ID: Author: mevenson Date: Thu Nov 15 04:33:01 2012 New Revision: 14246 Log: abcl-test: Fix DIRECTORY.4. Modified: trunk/abcl/test/lisp/abcl/file-system-tests.lisp Modified: trunk/abcl/test/lisp/abcl/file-system-tests.lisp ============================================================================== --- trunk/abcl/test/lisp/abcl/file-system-tests.lisp Thu Nov 15 04:33:00 2012 (r14245) +++ trunk/abcl/test/lisp/abcl/file-system-tests.lisp Thu Nov 15 04:33:01 2012 (r14246) @@ -341,7 +341,8 @@ :defaults directory-pathname)))) (and (listp directory) (= (length directory) 1) - (pathnames-equal-p (car directory) file-pathname)))) + (pathnames-equal-p (truename (car directory)) + (truename file-pathname))))) (delete-directory-and-files directory-pathname))) t) #+clisp From mevenson at common-lisp.net Fri Nov 16 00:27:45 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 15 Nov 2012 16:27:45 -0800 Subject: [armedbear-cvs] r14247 - trunk/abcl/test/lisp/abcl Message-ID: Author: mevenson Date: Thu Nov 15 16:27:44 2012 New Revision: 14247 Log: abcl-test: ensure that the logical pathname host is defined at compile time. Modified: trunk/abcl/test/lisp/abcl/pathname-tests.lisp Modified: trunk/abcl/test/lisp/abcl/pathname-tests.lisp ============================================================================== --- trunk/abcl/test/lisp/abcl/pathname-tests.lisp Thu Nov 15 04:33:01 2012 (r14246) +++ trunk/abcl/test/lisp/abcl/pathname-tests.lisp Thu Nov 15 16:27:44 2012 (r14247) @@ -119,8 +119,9 @@ ,namestring)) ;; Define a logical host. -(setf (logical-pathname-translations "effluvia") - '(("**;*.*.*" "/usr/local/**/*.*"))) +(eval-when (:compile-toplevel :load-toplevel :execute) + (setf (logical-pathname-translations "effluvia") + '(("**;*.*.*" "/usr/local/**/*.*")))) (deftest equal.1 (equal (make-pathname :name "foo" :type "bar") @@ -1720,4 +1721,4 @@ (values (pathname-name p) (pathname-type p) (pathname-version p) (pathname-directory p))) :wild :wild :wild (:absolute :wild)) - \ No newline at end of file + From mevenson at common-lisp.net Fri Nov 16 00:34:01 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Thu, 15 Nov 2012 16:34:01 -0800 Subject: [armedbear-cvs] r14248 - trunk/abcl/test/lisp/abcl Message-ID: Author: mevenson Date: Thu Nov 15 16:34:00 2012 New Revision: 14248 Log: abcl-test: mark BUGS.PATHNAME.MAKE-PATHNAME.1 as an expected failure. Modified: trunk/abcl/test/lisp/abcl/bugs.lisp Modified: trunk/abcl/test/lisp/abcl/bugs.lisp ============================================================================== --- trunk/abcl/test/lisp/abcl/bugs.lisp Thu Nov 15 16:27:44 2012 (r14247) +++ trunk/abcl/test/lisp/abcl/bugs.lisp Thu Nov 15 16:34:00 2012 (r14248) @@ -116,7 +116,10 @@ (signals-error (make-pathname :device (list "foo")) 'error) -t) + t) +;; Dunno about this one. Maybe we should signal an error when +;; constructed a pathname that we *know* can never refer to any resource. +(push 'bugs.pathname.make-pathname.1 *expected-failures*) (deftest bugs.pathname.make-pathname.2 From mevenson at common-lisp.net Fri Nov 16 13:40:50 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Fri, 16 Nov 2012 05:40:50 -0800 Subject: [armedbear-cvs] r14249 - trunk/abcl/test/lisp/ansi Message-ID: Author: mevenson Date: Fri Nov 16 05:40:47 2012 New Revision: 14249 Log: ansi-tests: always clean out the intermediate artifacts when running ANSI tests. Now output the removed artifacts to *STANDARD-OUTPUT*. Modified: trunk/abcl/test/lisp/ansi/abcl-ansi.lisp Modified: trunk/abcl/test/lisp/ansi/abcl-ansi.lisp ============================================================================== --- trunk/abcl/test/lisp/ansi/abcl-ansi.lisp Thu Nov 15 16:34:00 2012 (r14248) +++ trunk/abcl/test/lisp/ansi/abcl-ansi.lisp Fri Nov 16 05:40:47 2012 (r14249) @@ -14,6 +14,10 @@ "Run the ANSI-TESTS suite, to be found in *ANSI-TESTS-DIRECTORY*. Possibly running the compiled version of the tests if COMPILE-TESTS is non-NIL." (verify-ansi-tests) + (mapcar (lambda (result) + (when (second result) + (format t "Removed ~A.~&" (first result)))) + (clean-tests)) (let* ((ansi-tests-directory *ansi-tests-directory*) (boot-file @@ -57,7 +61,9 @@ ;; so we don't have to hunt for 'make' in the PATH on win32. (verify-ansi-tests) - (mapcar #'delete-file + (mapcar (lambda (p) + (when (probe-file p) + (list p (delete-file p)))) (append (directory (format nil "~A/*.cls" *ansi-tests-directory*)) (directory (format nil "~A/*.abcl" *ansi-tests-directory*)) (directory (format nil "~A/scratch/*" *ansi-tests-directory*)) From mevenson at common-lisp.net Fri Nov 16 13:55:53 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Fri, 16 Nov 2012 05:55:53 -0800 Subject: [armedbear-cvs] r14250 - trunk/abcl/test/lisp/ansi Message-ID: Author: mevenson Date: Fri Nov 16 05:55:52 2012 New Revision: 14250 Log: ansi-tests: add 1.0.1 and current trunk failures. Modified: trunk/abcl/test/lisp/ansi/ansi-test-failures Modified: trunk/abcl/test/lisp/ansi/ansi-test-failures ============================================================================== --- trunk/abcl/test/lisp/ansi/ansi-test-failures Fri Nov 16 05:40:47 2012 (r14249) +++ trunk/abcl/test/lisp/ansi/ansi-test-failures Fri Nov 16 05:55:52 2012 (r14250) @@ -444,6 +444,41 @@ PRINT.STRING.RANDOM.1 PRINT.RANDOM-STATE.1 PPRINT-LOGICAL-BLOCK.17 TRACE.8)) +(doit 1.0.1 :id saturn-java6 + :uname "i386-pc-solaris2.11.oi_151a7" :jvm "jdk-1.6.0_37" + (DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 DEFGENERIC.30 + CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 + DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 INVOKE-DEBUGGER.1 + MAKE-CONDITION.3 MAKE-CONDITION.4 SXHASH.8 DELETE-PACKAGE.5 + DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 + PRINT.RANDOM-STATE.1 PPRINT-LOGICAL-BLOCK.17 READ-SYMBOL.22)) + +(compileit 1.0.1 :id saturn-java6 + (DEFGENERIC.ERROR.20 DEFGENERIC.ERROR.21 DEFGENERIC.30 + CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 + DEFMETHOD.ERROR.14 DEFMETHOD.ERROR.15 INVOKE-DEBUGGER.1 + MAKE-CONDITION.3 MAKE-CONDITION.4 SXHASH.8 DELETE-PACKAGE.5 + DELETE-PACKAGE.6 MAP.48 TYPE-OF.1 TYPE-OF.4 + ENSURE-DIRECTORIES-EXIST.8 PRINT.RANDOM-STATE.1 + PPRINT-LOGICAL-BLOCK.17 READ-SYMBOL.22 TRACE.8)) + + +(doit r14249 :id saturn-java6 + (PSETF.37 CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 + INVOKE-DEBUGGER.1 MAKE-CONDITION.3 MAKE-CONDITION.4 SXHASH.8 MAP.48 + TYPE-OF.1 TYPE-OF.4 MAKE-CONCATENATED-STREAM.30 + PRINT.BACKQUOTE.RANDOM.14 PRINT.RANDOM-STATE.1 + PPRINT-LOGICAL-BLOCK.17 COMPILE-FILE.2 COMPILE-FILE.2A)) + + +(compileit r14249 :id saturn-java6 + (PSETF.37 CALL-NEXT-METHOD.ERROR.1 CALL-NEXT-METHOD.ERROR.2 + INVOKE-DEBUGGER.1 MAKE-CONDITION.3 MAKE-CONDITION.4 SXHASH.8 + MAP.48 TYPE-OF.1 TYPE-OF.4 ENSURE-DIRECTORIES-EXIST.8 + MAKE-CONCATENATED-STREAM.30 PRINT.RANDOM-STATE.1 + PPRINT-LOGICAL-BLOCK.17 COMPILE-FILE.2 COMPILE-FILE.2A TRACE.8)) + + From mevenson at common-lisp.net Sat Nov 17 07:34:00 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Fri, 16 Nov 2012 23:34:00 -0800 Subject: [armedbear-cvs] r14251 - trunk/abcl Message-ID: Author: mevenson Date: Fri Nov 16 23:33:59 2012 New Revision: 14251 Log: Further CHANGES updates. Modified: trunk/abcl/CHANGES Modified: trunk/abcl/CHANGES ============================================================================== --- trunk/abcl/CHANGES Fri Nov 16 05:55:52 2012 (r14250) +++ trunk/abcl/CHANGES Fri Nov 16 23:33:59 2012 (r14251) @@ -36,11 +36,19 @@ ** If the check for the presence of a class fails, find a maven-3.0.4 binary locally, execute its Aether connector to retrieve its transitive dependencies from the network. + + * The facility to construct runtime classes via JNEW-RUNTIME-CLASS + + ** Fields + ** Annotations + ** getter/setters for fields * JSS Java Syntax Sucks ** extensive bugfixing + + Changes ------- @@ -52,6 +60,16 @@ * [r13700] ABCL loads under the Weblogic 10.3 application server. + * [r13768] [#193] Allow zero-length symbols + + * [r13785] JNEW-RUNTIME-CLASS gets fields and annotations + + * [r13790] JNEW-RUNTIME-CLASS getters/setters for fields + + * [r13796] [r13797] N3 DOAP description for ABCL + + * [r13803] Build target 'abcl-contrib.jar' packages ABCL-CONTRIB + Version 1.0.1 ============== From mevenson at common-lisp.net Sat Nov 17 17:42:41 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Sat, 17 Nov 2012 09:42:41 -0800 Subject: [armedbear-cvs] r14252 - trunk/abcl Message-ID: Author: mevenson Date: Sat Nov 17 09:42:41 2012 New Revision: 14252 Log: Changes for abcl-1.1.0. For John and Yoko. Modified: trunk/abcl/CHANGES Modified: trunk/abcl/CHANGES ============================================================================== --- trunk/abcl/CHANGES Fri Nov 16 23:33:59 2012 (r14251) +++ trunk/abcl/CHANGES Sat Nov 17 09:42:41 2012 (r14252) @@ -1,57 +1,87 @@ Version 1.1.0 ============= svn.uri=:"http//common-lisp.net/project/armedbear/svn/trunk/abcl/" -(15 November 2012) +(22 November 2012) Features -------- - * A functioning (A)MOP implementation through the hard work of Rudi Schlatte + * A functioning (A)MOP implementation through the hard work of Rudi + Schlatte (@rudi) * The implementation can be used across many more Quicklisp systems - because the two top blockers have been fixed: + through a process of extensive testing. Thanks @xach! Nota bene: all of the following systems need patches to work as of the 2012-10-13 Quicklisp. All patches have been accepted in at least an initial form by the upstream maintainers. ** CLOSER-MOP + Quite possible with local patches ** CFFI + Needs patches to 2012-10-13 Quicklisp. [!!?] + *** Dynamic interfaces idempotent across process -- no more reloading ** HUNCHENTOOT - + *** some bugs with underlying streams to be fixed in abcl-1.2-dev + ** CXML + Basic XML parsing works. XPath still borked. [???] * Java 5 bytecode Compiler The internal Lisp-to-Java bytecode compiler has been hardened by regression testing across Quicklisp libraries. - ** large objects (???) - ** (??) - - * ABCL-ASDF Network installation of binary artifacts named by Maven POM uris. - - ** based on stock ASDF-2.26 - - ** checks at runtime if a given class is present in the accessible classloaders + ** Extensive interpreter/compiler bug fixes due to access to cl-test-suite [???] @antov + ** large objects (?!?) - ** If the check for the presence of a class fails, find a - maven-3.0.4 binary locally, execute its Aether connector to - retrieve its transitive dependencies from the network. + * The facility to construct runtime classes via JNEW-RUNTIME-CLASS (@astalla) - * The facility to construct runtime classes via JNEW-RUNTIME-CLASS + Pretty close to full coverage of primtives for creating synthethic + java classes at runtime. Easy to extend with your needs; sensible + defaults. ** Fields + *** getter/setters ** Annotations - ** getter/setters for fields - - * JSS Java Syntax Sucks + + + * ASDF + + ** Stock ASDF-2.26 with conditional patches for the URL-PATHAME and + JAR-PATHNAME implementation extensions to ANSI. + + * ABCL-CONTRIB + + ** ABCL-ASDF + + Network installation of binary artifacts named by Maven POM uris. + + *** checks at runtime if a given class is present in the + accessible classloaders + + *** If the check for the presence of a class fails, find a + maven-3.0.4 binary locally, execute its Aether connector + to retrieve its transitive dependencies from the network. + + ** JSS + + Java Syntax Sucks. q.v [lsw2] - ** extensive bugfixing + Extensive bugfixing wrt. method resolution [#229] + ** JFLI + + A "captured from the wild" version of what @rich.hickey did before Clojure. + Changes ------- + * [#249] PATHNAME merge semantics DWIMs on an inferred type + + Extends ANSI PATHNAME in a non-conforming manner, which was probably + already the case. + * [r13695] Reimplementation of global symbol macros to avoid using the symbol's value slot. @@ -70,6 +100,25 @@ * [r13803] Build target 'abcl-contrib.jar' packages ABCL-CONTRIB +Fixes +----- + + * ANSI [#241] + + ** &AUX parameters fixes RESTAS + + + * [#221] Stack exhaustsion on funcall in non-existing package + + * [#113] DEFSTRUCT concurrency + + * [#216][#211] Compiler + + ** stack inconsistency + + * [#187] Better SORT and STABLE-SORT via Jorge Tavares [???] + + Version 1.0.1 ============== From rschlatte at common-lisp.net Mon Nov 26 19:38:26 2012 From: rschlatte at common-lisp.net (rschlatte at common-lisp.net) Date: Mon, 26 Nov 2012 11:38:26 -0800 Subject: [armedbear-cvs] r14253 - trunk/abcl/doc/manual Message-ID: Author: rschlatte Date: Mon Nov 26 11:38:25 2012 New Revision: 14253 Log: Tiny manual fixes Modified: trunk/abcl/doc/manual/abcl.tex Modified: trunk/abcl/doc/manual/abcl.tex ============================================================================== --- trunk/abcl/doc/manual/abcl.tex Sat Nov 17 09:42:41 2012 (r14252) +++ trunk/abcl/doc/manual/abcl.tex Mon Nov 26 11:38:25 2012 (r14253) @@ -968,6 +968,13 @@ \section{Extensions to CLOS} +\subsection{Metaobject Protocol} + +ABCL implements the metaobject protocol for CLOS as specified in AMOP. +The symbols are exported from the package \code{MOP}. + +\subsection{Specializing on Java classes} + There is an additional syntax for specializing the parameter of a generic function on a java class, viz. \code{(java:jclass CLASS-STRING)} where \code{CLASS-STRING} is a string naming a Java class in dotted package @@ -993,10 +1000,10 @@ (defparameter *other-classloader* (jcall "getBaseLoader" cl-user::*classpath-manager*)) -(defmethod print-object ((device-id (java:jclass - "dto.nbi.service.hdm.alcatel.com.NBIDeviceID" - *other-classloader*)) - stream) +(defmethod print-object + ((device-id (java:jclass "dto.nbi.service.hdm.alcatel.com.NBIDeviceID" + *other-classloader*)) + stream) ;;; ... ) \end{listing-lisp} @@ -1009,9 +1016,9 @@ which we wish to make text processing efficient. Should the User require more control over UNICODE processing we recommend Edi Weisz' excellent work with FLEXI-STREAMS which we fully support}, namely we -allow a sequences of the form \# \textbackslash Uxxxx to be processed +allow a sequences of the form \verb~#\U~\emph{\texttt{xxxx}} to be processed by the reader as character whose code is specified by the hexadecimal -digits ``xxxx''. The hexadecimal sequence may be one to four digits +digits \emph{\texttt{xxxx}}. The hexadecimal sequence may be one to four digits long. % Why doesn't ALEXANDRIA work? Note that this sequence is never output by the implementation. Instead, From rschlatte at common-lisp.net Mon Nov 26 19:38:29 2012 From: rschlatte at common-lisp.net (rschlatte at common-lisp.net) Date: Mon, 26 Nov 2012 11:38:29 -0800 Subject: [armedbear-cvs] r14254 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: rschlatte Date: Mon Nov 26 11:38:28 2012 New Revision: 14254 Log: Fix (documentation symbol 'function) when symbol names a generic function - fixes #270 Modified: trunk/abcl/src/org/armedbear/lisp/Primitives.java trunk/abcl/src/org/armedbear/lisp/clos.lisp Modified: trunk/abcl/src/org/armedbear/lisp/Primitives.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/Primitives.java Mon Nov 26 11:38:25 2012 (r14253) +++ trunk/abcl/src/org/armedbear/lisp/Primitives.java Mon Nov 26 11:38:28 2012 (r14254) @@ -5670,6 +5670,7 @@ LispObject doc = object.getDocumentation(docType); if (doc == NIL) { if (docType == Symbol.FUNCTION && object instanceof Symbol) { + // Generic functions are handled at lisp-level, not here LispObject function = object.getSymbolFunction(); if (function != null) doc = function.getDocumentation(docType); @@ -5692,6 +5693,7 @@ LispObject documentation) { + // Generic functions are handled at lisp-level, not here object.setDocumentation(docType, documentation); return documentation; } Modified: trunk/abcl/src/org/armedbear/lisp/clos.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/clos.lisp Mon Nov 26 11:38:25 2012 (r14253) +++ trunk/abcl/src/org/armedbear/lisp/clos.lisp Mon Nov 26 11:38:28 2012 (r14254) @@ -3340,7 +3340,14 @@ (%set-documentation x doc-type new-value)) (defmethod documentation ((x symbol) (doc-type (eql 'function))) - (%documentation x 'function)) + (if (typep (fdefinition x) 'generic-function) + (documentation (fdefinition x) doc-type) + (%documentation x doc-type))) + +(defmethod (setf documentation) (new-value (x symbol) (doc-type (eql 'function))) + (if (typep (fdefinition x) 'generic-function) + (setf (documentation (fdefinition x) 'function) new-value) + (%set-documentation x 'function new-value))) (defmethod documentation ((x symbol) (doc-type (eql 'type))) (let ((class (find-class x nil))) From rschlatte at common-lisp.net Mon Nov 26 19:51:45 2012 From: rschlatte at common-lisp.net (rschlatte at common-lisp.net) Date: Mon, 26 Nov 2012 11:51:45 -0800 Subject: [armedbear-cvs] r14255 - trunk/abcl Message-ID: Author: rschlatte Date: Mon Nov 26 11:51:44 2012 New Revision: 14255 Log: add documentation about documentation about running tests Modified: trunk/abcl/README Modified: trunk/abcl/README ============================================================================== --- trunk/abcl/README Mon Nov 26 11:38:28 2012 (r14254) +++ trunk/abcl/README Mon Nov 26 11:51:44 2012 (r14255) @@ -97,6 +97,7 @@ unix$ ant or + dos> ant.bat from the directory containing this README file will create an @@ -190,6 +191,9 @@ Maxima's test suite runs without failures. +ABCL comes with a test suite, see the output of `ant help.test` for more +information. + ### Deficiencies The MOP implementation is incompletel untested. From ehuelsmann at common-lisp.net Mon Nov 26 22:45:49 2012 From: ehuelsmann at common-lisp.net (ehuelsmann at common-lisp.net) Date: Mon, 26 Nov 2012 14:45:49 -0800 Subject: [armedbear-cvs] r14256 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: ehuelsmann Date: Mon Nov 26 14:45:48 2012 New Revision: 14256 Log: Patch submitted by Carlos Ungil: Correctly identify the platforms to support CFFI. Modified: trunk/abcl/src/org/armedbear/lisp/Lisp.java Modified: trunk/abcl/src/org/armedbear/lisp/Lisp.java ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/Lisp.java Mon Nov 26 11:51:44 2012 (r14255) +++ trunk/abcl/src/org/armedbear/lisp/Lisp.java Mon Nov 26 14:45:48 2012 (r14256) @@ -2378,9 +2378,9 @@ } // Processor architecture if(osArch != null) { - if (osArch.equals("amd64")) + if (osArch.equals("amd64") || osArch.equals("x86_64")) featureList = new Cons(Keyword.X86_64, featureList); - else if (osArch.equals("x86")) + else if (osArch.equals("x86") || osArch.equals("i386")) featureList = new Cons(Keyword.X86, featureList); } Symbol.FEATURES.initializeSpecial(featureList); From mevenson at common-lisp.net Wed Nov 28 08:56:25 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Wed, 28 Nov 2012 00:56:25 -0800 Subject: [armedbear-cvs] r14257 - trunk/abcl/contrib/jfli Message-ID: Author: mevenson Date: Wed Nov 28 00:56:15 2012 New Revision: 14257 Log: jfli: move IntellJ dependent tests into separate ASDF system. Reported by Carlos Ungil. Modified: trunk/abcl/contrib/jfli/jfli.asd Modified: trunk/abcl/contrib/jfli/jfli.asd ============================================================================== --- trunk/abcl/contrib/jfli/jfli.asd Mon Nov 26 14:45:48 2012 (r14256) +++ trunk/abcl/contrib/jfli/jfli.asd Wed Nov 28 00:56:15 2012 (r14257) @@ -1,6 +1,12 @@ (require :asdf) + (asdf:defsystem jfli + :version "0.2.0" + :components ((:file "jfli"))) + + +;;; Requires integration with +(asdf:defsystem jfli-intellij-tests :version "0.1.0" - :components ((:file "jfli") - (:module test :components - ((:file "yanking"))))) + :components ((:module test + :components ((:file "yanking"))))) From mevenson at common-lisp.net Wed Nov 28 09:16:24 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Wed, 28 Nov 2012 01:16:24 -0800 Subject: [armedbear-cvs] r14258 - in trunk/abcl/contrib/jfli: . test Message-ID: Author: mevenson Date: Wed Nov 28 01:16:24 2012 New Revision: 14258 Log: jfli: set svn:eol-style to native. Modified: trunk/abcl/contrib/jfli/README (props changed) trunk/abcl/contrib/jfli/jfli.asd (props changed) trunk/abcl/contrib/jfli/jfli.lisp (props changed) trunk/abcl/contrib/jfli/test/yanking.lisp (contents, props changed) Modified: trunk/abcl/contrib/jfli/test/yanking.lisp ============================================================================== --- trunk/abcl/contrib/jfli/test/yanking.lisp Wed Nov 28 00:56:15 2012 (r14257) +++ trunk/abcl/contrib/jfli/test/yanking.lisp Wed Nov 28 01:16:24 2012 (r14258) @@ -1,386 +1,386 @@ -(defpackage :my (:use :cl)) -(in-package :my) - -;; runtime-class.lisp is a part of ABCL, but it is excluded from ABCL build, -;; because it requires asm.jar to be present in classpath during the build. -;; -;; The functionality it provides is necessary for dynamic creation of -;; new java classes from Lisp (in particular for the -;; NEW-CLASS macro of jfli ABCL port) -(load (concatenate 'string abclidea:*lisp-dir* "org/armedbear/lisp/runtime-class.lisp")) - -;; Load jfli -(load (concatenate 'string abclidea:*lisp-dir* "jfli-abcl/jfli-abcl.lisp")) - -(use-package :jfli) - -;; "Import" java classes we use. -;; -;; You may produce DEF-JAVA-CLASS forms for all the IDEA API classes automatically: -;; -;; (jfli:dump-wrapper-defs-to-file (concatenate 'string abclidea:*lisp-dir* "idea-api.lisp") -;; (jfli:get-jar-classnames "path/to/idea/openapi.jar" -;; "com/intellij")) -;; -;; -;; In result they will be stored in idea-api.lisp file. -;; -;; But we do it manually, because there are not so many classes we use. - -(def-java-class "com.intellij.openapi.ui.Messages") -(use-package "com.intellij.openapi.ui") - -(def-java-class "com.intellij.openapi.application.ModalityState") -(def-java-class "com.intellij.openapi.application.Application") -(def-java-class "com.intellij.openapi.application.ApplicationManager") -(use-package "com.intellij.openapi.application") - -(def-java-class "com.intellij.openapi.actionSystem.AnAction") -(def-java-class "com.intellij.openapi.actionSystem.AnActionEvent") -(def-java-class "com.intellij.openapi.actionSystem.ActionManager") -(def-java-class "com.intellij.openapi.actionSystem.DefaultActionGroup") -(def-java-class "com.intellij.openapi.actionSystem.CustomShortcutSet") -(def-java-class "com.intellij.openapi.actionSystem.Shortcut") -(def-java-class "com.intellij.openapi.actionSystem.KeyboardShortcut") -(def-java-class "com.intellij.openapi.actionSystem.CustomShortcutSet") -(use-package "com.intellij.openapi.actionSystem") - -(def-java-class "com.intellij.openapi.ide.CopyPasteManager") -(use-package "com.intellij.openapi.ide") - -(def-java-class "com.intellij.openapi.keymap.KeymapManager") -(def-java-class "com.intellij.openapi.keymap.Keymap") -(use-package "com.intellij.openapi.keymap") - -(def-java-class "com.intellij.openapi.project.ProjectManager") -(use-package "com.intellij.openapi.project") - -(def-java-class "com.intellij.openapi.editor.Editor") -(def-java-class "com.intellij.openapi.editor.Document") -(def-java-class "com.intellij.openapi.editor.SelectionModel") -(use-package "com.intellij.openapi.editor") - -(def-java-class "com.intellij.openapi.fileEditor.FileEditorManager") -(def-java-class "com.intellij.openapi.fileEditor.FileEditor") -(def-java-class "com.intellij.openapi.fileEditor.TextEditor") -(use-package "com.intellij.openapi.fileEditor") - -(def-java-class "com.intellij.openapi.command.CommandProcessor") -(def-java-class "com.intellij.openapi.command.CommandAdapter") -(def-java-class "com.intellij.openapi.command.CommandEvent") -(use-package "com.intellij.openapi.command") - -(def-java-class "com.intellij.openapi.wm.WindowManager") -(def-java-class "com.intellij.openapi.wm.StatusBar") -(use-package "com.intellij.openapi.wm") - -(def-java-class "java.lang.Runnable") -(def-java-class "java.lang.Thread") -(def-java-class "java.lang.Object") -(def-java-class "java.lang.Class") -(def-java-class "java.lang.String") -(use-package "java.lang") - -(def-java-class "java.awt.datatransfer.Transferable") -(def-java-class "java.awt.datatransfer.DataFlavor") -(use-package "java.awt.datatransfer") - -(def-java-class "javax.swing.KeyStroke") -(use-package "javax.swing") - -(define-condition action-is-not-applicable () - ((why :initarg :why :reader why)) - (:report (lambda (condition stream) - (format stream "Action is not applicable: ~A" (why condition))))) - -(defun cur-prj () - (let ((all-prjs (projectmanager.getopenprojects (projectmanager.getinstance)))) - (when (> (jlength all-prjs) 0) - (jref all-prjs 0)))) - -(defun cur-prj-safe () - (or (cur-prj) (error 'action-is-not-applicable :why "no current project"))) - -(defun cur-editor (prj) - (fileeditormanager.getselectedtexteditor (fileeditormanager.getinstance prj))) - -(defun cur-editor-safe (prj) - (or (cur-editor prj) - (error 'action-is-not-applicable - :why "no text editor is selected"))) - -;; region object -(defun make-region (start end) - (cons start end)) - -(defun region-start (region) - (car region)) - -(defun region-end (region) - (cdr region)) - -(defun get-sel-region() - "Selection in the currently active editor" - (let* ((cur-prj (cur-prj-safe)) - (cur-editor (cur-editor-safe cur-prj)) - (sel-model (editor.getselectionmodel cur-editor))) - (make-region - (selectionmodel.getselectionstart sel-model) - (selectionmodel.getselectionend sel-model)))) - -(defun replace-region (replacement-text region) - "Replace text in the curently active editor" - (let* ((cur-prj (cur-prj-safe)) - (cur-editor (cur-editor-safe cur-prj)) - (cur-doc (editor.getdocument cur-editor))) - (document.replacestring cur-doc - (region-start region) - (region-end region) - replacement-text))) - -(defvar *yank-index* 0 - "Index of clipboard item that will be pasted by the next yank or - yank-pop operation $similar to kill-ring-yank-pointer in Emacs$.") - -(defvar *yank-region* nil - "Region of text that was inserted by previous yank or yank-pop command, -and that must be replaced by next yank-pop.") - -(defvar *yank-undo-id* 0 - "Yank following by a sequence of yank-pop must be considered as a -single action by undo mechanism. This variable is unique identifier -of such an compound action.") - -(defun get-yank-text (&optional (index 0)) - (let ((all-contents (copypastemanager.getallcontents (copypastemanager.getinstance))) - content) - (when (zerop (jlength all-contents)) - (RETURN-FROM get-yank-tex nil)) - (setf content (jref all-contents (mod index (jlength all-contents)))) - (transferable.gettransferdata content (dataflavor.stringflavor)))) - -(defun get-yank-text-safe (&optional (index 0)) - (or (get-yank-text index) - (error 'action-is-not-applicable :why "clipboard is empty"))) - -(defun next-yank-region (cur-selection-region replacement-text) - (make-region (region-start cur-selection-region) - (+ (region-start cur-selection-region) - (length (java:jobject-lisp-value replacement-text))))) -(defun yank() - (let ((sel-region (get-sel-region)) - (yank-text (get-yank-text-safe))) - (replace-region yank-text - sel-region) - (setf *yank-region* (next-yank-region sel-region - yank-text)) - (setf *yank-index* 1))) - -(defun make-runnable (fun) - (java:jinterface-implementation - "java.lang.Runnable" - "run" - ;; wrap FUN into lambda to allow it to be - ;; not only function objects, but also symbols - ;; (java:jinterface-implementation supports - ;; only function objects) - (lambda () (funcall fun)))) - -(defmacro runnable (&body body) - `(make-runnable (lambda () , at body))) - -(defun run-write-action (fun) - (let ((app (applicationmanager.getapplication)) - (runnable (make-runnable fun))) - (application.runwriteaction app runnable))) - -(defun exec-cmd (fun name group-id) - (commandprocessor.executecommand (commandprocessor.getinstance) - (cur-prj) - (make-runnable fun) - name - group-id)) - -;; set status bar text -(defun set-status (status-text) - (statusbar.setinfo (windowmanager.getstatusbar - (windowmanager.getinstance) - (cur-prj)) - status-text)) - -(new-class - "MY.MyAction" ;; class name - anaction. ;; super class - - ;; constructors - ( - (((text "java.lang.String") (func "java.lang.Object")) - (super text) - (setf (myaction.func this) func)) - ) - - ;; methods - ( - ("actionPerformed" :void :public (action-event) - ;; It's usefull to setup a restart before - ;; calling FUNC. - ;; - ;; It helps when slime is connected to - ;; the IDEA and error happens - ;; during action execution. - ;; - ;; Slime debugger hooks the error, - ;; but as actions are invoked from - ;; idea UI event dispatching thread, - ;; no slime restarts are set - ;; and our restart is the only - ;; way to leave SLIME debugger. - (restart-case - (handler-case - (funcall (myaction.func this) action-event) - (action-is-not-applicable () - ;; NOTE: it is not guaranteed - ;; that execution will be passed to this - ;; handler, even if your code signals - ;; ACTION-IS-NOT-APPLICABLE. - ;; - ;; It's so because ABCL impements - ;; non local exits using java exceptions - ;; (org.armedbear.lisp.Go); if somewhere - ;; in the call stack below our HANDLER-CASE - ;; and above the SIGNAL there is a - ;; - ;; catch (Throwable) - ;; - ;; then ABCL's Go exception will be catched. - ;; - ;; catch (Throwable) is in partiular - ;; used by IDEA methods that accept Runnable - ;; (like CommandProcessor.executeCommand, - ;; Application.runWriteAction) - ;; - ;; But even despite that, HANDLER-CASE - ;; is useful, because ACTION-IS-NOT-APPLICABLE - ;; is not trapped by Slime debugger. - )) - (continue () - :report "Return from IDEA action" - nil))) - ) - - ;; fields - ( - ("func" "java.lang.Object" :public)) - ) - -(setf act-yank (myaction.new "yank" nil)) -(setf (myaction.func act-yank) - #'(lambda (action-event) - (declare (ignore action-event)) - (incf *yank-undo-id*) - (exec-cmd (lambda () - (run-write-action 'yank)) - "yank" - (format nil "yank-~A" *yank-undo-id*)))) - -(setf edit-menu (actionmanager.getaction (actionmanager.getinstance) "EditMenu")) - -(actionmanager.registeraction (actionmanager.getinstance) "yank" act-yank) -(defaultactiongroup.add edit-menu act-yank) - -;;(actionmanager.unregisteraction (actionmanager.getinstance) "yank") -;;(defaultactiongroup.remove edit-menu act-yank) - -;; assign keyboard shortcut Ctrl-Y to our action -;; (by default Ctrl-Y is used for delete-line operation in IDEA; -;; override this by unregistering Ctrl-Y from delete-line) -(defun action-shortcut (anaction) - "The first element of AnAction.getShorcuts()" - (jref (customshortcutset.getshortcuts (anaction.getshortcutset anaction)) 0)) - -(defun remove-shortcut (keystroke-str) - "Unregister all the shortcuts specified by KEYSTROKE-STR -for all the actions in the active keymap. -Example $REMOVE-SHORTCUT \"control Y\"$" - (let* ((keymap (keymapmanager.getactivekeymap (keymapmanager.getinstance))) - (keystroke (keystroke.getkeystroke keystroke-str)) - (act-ids (keymap.getactionids keymap keystroke))) - (dotimes (i (jlength act-ids)) - (let ((shortcuts (keymap.getshortcuts keymap (jref act-ids i)))) - (dotimes (j (jlength shortcuts)) - (let ((shortcut (jref shortcuts j))) - (when (class.isinstance (class.forname "com.intellij.openapi.actionSystem.KeyboardShortcut") - shortcut) - (when (jeq (keyboardshortcut.getfirstkeystroke shortcut) - keystroke) - (keymap.removeshortcut keymap (jref act-ids i) shortcut))))))))) - -;; this is to display shortcut correctly in the menu -(anaction.setshortcutset act-yank - (customshortcutset.new (keystroke.getkeystroke "control Y"))) - -;; this is to make it actually fired when user presses the key combination -(remove-shortcut "control Y") -(keymap.addshortcut (keymapmanager.getactivekeymap (keymapmanager.getinstance)) - "yank" - (action-shortcut act-yank)) - -;; yank-pop is allowed only if previous command was yank or yank-pop. -;; Add a command listentener that clears *yank-region* when any -;; other command is executed, and thus makes yank-pop impossible. -(new-class - "MY.MyCommandListener" ;; class name - commandadapter. ;; super class - - ;; constructors - () - - ;; methods - ( - ("commandFinished" :void :public (command-event) - (unless (member (java:jobject-lisp-value (commandevent.getcommandname - command-event)) - '("yank" "yank-pop") - :test #'string=) - (setf *yank-region* nil))) - ) - - ;; fields - () - ) - -(setf my-cmd-listener (mycommandlistener.new)) -(commandprocessor.addcommandlistener (commandprocessor.getinstance) - my-cmd-listener) - -;; (actionmanager.unregisteraction (actionmanager.getinstance) "yank-pop") -;; (defaultactiongroup.remove edit-menu act-yank-pop) - -(defun yank-pop () - (let ((yank-text (get-yank-text *yank-index*))) - (replace-region yank-text *yank-region*) - (setf *yank-region* (make-region (region-start *yank-region*) - (+ (region-start *yank-region*) - (string.length yank-text))))) - (incf *yank-index*)) - -(setf act-yank-pop (myaction.new "yank-pop" nil)) -(setf (myaction.func act-yank-pop) - #'(lambda (action-event) - (if *yank-region* - (exec-cmd (lambda () - (run-write-action 'yank-pop)) - "yank-pop" - (format nil "yank-~A" *yank-undo-id*)) - (set-status "Previous command was not a yank")))) - -(actionmanager.registeraction (actionmanager.getinstance) "yank-pop" act-yank-pop) -(defaultactiongroup.add edit-menu act-yank-pop) - -(anaction.setshortcutset act-yank-pop - (customshortcutset.new (keystroke.getkeystroke "alt Y"))) - -(keymap.addshortcut (keymapmanager.getactivekeymap (keymapmanager.getinstance)) - "yank-pop" - (action-shortcut act-yank-pop)) - +(defpackage :my (:use :cl)) +(in-package :my) + +;; runtime-class.lisp is a part of ABCL, but it is excluded from ABCL build, +;; because it requires asm.jar to be present in classpath during the build. +;; +;; The functionality it provides is necessary for dynamic creation of +;; new java classes from Lisp (in particular for the +;; NEW-CLASS macro of jfli ABCL port) +(load (concatenate 'string abclidea:*lisp-dir* "org/armedbear/lisp/runtime-class.lisp")) + +;; Load jfli +(load (concatenate 'string abclidea:*lisp-dir* "jfli-abcl/jfli-abcl.lisp")) + +(use-package :jfli) + +;; "Import" java classes we use. +;; +;; You may produce DEF-JAVA-CLASS forms for all the IDEA API classes automatically: +;; +;; (jfli:dump-wrapper-defs-to-file (concatenate 'string abclidea:*lisp-dir* "idea-api.lisp") +;; (jfli:get-jar-classnames "path/to/idea/openapi.jar" +;; "com/intellij")) +;; +;; +;; In result they will be stored in idea-api.lisp file. +;; +;; But we do it manually, because there are not so many classes we use. + +(def-java-class "com.intellij.openapi.ui.Messages") +(use-package "com.intellij.openapi.ui") + +(def-java-class "com.intellij.openapi.application.ModalityState") +(def-java-class "com.intellij.openapi.application.Application") +(def-java-class "com.intellij.openapi.application.ApplicationManager") +(use-package "com.intellij.openapi.application") + +(def-java-class "com.intellij.openapi.actionSystem.AnAction") +(def-java-class "com.intellij.openapi.actionSystem.AnActionEvent") +(def-java-class "com.intellij.openapi.actionSystem.ActionManager") +(def-java-class "com.intellij.openapi.actionSystem.DefaultActionGroup") +(def-java-class "com.intellij.openapi.actionSystem.CustomShortcutSet") +(def-java-class "com.intellij.openapi.actionSystem.Shortcut") +(def-java-class "com.intellij.openapi.actionSystem.KeyboardShortcut") +(def-java-class "com.intellij.openapi.actionSystem.CustomShortcutSet") +(use-package "com.intellij.openapi.actionSystem") + +(def-java-class "com.intellij.openapi.ide.CopyPasteManager") +(use-package "com.intellij.openapi.ide") + +(def-java-class "com.intellij.openapi.keymap.KeymapManager") +(def-java-class "com.intellij.openapi.keymap.Keymap") +(use-package "com.intellij.openapi.keymap") + +(def-java-class "com.intellij.openapi.project.ProjectManager") +(use-package "com.intellij.openapi.project") + +(def-java-class "com.intellij.openapi.editor.Editor") +(def-java-class "com.intellij.openapi.editor.Document") +(def-java-class "com.intellij.openapi.editor.SelectionModel") +(use-package "com.intellij.openapi.editor") + +(def-java-class "com.intellij.openapi.fileEditor.FileEditorManager") +(def-java-class "com.intellij.openapi.fileEditor.FileEditor") +(def-java-class "com.intellij.openapi.fileEditor.TextEditor") +(use-package "com.intellij.openapi.fileEditor") + +(def-java-class "com.intellij.openapi.command.CommandProcessor") +(def-java-class "com.intellij.openapi.command.CommandAdapter") +(def-java-class "com.intellij.openapi.command.CommandEvent") +(use-package "com.intellij.openapi.command") + +(def-java-class "com.intellij.openapi.wm.WindowManager") +(def-java-class "com.intellij.openapi.wm.StatusBar") +(use-package "com.intellij.openapi.wm") + +(def-java-class "java.lang.Runnable") +(def-java-class "java.lang.Thread") +(def-java-class "java.lang.Object") +(def-java-class "java.lang.Class") +(def-java-class "java.lang.String") +(use-package "java.lang") + +(def-java-class "java.awt.datatransfer.Transferable") +(def-java-class "java.awt.datatransfer.DataFlavor") +(use-package "java.awt.datatransfer") + +(def-java-class "javax.swing.KeyStroke") +(use-package "javax.swing") + +(define-condition action-is-not-applicable () + ((why :initarg :why :reader why)) + (:report (lambda (condition stream) + (format stream "Action is not applicable: ~A" (why condition))))) + +(defun cur-prj () + (let ((all-prjs (projectmanager.getopenprojects (projectmanager.getinstance)))) + (when (> (jlength all-prjs) 0) + (jref all-prjs 0)))) + +(defun cur-prj-safe () + (or (cur-prj) (error 'action-is-not-applicable :why "no current project"))) + +(defun cur-editor (prj) + (fileeditormanager.getselectedtexteditor (fileeditormanager.getinstance prj))) + +(defun cur-editor-safe (prj) + (or (cur-editor prj) + (error 'action-is-not-applicable + :why "no text editor is selected"))) + +;; region object +(defun make-region (start end) + (cons start end)) + +(defun region-start (region) + (car region)) + +(defun region-end (region) + (cdr region)) + +(defun get-sel-region() + "Selection in the currently active editor" + (let* ((cur-prj (cur-prj-safe)) + (cur-editor (cur-editor-safe cur-prj)) + (sel-model (editor.getselectionmodel cur-editor))) + (make-region + (selectionmodel.getselectionstart sel-model) + (selectionmodel.getselectionend sel-model)))) + +(defun replace-region (replacement-text region) + "Replace text in the curently active editor" + (let* ((cur-prj (cur-prj-safe)) + (cur-editor (cur-editor-safe cur-prj)) + (cur-doc (editor.getdocument cur-editor))) + (document.replacestring cur-doc + (region-start region) + (region-end region) + replacement-text))) + +(defvar *yank-index* 0 + "Index of clipboard item that will be pasted by the next yank or + yank-pop operation $similar to kill-ring-yank-pointer in Emacs$.") + +(defvar *yank-region* nil + "Region of text that was inserted by previous yank or yank-pop command, +and that must be replaced by next yank-pop.") + +(defvar *yank-undo-id* 0 + "Yank following by a sequence of yank-pop must be considered as a +single action by undo mechanism. This variable is unique identifier +of such an compound action.") + +(defun get-yank-text (&optional (index 0)) + (let ((all-contents (copypastemanager.getallcontents (copypastemanager.getinstance))) + content) + (when (zerop (jlength all-contents)) + (RETURN-FROM get-yank-tex nil)) + (setf content (jref all-contents (mod index (jlength all-contents)))) + (transferable.gettransferdata content (dataflavor.stringflavor)))) + +(defun get-yank-text-safe (&optional (index 0)) + (or (get-yank-text index) + (error 'action-is-not-applicable :why "clipboard is empty"))) + +(defun next-yank-region (cur-selection-region replacement-text) + (make-region (region-start cur-selection-region) + (+ (region-start cur-selection-region) + (length (java:jobject-lisp-value replacement-text))))) +(defun yank() + (let ((sel-region (get-sel-region)) + (yank-text (get-yank-text-safe))) + (replace-region yank-text + sel-region) + (setf *yank-region* (next-yank-region sel-region + yank-text)) + (setf *yank-index* 1))) + +(defun make-runnable (fun) + (java:jinterface-implementation + "java.lang.Runnable" + "run" + ;; wrap FUN into lambda to allow it to be + ;; not only function objects, but also symbols + ;; (java:jinterface-implementation supports + ;; only function objects) + (lambda () (funcall fun)))) + +(defmacro runnable (&body body) + `(make-runnable (lambda () , at body))) + +(defun run-write-action (fun) + (let ((app (applicationmanager.getapplication)) + (runnable (make-runnable fun))) + (application.runwriteaction app runnable))) + +(defun exec-cmd (fun name group-id) + (commandprocessor.executecommand (commandprocessor.getinstance) + (cur-prj) + (make-runnable fun) + name + group-id)) + +;; set status bar text +(defun set-status (status-text) + (statusbar.setinfo (windowmanager.getstatusbar + (windowmanager.getinstance) + (cur-prj)) + status-text)) + +(new-class + "MY.MyAction" ;; class name + anaction. ;; super class + + ;; constructors + ( + (((text "java.lang.String") (func "java.lang.Object")) + (super text) + (setf (myaction.func this) func)) + ) + + ;; methods + ( + ("actionPerformed" :void :public (action-event) + ;; It's usefull to setup a restart before + ;; calling FUNC. + ;; + ;; It helps when slime is connected to + ;; the IDEA and error happens + ;; during action execution. + ;; + ;; Slime debugger hooks the error, + ;; but as actions are invoked from + ;; idea UI event dispatching thread, + ;; no slime restarts are set + ;; and our restart is the only + ;; way to leave SLIME debugger. + (restart-case + (handler-case + (funcall (myaction.func this) action-event) + (action-is-not-applicable () + ;; NOTE: it is not guaranteed + ;; that execution will be passed to this + ;; handler, even if your code signals + ;; ACTION-IS-NOT-APPLICABLE. + ;; + ;; It's so because ABCL impements + ;; non local exits using java exceptions + ;; (org.armedbear.lisp.Go); if somewhere + ;; in the call stack below our HANDLER-CASE + ;; and above the SIGNAL there is a + ;; + ;; catch (Throwable) + ;; + ;; then ABCL's Go exception will be catched. + ;; + ;; catch (Throwable) is in partiular + ;; used by IDEA methods that accept Runnable + ;; (like CommandProcessor.executeCommand, + ;; Application.runWriteAction) + ;; + ;; But even despite that, HANDLER-CASE + ;; is useful, because ACTION-IS-NOT-APPLICABLE + ;; is not trapped by Slime debugger. + )) + (continue () + :report "Return from IDEA action" + nil))) + ) + + ;; fields + ( + ("func" "java.lang.Object" :public)) + ) + +(setf act-yank (myaction.new "yank" nil)) +(setf (myaction.func act-yank) + #'(lambda (action-event) + (declare (ignore action-event)) + (incf *yank-undo-id*) + (exec-cmd (lambda () + (run-write-action 'yank)) + "yank" + (format nil "yank-~A" *yank-undo-id*)))) + +(setf edit-menu (actionmanager.getaction (actionmanager.getinstance) "EditMenu")) + +(actionmanager.registeraction (actionmanager.getinstance) "yank" act-yank) +(defaultactiongroup.add edit-menu act-yank) + +;;(actionmanager.unregisteraction (actionmanager.getinstance) "yank") +;;(defaultactiongroup.remove edit-menu act-yank) + +;; assign keyboard shortcut Ctrl-Y to our action +;; (by default Ctrl-Y is used for delete-line operation in IDEA; +;; override this by unregistering Ctrl-Y from delete-line) +(defun action-shortcut (anaction) + "The first element of AnAction.getShorcuts()" + (jref (customshortcutset.getshortcuts (anaction.getshortcutset anaction)) 0)) + +(defun remove-shortcut (keystroke-str) + "Unregister all the shortcuts specified by KEYSTROKE-STR +for all the actions in the active keymap. +Example $REMOVE-SHORTCUT \"control Y\"$" + (let* ((keymap (keymapmanager.getactivekeymap (keymapmanager.getinstance))) + (keystroke (keystroke.getkeystroke keystroke-str)) + (act-ids (keymap.getactionids keymap keystroke))) + (dotimes (i (jlength act-ids)) + (let ((shortcuts (keymap.getshortcuts keymap (jref act-ids i)))) + (dotimes (j (jlength shortcuts)) + (let ((shortcut (jref shortcuts j))) + (when (class.isinstance (class.forname "com.intellij.openapi.actionSystem.KeyboardShortcut") + shortcut) + (when (jeq (keyboardshortcut.getfirstkeystroke shortcut) + keystroke) + (keymap.removeshortcut keymap (jref act-ids i) shortcut))))))))) + +;; this is to display shortcut correctly in the menu +(anaction.setshortcutset act-yank + (customshortcutset.new (keystroke.getkeystroke "control Y"))) + +;; this is to make it actually fired when user presses the key combination +(remove-shortcut "control Y") +(keymap.addshortcut (keymapmanager.getactivekeymap (keymapmanager.getinstance)) + "yank" + (action-shortcut act-yank)) + +;; yank-pop is allowed only if previous command was yank or yank-pop. +;; Add a command listentener that clears *yank-region* when any +;; other command is executed, and thus makes yank-pop impossible. +(new-class + "MY.MyCommandListener" ;; class name + commandadapter. ;; super class + + ;; constructors + () + + ;; methods + ( + ("commandFinished" :void :public (command-event) + (unless (member (java:jobject-lisp-value (commandevent.getcommandname + command-event)) + '("yank" "yank-pop") + :test #'string=) + (setf *yank-region* nil))) + ) + + ;; fields + () + ) + +(setf my-cmd-listener (mycommandlistener.new)) +(commandprocessor.addcommandlistener (commandprocessor.getinstance) + my-cmd-listener) + +;; (actionmanager.unregisteraction (actionmanager.getinstance) "yank-pop") +;; (defaultactiongroup.remove edit-menu act-yank-pop) + +(defun yank-pop () + (let ((yank-text (get-yank-text *yank-index*))) + (replace-region yank-text *yank-region*) + (setf *yank-region* (make-region (region-start *yank-region*) + (+ (region-start *yank-region*) + (string.length yank-text))))) + (incf *yank-index*)) + +(setf act-yank-pop (myaction.new "yank-pop" nil)) +(setf (myaction.func act-yank-pop) + #'(lambda (action-event) + (if *yank-region* + (exec-cmd (lambda () + (run-write-action 'yank-pop)) + "yank-pop" + (format nil "yank-~A" *yank-undo-id*)) + (set-status "Previous command was not a yank")))) + +(actionmanager.registeraction (actionmanager.getinstance) "yank-pop" act-yank-pop) +(defaultactiongroup.add edit-menu act-yank-pop) + +(anaction.setshortcutset act-yank-pop + (customshortcutset.new (keystroke.getkeystroke "alt Y"))) + +(keymap.addshortcut (keymapmanager.getactivekeymap (keymapmanager.getinstance)) + "yank-pop" + (action-shortcut act-yank-pop)) + From mevenson at common-lisp.net Wed Nov 28 11:06:09 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Wed, 28 Nov 2012 03:06:09 -0800 Subject: [armedbear-cvs] r14259 - in trunk/abcl/contrib: . abcl-asdf Message-ID: Author: mevenson Date: Wed Nov 28 03:06:03 2012 New Revision: 14259 Log: abcl-asdf: restore the ability to use maven-3.0.3 Warn when interpreting alias for "com.sun.jna:jna". Closes #268. Modified: trunk/abcl/contrib/README.markdown trunk/abcl/contrib/abcl-asdf/README.markdown trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd trunk/abcl/contrib/abcl-asdf/maven-embedder.lisp Modified: trunk/abcl/contrib/README.markdown ============================================================================== --- trunk/abcl/contrib/README.markdown Wed Nov 28 01:16:24 2012 (r14258) +++ trunk/abcl/contrib/README.markdown Wed Nov 28 03:06:03 2012 (r14259) @@ -38,7 +38,7 @@ --- A collection of various useful JVM artifacts downloaded and cached by -the Aether Maven connector. Requires the maven-3.0.4 executable "mvn" +the Aether Maven connector. Requires the maven-3.0.3 executable "mvn" (or "mvn.bat" under MSFT Windows) to be in the current processes's path. jna @@ -64,7 +64,7 @@ Mark Created: 2011-09-11 -Revised: 2012-10-12 +Revised: 2012-11-28 Modified: trunk/abcl/contrib/abcl-asdf/README.markdown ============================================================================== --- trunk/abcl/contrib/abcl-asdf/README.markdown Wed Nov 28 01:16:24 2012 (r14258) +++ trunk/abcl/contrib/abcl-asdf/README.markdown Wed Nov 28 03:06:03 2012 (r14259) @@ -159,45 +159,10 @@ [1]: http://www.iris-reasoner.org/ -Releases --------- - -### 9.9.2 2012-11-09 - - - - -### 0.7.0 2012-02-05 - -Plausibly work under MSFT operating systems. - -Working with maven-3.0.4. - -### 0.5.0 2012-01-22 - - o just bless this as a release to stablize its offered API "as is" - - o definitely failing under MSFT - - o ASDF version has to be a three value integer (i.e. no "-snapshot" - after version). Should be fixed with appropiate :AROUND method - as implementation specific monkeypatch. - - -### 0.4.1 2011-09-06 - - o locating the proper Maven3 libraries could work in more places - - o untested under Windows - - o more information should be optionally available when downloading - as this process can potentially take a long time. - - #### Colophon Mark Created: 2011-01-01 - Revised: 2012-11-09 + Revised: 2012-11-28 Modified: trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd ============================================================================== --- trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd Wed Nov 28 01:16:24 2012 (r14258) +++ trunk/abcl/contrib/abcl-asdf/abcl-asdf.asd Wed Nov 28 03:06:03 2012 (r14259) @@ -2,7 +2,7 @@ (asdf:defsystem :abcl-asdf :author "Mark Evenson" - :version "0.9.2" + :version "1.0.0" :depends-on (jss) :components ((:module packages :pathname "" Modified: trunk/abcl/contrib/abcl-asdf/maven-embedder.lisp ============================================================================== --- trunk/abcl/contrib/abcl-asdf/maven-embedder.lisp Wed Nov 28 01:16:24 2012 (r14258) +++ trunk/abcl/contrib/abcl-asdf/maven-embedder.lisp Wed Nov 28 03:06:03 2012 (r14259) @@ -144,7 +144,7 @@ (>= minor 1)) (and (>= major 3) (>= minor 0) - (>= patch 4))))) + (>= patch 3))))) (defparameter *init* nil) @@ -154,18 +154,22 @@ (setf *mvn-libs-directory* (find-mvn-libs))) (unless (and *mvn-libs-directory* (probe-file *mvn-libs-directory*)) - (error "You must download maven-3.0.4 or later from http://maven.apache.org/download.html, then set ABCL-ASDF:*MVN-DIRECTORY* appropiately.")) + (error "Please obtain and install maven-3.0.4 locally from http://maven.apache.org/download.html, then set ABCL-ASDF:*MVN-DIRECTORY* appropiately.")) (unless (ensure-mvn-version) - (error "We need maven-3.0.4 or later.")) (add-directory-jars-to-class-path *mvn-libs-directory* nil) + (error "We need maven-3.0.3 or later.")) (add-directory-jars-to-class-path *mvn-libs-directory* nil) (setf *init* t)) -(defparameter *http-wagon-implementations* - ;;; maven-3.0.3 reported as not working with all needed functionality - `("org.apache.maven.wagon.providers.http.HttpWagon" ;; introduced as default with maven-3.0.4 - "org.apache.maven.wagon.providers.http.LightweightHttpWagon") - "A list of possible candidate implementations that provide access to http and https resources. +(defun find-http-wagon () + "Find an implementation of the object that provides access to http and https resources. -Supposedly configurable with the java.net.protocols (c.f. reference maso2000 in the Manual.)") +Supposedly configurable with the java.net.protocols (c.f. reference +maso2000 in the Manual.)" + (handler-case + ;; maven-3.0.4 + (java:jnew "org.apache.maven.wagon.providers.http.HttpWagon") + (error () + ;; maven-3.0.3 reported as not working with all needed functionality + (java:jnew "org.apache.maven.wagon.providers.http.LightweightHttpWagon")))) (defun make-wagon-provider () "Returns an implementation of the org.sonatype.aether.connector.wagon.WagonProvider contract. @@ -179,7 +183,7 @@ (lambda (role-hint) (cond ((find role-hint '("http" "https") :test #'string-equal) - (some (lambda (provider) (java:jnew provider)) *http-wagon-implementations*)) + (find-http-wagon)) (t (progn (format *maven-verbose* @@ -189,10 +193,16 @@ (lambda (wagon) (declare (ignore wagon))))) +(defun find-service-locator () + (handler-case + (java:jnew "org.apache.maven.repository.internal.MavenServiceLocator") ;; maven-3.0.4 + (error () + (java:jnew "org.apache.maven.repository.internal.DefaultServiceLocator")))) + (defun make-repository-system () (unless *init* (init)) (let ((locator - (java:jnew "org.apache.maven.repository.internal.MavenServiceLocator")) + (find-service-locator)) (wagon-provider-class (java:jclass "org.sonatype.aether.connector.wagon.WagonProvider")) (wagon-repository-connector-factory-class @@ -415,17 +425,13 @@ (let ((result (split-string string ":"))) (cond ((= (length result) 3) - (resolve-dependencies (first result) (second result) (third result))) + (resolve-dependencies + (first result) (second result) (third result))) ((string= string "com.sun.jna:jna") - (resolve-dependencies "net.java.dev.jna" "jna" "3.4.0")) + (warn "Replacing request for no longer available com.sun.jna:jna with net.java.dev.jna:jna") + (resolve-dependencies "net.java.dev.jna" "jna" "LATEST")) (t (apply #'resolve-dependencies result))))) -#+nil -(defmethod resolve ((mvn asdf:mvn)) - (with-slots (asdf::group-id asdf::artifact-id asdf::version) - (asdf:ensure-parsed-mvn mvn) - (resolve-dependencies (format nil "~A:~A:~A" asdf::group-id asdf::artifact-id asdf::version)))) - ;;; Currently the last file listed in ASDF (provide 'abcl-asdf) From mevenson at common-lisp.net Wed Nov 28 14:35:55 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Wed, 28 Nov 2012 06:35:55 -0800 Subject: [armedbear-cvs] r14260 - trunk/abcl/src/org/armedbear/lisp Message-ID: Author: mevenson Date: Wed Nov 28 06:35:49 2012 New Revision: 14260 Log: Restore warning and failure values from CL:COMPILE-FILE. Closes #265. Modified: trunk/abcl/src/org/armedbear/lisp/compile-file.lisp Modified: trunk/abcl/src/org/armedbear/lisp/compile-file.lisp ============================================================================== --- trunk/abcl/src/org/armedbear/lisp/compile-file.lisp Wed Nov 28 03:06:03 2012 (r14259) +++ trunk/abcl/src/org/armedbear/lisp/compile-file.lisp Wed Nov 28 06:35:49 2012 (r14260) @@ -726,7 +726,9 @@ (*class-number* 0) (namestring (namestring *compile-file-truename*)) (start (get-internal-real-time)) - *fasl-uninterned-symbols*) + *fasl-uninterned-symbols* + (warnings-p nil) + (failure-p nil)) (when *compile-verbose* (format t "; Compiling ~A ...~%" namestring)) (with-compilation-unit () @@ -864,7 +866,8 @@ (when *compile-verbose* (format t "~&; Wrote ~A (~A seconds)~%" (namestring output-file) - (/ (- (get-internal-real-time) start) 1000.0)))) ) + (/ (- (get-internal-real-time) start) 1000.0))) + (values (truename output-file) warnings-p failure-p))) (defun compile-file (input-file &key @@ -899,14 +902,13 @@ (exports-file (pathname-with-type output-file "exps")) *toplevel-functions* *toplevel-macros* - *toplevel-exports* - (warnings-p nil) - (failure-p nil)) + *toplevel-exports*) (with-open-file (in input-file :direction :input :external-format external-format) - (compile-from-stream in output-file temp-file temp-file2 - extract-toplevel-funcs-and-macros - functions-file macros-file exports-file)) - (values (truename output-file) warnings-p failure-p)))) + (multiple-value-bind (output-file-truename warnings-p failure-p) + (compile-from-stream in output-file temp-file temp-file2 + extract-toplevel-funcs-and-macros + functions-file macros-file exports-file) + (values (truename output-file) warnings-p failure-p)))))) (defun compile-file-if-needed (input-file &rest allargs &key force-compile &allow-other-keys) From mevenson at common-lisp.net Wed Nov 28 18:48:10 2012 From: mevenson at common-lisp.net (mevenson at common-lisp.net) Date: Wed, 28 Nov 2012 10:48:10 -0800 Subject: [armedbear-cvs] r14261 - trunk/abcl/contrib/quicklisp Message-ID: Author: mevenson Date: Wed Nov 28 10:48:10 2012 New Revision: 14261 Log: abcl-contrib> QUICKLISP-ABCL now installs Quicklisp from the REPL. Use via (dolist (system (:abcl-contrib :quicklisp-abcl)) (require system)) Modified: trunk/abcl/contrib/quicklisp/quicklisp-abcl.asd Modified: trunk/abcl/contrib/quicklisp/quicklisp-abcl.asd ============================================================================== --- trunk/abcl/contrib/quicklisp/quicklisp-abcl.asd Wed Nov 28 06:35:49 2012 (r14260) +++ trunk/abcl/contrib/quicklisp/quicklisp-abcl.asd Wed Nov 28 10:48:10 2012 (r14261) @@ -19,9 +19,15 @@ (user-homedir-pathname)))) (if (probe-file quicklisp-init) (load quicklisp-init) - (progn - (load "http://beta.quicklisp.org/quicklisp.lisp") - (funcall (intern "INSTALL" "QUICKLISP-QUICKSTART")))))) + (handler-case + (load "https://beta.quicklisp.org/quicklisp.lisp") + (error (e) + (warn "Using insecure transport for remote installation + of Quicklisp:~&~A~&." e) + (load "http://beta.quicklisp.org/quicklisp.lisp")))) + (unless (find-package :quicklisp) + (funcall (intern "INSTALL" "QUICKLISP-QUICKSTART"))))) +

FAQ: ABCL - Common Lisp on the JVM

ABCL Testimonials

Testimonials