Commit 4ba0467d authored by Dave Cooper's avatar Dave Cooper

made it depend on zacl for CCL

parent 687d7f5d
......@@ -397,6 +397,7 @@ If you are interested in this effort we would love to hear from you at open-sour
#:patches-dir
#:process-run-function
#:remote-host
#:local-host
#:replace-regexp
#:room-report
#:slot-definition-name
......
......@@ -67,35 +67,24 @@
(defun quicklisp-copyright-string ()
(let ((ql-libs
(safe-sort
(set-difference *already-loaded-systems*
(append (list "asdf" "crypt" "quicklisp" "base" "ent" "validate" "glisp"
"monofasl" "pro" "enterprise")
*packages-to-lock*)
:key #'string :test #'string-equal) #'string-lessp))
(ql-version (with-open-file (in (or (probe-file
(merge-pathnames "quicklisp/dists/quicklisp/distinfo.txt"
glisp:*gdl-home*))
(probe-file
(merge-pathnames "genworks/quicklisp/dists/quicklisp/distinfo.txt"
glisp:*gdl-home*))
(probe-file
(merge-pathnames "quicklisp/dists/quicklisp/distinfo.txt"
glisp:*genworks-source-home*))
(probe-file
(merge-pathnames "../distinfo.txt"
glisp:*genworks-source-home*))))
(read-line in)
(string-trim (list #\space) (second (glisp:split-regexp ":" (read-line in)))))))
(format nil "Also contains the following Common Lisp libraries
(when *already-loaded-systems*
(let ((ql-libs
(safe-sort
(set-difference *already-loaded-systems*
(append (list "asdf" "crypt" "quicklisp" "base" "ent" "validate" "glisp"
"monofasl" "pro" "enterprise")
*packages-to-lock*)
:key #'string :test #'string-equal) #'string-lessp))
(ql-version (with-open-file (in (or (probe-file (merge-pathnames "dists/quicklisp/distinfo.txt" *quicklisp-home*))
(error "Quicklisp directory not found in gendl:*quicklisp-home*,
which is set to: ~a.~%" *quicklisp-home*)))
(read-line in) (string-trim (list #\space) (second (glisp:split-regexp ":" (read-line in)))))))
(format nil "Also contains the following Common Lisp libraries
from Quicklisp version ~a, whose source files are available in the
Quicklisp repository at http://quicklisp.org, Copyright© their
respective authors:
~{~a~^, ~}.~%"
ql-version
ql-libs)))
~{~a~^, ~}.~%" ql-version ql-libs))))
(defun startup-banner ()
......
......@@ -30,8 +30,14 @@
:directory (butlast (pathname-directory glisp:*gdl-program-home*))
:defaults glisp:*gdl-program-home*))
(setq glisp:*gendl-home* glisp:*gdl-home*)
(setq *quicklisp-home* (or (probe-file (merge-pathnames "quicklisp/" glisp:*gendl-home*))
(probe-file (merge-pathnames "genworks/quicklisp/" glisp:*gendl-home*))))
(setq *quicklisp-home* (or (when (and (find-package :ql) (boundp (read-from-string "ql:*quicklisp-home*")))
(symbol-value (read-from-string "ql:*quicklisp-home*")))
(probe-file (merge-pathnames "quicklisp/" glisp:*gendl-home*))
(probe-file (merge-pathnames "genworks/quicklisp/" glisp:*gendl-home*))
(probe-file (merge-pathnames "quicklisp/" glisp:*genworks-source-home*))
(probe-file (merge-pathnames "genworks/quicklisp/dists/quicklisp/distinfo.txt"
glisp:*gdl-home*))
))
(pushnew (make-keyword (format nil "gendl-~a" *gendl-version*)) *features*)
(glisp:set-genworks-source-home-if-known)
(glisp:set-default-float-format)
......
"(:base :uiop :cl-typesetting :cl-ppcre :cl-who #-allegro :cl-base64 #-allegro :babel #-allegro :acl-compat)"
"(:base :uiop :cl-typesetting :cl-ppcre :cl-who #-allegro :cl-base64 #-allegro :babel #-(or allegro ccl) :acl-compat #+ccl zacl)"
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:glisp :description
"The Gendl\" Common Lisp Portability" :author "John McCarthy"
:license "Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial t :version "20160828" :depends-on
(:base :uiop :cl-typesetting :cl-ppcre :cl-who #-allegro :cl-base64 #-allegro :babel #-allegro :acl-compat)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "source/presets") (:file "source/parameters")
(:file "source/genworks") (:file "source/initialize")
(:file "source/zzinit")))
;;;; -*- coding: utf-8 -*-
(asdf:defsystem #:glisp :description
"The Gendl® Common Lisp Portability" :author "John McCarthy"
:license "Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial t :version "20161125" :depends-on
(:base :uiop :cl-typesetting :cl-ppcre :cl-who #-allegro :cl-base64 #-allegro :babel #-(or allegro ccl) :acl-compat #+ccl zacl)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings )
#+asdf-unicode :defsystem-depends-on #+asdf-unicode ()
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "source/presets") (:file "source/parameters")
(:file "source/genworks") (:file "source/initialize")
(:file "source/zzinit")))
......@@ -268,23 +268,6 @@ The command line was: ~%~%~s~%" command result error command-line)))))
(unless (zerop result) (error "Ghostscript threw error"))))
#+nil
(defun run-gs (command)
"Shell out a ghostscript command and handle errors."
(format t "~a" command)
(let ((result (#+allegro
excl:run-shell-command
#-allegro
acl-compat.excl:run-shell-command
command
;;:show-window :hide
)))
(when result
(unless (zerop result) (error "Ghostscript threw error")))))
(defun run-program (command &rest keys
&key ignore-error-status force-shell
......@@ -439,11 +422,34 @@ the \"current\" error."
)
(defun local-port (socket)
(#+(or allegro zacl) socket:local-port #-(or allegro zacl) acl-compat.socket:local-port socket))
#+nil
(defun local-port (socket)
(#+allegro
socket:local-port
#-allegro acl-compat.socket:local-port socket))
(defun match-regexp (string-or-regexp string-to-match
&key newlines-special case-fold return
(start 0) end shortest)
(when (or newlines-special case-fold return shortest)
(error "keyword arguments :newlines-special, :case-fold, :return, and :shortest
are no longer supported by glisp:match-regexp.~%"))
(#+allegro excl:match-regexp
#-allegro cl-ppcre:scan string-or-regexp string-to-match
:start start
:end end))
#+nil
(defun match-regexp (string-or-regexp string-to-match
&key newlines-special case-fold return
(start 0) end shortest)
......@@ -459,6 +465,15 @@ the \"current\" error."
(defun patches-dir ()
nil)
(defun process-run-function (name-or-options preset-function &rest args)
#-allegro (when args (error "args not supported for glisp:process-run-function on ~a.~%" (lisp-implementation-type)))
(apply #+allegro #'mp:process-run-function
#-allegro #'bt:make-thread preset-function name-or-options))
#+nil
(defun process-run-function (name-or-options preset-function &rest args)
(apply #+allegro #'mp:process-run-function
#-allegro #'acl-compat.mp:process-run-function
......@@ -471,8 +486,13 @@ the \"current\" error."
(defun remote-host (socket)
#+allegro (socket:remote-host socket)
#-allegro (acl-compat.socket:remote-host socket))
#+(or allegro zacl) (socket:remote-host socket)
#-(or allegro zacl) (acl-compat.socket:remote-host socket))
(defun local-host (socket)
#+(or allegro zacl) (socket:local-host socket)
#-(or allegro zacl) (acl-compat.socket:local-host socket))
(defun replace-regexp (string regexp to-string)
(cl-ppcre:regex-replace-all regexp string to-string))
......@@ -651,16 +671,17 @@ please find implementation for the currently running lisp.~%")
#-allegro `(let ((*print-case* :downcase)) ,@body)
#+allegro `(progn ,@body))
(defun with-timeout-sym ()
"Returns the appropriate symbol for with-timeout, for substitution within macros."
#+allegro 'sys:with-timeout
#-allegro 'acl-compat.mp:with-timeout)
#+(or allegro zacl) 'sys:with-timeout
#-(or allegro zacl) 'acl-compat.mp:with-timeout)
(defmacro with-timeout ((seconds &body timeout-body) &body body)
#+allegro `(mp:with-timeout (,seconds ,@timeout-body)
,@body)
#-allegro `(acl-compat.mp:with-timeout (,seconds ,@timeout-body)
,@body))
#+(or allegro zacl) `(sys:with-timeout (,seconds ,@timeout-body) ,@body)
#-(or allegro zacl) `(acl-compat.mp:with-timeout (,seconds ,@timeout-body) ,@body))
(defmacro without-redefinition-warnings (&rest body)
#+allegro
......
(:bordeaux-threads :glisp :aserve :yason)
"(:bordeaux-threads :glisp #+ccl :aserve #-ccl :paserve :yason)"
......@@ -39,6 +39,9 @@ Defaults to nil."
("Keyword symbol. The ID attribute for this tag. Defaults to (the field-name)."
id (the field-name))
("Keyword symbol. The name of this field. Computed from the object name within the tree."
field-name (make-keyword-sensitive (the base64-encoded-root-path)))
)
:computed-slots
......@@ -66,8 +69,7 @@ Previously known as form-control-string. Default is the form-control-string."
(with-format (html-format *stream*)
(write-the string))))
("Keyword symbol. The name of this field. Computed from the object name within the tree."
field-name (make-keyword-sensitive (the base64-encoded-root-path)))
......
......@@ -3,9 +3,10 @@
(asdf:defsystem #:gwl :description
"The Gendl® Generative Web Language (GWL)" :author "John McCarthy"
:license "Affero Gnu Public License (http://www.gnu.org/licenses/)"
:serial t :version "20161025" :depends-on
(:bordeaux-threads :glisp :aserve :yason)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings)
:serial t :version "20161125" :depends-on
(:bordeaux-threads :glisp #+ccl :aserve #-ccl :paserve :yason)
#-asdf-unicode :defsystem-depends-on #-asdf-unicode (:asdf-encodings )
#+asdf-unicode :defsystem-depends-on #+asdf-unicode ()
#+asdf-encodings :encoding #+asdf-encodings :utf-8
:components
((:file "source/package") (:file "source/with-all-servers")
......@@ -16,10 +17,9 @@
(:file "source/utilities") (:file "source/answer")
(:file "source/accessories") (:file "source/gdl-remote")
(:file "source/vanilla-remote") (:file "source/base64-utils")
(:file "source/cl-pdf-patches") (:file "source/color-palette")
(:file "source/crawler") (:file "source/log-utils")
(:file "source/new-urls") (:file "source/publish")
(:file "source/remote-object")
(:file "source/color-palette") (:file "source/crawler")
(:file "source/log-utils") (:file "source/new-urls")
(:file "source/publish") (:file "source/remote-object")
(:file "source/security-check-failed")
(:file "form-elements/source/grid-form-element")
(:file "form-elements/source/macros")
......
......@@ -104,8 +104,8 @@ object.")
:input-slots
(
;;(respondent (the bashee) :defaulting)
(respondent (the bashee))
(respondent (the bashee) :defaulting)
;;(respondent (the bashee))
("GDL object. Default object to which control will return with the write-back-link method"
return-object (the :parent))
......
;;; cl-pdf copyright 2002-2005 Marc Battyani see license.txt for the details
;;; You can reach me at marc.battyani@fractalconcept.com or marc@battyani.net
;;; The homepage of cl-pdf is here: http://www.fractalconcept.com/asp/html/cl-pdf.html
(in-package :pdf)
#+nil
(defmethod write-object ((obj indirect-object) &optional root-level)
(gdl:print-variables *pdf-stream*)
(if root-level
(progn
(vector-push-extend (format nil "~10,'0d ~5,'0d n "
;;FLAG -- DJC added conditional for allegro to handle aserve streams
#+allegro (typecase *pdf-stream*
((excl::hiper-socket-stream
net.aserve::chunking-stream)
(force-output *pdf-stream*)
(excl::socket-bytes-written *pdf-stream*))
(otherwise (file-position *pdf-stream*)))
#+lispworks (if (typep *pdf-stream* 'acl-compat.socket::bidirectional-binary-socket-stream)
(progn (force-output *pdf-stream*)
(acl-compat.socket::stream-file-position *pdf-stream*))
(file-position *pdf-stream*))
#-(or allegro lispworks) (file-position *pdf-stream*)
(gen-number obj))
*xrefs*)
(format *pdf-stream* "~d ~d obj~%" (obj-number obj)(gen-number obj))
(when (content obj)(write-object (content obj)))
(write-string "endobj" *pdf-stream*)
(write-char #\Newline *pdf-stream*))
(format *pdf-stream* "~d ~d R" (obj-number obj)(gen-number obj))))
#+nil
(defmethod write-document ((s stream) &optional (document *document*))
(gdl:print-variables s)
(let ((*xrefs* (make-array 10 :adjustable t :fill-pointer 0))
startxref
(*pdf-stream* s))
;;(with-standard-io-syntax
#+lispworks (if (typep s 'acl-compat.socket::bidirectional-binary-socket-stream)
(setf acl-compat.socket::*socket-bytes-written* 0))
(let ((*read-default-float-format* 'double-float))
(process-outlines document)
(vector-push-extend "0000000000 65535 f " *xrefs*)
(write-line +pdf-header+ *pdf-stream*)
(loop for obj across (objects document)
for first = t then nil
if obj do (write-object obj t)
else do (unless first (vector-push-extend "0000000000 00001 f " *xrefs*)))
;;(setf startxref (file-position s))
(setf startxref #+allegro (typecase *pdf-stream*
((excl::hiper-socket-stream net.aserve::chunking-stream)
(force-output *pdf-stream*)
(excl::socket-bytes-written *pdf-stream*))
(otherwise (file-position *pdf-stream*)))
#+lispworks (if (typep s 'acl-compat.socket::bidirectional-binary-socket-stream)
(progn (force-output s)
(acl-compat.socket::stream-file-position s))
(file-position s))
#-(or allegro lispworks) (file-position s))
(unless startxref (setf startxref (file-position s)))
(format *pdf-stream* "xref~%0 ~d~%" (length *xrefs*))
(loop for xref across *xrefs*
do (write-line xref s))
(format s "trailer~%<< /Size ~d~%/Root " (length *xrefs*)) ;(1- (length (objects document))))
(write-object (catalog document))
(when (docinfo document)
(format s " /Info ")
(write-object (docinfo document)))
(format s "~%>>~%startxref~%~d~%%%EOF~%" startxref))))
......@@ -282,11 +282,7 @@
;; FIXME: better way to get this ?
(when (boundp '*wserver*)
(let ((sock (wserver-socket *wserver*)))
(when sock
#+allegro
(socket:local-host sock)
#-allegro
(acl-compat.socket:local-host sock)))))
(when sock (glisp:local-host sock)))))
(defun encode-object-for-http (item id)
(list :remote-gdl-instance
......
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