Commit 5df9fe64 authored by Dave Cooper's avatar Dave Cooper

Merge branch 'release/1592'

parents 3cf4a885 3ecc4eba
......@@ -4,6 +4,7 @@
*.fas
*.xfasl
*.dx64fsl
*.wx64fsl
*.64xfasl
*.lib
bin
......
......@@ -105,10 +105,10 @@ loading Glime and Gendl into an emacs environment.
### Further Documentation
Documentation is published
[here](http://genworks.com/downloads/tutorial.pdf), and this very much
[here](http://gen.works/downloads/tutorial.pdf), and this very much
an active work in progress. Training tutorials and videos are also in
progress and in their current state are available in the Documentation
section on http://genworks.com.
section on http://gen.works.
### Support/Community
......@@ -123,7 +123,7 @@ section on http://genworks.com.
* Genworks would like to begin hosting free Gendl/GDL training
seminars in Metro Detroit and possibly other locations. Please
contact [Genworks](http://genworks.com) if you are interested in
contact [Genworks](http://gen.works) if you are interested in
being notified of any upcoming seminars.
......@@ -188,7 +188,7 @@ without the SMLib library and associated middleware available, they
will not be able to return any results. The SMLib kernel and
associated middleware are available as part of the commercial
Genworks® GDL product from [Genworks®
International](http://genworks.com).
International](http://gen.works).
### License
......@@ -205,21 +205,20 @@ distributed at all).
For Proprietary (closed-source) development and distribution, the
commercial Genworks® GDL system (including Gendl® technology and,
optionally, commercial CL engines, technical support, and commercial
solid modeling engine) is available from [Genworks](http://genworks.com).
solid modeling engine) is available from [Genworks](http://gen.works).
### Bug Bounty Program, Bug Fix Program
Genworks offers a modest bounty for reporting (and sometimes solving)
of bugs on the [Issues
List](https://gitlab.common-lisp.net/gendl/gendl/issues?scope=all&state=opened).
Please contact [Genworks](http://gen.works) for details.
### Bug Bounty Program
Genworks offers a modest bounty for reporting of bugs on the [Github
Issues
List](https://github.com/genworks/gendl/issues?state=open). Please
contact [Genworks](http://genworks.com) for details.
### Bug Fix Program
Genworks is open to considering bids for providing cleanly mergeable
fixes to bugs listed on the [Github Issues
List](https://github.com/genworks/gendl/issues?state=open). Please
contact [Genworks](http://genworks.com) for details.
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:dom :description
"The Gendl\" dom Subsystem" :author "John McCarthy" :license
"The Gendl® dom Subsystem" :author "Genworks International" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20160808" :depends-on (:cl-who :yadd)
:version "20170524" :depends-on (:cl-who :yadd)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-unicode :defsystem-depends-on #+asdf-unicode nil
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "base/source/package") (:file "base/source/assembly")
......
......@@ -29,6 +29,8 @@
(defparameter *index-hash* nil)
(defparameter *footnotes* nil)
(defparameter *footnotetext* nil)
(defparameter *debug-index* nil)
(define-lens (html-format assembly) ()
......@@ -53,12 +55,32 @@
(with-cl-who ()
(:html (:head (:title (str (the title)))
((:link :href (the style-url) :rel "stylesheet" :type "text/css")))
(let ((*index-hash* (make-hash-table :test #'equalp)))
(let ((*index-hash* (make-hash-table :test #'equalp))
(*footnotes* (make-array 50 :adjustable t :fill-pointer 0))
(*footnotetext* nil))
(htm
(:body (:div (write-the cl-who-contents-out))
(:div (write-the cl-who-base))
(when *footnotetext*
(htm (:div (:hr)
(dolist (elements *footnotetext*)
(htm (:p (dolist (element (list-elements elements))
(write-the-object element cl-who-base))))))))
(when (> (length *footnotes*) 0)
(htm (:div (write-the cl-who-footnotes))))
(:div (write-the cl-who-index))))))))
(cl-who-footnotes
()
(with-cl-who ()
(:p (:h2 "Footnotes"))
(loop for elements across *footnotes* as index upfrom 1
do (htm
(:p "[" (:a :name (format nil "FtNt~d" index) :href (format nil "#FtNtR~d" index)
(fmt "~d" index))
"] "
(dolist (element (list-elements elements))
(write-the-object element cl-who-base)))))))
(cl-who-index
()
(with-cl-who ()
......@@ -177,27 +199,70 @@
(dolist (element (list-elements (the elements)))
(write-the-object element cl-who-base)))))
(:emph (htm (:i (dolist (element (list-elements (the elements)))
(write-the-object element cl-who-base)))))
((:emph :i) (htm (:i (dolist (element (list-elements (the elements)))
(write-the-object element cl-who-base)))))
(:textbf (htm (:b (dolist (element (list-elements (the elements)))
(write-the-object element cl-who-base)))))
((:textbf :b) (htm (:b (dolist (element (list-elements (the elements)))
(write-the-object element cl-who-base)))))
(:texttt (htm (:tt (dolist (element (list-elements (the elements)))
(write-the-object element cl-who-base)))))
(:underline (htm (:span :style "text-decoration: underline;"
(dolist (element (list-elements (the elements)))
(write-the-object element cl-who-base)))))
(:quote (htm (:blockquote (dolist (element (list-elements (the elements)))
(write-the-object element cl-who-base)))))
(:index (dolist (element (list-elements (the elements)))
(let* ((data (the-object element data))
(anchor-tag (string (gensym)))
(current (gethash data *index-hash*)))
(if current (pushnew anchor-tag current)
(setf (gethash data *index-hash*) (list anchor-tag)))
(htm ((:a :name anchor-tag))
(write-the-object element cl-who-base)))))
(:copyright (htm "©"))
(:rightarrow (htm "→"))
(:$ (htm "$"))
(:textgreater (htm ">"))
(:textasciitilde (htm "˜"))
((:index :indexed)
(dolist (element (list-elements (the elements)))
(let* ((data (the-object element data))
(anchor-tag (string (gensym))))
(push anchor-tag (gethash data *index-hash*))
(htm (:a :name anchor-tag))
(when (eq (the markup-tag) :indexed)
(write-the-object element cl-who-base)))))
(:footnote
(let ((index (1+ (vector-push-extend (the elements) *footnotes*))))
(htm (:a :name (format nil "FtNtR~d" index) :href (format nil "#FtNt~d" index)
(fmt "[~d]" index)))))
(:footnotetext
(push (the elements) *footnotetext*))
((:cite :href)
(let* ((args (list-elements (the elements)))
(target (the-object (car args) data)))
(htm (:a :href (if (eq (the markup-tag) :cite)
(format nil "#~a" target)
target)
(dolist (element (or (cdr args) args))
(write-the-object element cl-who-base))))))
;; :small and :tiny are always used as (:small (:verbatim ...)) and in most browsers,
;; verbatim is already small, so don't do anything.
((:no-op :small :tiny)
(dolist (element (list-elements (the elements)))
(write-the-object element cl-who-base)))
(:include (dolist (element (list-elements (the elements)))
(let ((filename (the-object element data)))
(when (and (> (length filename) 8)
(string= filename "~/gendl/" :end1 8))
(setq filename (merge-pathnames (subseq filename 8)
(asdf:system-source-directory :gendl))))
(with-open-file (s filename)
(let ((buffer (make-string (file-length s))))
(read-sequence buffer s)
(htm (esc buffer)))))))
(otherwise (when *warn-on-unrecognized-tags?*
(warn "Markup tag ~s was not recognized~%" (the markup-tag))))
......@@ -269,7 +334,12 @@
()
(with-cl-who ()
(:p (:table (:tr (:td (ecase (the style)
(:image-figure "Image Goes Here")
(:image-figure
(htm (:img :src (if (stringp (the image-file))
(concatenate 'string "images/" (the image-file))
(namestring (the image-file)))
:style (format nil "width:~a;height:~a;" (the width) (the height))
:alt (the caption))))
(:boxed-figure (dolist (element (list-elements (the :elements)))
(write-the-object element cl-who-base))))))
(:tr (:td (:i (:princ (the caption)))))))))))
......
......@@ -189,20 +189,21 @@
(:indexed :index)
(:verbatim "begin{verbatim}")
(:small "{\\small")
(otherwise (the :markup-tag)))))
(when (not (member (the :markup-tag) (list :verbatim :footnote :emph :indexed :index :texttt)))
(otherwise (the :markup-tag))))
(elements (list-elements (the :elements))))
(when (and elements (not (member (the :markup-tag) (list :verbatim :footnote :emph :indexed :index :texttt))))
(write-env (:newline-out)))
(when (not (eql (the markup-tag) :small)) (write-env "\\"))
(when (not (member (the markup-tag) '(:$ :small))) (write-env "\\"))
(write-env (:a (string-downcase markup-tag)))
(when (not (member (the :markup-tag) '(:verbatim :small)))
(write-env "{")))
(dolist (element (list-elements (the :elements)))
(write-the-object element (base :escape-strings? (not (eql (the :markup-tag) :verbatim)))))
(if (eql (the :markup-tag) :verbatim)
(write-env (:newline-out)
"\\end{verbatim}"
)
(write-env "}" ))
(when elements (write-env "{")))
(dolist (element elements)
(write-the-object element (base :escape-strings? (not (eql (the :markup-tag) :verbatim)))))
(if (eql (the :markup-tag) :verbatim)
(write-env (:newline-out)
"\\end{verbatim}"
)
(when elements (write-env "}" ))))
(when (eql (the :markup-tag) :indexed)
(dolist (element (list-elements (the :elements)))
(write-the-object element (base)))))))))
......
......@@ -42,6 +42,5 @@
(replace-substring
(replace-substring
(replace-substring
(replace-substring
(replace-substring string "#" "\\#") "$" "\\$") "_" "\\_") "$" "$") "^" "hat-") "&" "\\&") "%" "\\%"))
(replace-substring string "#" "\\#") "$" "\\$") "_" "\\_") "^" "hat-") "&" "\\&") "%" "\\%"))
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:gorg :description
"The Gendl gorg Subsystem" :author "Xinyue (Cherie) Yang" :license
"The Gendl® gorg Subsystem" :author "Xinyue (Cherie) Yang" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20150613" :depends-on (:html-template :gwl-graphics)
:version "20170524" :depends-on (:html-template :gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-unicode :defsystem-depends-on #+asdf-unicode nil
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "source/package") (:file "source/base-framework")
......
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:graphs :description
"The Gendl™ graphs Subsystem" :author "Dave Cooper" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20160110" :depends-on (:gwl-graphics)
"The Gendl® graphs Subsystem" :author "Genworks International"
:license "Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial t :version "20170524" :depends-on (:gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-unicode :defsystem-depends-on #+asdf-unicode nil
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "source/package") (:file "source/assembly")
......
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:ta2 :description
"The Gendl\" (legacy) Testing and Tracking Utility, version 2 (using Ajax but pre-gdlAjax, and no JQuery or CSS)"
:author "John McCarthy" :license
"The Gendl® (legacy) Testing and Tracking Utility, version 2 (using Ajax but pre-gdlAjax, and no JQuery or CSS)"
:author "Genworks International" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20160808" :depends-on (:gwl-graphics)
:version "20170524" :depends-on (:gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-unicode :defsystem-depends-on #+asdf-unicode nil
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "source/package") (:file "source/parameters")
......
......@@ -69,7 +69,6 @@ o allow input of required input-slots.
(the root-object update!)
(mapsend (list (the tree) (the inspector) (the viewport)) :update!)))
#+nil
(tatu-update-function
#'(lambda()
(the (set-slot! :root-object (the root-object)))
......
......@@ -23,13 +23,17 @@
(in-package :tasty)
(let ((tutorial-file
(or (probe-file (merge-pathnames "../doc/tutorial.pdf" (glisp:executable-homedir-pathname)))
(probe-file (merge-pathnames "gendl/documenation/tutorial/pdf/tutorial.pdf" glisp:*genworks-source-home*))
(warn "tutorial.pdf not found in distribution doc/ directory or source documentation directory for
(defun publish-tutorial (server)
(let ((tutorial-file
(or (probe-file (merge-pathnames "../doc/tutorial.pdf" (glisp:executable-homedir-pathname)))
(probe-file (merge-pathnames "gendl/documenation/tutorial/pdf/tutorial.pdf" glisp:*genworks-source-home*))
(warn "tutorial.pdf not found in distribution doc/ directory or source documentation directory for
publishing in tasty Help menu.~%"))))
(when tutorial-file (publish-file :path "/tutorial.pdf"
:file (namestring (truename tutorial-file)))))
(when tutorial-file (publish-file :path "/tutorial.pdf"
:server server
:file (namestring (truename tutorial-file))))))
(pushnew 'publish-tutorial *publishers*)
(define-object menu-section (sheet-section)
......
......@@ -22,6 +22,9 @@
(in-package :tasty)
(publish-gwl-app "/tasty" "tasty:assembly" :make-object-args (list :title "Genworks tasty"))
(defun publish-tasty (server)
(publish-gwl-app "/tasty" "tasty:assembly" :make-object-args (list :title "Genworks tasty") :server server))
(pushnew 'publish-tasty *publishers*)
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:tasty :description
"The Gendl\" Web-based Development Environment (tasty)" :author
"John McCarthy" :license
"The Gendl® Web-based Development Environment (tasty)" :author
"Genworks International" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20160808" :depends-on (:tree :gwl-graphics)
:version "20170524" :depends-on (:tree :gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-unicode :defsystem-depends-on #+asdf-unicode nil
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "source/package") (:file "source/parameters")
......
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:timer :description
"The Gendl™ timer Subsystem" :author "John McCarthy" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20151024" :depends-on (:cl-smtp :gwl)
"The Gendl® timer Subsystem" :author "Genworks International"
:license "Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial t :version "20170524" :depends-on (:cl-smtp :gwl)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-unicode :defsystem-depends-on #+asdf-unicode nil
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "source/package") (:file "source/parameters")
......
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:translators :description
"The Gendl\" Translators to/from XML and potentially other high-level KBE and Knowledge formats"
:author "John McCarthy" :license
"The Gendl® Translators to/from XML and potentially other high-level KBE and Knowledge formats"
:author "Genworks International" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20160808" :depends-on (:gwl)
:version "20170524" :depends-on (:gwl)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-unicode :defsystem-depends-on #+asdf-unicode nil
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "xml/source/package") (:file "xml/source/genworks")
......
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:tree :description
"The Gendl\" Tree component used by Tasty and potentially as a UI component on its own"
:author "John McCarthy" :license
"The Gendl® Tree component used by Tasty and potentially as a UI component on its own"
:author "Genworks International" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20160808" :depends-on (:gwl-graphics)
:version "20170524" :depends-on (:gwl-graphics)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-unicode :defsystem-depends-on #+asdf-unicode nil
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "source/package") (:file "source/parameters")
......
......@@ -521,47 +521,48 @@ If you specify :part-symbol-supplied, do not specify :instance-supplied."))
(let ((image-file (the image-file)) (image-format :png)
(pdf-file (merge-pathnames "example.pdf" (glisp:temporary-folder)))
(url (the image-url)) (lisp-file (the lisp-file)))
(publish :path url
:content-type "image/png"
:format :binary
:function #'(lambda(req ent)
(format t "~&~%Loading example code and generating example image for ~s...~%"
(the part-full-symbol))
(the load-example)
(let ((command (format nil "\"~a\" -q -sDEVICE=~a \"-sOutputFile=~a\" -dTextAlphaBits=~a -dGraphicsAlphaBits=~a -dSAFER -dBATCH -dNOPAUSE \"~a\""
*gs-path* (ecase image-format
(:png "png16m")
(:gif "gif")
((:jpg :jpeg) "jpeg"))
image-file
*gs-text-alpha-bits*
*gs-graphics-alpha-bits*
pdf-file)))
(with-all-servers (server)
(publish :path url
:server server
:content-type "image/png"
:format :binary
:function #'(lambda(req ent)
(format t "~&~%Loading example code and generating example image for ~s...~%"
(the part-full-symbol))
(the load-example)
(let ((command (format nil "\"~a\" -q -sDEVICE=~a \"-sOutputFile=~a\" -dTextAlphaBits=~a -dGraphicsAlphaBits=~a -dSAFER -dBATCH -dNOPAUSE \"~a\""
*gs-path* (ecase image-format
(:png "png16m")
(:gif "gif")
((:jpg :jpeg) "jpeg"))
image-file
*gs-text-alpha-bits*
*gs-graphics-alpha-bits*
pdf-file)))
(let ((return-value
(glisp:run-program command :show-window? nil)))
(with-http-response (req ent)
(setf (reply-header-slot-value req :cache-control) "no-cache")
(setf (reply-header-slot-value req :pragma) "no-cache")
(with-http-body (req ent)
(let
((reply-stream (request-reply-stream req)))
(with-open-file
(image-stream image-file :element-type '(unsigned-byte 8))
(do ((val (read-byte image-stream nil nil)
(read-byte image-stream nil nil)))
((null val))
(write-byte val reply-stream))))))
(let ((return-value
(glisp:run-program command :show-window? nil)))
(with-http-response (req ent)
(setf (reply-header-slot-value req :cache-control) "no-cache")
(setf (reply-header-slot-value req :pragma) "no-cache")
(with-http-body (req ent)
(let
((reply-stream (request-reply-stream req)))
(with-open-file
(image-stream image-file :element-type '(unsigned-byte 8))
(do ((val (read-byte image-stream nil nil)
(read-byte image-stream nil nil)))
((null val))
(write-byte val reply-stream))))))
(when (or (null return-value) (zerop return-value))
(delete-file pdf-file)
(delete-file image-file)
(delete-file lisp-file)
(delete-file (make-pathname :name (pathname-name lisp-file)
:type glisp:*fasl-extension*
:directory (pathname-directory lisp-file)
:device (pathname-device lisp-file))))))))
(when (or (null return-value) (zerop return-value))
(delete-file pdf-file)
(delete-file image-file)
(delete-file lisp-file)
(delete-file (make-pathname :name (pathname-name lisp-file)
:type glisp:*fasl-extension*
:directory (pathname-directory lisp-file)
:device (pathname-device lisp-file)))))))))
(push url (gethash (make-keyword (the instance-id)) gwl::*url-hash-table*))
......
......@@ -21,10 +21,14 @@
(in-package :yadd)
(publish-shared :path "/yadd-lookup"
:object-type 'yadd::all)
(with-all-servers (server)
(defun publish-yadd (server)
(publish-shared :path "/yadd-lookup"
:server server
:object-type 'yadd::all)
(publish :path "/user-yadd"
:server server
:function #'(lambda(req ent)
......@@ -37,3 +41,5 @@
:server server
:function #'(lambda(req ent)
(gwl-make-part req ent "yadd:package-dokumentation"))))
(pushnew 'publish-yadd *publishers*)
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:yadd :description
"The Gendl\" Yet Another Definition Documenter (yadd)" :author
"John McCarthy" :license
"The Gendl® Yet Another Definition Documenter (yadd)" :author
"Genworks International" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20160808" :depends-on
:version "20170524" :depends-on
(:gwl-graphics #-allegro :cl-html-parse)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-unicode :defsystem-depends-on #+asdf-unicode nil
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "source/package") (:file "source/genworks")
......
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:base :description
"The Gendl\" Base Core Kernel Engine" :author "John McCarthy"
:license "Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial t :version "20160808" :depends-on (:bordeaux-threads)
"The Gendl® Base Core Kernel Engine" :author
"Genworks International" :license
"Affero Gnu Public License (http://www.gnu.org/licenses/)" :serial t
:version "20170524" :depends-on (:bordeaux-threads)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-unicode :defsystem-depends-on #+asdf-unicode nil
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "source/package") (:file "source/genworks")
......
......@@ -367,3 +367,8 @@ set to nil to improve memory performance.")
(defparameter *with-format-element-type* nil
"Element-type. The default for the :element-type format-slot
for the base format. Defaults to nil. Needs a better default.")
(defparameter *allow-nil-list-of-numbers?* nil "Boolean. If set to t,
allows list-of-numbers function to return nil instead of error
when num1 is greater than num2 with positive increment or vice-versa.
Default is nil.")