From e33910f773912fcc3315077f1139cd1014e671e3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtes Date: Sat, 18 Mar 2006 18:12:00 +0000 Subject: Moved `convert-image' et al. to `utils/images.scm'. * src/guile/skribilo/runtime.scm: Moved image-related code to... * src/guile/skribilo/utils/images.scm: ... here (new file). * src/guile/skribilo/utils/Makefile.am (dist_guilemodule_DATA): Updated. * src/guile/skribilo/module.scm (%skribilo-user-autoloads): Added `(skribilo utils images)'. git-archimport-id: lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2--patch-47 --- ChangeLog | 25 +++++++++ src/guile/skribilo/module.scm | 1 + src/guile/skribilo/runtime.scm | 66 +----------------------- src/guile/skribilo/utils/Makefile.am | 2 +- src/guile/skribilo/utils/images.scm | 99 ++++++++++++++++++++++++++++++++++++ 5 files changed, 128 insertions(+), 65 deletions(-) create mode 100644 src/guile/skribilo/utils/images.scm diff --git a/ChangeLog b/ChangeLog index e485abf..9451c55 100644 --- a/ChangeLog +++ b/ChangeLog @@ -2,6 +2,31 @@ # arch-tag: automatic-ChangeLog--lcourtes@laas.fr--2005-mobile/skribilo--devel--1.2 # +2006-03-18 18:12:00 GMT Ludovic Courtes patch-47 + + Summary: + Moved `convert-image' et al. to `utils/images.scm'. + Revision: + skribilo--devel--1.2--patch-47 + + * src/guile/skribilo/runtime.scm: Moved image-related code to... + + * src/guile/skribilo/utils/images.scm: ... here (new file). + + * src/guile/skribilo/utils/Makefile.am (dist_guilemodule_DATA): Updated. + + * src/guile/skribilo/module.scm (%skribilo-user-autoloads): Added + `(skribilo utils images)'. + + new files: + src/guile/skribilo/utils/images.scm + + modified files: + ChangeLog src/guile/skribilo/module.scm + src/guile/skribilo/runtime.scm + src/guile/skribilo/utils/Makefile.am + + 2006-03-18 18:09:34 GMT Ludovic Courtes patch-46 Summary: diff --git a/src/guile/skribilo/module.scm b/src/guile/skribilo/module.scm index 10b4d6b..753aca8 100644 --- a/src/guile/skribilo/module.scm +++ b/src/guile/skribilo/module.scm @@ -72,6 +72,7 @@ ((skribilo engine latex) . (!latex LaTeX TeX)) ((skribilo engine html) . (html-markup-class html-class html-width)) + ((skribilo utils images) . (convert-image)) ((skribilo source) . (source-read-lines source-fontify language? language-extractor language-fontifier source-fontify)) diff --git a/src/guile/skribilo/runtime.scm b/src/guile/skribilo/runtime.scm index da5c525..73d776c 100644 --- a/src/guile/skribilo/runtime.scm +++ b/src/guile/skribilo/runtime.scm @@ -24,20 +24,11 @@ :export (;; Utilities strip-ref-base string-canonicalize - - ;; Images - convert-image - ;; String writing make-string-replace) - :use-module (skribilo parameters) + :autoload (skribilo parameters) (*ref-base*) :use-module (skribilo lib) - :use-module (srfi srfi-13) - :use-module (srfi srfi-35) - :autoload (skribilo utils files) (file-prefix file-suffix) - :autoload (skribilo condition) (&file-search-error) - :autoload (srfi srfi-34) (raise)) - + :use-module (srfi srfi-13)) ;;; ====================================================================== @@ -97,59 +88,6 @@ -;;; ====================================================================== -;;; -;;; I M A G E S -;;; -;;; ====================================================================== -(define (builtin-convert-image from fmt dir) - (let* ((s (file-suffix from)) - (f (string-append (file-prefix (basename from)) "." fmt)) - (to (string-append dir "/" f))) ;; FIXME: - (cond - ((string=? s fmt) - to) - ((file-exists? to) - to) - (else - (let ((c (if (string=? s "fig") - (string-append "fig2dev -L " fmt " " from " > " to) - (string-append "convert " from " " to)))) - (cond - ((> (*verbose*) 1) - (format (current-error-port) " [converting image: ~S (~S)]" from c)) - ((> (*verbose*) 0) - (format (current-error-port) " [converting image: ~S]" from))) - (and (zero? (system c)) - to)))))) - -(define (convert-image file formats) - (let ((path (search-path (*image-path*) file))) - (if (not path) - (raise (condition (&file-search-error (file-name file) - (path (*image-path*))))) - (let ((suf (file-suffix file))) - (if (member suf formats) - (let* ((dir (if (string? (*destination-file*)) - (dirname (*destination-file*)) - #f))) - (if dir - (let ((dest (basename path))) - (copy-file path (string-append dir "/" dest)) - dest) - path)) - (let loop ((fmts formats)) - (if (null? fmts) - #f - (let* ((dir (if (string? (*destination-file*)) - (dirname (*destination-file*)) - ".")) - (p (builtin-convert-image path (car fmts) dir))) - (if (string? p) - p - (loop (cdr fmts))))))))))) - - ;;; ====================================================================== ;;; ;;; S T R I N G - W R I T I N G diff --git a/src/guile/skribilo/utils/Makefile.am b/src/guile/skribilo/utils/Makefile.am index 5044c1b..fa693a1 100644 --- a/src/guile/skribilo/utils/Makefile.am +++ b/src/guile/skribilo/utils/Makefile.am @@ -1,4 +1,4 @@ guilemoduledir = $(GUILE_SITE)/skribilo/utils -dist_guilemodule_DATA = syntax.scm compat.scm files.scm +dist_guilemodule_DATA = syntax.scm compat.scm files.scm images.scm ## arch-tag: 3a18b64b-1da2-417b-8338-2c534bca277f diff --git a/src/guile/skribilo/utils/images.scm b/src/guile/skribilo/utils/images.scm new file mode 100644 index 0000000..f65d036 --- /dev/null +++ b/src/guile/skribilo/utils/images.scm @@ -0,0 +1,99 @@ +;;; images.scm -- Images handling utilities. +;;; +;;; Copyright 2003, 2004 Erick Gallesio - I3S-CNRS/ESSI +;;; Copyright 2005, 2006 Ludovic Courtès +;;; +;;; +;;; This program is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 2 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 General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with this program; if not, write to the Free Software +;;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, +;;; USA. + +(define-module (skribilo utils images) + :export (convert-image + *fig-convert-program* *bitmap-convert-program*) + + :autoload (skribilo utils files) (file-suffix file-prefix) + :autoload (skribilo parameters) (*image-path*) + :autoload (skribilo condition) (&file-search-error) + :autoload (srfi srfi-34) (raise) + :use-module (srfi srfi-35) + :use-module (srfi srfi-39)) + +;;; Author: Erick Gallesio, Ludovic Courtès +;;; +;;; Commentary: +;;; +;;; This module provides convenience functions to handle image files, notably +;;; for format conversion via ImageMagick's `convert'. +;;; +;;; Code: + +(define *fig-convert-program* (make-parameter "fig2dev -L")) +(define *generic-convert-program* (make-parameter "convert")) + +(define (builtin-convert-image from fmt dir) + (let* ((s (file-suffix from)) + (f (string-append (file-prefix (basename from)) "." fmt)) + (to (string-append dir "/" f))) ;; FIXME: + (cond + ((string=? s fmt) + to) + ((file-exists? to) + to) + (else + (let ((c (if (string=? s "fig") + (string-append (*fig-convert-program*) " " + fmt " " from " > " to) + (string-append (*generic-convert-program*) " " + from " " to)))) + (cond + ((> (*verbose*) 1) + (format (current-error-port) " [converting image: ~S (~S)]" from c)) + ((> (*verbose*) 0) + (format (current-error-port) " [converting image: ~S]" from))) + (and (zero? (system c)) + to)))))) + +(define (convert-image file formats) + (let ((path (search-path (*image-path*) file))) + (if (not path) + (raise (condition (&file-search-error (file-name file) + (path (*image-path*))))) + (let ((suf (file-suffix file))) + (if (member suf formats) + (let* ((dir (if (string? (*destination-file*)) + (dirname (*destination-file*)) + #f))) + (if dir + (let* ((dest (basename path)) + (dest-path (string-append dir "/" dest))) + (if (not (string=? path dest-path)) + (copy-file path dest-path)) + dest) + path)) + (let loop ((fmts formats)) + (if (null? fmts) + #f + (let* ((dir (if (string? (*destination-file*)) + (dirname (*destination-file*)) + ".")) + (p (builtin-convert-image path (car fmts) dir))) + (if (string? p) + p + (loop (cdr fmts))))))))))) + + +;;; arch-tag: a1992fa8-6073-4cd7-a018-80e2cc8d537c + +;;; images.scm ends here -- cgit v1.2.3