[graphic-forms-cvs] r28 - in trunk/src/third-party: . lw-compat
junrue at common-lisp.net
junrue at common-lisp.net
Sun Mar 5 23:36:31 UTC 2006
Author: junrue
Date: Sun Mar 5 18:36:30 2006
New Revision: 28
Added:
trunk/src/third-party/
trunk/src/third-party/lw-compat/
trunk/src/third-party/lw-compat/lw-compat-package.lisp
trunk/src/third-party/lw-compat/lw-compat.asd
trunk/src/third-party/lw-compat/lw-compat.lisp
Log:
added local copy of lw-compat lib written by Pascal Costanza
Added: trunk/src/third-party/lw-compat/lw-compat-package.lisp
==============================================================================
--- (empty file)
+++ trunk/src/third-party/lw-compat/lw-compat-package.lisp Sun Mar 5 18:36:30 2006
@@ -0,0 +1,34 @@
+;;;;
+;;;; Copyright (c) 2005 Pascal Costanza
+;;;; with permission from http://www.lispworks.com
+;;;;
+;;;; Permission is hereby granted, free of charge, to any person
+;;;; obtaining a copy of this software and associated documentation
+;;;; files (the \"Software\"), to deal in the Software without
+;;;; restriction, including without limitation the rights to use,
+;;;; copy, modify, merge, publish, distribute, sublicense, and/or
+;;;; sell copies of the Software, and to permit persons to whom the
+;;;; Software is furnished to do so, subject to the following
+;;;; conditions:
+;;;;
+;;;; The above copyright notice and this permission notice shall be
+;;;; included in all copies or substantial portions of the Software.
+;;;;
+;;;; THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND,
+;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+;;;; OTHER DEALINGS IN THE SOFTWARE.
+;;;;
+
+;;; (in-package :cl-user)
+(in-package #:graphic-forms-system)
+
+#-lispworks
+(defpackage #:lispworks
+ (:use #:common-lisp)
+ (:export #:appendf #:nconcf #:rebinding #:removef
+ #:when-let #:when-let* #:with-unique-names))
Added: trunk/src/third-party/lw-compat/lw-compat.asd
==============================================================================
--- (empty file)
+++ trunk/src/third-party/lw-compat/lw-compat.asd Sun Mar 5 18:36:30 2006
@@ -0,0 +1,36 @@
+(in-package :cl-user)
+
+(asdf:defsystem #:lw-compat
+ :name "LispWorks Compatibility Library"
+ :author "Pascal Costanza, with permission from http://www.lispworks.com"
+ :version "0.2"
+ :licence "
+Copyright (c) 2005 Pascal Costanza
+with permission from http://www.lispworks.com
+
+Permission is hereby granted, free of charge, to any person
+obtaining a copy of this software and associated documentation
+files (the \"Software\"), to deal in the Software without
+restriction, including without limitation the rights to use,
+copy, modify, merge, publish, distribute, sublicense, and/or
+sell copies of the Software, and to permit persons to whom the
+Software is furnished to do so, subject to the following
+conditions:
+
+The above copyright notice and this permission notice shall be
+included in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+OTHER DEALINGS IN THE SOFTWARE.
+"
+ :components (#-lispworks
+ (:file "lw-compat-package")
+ #-lispworks
+ (:file "lw-compat"
+ :depends-on ("lw-compat-package"))))
Added: trunk/src/third-party/lw-compat/lw-compat.lisp
==============================================================================
--- (empty file)
+++ trunk/src/third-party/lw-compat/lw-compat.lisp Sun Mar 5 18:36:30 2006
@@ -0,0 +1,76 @@
+;;;;
+;;;; Copyright (c) 2005 Pascal Costanza
+;;;; with permission from http://www.lispworks.com
+;;;;
+;;;; Permission is hereby granted, free of charge, to any person
+;;;; obtaining a copy of this software and associated documentation
+;;;; files (the \"Software\"), to deal in the Software without
+;;;; restriction, including without limitation the rights to use,
+;;;; copy, modify, merge, publish, distribute, sublicense, and/or
+;;;; sell copies of the Software, and to permit persons to whom the
+;;;; Software is furnished to do so, subject to the following
+;;;; conditions:
+;;;;
+;;;; The above copyright notice and this permission notice shall be
+;;;; included in all copies or substantial portions of the Software.
+;;;;
+;;;; THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND,
+;;;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+;;;; OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
+;;;; NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
+;;;; HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+;;;; WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+;;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
+;;;; OTHER DEALINGS IN THE SOFTWARE.
+;;;;
+
+(in-package #:lispworks)
+
+#+lispworks
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (error "lw-compat is not needed in LispWorks."))
+
+(define-modify-macro appendf (&rest lists)
+ append "Appends lists to the end of given list.")
+
+(define-modify-macro nconcf (&rest lists)
+ nconc "Appends lists to the end of given list by NCONC.")
+
+(defmacro rebinding (vars &body body)
+ "Ensures unique names for all the variables in a groups of forms."
+ (loop for var in vars
+ for name = (gensym (symbol-name var))
+ collect `(,name ,var) into renames
+ collect ``(,,var ,,name) into temps
+ finally (return `(let ,renames
+ (with-unique-names
+ ,vars
+ `(let (,, at temps)
+ ,, at body))))))
+
+(define-modify-macro removef (item &rest keys)
+ (lambda (place item &rest keys &key test test-not start end key)
+ (declare (ignorable test test-not start end key))
+ (apply #'remove item place keys))
+ "Removes an item from a sequence.")
+
+(defmacro when-let ((var form) &body body)
+ "Executes a body of code if a form evaluates to non-nil,
+ propagating the result of the form through the body of code."
+ `(let ((,var ,form))
+ (when ,var
+ (locally
+ , at body))))
+
+(defmacro when-let* (bindings &body body)
+ "Executes a body of code if a series of forms evaluates to non-nil,
+ propagating the results of the forms through the body of code."
+ (loop for form = `(progn , at body) then `(when-let (,(car binding) ,(cadr binding)) ,form)
+ for binding in (reverse bindings)
+ finally (return form)))
+
+(defmacro with-unique-names (names &body body)
+ "Returns a body of code with each specified name bound to a similar name."
+ `(let ,(mapcar (lambda (name) `(,name (gensym ,(symbol-name name))))
+ names)
+ , at body))
More information about the Graphic-forms-cvs
mailing list