Changeset 14504 in project


Ignore:
Timestamp:
04/29/09 00:28:53 (11 years ago)
Author:
Ivan Raikov
Message:

sigma ported to Chicken 4

Location:
release/4/sigma
Files:
4 edited
1 copied

Legend:

Unmodified
Added
Removed
  • release/4/sigma/trunk/sigma-eggdoc.scm

    r13056 r14504  
    1 ;;
     1
    22;;
    33;; sigma documentation for the Chicken Scheme module system.
    4 ;;
    5 ;;
    6 ;; Version $Revision$
    7 ;;
    8 ;;
    94;;
    105;; This program is free software: you can redistribute it and/or
     
    3328     (description "Image gallery generator.")
    3429
    35      (author (url "http://chicken.wiki.br/ivan raikov" "Ivan Raikov"))
     30     (author (url "http://chicken.wiki.br/users/ivan-raikov" "Ivan Raikov"))
    3631
    3732     (history
     33      (version "1.17" "Ported to Chicken 4")
    3834      (version "1.16" "Using compiled regular expressions with find-files")
    3935      (version "1.15" "Added some error checking for temporary directory creation")
  • release/4/sigma/trunk/sigma.meta

    r9305 r14504  
     1;;;; -*- Hen -*-
     2
    13((egg "sigma.egg") ; This should never change
    24
     
    1719 ; A list of eggs sigma depends on.
    1820
    19  (needs eggdoc args sxml-transforms doctype utf8 uri fmt)
     21 (needs eggdoc args sxml-transforms doctype utf8 uri-generic fmt matchable)
    2022
    2123 (eggdoc "sigma-eggdoc.scm")
  • release/4/sigma/trunk/sigma.scm

    r13056 r14504  
    88;;
    99;;
    10 ;; Copyright 2007 Ivan Raikov
     10;; Copyright 2007-2009 Ivan Raikov.
    1111;;
    1212;; This program is free software: you can redistribute it and/or
     
    2525
    2626
    27 (require-extension srfi-13)
    28 (require-extension posix)
    29 (require-extension extras)
    30 (require-extension regex)
    31 (require-extension utils)
    32 (require-extension args)
    33 (require-extension sxml-transforms)
    34 (require-extension doctype)
    35 (require-extension utf8)
    36 (require-extension uri)
    37 (require-extension fmt)
    38 
     27(module main ()
     28
     29(import scheme chicken foreign extras utils posix regex files data-structures ports)
     30
     31(require-extension srfi-1 srfi-13 args doctype uri-generic fmt utf8 matchable sxml-transforms)
    3932
    4033(define s+ string-append)
     
    5346
    5447(foreign-declare "#include <math.h>")
     48
    5549(define mkdtemp (foreign-lambda c-string "mkdtemp" c-string))
    5650(define log10 (foreign-lambda double "log10" double))
     
    278272(define args    (command-line-arguments))
    279273
    280 (set!-values (options operands)  (args:parse args opts))
    281 
    282274
    283275(define v:quiet 0)
     
    329321            (map smooth explist)))
    330322
    331 (define-macro (run . explist)
    332   `(run:execute* (list ,@(map (lambda (x) (list 'quasiquote x)) explist))))
    333 
    334 (define-macro (run- . explist)
    335   `(run:execute (list ,@(map (lambda (x) (list 'quasiquote x)) explist))))
     323
     324(define-syntax run
     325  (syntax-rules ()
     326    ((_ exp ...)
     327     (run:execute* (list `exp ...)))))
     328
     329(define-syntax run-
     330  (syntax-rules ()
     331    ((_ exp ...)
     332     (run:execute (list `exp ...)))))
    336333
    337334
     
    345342   (smooth cmd)))
    346343
    347 (define-macro (ipipe lam . explist)
    348   `(ipipe:execute ,lam ,@(map (lambda (x) (list 'quasiquote x)) explist)))
     344(define-syntax ipipe
     345  (syntax-rules ()
     346    ((_ lam exp)
     347     (ipipe:execute lam `exp ))))
    349348
    350349
     
    863862                                 (if omit-image-count? title
    864863                                     (list title " (" (number->string counter) ")"))))
    865                       (slide-url  (uri-encode
     864                      (slide-url  (uri-encode-string
    866865                                   (if yslide
    867866                                       (s+ slideprefix imagename)
    868867                                       imagename)))
    869                       (image-url   (uri-encode imagename))
     868                      (image-url   (uri-encode-string imagename))
    870869                      (date        (let ((v         (seconds->local-time (current-seconds)))
    871870                                         (num->str  (lambda (i w) (fmt #f (pad-char #\0 (fit/left w i))))))
     
    931930                            (let ((thumbname (s+ thumbprefix fname)))
    932931                              `(div (@ (class "thumb"))
    933                                     (a (@ (href ,(uri-encode sname)))
    934                                        (img (@ (src ,(uri-encode thumbname)))) ,nl)
     932                                    (a (@ (href ,(uri-encode-string sname)))
     933                                       (img (@ (src ,(uri-encode-string thumbname)))) ,nl)
    935934                                    (div (@ (class "thumb-caption"))
    936935                                         ,(cond (opt_u  `(p (@ (size "-2")) ,caption))
     
    960959                    (subfolders  (map (lambda (sub)
    961960                                        (let ((index-path  (s+ (first sub) dirsep html-index "." html-ext))
    962                                               (thumb-path  (s+ (first sub) dirsep (uri-encode (second sub))))
     961                                              (thumb-path  (s+ (first sub) dirsep (uri-encode-string (second sub))))
    963962                                              (caption     (if (string-null? (third sub)) (first sub) (third sub))))
    964963                                        `(div (@ (class "thumb"))
     
    10181017               (subfolders  (map (lambda (sub)
    10191018                                   (let ((index-path  (s+ (first sub) dirsep html-index "." html-ext))
    1020                                          (thumb-path  (s+ (first sub) dirsep (uri-encode (second sub))))
     1019                                         (thumb-path  (s+ (first sub) dirsep (uri-encode-string (second sub))))
    10211020                                         (caption     (if (string-null? (third sub)) (first sub) (third sub))))
    10221021                                     `(div (@ (class "thumb"))
     
    12081207        (message "CD image size is estimated to be " (* 2 blocks) " KB. " )
    12091208        (message "CD image size is estimated to be " size-MB " MB. " ))
    1210     (if (<= size *blocks-in-650MB*)
    1211         (let ((remaining (- *blocks-in-650MB* size)))
     1209    (if (<= size-MB *blocks-in-650MB*)
     1210        (let ((remaining (- *blocks-in-650MB* size-MB)))
    12121211          (message "it will fit in a 650 MB (70 min) disk, leaving "
    12131212                   (blocks->MB remaining)
    12141213                   " MB (" remaining " blocks) unused. ")
    12151214          'cd650)
    1216         (let ((remaining (- *blocks-in-700MB* size))
    1217               (excess    (- size *blocks-in-650MB*)))
    1218           (cond ((> size *blocks-in-700MB*)
     1215        (let ((remaining (- *blocks-in-700MB* size-MB))
     1216              (excess    (- size-MB *blocks-in-650MB*)))
     1217          (cond ((> size-MB *blocks-in-700MB*)
    12191218                 (message "it will not fit in a 700 MB (80 min) disk, for "
    12201219                          (blocks->MB (abs remaining))
     
    13051304          ;; makes a directory to store slides for a CD image
    13061305          (slide-dir (and (commands 'cdimage?)
    1307                           (let ((temp-dir-name (s+ image-dir dirsep ".sigma-cdimage.XXXXXX"))
    1308                                 (temp-dir      (mkdtemp temp-dir-name )))
     1306                          (let* ((temp-dir-name (s+ image-dir dirsep ".sigma-cdimage.XXXXXX"))
     1307                                 (temp-dir      (mkdtemp temp-dir-name )))
    13091308                            (if (not temp-dir)
    13101309                                (sigma:error 'main ": unable to create temporary directory " temp-dir-name))
     
    13521351         
    13531352
    1354 
    1355 (main options operands)
    1356 
     1353(let-values (((options operands)  (args:parse args opts)))
     1354            (main options operands))
     1355
     1356)
  • release/4/sigma/trunk/sigma.setup

    r13056 r14504  
     1;;;; -*- Hen -*-
    12
    2 (compile -O2 sigma.scm -lchicken -lm)
     3(compile -O2 sigma.scm)
    34
    45(run (csi -qbs sigma-eggdoc.scm > sigma.html))
Note: See TracChangeset for help on using the changeset viewer.