cl-pdf in Corman Lisp

Dear all,

I've recently sent to Marc Battyani a set of patches needed to get a 
Corman Lisp compatible cl-pdf package.

There were a few issues that I had to address, and probably my 
solutions are far from optimal and you can suggest some improvements. 

There were two major issues that I addressed redefining functions:

* parse-integer is terribly broken, so I used JP Massar's version, 
with a little correction (see whole function at the end)
From the HyperSpec:
The second value is either the index into the string of the
delimiter that terminated the parse, or the upper bounding index of
the substring if the parse terminated at the end of the substring
(as is always the case if junk-allowed is false).
I understand that (and otherwise cl-pdf doesn't work)
(parse-integer "012  5" :junk-allowed t) -> (123,3),
but it was returning (123,5)

* the +external-format+ option is ignored by open, and there is no way 
to disable the #\Newline -> CR/LF conversion for a particular file. 
This leads to corrupted binary streams (which are used if compression 
is enabled or the document includes jpeg images). I've been unable to 
find a way to make the change visible only in the cl-pdf package, if 
the patch is applied it affects the whole system (it's not needed if 
compression and images are not used, though). Any idea to reduce the 
visibility only to the places where the new definition is really 
needed?

(in-package cl)
(defun expand-line-feeds (string len)
  (let* ((size len))
    (let ((buf (make-array size :element-type 'byte)))
      (do ((i 0 (+ i 1)))
	  ((= i len))
	(setf (elt buf i)(char-int (char string i))))
      buf)))

The changes required in pdf.lisp and pdf-base.lisp are workaround 
around three problems:

* read-sequence doesn't recognize the element-type '(unsigned-byte 8)

This affects the reading of jpeg images to be included in the 
document. I just changed the element-type to unsigned-byte:

diff cl-pdf-1.1.2/pdf-base.lisp cl-pdf-1.1.2-corman/pdf-base.lisp
186c186
<   (with-open-file (s filename :direction :input :element-type '(unsigned-byte 8))
---
>   (with-open-file (s filename :direction :input :element-type #-cormanlisp '(unsigned-byte 8) #+cormanlisp 'unsigned-byte)


* method dispatching doesn't work properly for pathnames, it tries to 
find the method corresponding to pathnames::pathname-internal

I specialized the method on pathnames::pathname-internal instead, but 
maybe there is a more elegant way to achive the same result. I 
don't know to much about CLOS, and debugging the method dispatching 
was quite difficult, so when I got something working I just stopped 
investigating.

diff cl-pdf-1.1.2/pdf-base.lisp cl-pdf-1.1.2-corman/pdf-base.lisp
218c218
< (defmethod make-jpeg-image ((pathname pathname))
---
> (defmethod make-jpeg-image ((pathname #-cormanlisp pathname #+cormanlisp pathnames::pathname-internal))

diff cl-pdf-1.1.2/pdf.lisp cl-pdf-1.1.2-corman/pdf.lisp
370c371
< (defmethod write-document ((filename pathname) &optional (document *document*))
---
> (defmethod write-document ((filename #-cormanlisp pathname #+cormanlisp pathnames::pathname-internal) &optional (document *document*))


* the file-position gets out of synchrony when format is used. This 
causes the reference table to be corrupted. The files generated can be 
"fixed" by Acrobat Reader, but it's annowing anyway. I fixed the 
problem converting all the (format *pdf-stream* ...) forms to 
write-string and write-line. 

diff cl-pdf-1.1.2/pdf.lisp cl-pdf-1.1.2-corman/pdf.lisp
311c311
<   (format *pdf-stream* "~d ~d R" (obj-number obj)(gen-number obj)))
---
>   (write-string (format nil "~d ~d R" (obj-number obj)(gen-number obj)) *pdf-stream*))
[similar changes in 319c319; 321,322c321,322; 339c339; 363c363; 366c366]
368c368,369
<      (format s "~%>>~%startxref~%~d~%%%EOF~%" startxref)))
---
>      (write-line (format nil "~%>>~%startxref~%~d~%%%EOF" startxref) *pdf-stream*))
>    nil)

Cheers,

Carlos


-------------

;;; Patch for PARSE-INTEGER
;;; Author:  JP Massar

;; bug fixed by Carlos Ungil
;; The second value is either the index into the string of the
;; delimiter that terminated the parse, or the upper bounding index of
;; the substring if the parse terminated at the end of the substring
;; (as is always the case if junk-allowed is false).
;; (parse-integer "012  5" :junk-allowed t) -> (123,3) ;was (123,5)

(in-package pdf)

(defun parse-integer (string
			&key (start 0)
			(end nil)
			(radix 10)
			(junk-allowed nil)
			&aux (result 0)
			(state :initial)
			(sign 1)
			c)
  (let ((len (length string))
	(whitespace '(#\Space #\Tab #\Newline)))
    (flet ((whitespace? (x) (member x whitespace)))
      (when (null end) (setq end len))
      (cond
       ((or (not (zerop start)) (not (= end len)))
	(multiple-value-bind (val bound)
	    (parse-integer (subseq string start end)
			   :radix radix :junk-allowed junk-allowed)
	  (values val (+ bound start))
	  ))
       ((or (zerop len) (not (find-if-not #'whitespace? string)))
	(if junk-allowed
	    (values nil len)
	  (error "Cannot parse null or blank string as an integer")))
       ((whitespace? (char string 0))
	(let ((start-pos (position-if-not #'whitespace? string)))
	  (multiple-value-bind (val bound)
	      (parse-integer (string-trim whitespace string)
			     :radix radix :junk-allowed junk-allowed)
	    (values val (+ bound start-pos))
	    )))
       ((whitespace? (char string (1- len)))
	(parse-integer (string-trim whitespace string)
		       :radix radix :junk-allowed junk-allowed))
       (t
	(setf c (char string start))
	(if (char= c #\-)
	    (progn (setf sign -1) (incf start))
	  (if (char= c #\+)
	      (incf start)))
	(do* ((i start (+ i 1))
	      (n 0))
	    ((>= i end))
	  (setq c (char string i))
	  (setq n (digit-char-p c radix))
	  (cond
	   (n (progn
		(cond
		 ((eq state :finished)
		  (if (not junk-allowed)
		      (error "Invalid integer parsed: ~A" string)
;		    (progn (setq end i) (return)))))
		    (return))))
		(setq result (+ (* result radix) n))
		(setq state :collecting)))
	   ((member c (list (int-char 13) (int-char 32) (int-char 9)))
	    (cond
;	     ((eq state :collecting) (setq state :finished))
	     ((eq state :collecting)
	      (progn
		(setq state :finished)
		(setq end i)))
	     ((eq state :initial) nil)
	     ((eq state :finished) nil)))
	   (t
	    (if (not junk-allowed)
		(error "Invalid integer parsed: ~A" string) ;; string
	      (progn (setq end i) (return))))))
	(if (eq state :initial)
	    (setq result nil)
	  (setq result (* result sign)))
	(values result end))))))



------------------------ Yahoo! Groups Sponsor ---------------------~-->
Looking for the latest Free IT White Papers?
Visit SearchMobileComputing.com to access over 500 white papers.
Get instant access at SearchMobileComputing.com Today
http://us.click.yahoo.com/9lAzoD/PLNGAA/witMAA/SyjtlB/TM
---------------------------------------------------------------------~->

To unsubscribe from this group, send an email to:
[email protected]

 

Your use of Yahoo! Groups is subject to http://docs.yahoo.com/info/terms/