aboutsummaryrefslogtreecommitdiff
path: root/src/guile
diff options
context:
space:
mode:
authorLudovic Court`es2006-02-14 14:26:42 +0000
committerLudovic Court`es2006-02-14 14:26:42 +0000
commit8f5bd5e1126f1866921eb247ef55ed5b32c966f9 (patch)
tree61b3e1a66d59f8edcabc17b6cf11c95bd711b4d3 /src/guile
parent4b640e644739172f565b444d9d75967f9bf697f8 (diff)
downloadskribilo-8f5bd5e1126f1866921eb247ef55ed5b32c966f9.tar.gz
skribilo-8f5bd5e1126f1866921eb247ef55ed5b32c966f9.tar.lz
skribilo-8f5bd5e1126f1866921eb247ef55ed5b32c966f9.zip
Implemented `lout-illustration' for non-Lout engines.
* src/guile/skribilo/engine/lout.scm (lout-illustration): Implemented for Guile and non-Lout engines. git-archimport-id: lcourtes@laas.fr--2004-libre/skribilo--devel--1.2--patch-43
Diffstat (limited to 'src/guile')
-rw-r--r--src/guile/skribilo/engine/lout.scm72
1 files changed, 35 insertions, 37 deletions
diff --git a/src/guile/skribilo/engine/lout.scm b/src/guile/skribilo/engine/lout.scm
index c2339ca..de6fb3e 100644
--- a/src/guile/skribilo/engine/lout.scm
+++ b/src/guile/skribilo/engine/lout.scm
@@ -1,6 +1,6 @@
;;; lout.scm -- A Lout engine.
;;;
-;;; Copyright 2004, 2005 Ludovic Courtès <ludovic.courtes@laas.fr>
+;;; Copyright 2004, 2005, 2006 Ludovic Courtès <ludovic.courtes@laas.fr>
;;;
;;;
;;; This program is free software; you can redistribute it and/or modify
@@ -24,6 +24,7 @@
(define-skribe-module (skribilo engine lout)
+ :autoload (ice-9 popen) (open-output-pipe)
:autoload (ice-9 rdelim) (read-line))
@@ -2780,6 +2781,8 @@
;* Illustrations */
;*---------------------------------------------------------------------*/
(define-public (lout-illustration . args)
+ ;; FIXME: This should be a markup.
+
;; Introduce a Lout illustration (such as a diagram) whose code is either
;; the body of `lout-illustration' or the contents of `file'. For engines
;; other than Lout, an EPS file is produced and then converted if needed.
@@ -2833,46 +2836,41 @@
(file-contents file))))
(if (engine-format? "lout")
(! contents) ;; simply inline the illustration
- (cond-expand
- (bigloo
- (let* ((lout (find-engine 'lout))
- (output (string-append (or ident
- (symbol->string
- (gensym 'lout-illustration)))
- ".eps"))
- (proc (run-process (or (engine-custom lout
- 'lout-program-name)
- "lout")
- "-o" output
- "-EPS"
- input: pipe:))
- (port (process-input-port proc)))
-
- ;; send the illustration to Lout's standard input
- (display (illustration-header) port)
- (display contents port)
- (display (illustration-ending) port)
- (close-output-port port)
-
- (process-wait proc)
- (if (not (= 0 (process-exit-status proc)))
+ (let* ((lout (find-engine 'lout))
+ (output (string-append (or ident
+ (symbol->string
+ (gensym 'lout-illustration)))
+ ".eps"))
+ (port (open-output-pipe
+ (string-append (or (engine-custom lout
+ 'lout-program-name)
+ "lout")
+ " -o " output
+ " -EPS"))))
+
+ ;; send the illustration to Lout's standard input
+ (display (illustration-header) port)
+ (display contents port)
+ (display (illustration-ending) port)
+
+ (let ((exit-val (status:exit-val (close-pipe port))))
+ (if (not (eqv? 0 exit-val))
(skribe-error 'lout-illustration
- "lout exited with error code"
- (process-exit-status proc)))
- (if (not (file-exists? output))
- (skribe-error 'lout-illustration "file not created"
- output))
- (if (= 0 (file-size output))
+ "lout exited with error code" exit-val)))
+
+ (if (not (file-exists? output))
+ (skribe-error 'lout-illustration "file not created"
+ output))
+
+ (let ((file-info (false-if-exception (stat output))))
+ (if (or (not file-info)
+ (= 0 (stat:size file-info)))
(skribe-error 'lout-illustration
- "empty output file" output))
+ "empty output file" output)))
- ;; the image
- (image :file output alt)))
+ ;; the image (FIXME: Should set its location)
+ (image :file output alt))))))
- (else ;; Unfortunately, chances are low that STklos has the same
- ;; process API as the one Bigloo has.
- (skribe-error 'lout
- "lout-illustration: Not implemented" file)))))))
;*---------------------------------------------------------------------*/