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

Improving the load experience on Lispworks. Working with Slime on LispWorks.

parent 9f132e27
......@@ -288,8 +288,7 @@
#+lispworks compiler:*produce-xref-info*
(defun display-startup-banner (edition banner banner2)
(defun display-startup-banner (edition banner)
(ecase edition
#-lispworks (format t banner)
#+lispworks (capi:prompt-with-message banner2))))
(:open-source (format t banner))))
......@@ -74,22 +74,8 @@
Copyright 2002-2011 Genworks International and Genworks BV
This is the General-purpose Declarative Language (GDL).
This program contains free software: you can redistribute it 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 program 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 the source code for this program. If not, see:
(pushnew #'startup-banner *gdl-init-functions*)
(:gdl-base :cl-typesetting)
(:cl-lite :cl-typesetting)
......@@ -4,69 +4,6 @@
(in-package :pdf)
(defmethod write-object ((obj indirect-object) &optional root-level)
(if root-level
(vector-push-extend (format nil "~10,'0d ~5,'0d n "
;;FLAG -- DJC added conditional for allegro to handle aserve streams
#+allegro (if (typep *pdf-stream* 'excl::hiper-socket-stream)
(progn (force-output *pdf-stream*)
(excl::socket-bytes-written *pdf-stream*))
(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))
(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))))
(defmethod write-document ((s stream) &optional (document *document*))
(let ((*xrefs* (make-array 10 :adjustable t :fill-pointer 0))
(*pdf-stream* s))
#+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 (if (typep s 'excl::hiper-socket-stream)
(progn (force-output s)
(excl::socket-bytes-written s))
(file-position s))
#+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))
(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))))
(defmacro with-page ((&rest args) &body body)
`(let* ((*page* (make-instance 'page ,@args)))
......@@ -8,6 +8,7 @@
......@@ -43,6 +44,12 @@
#+allegro (excl:gc t)
#+lispworks (hcl:gc-all))
(defun initialize-multiprocessing ()
#+lispworks (mp:initialize-multiprocessing)
;; Don't have to do it in Allegro - see about other CLs when we get here.
(defun load-html-parser ()
#+allegro (require :phtml)
......@@ -76,6 +76,7 @@
(defun initialize-gwl (&key edition) (declare (ignore edition))
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