Commit f07ce646 authored by Dave Cooper's avatar Dave Cooper
Browse files

Starting to remove unneeded clutter.

parent ff5b2c3c
......@@ -29,10 +29,6 @@
#+allegro (mapcar #'(lambda(pair) (intern (first pair) :keyword)) excl::*autoload-package-name-alist*)
)))
#-(or allegro lispworks sbcl ccl) (error "Need implementation for package-documentation for the currently running Lisp.~%")
(defun package-documentation (package)
#+(or allegro lispworks ccl) (documentation (find-package package) t)
#+sbcl (sb-kernel:package-doc-string (find-package package)))
#-(or allegro lispworks sbcl cmu ccl) (error "Need implementation for function-documentation for the currently running Lisp.~%")
......
(defsystem #:gdl-yadd
:description
"Auto-generated asdf defsys from Genworks GDL cl-lite."
:author
"Genworks and Dave Cooper unless otherwise indicated"
:license
"AGPL unless otherwise indicated"
:serial
t
:version
"2013031000"
:depends-on
(:gdl-gwl-graphics)
(defsystem #:yadd :description
"Auto-generated asdf defsys from Genworks GenDL cl-lite. Please avoid hand-editing."
:author "Dave Cooper and Genworks International" :license
"Gnu Affero General Public License (please see http://www.gnu.org/licenses/)"
:serial t :version "20130314" :depends-on (:gwl-graphics)
:components
((:file "source/package") (:file "source/genworks")
(:file "source/mixins")
......
(asdf:defsystem #:gdl-base :description
(asdf:defsystem #:base :description
"Auto-generated asdf defsys from Genworks GDL cl-lite."
:author
"Genworks and Dave Cooper unless otherwise indicated"
......@@ -8,7 +8,7 @@
:components
((:file "common/package")
(:file "common/genworks")
(:file "common/start-gdl")
(:file "common/start-gendl")
(:file "prereqs/source/parameters")
(:file "prereqs/source/metaclasses")
(:file "prereqs/source/utilities")
......
......@@ -35,16 +35,16 @@
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun set-genworks-source-home-if-known ()
(when (find-package :asdf)
(multiple-value-bind (gdl-base-home error)
(ignore-errors (funcall (read-from-string "asdf:system-source-directory") "gdl-base"))
(multiple-value-bind (base-home error)
(ignore-errors (funcall (read-from-string "asdf:system-source-directory") "base"))
(if (typep error 'error)
(warn "~&ASDF is loaded, but :gdl-base is not registered. glisp:*genworks-source-home* remains unknown and set to nil.~%")
(warn "~&ASDF is loaded, but :base is not registered. glisp:*genworks-source-home* remains unknown and set to nil.~%")
(setq *genworks-source-home*
(make-pathname :name nil
:type nil
:directory (butlast
(butlast (pathname-directory gdl-base-home)))
:defaults gdl-base-home)))))))
(butlast (pathname-directory base-home)))
:defaults base-home)))))))
(set-genworks-source-home-if-known)
......@@ -77,6 +77,9 @@
(progn (warn "Don't know how to get executable-homedir-pathname on ~a! Please find out.~%"
(lisp-implementation-type)) nil))
(defparameter *gendl-program-home* *gdl-program-home*)
(defparameter *gdl-home* #-abcl
(make-pathname :name nil
:type nil
......@@ -86,6 +89,8 @@
(progn (warn "Don't know how to get *gdl-home* on ABCL! Please find out.~%")
nil))
(defparameter *gendl-home* *gdl-home*)
;;
;; FLAG -- bind these redefinitions more precisely/surgically. for
......@@ -269,6 +274,14 @@
#+ccl :weak #+ccl :key #+ccl :test #+ccl #'eq
args))
#-(or allegro lispworks sbcl ccl)
(error "Need implementation for package-documentation for the currently running Lisp.~%")
(defun package-documentation (package)
#+(or allegro lispworks ccl) (documentation (find-package package) t)
#+sbcl (sb-kernel:package-doc-string (find-package package)))
(defun set-default-float-format ()
#+allegro (tpl:setq-default *read-default-float-format* 'double-float)
#+ccl (ccl::def-standard-initial-binding *read-default-float-format* 'double-float)
......@@ -409,16 +422,3 @@
,@body)))
;;
;; ASDF extensions -- depends on asdf being there, have to swap this
;; out if moving to new system definition system.
;;
;; FLAG have to initialize these if loading asdf into a pre-built image
;; which started out sans asdf.
;;
#+nil
(defclass asdf::gdl (asdf::cl-source-file) ((type :initform "gdl")))
#+nil
(defclass asdf::gendl (asdf::cl-source-file) ((type :initform "gendl")))
#+nil
(defclass asdf::lisp (asdf::cl-source-file) ())
......@@ -32,8 +32,9 @@ If you are interested in this effort we would love to hear from you at open-sour
" (lisp-implementation-type)))
(defpackage :gdl
(:documentation "General-purpose Declarative Language")
(defpackage :gendl
(:nicknames :gdl :genworks)
(:documentation "General-purpose Declarative Language (Gendl)")
(:use :common-lisp)
(:shadow #:the)
(:export #:%bottom-margin%
......@@ -194,7 +195,7 @@ If you are interested in this effort we would love to hear from you at open-sour
#:read-snapshot
#:readable-expression
;;#:record-source-file
#:register-asdf-systems
#:register-init-function
#:remote-object
#:remove-plist-key
#:remove-plist-entry
......@@ -216,7 +217,9 @@ If you are interested in this effort we would love to hear from you at open-sour
#:split
#:standard-query
#:start-gdl
#:start-gendl
#:start-gdl-runtime
#:start-gendl-runtime
#:status-message
#:string-append
#:sum-elements
......@@ -232,6 +235,7 @@ If you are interested in this effort we would love to hear from you at open-sour
#:undefine-object
#:update
#:update-gdl
#:update-gendl
#:vanilla-mixin
#:vanilla-mixin*
#:vanilla-remote
......@@ -259,123 +263,132 @@ If you are interested in this effort we would love to hear from you at open-sour
(:nicknames :glisp)
(:import-from #+(or allegro abcl) :mop #+lispworks :hcl #+sbcl :sb-mop #+ccl :ccl #+(or ecl clisp) :clos
#:validate-superclass)
(:export #:*external-text-format*
#:*gdl-home*
#:*gdl-program-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
#:ensure-string
#:eql-specializer
#:executable-homedir-pathname
#:featurep
#:find-feature-version
#:gl-class-name
#:gl-method-specializers
#:hex-string-to-integer
#:intern
#:make-sans-value-equalp-hash-table
#:make-sans-value-hash-table
#:make-weak-hash-table
#:make-versioned-features
#:set-default-float-format
#:set-default-package
#:set-defpackage-behavior
#:set-local-compiler-tweaks
#:set-features
#:set-settings
#:set-window-titles
#:source-pathname
#:system-home
#:set-genworks-source-home-if-known
#:upcase
#:validate-superclass
#:with-definition-unit
#:without-package-variance-warnings
#:w-o-interrupts
#:xref-off
#:xref-on
(:export
;;
;; Implemented in gdl/base/common/genworks.lisp.
;;
#:*external-text-format*
#:*gdl-home*
#:*gendl-home*
#:*gdl-program-home*
#:*gendl-program-home*
#:*genworks-source-home*
#:*gendl-source-home*
#:*gdl-source-home*
#:basic-command-line-arguments
#:begin-redefinitions-ok
#:current-directory
#:define-constant
#:direct-superclasses
#:direct-superclass-names
#:display-startup-banner
#:end-redefinitions-ok
#:ensure-string
#:eql-specializer
#:executable-homedir-pathname
#:featurep
#:find-feature-version
#:gl-class-name
#:gl-method-specializers
#:hex-string-to-integer
#:intern
#:make-sans-value-equalp-hash-table
#:make-sans-value-hash-table
#:make-weak-hash-table
#:make-versioned-features
#:set-default-float-format
#:set-default-package
#:set-defpackage-behavior
#:set-local-compiler-tweaks
#:set-features
#:set-settings
#:set-window-titles
#:source-pathname
#:system-home
#:set-genworks-source-home-if-known
#:upcase
#:validate-superclass
#:with-definition-unit
#:without-package-variance-warnings
#:w-o-interrupts
#:xref-off
#:xref-on
;;
;; Implemented in gdl/cl-lite/source/genworks.lisp.
;;
#:*fasl-extension*
#:concatenate-fasls
#:directory-list
#:file-directory-p
#:temporary-folder
#:temporary-file
;;
;; Implemented in gdl/geom-base/prereqs/source/genworks.lisp
;;
#:find-gs-path
#:get-pid
#:run-gs
#:set-gs-path
#:run-program
#:run-shell-command
;;
;; Implemented in gdl/gwl/source/genworks.lisp
;;
#:*enable-utf8?*
#:*base64-encode-func*
#:*base64-decode-func*
#:class-slots
#:gc-full
#:get-backtrace
#:initialize-multiprocessing
#:local-port
#:match-regexp
#:patches-dir
#:process-run-function
#:remote-host
#:replace-regexp
#:room-report
#:slot-definition-name
#:socket-bytes-written
#:split-regexp
#:with-heuristic-case-mode
#:with-timeout-sym
;;
;; Implemented in regression/utils/source/genworks.lisp
;;
#:close-old-areas
#:open-old-areas
#:get-mem-info
#:gc-scavenge
;;
;; Implemented in build/source/genworks.lisp
;;
#:copy-directory
#:copy-file
#:delete-directory-and-files
#:dump-memory
#:implementation-identifier
#:make-gdl-app
#:next-datestamp
;;
;; Implemented in gdl/apps/yadd/source/genworks.lisp
;;
#:autoloaded-packages
#:package-documentation
#:function-documentation
#:variable-documentation
;;
;; Implemented in gdl/cl-lite/source/genworks.lisp.
;;
#:*fasl-extension*
#:concatenate-fasls
#:directory-list
#:file-directory-p
#:temporary-folder
#:temporary-file
;;
;; Implemented in gdl/geom-base/prereqs/source/genworks.lisp
;;
#:find-gs-path
#:get-pid
#:run-gs
#:set-gs-path
#:run-program
#:run-shell-command
;;
;; Implemented in gdl/gwl/source/genworks.lisp
;;
#:*enable-utf8?*
#:*base64-encode-func*
#:*base64-decode-func*
#:class-slots
#:gc-full
#:get-backtrace
#:initialize-multiprocessing
#:local-port
#:match-regexp
#:patches-dir
#:process-run-function
#:remote-host
#:replace-regexp
#:room-report
#:slot-definition-name
#:socket-bytes-written
#:split-regexp
#:with-heuristic-case-mode
#:with-timeout-sym
;;
;; Implemented in regression/utils/source/genworks.lisp
;;
#:close-old-areas
#:open-old-areas
#:get-mem-info
#:gc-scavenge
;;
;; Implemented in build/source/genworks.lisp
;;
#:copy-directory
#:copy-file
#:delete-directory-and-files
#:dump-memory
#:implementation-identifier
#:make-gdl-app
#:make-gendl-app
#:next-datestamp
;;
;; Implemented in gdl/apps/yadd/source/genworks.lisp
;;
#:autoloaded-packages
#:package-documentation
#:function-documentation
#:variable-documentation
;;
;; Implemented in gdl/apps/translators/xml/source/genworks.lisp
;;
#:parse-xml
))
;;
;; Implemented in gdl/apps/translators/xml/source/genworks.lisp
;;
#:parse-xml
))
(defpackage :geom-base
(:use :common-lisp :gdl)
......
......@@ -22,17 +22,39 @@
(in-package :gdl)
(defparameter *gdl-init-functions* nil)
(defparameter *init-functions* nil)
(defun start-gdl (&key edition)
(mapc #'(lambda(function)
(funcall function :edition edition))
(reverse *gdl-init-functions*))
(startup-banner)
(load-gdl-init-files)
(defun register-init-function (function-symbol)
(unless (symbolp function-symbol)
(error "~&register-init-function only accepts a symbol which names a function (i.e. is fboundp).~%"))
(unless (fboundp function-symbol)
(warn "~&register-init-function was called with unbound function ~s.~%" function-symbol))
(format t "Registering ~s. Init functions now contain ~s.~%" function-symbol *init-functions*)
(setq *init-functions* (append *init-functions* (list function-symbol)))
*init-functions*)
;;
;; FLAG -- each initialize function should return nil or non-nil based
;; on its local anything-changed?. Consider collecting and reporting
;; those results here.
;;
(defun start-gendl ()
(dolist (package (list :gdl :geom-base :gwl))
(when (find-package package)
(let ((function-sym (read-from-string (format nil "~a::initialize" package))))
(when (fboundp function-sym)
(let ((description (glisp:package-documentation package)))
(format t "~&Initializing ~a (~a) subsystem...~%~%" description package)
(let ((anything-changed? (funcall function-sym)))
(format t "~&...Generative ~a (~a) subsystem initializaton is complete.~a~%~%"
description package (if anything-changed? ""
(format nil "~% (no new global settings).")))))))))
(startup-banner) (load-gdl-init-files) (values))
(values))
(defun load-gdl-init-files (&key edition)
(declare (ignore edition))
......@@ -55,11 +77,9 @@
(defun startup-banner (&key edition)
(glisp:display-startup-banner edition
"
Copyright 2013 Genworks International
This is the General-purpose Declarative Language (GenDL).
Welcome to Gendl(TM).
This program contains free software: you can redistribute it
and/or modify it under the terms of the GNU Affero General Public
......@@ -75,16 +95,7 @@
License along with the source code for this program. If not, see:
http://www.gnu.org/licenses/
-----
Note that you may have received Gendl under supplemental licensing
terms, e.g. Proprietary or Trial/Evaluation. The terms of such a
dual-license, and information about whether they do or do not
override the AGPL, were printed at the initial startup of your
session. Please contact Genworks if you have any uncertainty about
licensing terms beyond those in the AGPL.
"))
......@@ -92,29 +103,21 @@
;; FLAG -- do some of these at beginning of bootstrapping, others
;; defer until end of loading everything.
;;
(defun initialize ()
(defun initialize-gdl (&key edition)
(declare (ignore edition))
(declare (ignore edition))
(setq glisp:*gdl-program-home* (glisp:executable-homedir-pathname))
(setq glisp:*gdl-home* (make-pathname :name nil
:type nil
:directory (butlast (pathname-directory glisp:*gdl-program-home*))
:defaults glisp:*gdl-program-home*))
(glisp:set-genworks-source-home-if-known)
(glisp:set-default-float-format)
(glisp:set-defpackage-behavior)
(glisp:set-default-package)
(glisp:xref-off)
(glisp:set-window-titles))
(pushnew #'initialize-gdl *gdl-init-functions*)
(glisp:set-default-float-format)
(glisp:set-defpackage-behavior)
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