Commit 0b05e5ee authored by Teodor Gelu Chiciudean's avatar Teodor Gelu Chiciudean
Browse files

Merge remote-tracking branch 'upstream/master'

parents 6a2f0076 0bdb2e2f
......@@ -114,6 +114,7 @@ temporary directory, returned by <tt>(glisp:temporary-folder)</tt>."
(setq glisp:*gdl-home* (glisp:current-directory))
(setq glisp:*genworks-source-home* (merge-pathnames "src/" glisp:*gdl-home*))
(setq ql:*quicklisp-home* (merge-pathnames "quicklisp/" glisp:*gdl-home*))
(asdf:initialize-output-translations)
(gdl:start-gdl :edition :trial)
(glisp:set-gs-path (merge-pathnames "gpl/gs/gs8.63/bin/gswin32c.exe" glisp:*gdl-home*))))
......
......@@ -44,8 +44,9 @@
(dolist (entry (glisp:directory-list (the staging-directory)) (nreverse result))
(when (glisp:file-directory-p entry)
(let* ((full-name (lastcar (pathname-directory entry)))
(base (subseq full-name 0 (- (length full-name)
(length "-2011010100")))))
(base (when (>= (length full-name)(length "-2011010100"))
(subseq full-name 0 (- (length full-name)
(length "-2011010100"))))))
(when (member base (the known-releases) :test #'string-equal)
(push (cons entry
(merge-pathnames (format nil "~a/~a~a/program/"
......@@ -127,12 +128,16 @@
;; smlib shared library
;;
(ensure-directories-exist (merge-pathnames "SMLib8.18/" (the target-parent)))
(glisp:copy-file (merge-pathnames (format nil "../../common/SMLib8.18/~a" (glisp:smlib-name))
glisp:*genworks-source-home*)
(merge-pathnames (format nil "SMLib8.18/~a" (glisp:smlib-name))
(the target-parent)))
(ensure-directories-exist (merge-pathnames "SMLib8.40/" (the target-parent)))
(let ((smlib-name (if (find-package :smlib) (funcall (read-from-string "glisp:smlib-name"))
(error "smlib-name not known (smlib module probably not loaded)."))))
(glisp:copy-file (merge-pathnames (format nil "../../common/SMLib8.40/libs/~a/~a"
#+linux "linux"
#+mswindows "windows"
#+macosx "macos" smlib-name)
glisp:*genworks-source-home*)
(merge-pathnames (format nil "SMLib8.40/~a" smlib-name)
(the target-parent))))
;;
;; gpl on windows
;;
......
......@@ -19,7 +19,7 @@
;; <http://www.gnu.org/licenses/>.
;;
(in-package :user)
(in-package :gdl-user)
(gwl:define-package :genworks.demos.bus
(:nicknames :bus) (:export #:assembly #:fleet))
......
(in-package :user)
(in-package :gdl-user)
(gwl:define-package :ledger (:export #:assembly #:html-assembly))
......
......@@ -18,5 +18,6 @@
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(in-package :gdl-user)
(gwl:define-package :robot (:export #:assembly))
This diff is collapsed.
......@@ -3,14 +3,25 @@ cd `dirname "$0"`
export os_platform=`uname`
export cl_platform=''
export cl_platform=""
if [ "$1" == "sbcl" ]; then
cl_platform='SBCL'
fi
if [ "$os_platform" == "Linux" ]; then
cl_platform='Allegro'
emacs --no-splash --no-init-file -l devo.el $@
if [ "$cl_platform" == "" ]; then
cl_platform='Allegro'
fi
emacs --no-splash --no-init-file -l devo.el
elif [ "$os_platform" == "Darwin" ]; then
cl_platform='LispWorks'
/Applications/Emacs.app/Contents/MacOS/Emacs --no-splash --no-init-file -l devo.el $@
if [ "$cl_platform" == "" ]; then
cl_platform='LispWorks'
fi
/Applications/Emacs.app/Contents/MacOS/Emacs --no-splash --no-init-file -l devo.el
fi
......@@ -6,17 +6,29 @@
;; FLAG -- learn how to add command line args to inferior-lisp-program
;; to load load.lisp for Genworks GDL automatically.
;;
(setq slime-lisp-implementations
(cond ((and (string= (getenv "cl_platform") "LispWorks")
(string= (getenv "os_platform") "Darwin"))
'((lw60-macosx-x86 ("../../common/lw60-macosx-x86/lw-console"))))
'((lw60-macosx-x86 ("../../common/lw60-macosx-x86/lw-console"))
(sbcl-1.0.52-x86-64-darwin ("sbcl"))))
((and (string= (getenv "cl_platform") "SBCL")
(string= (getenv "os_platform") "Darwin"))
'((sbcl-1.0.52-x86-64-darwin ("sbcl"))
(lw60-macosx-x86 ("../../common/lw60-macosx-x86/lw-console"))))
((and (string= (getenv "cl_platform") "Allegro")
(string= (getenv "os_platform") "Linux"))
'((acl82m-linux-x86 ("../../common/acl82-linux-x86/mlisp"))
(acl82a-linux-x86 ("../../common/acl82-linux-x86/alisp"))
(sbcl-1.0.50.0.debian ("sbcl"))))
((and (string= (getenv "cl_platform") "SBCL")
(string= (getenv "os_platform") "Linux"))
'((sbcl-1.0.50.0.debian ("sbcl"))
(acl82m-linux-x86 ("../../common/acl82-linux-x86/mlisp"))
(acl82a-linux-x86 ("../../common/acl82-linux-x86/alisp"))))
(t '((acl82m-win-x86 ("../../common/acl82-win-x86/mlisp.exe"))
(acl82a-win-x86 ("../../common/acl82-win-x86/alisp.exe"))))))
(t (error (concat "Unknown OS/Lisp combination: "
(getenv "os_platform")
(getenv "cl_platform"))))))
(slime-setup '(slime-fancy))
......
......@@ -6,7 +6,8 @@
:license "AGPL unless otherwise indicated" :serial t
:version "2011102100" :depends-on (:gdl-gwl-graphics)
:components
((:file "source/package") (:file "source/mixins")
((:file "source/package") (:file "source/genworks")
(:file "source/mixins")
(:file "source/assembly") (:file "source/ass")
(:file "source/define-object-documentation")
(:file "source/format-documentation")
......
This diff is collapsed.
......@@ -19,4 +19,4 @@
;; <http://www.gnu.org/licenses/>.
;;
("package" "mixins" "defpart-documentation" "assembly")
("package" "genworks" "mixins" "define-object-documentation" "assembly")
......@@ -36,9 +36,7 @@
(do-symbols (symbol (the :package)
(sort (nreverse result) #'string< :key #'symbol-name))
(when (and (eql (symbol-package symbol) package-object)
#+allegro (get symbol 'excl::%fun-documentation)
#+cmu (documentation symbol 'function)
#+lispworks (get symbol 'system::%fun-documentation))
(glisp:function-documentation symbol))
(push symbol result))))))
(symbols-external (remove-duplicates
(let (result (package-object (the :package-object)))
......@@ -52,9 +50,7 @@
:key
#'symbol-name))
(when (and (eql (symbol-package symbol) package-object)
#+allegro (get symbol 'excl::%fun-documentation)
#+cmu (documentation symbol 'function)
#+lispworks (get symbol 'system::%fun-documentation))
(glisp:function-documentation symbol))
(push symbol result))))))))
......@@ -69,14 +65,8 @@
:computed-slots
((strings-for-display (format nil "~a" (the symbol)))
(doc-string #+allegro (get (the symbol) 'excl::%fun-documentation)
#+cmu (documentation (the symbol) 'function)
#+lispworks (get symbol 'system::%fun-documentation))
(macro? #+allegro (null (typep (symbol-function (the :symbol)) 'function))
#+cmu (macro-function (the symbol))
#+lispworks (macro-function (the symbol))))
(doc-string (glisp:function-documentation symbol))
(macro? (macro-function (the symbol))))
:functions
((write-html-sheet
......
;;
;; Copyright 2002-2011 Genworks International and Genworks BV
;;
;; This source file is part of the General-purpose Declarative
;; Language project (GDL).
;;
;; and/or modify it under the terms of the GNU Affero General Public
;; License as published by the Free Software Foundation, either
;; version 3 of the License, or (at your option) any later version.
;;
;; This source file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;; Affero General Public License for more details.
;;
;; You should have received a copy of the GNU Affero General Public
;; License along with this source file. If not, see
;; <http://www.gnu.org/licenses/>.
;;
(in-package :com.genworks.lisp)
(eval-when (:compile-toplevel :load-toplevel :execute)
(defpackage :com.genworks.lisp
(:use :common-lisp)
(:export #:autoloaded-packages
#:package-documentation
#:function-documentation
#:variable-documentation)))
(defun autoloaded-packages ()
(remove-if-not #'find-package
(append (list :win :windows :regexp)
(remove-duplicates
#-allegro nil
#+allegro (mapcar #'rest excl::*autoload-package-name-alist*)
))))
#-(or allegro lispworks sbcl) (error "Need implementation for package-documentation for the currently running Lisp.~%")
(defun package-documentation (package)
(#+(or allegro lispworks) documentation
#+sbcl sb-kernel:package-doc-string
(find-package package)))
#-(or allegro lispworks sbcl cmu) (error "Need implementation for function-documentation for the currently running Lisp.~%")
(defun function-documentation (function-symbol)
#+allegro (get function-symbol 'excl::%fun-documentation)
#+lispworks (get symbol 'system::%fun-documentation)
#+(or cmu sbcl) (documentation function-symbol 'function))
#-(or allegro lispworks sbcl cmu) (error "Need implementation for variable-documentation for the currently running Lisp.~%")
(defun variable-documentation (function-symbol)
#+allegro (get function-symbol 'excl::%var-documentation)
#+lispworks (get symbol 'system::%var-documentation)
#+(or cmu sbcl) (documentation function-symbol 'variable))
......@@ -35,15 +35,8 @@ link to the favicon.ico and a link to a default CSS sheet. All these elements ca
found in the *gdl-install-dir*/static/gwl/ directories."
default-header-content (html
((:link :href "/static/gwl/images/favicon.ico"
:type "image/x-icon" :rel "icon"))
;;
;; FLAG -- nil'ed out for now, this was causing tiny fonts.
;;
#+nil
((:link :href "/static/gwl/style/tasty-layout.css"
:type "text/css" :rel "stylesheet"))
))
:type "image/x-icon" :rel "icon"))))
("Contains standard jQuery files to include in the header for additional search funcionality.
This computed-slot contains javascript files, found in the *gdl-install-dir*
and used throughout the yadd pages for the generation of automatic search forms (like the master-index).
......
......@@ -19,7 +19,7 @@
;; <http://www.gnu.org/licenses/>.
;;
(in-package :user)
(in-package :common-lisp-user)
(gwl:define-package :yadd
......
......@@ -32,9 +32,7 @@
(do-symbols (symbol (the :package)
(sort (nreverse result) #'string< :key #'symbol-name))
(when (and (eql (symbol-package symbol) package-object)
#+allegro (get symbol 'excl::%var-documentation)
#+cmu (documentation symbol 'variable)
#+lispworks (get symbol 'system::%fun-documentation))
(glisp:variable-documentation symbol))
(push symbol result))))))
(symbols-external (remove-duplicates
(let (result (package-object (the :package-object)))
......@@ -48,13 +46,10 @@
:key
#'symbol-name))
(when (and (eql (symbol-package symbol) package-object)
#+allegro (get symbol 'excl::%var-documentation)
#+cmu (documentation symbol 'variable)
#+lispworks (get symbol 'system::%fun-documentation))
(glisp:variable-documentation symbol))
(push symbol result))))))))
(define-object variable-dokumentation (doc-string-parser-mixin
remark-writers-mixin base-yadd-sheet)
......@@ -65,9 +60,7 @@
(show-package? nil))
:computed-slots
((remark-string #+allegro (get (the symbol) 'excl::%var-documentation)
#+cmu (documentation (the symbol) 'variable)
#+lispworks (get symbol 'system::%fun-documentation)))
((remark-string (glisp:variable-documentation (the symbol))))
:functions
((write-html-sheet
......
......@@ -21,22 +21,26 @@
(in-package :gdl)
#-(or allegro lispworks sbcl) (error "Need package for mop:validate-superclass for currently running lisp.~%")
(eval-when (compile load eval)
(defpackage :com.genworks.lisp
(:use :common-lisp)
(:shadow #:intern)
(:nicknames :glisp)
(:import-from #+allegro :mop #+lispworks :hcl #+sbcl :sb-mop
#:validate-superclass)
(:export #:*external-text-format*
#:*gdl-home*
#:*genworks-source-home*
#:basic-command-line-arguments
#:begin-redefinitions-ok
#:current-directory
#:define-constant
#:direct-superclasses
#:direct-superclass-names
#:display-startup-banner
#:end-redefinitions-ok
#:eql-specializer
#:get-backtrace
#:gl-class-name
#:gl-method-specializers
#:hex-string-to-integer
......@@ -53,8 +57,7 @@
#:w-o-interrupts
#:xref-off
#:xref-on
#:display-startup-banner
)))
#:validate-superclass)))
(in-package :com.genworks.lisp)
......@@ -74,38 +77,52 @@
(defparameter *gdl-home* (merge-pathnames "../../common/" *genworks-source-home*))
#-(or allegro lispworks) (error "Need implementation for command-line-arguments in currently running lisp.~%")
#-(or allegro lispworks sbcl) (error "Need implementation for command-line-arguments in currently running lisp.~%")
(defun basic-command-line-arguments ()
#+allegro (sys:command-line-arguments :application nil)
#+lispworks system:*line-arguments-list*)
#+lispworks system:*line-arguments-list*
#+sbcl sb-ext:*posix-argv*)
#-(or allegro lispworks)
#-(or allegro lispworks sbcl)
(error "Need parameter for redefinition warnings for currently running lisp.~%")
(let ((original-redefinition-warnings
#+allegro excl:*redefinition-warnings*
#+lispworks lw:*redefinition-action*))
(defun begin-redefinitions-ok ()
#+sbcl (declaim (sb-ext:muffle-conditions sb-ext:compiler-note))
#+(or allegro lispworks)
(setq #+allegro excl:*redefinition-warnings*
#+lispworks lw:*redefinition-action* nil))
(defun end-redefinitions-ok ()
#+sbcl (declaim (sb-ext:unmuffle-conditions sb-ext:compiler-note))
#+(or allegro lispworks)
(setq #+allegro excl:*redefinition-warnings*
#+lispworks lw:*redefinition-action* original-redefinition-warnings)))
#-(or allegro lispworks cmu)
#-(or allegro lispworks cmu sbcl)
(error "Need implementation for current-directory for currently running lisp.~%")
(defun current-directory ()
#+allegro (excl:current-directory)
#+lispworks (sys:current-directory)
#+sbcl *default-pathname-defaults*
#+cmu (second (multiple-value-list (unix:unix-current-directory))))
;;
;; From SBCL manual (to avoid redef errors when compiling/loading defconstants in SBCL):
;;
(defmacro define-constant (name value &optional doc)
`(defconstant ,name (if (boundp ',name) (symbol-value ',name) ,value)
,@(when doc (list doc))))
#-(or allegro lispworks)
#-(or allegro lispworks sbcl)
(error "Need implementation for class-direct-superclasses for currently running lisp.~%")
(defun direct-superclasses (class)
"Return a list of the direct superclasses."
(#+allegro mop:class-direct-superclasses
#+lispworks hcl:class-direct-superclasses class))
#+lispworks hcl:class-direct-superclasses
#+sbcl sb-mop:class-direct-superclasses class))
(defun direct-superclass-names (class)
......@@ -113,49 +130,27 @@
(mapcar #'gl-class-name
(direct-superclasses class)))
#-(or allegro lispworks cmu)
#-(or allegro lispworks cmu sbcl)
(error "Need implementation for eql-specializer for currently running lisp.~%")
(defun eql-specializer (attr-sym)
#+allegro (mop:intern-eql-specializer attr-sym)
#+(or lispworks cmu) (list 'eql attr-sym))
#+(or lispworks cmu) (list 'eql attr-sym)
#+sbcl (sb-mop:intern-eql-specializer attr-sym))
;;
;; I believe this is from Hunchentoot:
;;
#-allegro (warn "Need full implementation for get-backtrace for currently running lisp. See Hunchentoot for a cross-platform implementation.~%")
(defun get-backtrace (error)
(with-output-to-string (s)
(with-standard-io-syntax
(let ((*print-readably* nil)
(*print-miser-width* 40)
(*print-pretty* t)
#+allegro(tpl:*zoom-print-circle* t)
#+allegro(tpl:*zoom-print-level* nil)
#+allegro(tpl:*zoom-print-length* nil))
(ignore-errors
(format *terminal-io* "~
~@<An unhandled error condition has been signalled:~3I ~a~I~:@>~%~%"
error))
(ignore-errors
(let ((*terminal-io* s)
(*standard-output* s))
#+allegro(tpl:do-command "zoom"
:from-read-eval-print-loop nil
:count t
:all t)))))))
(defun gl-class-name (class)
"Return the class name."
(#-cmu class-name #+cmu mop:class-name class))
#-(or allegro lispworks cmu)
(error "Need implementation for class-direct-superclasses for currently running lisp.~%")
#-(or allegro lispworks cmu sbcl)
(error "Need implementation for method-specializers for currently running lisp.~%")
(defun gl-method-specializers (method)
"Return a list of method specializers for the given method."
(#+allegro mop:method-specializers
(#+allegro mop:method-specializers
#+lispworks hcl:method-specializers
#+cmu pcl:method-specializers method))
#+cmu pcl:method-specializers
#+sbcl sb-mop:method-specializers method))
(defun hex-string-to-integer (string)
......@@ -188,11 +183,13 @@
#-allegro (make-hash-table)))
#-(or allegro lispworks) (error "Need implementation for make-weak-hash-table for currently running lisp.~%")
#-(or allegro lispworks sbcl) (error "Need implementation for make-weak-hash-table for currently running lisp.~%")
(defun make-weak-hash-table (&rest args)
(apply #'make-hash-table #+allegro :weak-keys #+allegro t
(apply #'make-hash-table
#+allegro :weak-keys #+allegro t
#+allegro :values #+allegro :weak
#+lispworks :weak-kind #+lispworks t
#+sbcl :weakness #+sbcl :key-or-value
args))
(defun set-default-float-format ()
......@@ -220,9 +217,6 @@
(excl:console-control :title "Genworks GDL Console")
(retitle-emacs))
#-allegro
(warn "Find out how to retitle Emacs window in currently running environment.")
(defun retitle-emacs (&key (title "Genworks GDL Interactive Authoring Environment"))
"Retitles the associated GDL emacs window with the specified title.
......@@ -244,14 +238,20 @@
(defmacro w-o-interrupts (&body body)
(warn "Without-interrupts is deprecated in multiprocessing Lisp - replace usage with something else.")
#-(or allegro lispworks cmu) (error "Need implementation for without-interrupts for currently running lisp.~%")
#-(or allegro lispworks cmu sbcl) (error "Need implementation for without-interrupts for currently running lisp.~%")
`(#+allegro excl:without-interrupts
#+lispworks progn
#+cmu system:without-interrupts
#+sbcl sb-sys:without-interrupts
,@body))
#-(or allegro lispworks)
#-(or allegro lispworks)
(warn "Need implementation for xref-off for the currently running lisp.~%")
#-(or allegro lispworks)
(defun xref-off (&optional include-source-info?)
(declare (ignore include-source-info?))
(warn "Need implementation for xref-off for the currently running lisp.~%"))
#+(or allegro lispworks)
(defun xref-off (&optional include-source-info?)
(when include-source-info?
(setq #+allegro excl:*load-source-file-info*
......@@ -269,6 +269,11 @@
#-(or allegro lispworks)
(warn "Need implementation for xref-off for the currently running lisp.~%")
#-(or allegro lispworks)
(defun xref-on (&optional include-source-info?)
(declare (ignore include-source-info?))
(warn "Need implementation for xref-off for the currently running lisp.~%"))
#+(or allegro lispworks)
(defun xref-on (&optional include-source-info?)
(when include-source-info?
......
......@@ -28,7 +28,6 @@
(:file "rest/source/vanilla-mixin")
(:file "rest/source/base-rule-object")
(:file "rest/source/bodies")
(:file "rest/source/ignore-errors-with-backtrace")
(:file "rest/source/init")
(:file "rest/source/make-part")
(:file "rest/source/null-part")
......
......@@ -68,6 +68,6 @@
(defclass gdl-skin-class (standard-class) ())
(defmethod validate-superclass ((class gdl-class) (superclass standard-class)) t)
(defmethod validate-superclass ((class gdl-format-class) (superclass standard-class)) t)
(defmethod validate-superclass ((class gdl-skin-class) (superclass standard-class)) t)
(defmethod glisp:validate-superclass ((class gdl-class) (superclass standard-class)) t)
(defmethod glisp:validate-superclass ((class gdl-format-class) (superclass standard-class)) t)
(defmethod glisp:validate-superclass ((class gdl-skin-class) (superclass standard-class)) t)
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment