Changeset 15628 in project


Ignore:
Timestamp:
08/29/09 07:30:08 (10 years ago)
Author:
iraikov
Message:

sigma converted to using getopt-long

Location:
release/4/sigma/trunk
Files:
4 edited

Legend:

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

    r14850 r15628  
    3131
    3232     (history
     33      (version "1.20" "Command-line handling converted to using getopt-long")
    3334      (version "1.19" "Bug fix in command-line handling")
    3435      (version "1.18" "Bug fix in filter-subfolders")
     
    5152      (version "1.0" "Initial release"))
    5253
    53      (requires (url "args.html" "args")
     54     (requires (url "getopt-long.html" "getopt-long")
    5455               (url "sxml-transforms.html" "sxml-transforms")
    55                (url "doctype.html" "doctype")
    5656               (url "utf8.html" "utf8")
    5757               (url "uri.html" "uri")
  • release/4/sigma/trunk/sigma.meta

    r14504 r15628  
    1919 ; A list of eggs sigma depends on.
    2020
    21  (needs eggdoc args sxml-transforms doctype utf8 uri-generic fmt matchable)
     21 (needs eggdoc matchable sxml-transforms utf8 uri-generic fmt getopt-long)
    2222
    2323 (eggdoc "sigma-eggdoc.scm")
  • release/4/sigma/trunk/sigma.scm

    r14850 r15628  
    2525
    2626
    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)
     27(import scheme chicken foreign)
     28
     29(require-extension
     30 extras utils posix regex files data-structures ports
     31 srfi-1 srfi-13 matchable getopt-long uri-generic fmt
     32 utf8 sxml-transforms)
    3233
    3334(define s+ string-append)
     
    3738    (let-optionals rest ((default #f))
    3839      (alist-ref k lst eq? default))))
    39 
    4040
    4141
     
    9393
    9494(define local-sigma-dir
    95   (let ((env (current-environment)))
    96     (let ((home (alist-ref "HOME" env string=?)))
     95    (let ((home (getenv "HOME")))
    9796      (if home (s+ home dirsep sigma-dir)
    98           sigma-dir))))
    99 
    100 
    101 ;; default command-line argument values
    102 (define opt_a      #f)       ; to write image size under thumbnails in index page
    103 (define opt_c      #f)       ; -c to use user-supplied captions
    104 (define opt_C      #f)       ; same as -c, but preserve image names as captions
    105 (define opt_d     ".")       ; look in current directory "."
    106 (define opt_f      #f)       ; -f to force thumbnail regeneration
    107 (define opt_g      "Default Gallery Title")     ; gallery title
    108 (define opt_h      #f)       ; print help
    109 (define opt_k      #f)         ; -k for the captions to also be used as slide titles
    110 (define opt_n      20)         ; -n maximum thumbnails per index page
    111 (define opt_R      #f)         ; -R to descend subdirectories recursively
    112 (define opt_t      #f)         ; if specified, place image gallery in this directory
    113 (define opt_u      #f)         ; write captions under thumbnails on index page
    114 (define opt_U      #f)         ; write image names under thumbnails on index page
    115 (define opt_x      #f)         ; -x to omit the image count from the caption
    116 (define opt_y      75)         ; max height of a thumbnail (defaults to 75)
    117 (define opt_ad     #f)         ; write out only dimensions
    118 (define opt_as     #f)         ; write out only file size
    119 (define opt_author             ; specify author name
    120   (let ((user (alist-ref "USER" (current-environment) string=?)))
    121     (if user (car (string-split (fifth (user-information user)) ",")) "")))
    122 (define opt_yslide   #f)       ; max height of the slides.  use if images are huge.
    123 (define opt_con      "")       ; options to be passed to convert
    124 (define opt_help     #f)       ; displays brief usage message; same as -h
    125 (define opt_hls      #f)       ; --hls to create a highlights page
    126 (define opt_hls-main #f)       ; --hls-main to create a highlights page as the main page
    127 (define opt_html-ext "html")   ; extension of output HTML files
    128 (define opt_html-index  "index")  ; name of the main thumbnail index file
    129 (define opt_html-hindex "hindex") ; name of the highlights index file
    130 (define opt_in       #f)       ; --in to use image file names for the .html files
    131 (define opt_sp       slideprefix) ; changes the slide filename prefix
    132 (define opt_tp       thumbprefix) ; changes the thumbnail filename prefix
    133 (define opt_top      #f)      ; if specified, create top-level index
    134                               ; file in directories that only contain
    135                               ; subfolders but no images
    136 (define opt_up       #f)      ; if specified, generate "Up" link even for top-level image galleries
    137 (define opt_verbose  1)       ; verbose mode
    138 (define opt_xy       #f)      ; scale thumbs to n pixels in their longer dimension
    139 (define opt_www      #f)      ; makes everything world-readable
    140 
    141 (define opt_gcd      #f) ;; the same as -g, but also sets the
    142                          ;; name of the CD image file
    143 
    144 (define opt_cd-file  "Photos") ;; name of CD image file
    145 (define opt_cd-dir             ;; directory for CD image output
    146   (let ((env (current-environment)))
    147     (let ((home (alist-ref "HOME" env string=?)))
    148       (if home (s+ home dirsep "tmp")
    149           (s+ dirsep "tmp")))))
    150 
    151 
     97          sigma-dir)))
     98
     99(define opt-defaults
     100  `(
     101    (d . ".")
     102    (g . "Default Gallery Title")
     103    (y . 75)
     104    (author .
     105     ,(let ((user (getenv "USER")))
     106        (if user (car (string-split
     107                       (fifth (user-information user)) ","))
     108            "")))
     109    (con .  "")
     110
     111    (cd-dir .
     112     ,(let ((home (getenv "HOME")))
     113        (if home (s+ home dirsep "tmp")
     114            (s+ dirsep "tmp"))))
     115
     116    (cd-file  .   "Photos")
     117    (html-ext .  "html")
     118    (html-index . "index")
     119    (html-hindex . "hindex")
     120    (sp .         ,slideprefix)
     121    (tp .        ,thumbprefix)
     122    (verbose .    1)
     123    ))
     124
     125(define (defopt x)
     126  (lookup-def x opt-defaults))
    152127                 
    153 (define opts
     128(define opt-grammar
    154129  `(
    155     ,(args:make-option (a)       #:none               "write image sizes under thumbnails on index page"
    156                        (set! opt_a #t))
    157     ,(args:make-option (c)       #:none               "first generate and then use captions"
    158                        (set! opt_c #t))
    159     ,(args:make-option (C)       #:none               "like -c, but preserve file names as captions"
    160                        (set! opt_C #t))
    161     ,(args:make-option (d)       (required: "DIR")   
    162                        (s+ "operate on files in directory DIR (default: " opt_d ")")
    163                        (set! opt_d arg))
    164     ,(args:make-option (f)       #:none               "force thumbnail regeneration and scaled slides"
    165                        (set! opt_f #t))
    166     ,(args:make-option (g)       (required: "TITLE")    (s+ "gallery title (default: " opt_g ")")
    167                        (set! opt_g arg))
    168     ,(args:make-option (k)       #:none               "use the image captions for the HTML slide titles"
    169                        (set! opt_k #t))
    170     ,(args:make-option (R)       #:none               "recursively descend subdirectories"
    171                        (set! opt_R #t))
    172     ,(args:make-option (t)       (required: "DIR")
    173                        "place gallery files in directory DIR (will be created if it doesn't exist)"
    174                        (set! opt_t arg))
    175     ,(args:make-option (u)       #:none               "write captions under thumbnails on index page"
    176                        (set! opt_u #t))
    177     ,(args:make-option (U)       #:none               "write slide names under thumbnails on index page"
    178                        (set! opt_U #t))
    179     ,(args:make-option (x)       #:none               "omit the image count from the captions"
    180                        (set! opt_x #t))
    181     ,(args:make-option (y)       (required: "N")     
    182                        (s+ "scale all thumbnails to the same height  "
    183                                       "(default: " (number->string opt_y) ")")
    184                        (let ((N (string->number arg)))
    185                          (if (not N) (sigma:error 'main ": invalid numeric argument " arg  " given to option -y"))
    186                          (set! opt_y N)))
    187     ,(args:make-option (ad)       #:none              "like -a, but write only the image dimensions"
    188                        (set! opt_ad #t))
    189     ,(args:make-option (as)       #:none              "like -a, but write only the file size (in kbytes)"
    190                        (set! opt_as #t))
    191     ,(args:make-option (author)    (required: "AUTHOR")  (s+ "specify author name "
    192                                                                         "(default: " opt_author ")")
    193                        (set! opt_author arg))
    194     ,(args:make-option (con)      (required: "OPTS")  "options to pass to convert"
    195                        (set! opt_con arg))
    196     ,(args:make-option (cd-dir)      (required: "DIR")  (s+ "directory for CD image output (default: "
    197                                                             opt_cd-dir ")")
    198                        (set! opt_cd-dir arg))
    199     ,(args:make-option (cd-file)      (required: "DIR")  (s+ "name of CD image file if --gcd is not specified (default: "
    200                                                              opt_cd-file ")")
    201                        (set! opt_cd-file arg))
    202     ,(args:make-option (gcd)       (required: "TITLE")    (s+ "like -g, but also sets CD image file name")
    203                        (set! opt_g arg)
    204                        (set! opt_gcd arg))
    205     ,(args:make-option (hls)       #:none             "creates a highlights page"
    206                        (set! opt_hls #t))
    207     ,(args:make-option (hls-main)       #:none        "creates a highlights page as the main page"
    208                        (set! opt_hls #t)
    209                        (set! opt_hls-main #t))
    210     ,(args:make-option (html-ext)       (required: "SUFFIX")
    211                        (s+ "suffix of output HTML files (default: " opt_html-ext ")")
    212                        (set! opt_html-ext arg))
    213     ,(args:make-option (html-index)     (required: "NAME")   
    214                        (s+ "name (without suffix) of the main thumbnail "
    215                                       "index file (default: " opt_html-index ")")
    216                        (set! opt_html-index arg))
    217     ,(args:make-option (html-hindex)     (required: "NAME")   
    218                        (s+ "name (without suffix) of the highlights "
    219                                       "index file (default: " opt_html-hindex ")")
    220                        (set! opt_html-hindex arg))
    221     ,(args:make-option (in)       #:none              "use image file names for the HTML slide files"
    222                        (set! opt_in #t))
    223     ,(args:make-option (sp)       (required: "PREFIX")   (s+ "sets the slide image prefix "
    224                                                                      "(default: " opt_sp ")")
    225                        (set! opt_sp arg))
    226     ,(args:make-option (top)       #:none              "create index pages for directories that only contain subfolders"
    227                        (set! opt_top #t))
    228     ,(args:make-option (tp)       (required: "PREFIX")   (s+ "sets the thumbnail image prefix "
    229                                                                      "(default: " opt_tp ")")
    230                        (set! opt_tp arg))
    231     ,(args:make-option (up)       #:none               "create Up links even in top-level image galleries"
    232                        (set! opt_up #t))
    233     ,(args:make-option (verbose)       (required: "LEVEL")
    234                        (s+ "set verbose mode (0: quiet; 1: info; 2: debug)")
    235                        (let ((N (string->number arg)))
    236                          (if (not N) (sigma:error 'main ": invalid numeric argument " arg  " given to option --verbose"))
    237                          (set! opt_verbose N)))
    238     ,(args:make-option (www)      #:none              "makes all SIGMA files world-readable"
    239                        (set! opt_www #t))
    240     ,(args:make-option (xy)       (required: "N")     "scale thumbnails to N pixels in their longer dimension"
    241                        (let ((N (string->number arg)))
    242                          (if (not N) (sigma:error 'main ": invalid numeric argument " arg  " given to option --xy"))
    243                          (set! opt_xy N)))
    244     ,(args:make-option (yslide)     (required: "N")   "scale slides to the given maximum height"
    245                        (let ((N (string->number arg)))
    246                          (if (not N) (sigma:error 'main ": invalid numeric argument " arg  " given to option --yslide"))
    247                          (set! opt_yslide N)))
    248     ,(args:make-option (h help)  #:none               "Print help"
    249                        (usage))))
     130    (a  "write image sizes under thumbnails on index page")
     131    (c  "first generate and then use captions")
     132    (C  "like -c, but preserve file names as captions")
     133
     134    (d  ,(s+ "operate on files in directory DIR (default: " (defopt 'd) ")")
     135        (value (required DIR)
     136               (predicate ,directory?)
     137               (default ".")))
     138               
     139    (f  "force thumbnail regeneration and scaled slides")
     140
     141    (g  ,(s+ "gallery title (default: " (defopt 'g) ")")
     142        (value (required TITLE)
     143               (default "Default Gallery Title")))
     144
     145    (k  "use the image captions for the HTML slide titles")
     146    (R  "recursively descend subdirectories")
     147
     148    (t  ,(s+ "place gallery files in directory DIR "
     149             "(will be created if it doesn't exist)")
     150        (value (required DIR)))
     151
     152    (u  "write captions under thumbnails on index page")
     153    (U  "write slide names under thumbnails on index page")
     154    (x  "omit the image count from the captions")
     155
     156    (y  ,(s+ "scale all thumbnails to the same height  "
     157             "(default: " (number->string (defopt 'y)) ")")
     158        (value (required N)
     159               (predicate ,string->number)
     160               (transformer ,string->number)
     161               (default 75)))
     162
     163    (ad  "like -a, but write only the image dimensions")
     164    (as  "like -a, but write only the file size (in kbytes)")
     165
     166    (author   ,(s+ "specify author name "
     167                   "(default: " (defopt 'author) ")")
     168              (value (required AUTHOR)
     169                     (default
     170                       ,(let ((user (getenv "USER")))
     171                          (if user (car (string-split
     172                                         (fifth (user-information user)) ","))
     173                              "")))))
     174
     175    (con      "options to pass to convert"
     176              (value (required OPTS)
     177                     (default "")))
     178
     179    (cd-dir   ,(s+ "directory for CD image output "
     180                   "(default: "   (defopt 'cd-dir) ")")
     181              (value (required DIR)
     182                     (predicate ,directory?)
     183                     (default
     184                       ,(let ((home (getenv "HOME")))
     185                          (if home (s+ home dirsep "tmp")
     186                              (s+ dirsep "tmp"))))))
     187
     188    (cd-file  ,(s+ "name of CD image file if --gcd is not specified "
     189                   "(default: " (defopt 'cd-file) ")")
     190              (value (required FILE) 
     191                     (default "Photos")))
     192
     193    (gcd       "like -g, but also sets CD image file name"
     194               (value (required TITLE)))
     195
     196    (hls       "creates a highlights page")
     197    (hls-main  "creates a highlights page as the main page")
     198
     199    (html-ext  ,(s+ "suffix of output HTML files "
     200                    "(default: " (defopt 'html-ext) ")")
     201               (value (required SUFFIX)
     202                      (default "html")))
     203
     204    (html-index  ,(s+ "name (without suffix) of the main thumbnail "
     205                      "index file (default: " (defopt 'html-index) ")")   
     206                 (value (required NAME)
     207                        (default "index")))
     208                       
     209    (html-hindex  ,(s+ "name (without suffix) of the highlights "
     210                       "index file (default: " (defopt 'html-hindex) ")")   
     211                  (value (required NAME)
     212                         (default "hindex")))
     213
     214    (in          "use image file names for the HTML slide files")
     215    (sp          ,(s+ "sets the slide image prefix "
     216                      "(default: " (defopt 'sp) ")")
     217                 (value (required PREFIX)
     218                        (default ,slideprefix)))
     219
     220    (top         "create index pages for directories that only contain subfolders")
     221    (tp          ,(s+ "sets the thumbnail image prefix "
     222                      "(default: " (defopt 'tp) ")")
     223                 (value (required PREFIX)
     224                        (default ,thumbprefix)))
     225
     226    (up          "create Up links even in top-level image galleries")
     227
     228    (verbose      ,(s+ "set verbose mode (0: quiet; 1: info; 2: debug)")
     229                  (value (required LEVEL)
     230                         (default 1)
     231                         (predicate ,string->number)
     232                         (transformer ,string->number)))
     233
     234    (www          "makes all SIGMA files world-readable")
     235    (xy           "scale thumbnails to N pixels in their longer dimension"
     236                  (value (required N)     
     237                         (predicate ,string->number)
     238                         (transformer ,string->number)))
     239
     240    (yslide       "scale slides to the given maximum height"
     241                  (value (required N)   
     242                         (predicate ,string->number)
     243                         (transformer ,string->number)))
     244
     245    (help         (single-char #\h))           
     246
     247    ))
    250248
    251249
    252250;; Use args:usage to generate a formatted list of options (from OPTS),
    253251;; suitable for embedding into help text.
    254 (define (usage)
     252(define (sigma:usage)
    255253  (print "Usage: " (car (argv)) " [options...] commands ")
    256254  (newline)
     
    270268  (print "The following options are recognized: ")
    271269  (newline)
    272   (print (parameterize ((args:indent 5)) (args:usage opts)))
     270  (print (parameterize ((indent 5)) (usage opt-grammar)))
    273271  (exit 1))
    274272
     
    277275;; alist, and operands (filenames) into OPERANDS.  You can handle
    278276;; options as they are processed, or afterwards.
    279 (define args    (command-line-arguments))
     277
     278(define opts    (getopt-long (command-line-arguments) opt-grammar))
     279(define opt     (make-option-dispatch opts opt-grammar))
    280280
    281281
     
    286286(define (done . rest)
    287287  (let-optionals rest ((indicator "done!"))
    288     (if (= opt_verbose v:info)
     288    (if (= (opt 'verbose) v:info)
    289289        (begin
    290290          (display indicator)
     
    293293(define (progress . rest)
    294294  (let-optionals rest ((indicator "."))
    295     (if (= opt_verbose v:info)
     295    (if (= (opt 'verbose) v:info)
    296296        (display indicator))))
    297297
    298298(define (message x . rest)
    299   (if (positive? opt_verbose)
     299  (if (positive? (opt 'verbose))
    300300      (let loop ((port (open-output-string)) (objs (cons x rest)))
    301301        (if (null? objs)
     
    315315      (string-intersperse (cons (car slst) (cdr slst)) " ")))
    316316  (for-each (lambda (cmd)
    317               (if (>= opt_verbose 2) (printf "  ~A~%~!" cmd))
     317              (if (>= (opt 'verbose) 2) (printf "  ~A~%~!" cmd))
    318318              (system (->string cmd)))
    319319            (map smooth explist)))
     
    324324      (string-intersperse (cons (car slst) (cdr slst)) " ")))
    325325  (for-each (lambda (cmd)
    326               (if (>= opt_verbose 2) (printf "  ~A~%~!" cmd))
     326              (if (>= (opt 'verbose) 2) (printf "  ~A~%~!" cmd))
    327327              (system* "~a" cmd))
    328328            (map smooth explist)))
     
    345345      (string-intersperse (cons (car slst) (cdr slst)) " ")))
    346346  ((lambda (cmd)
    347      (if (>= opt_verbose 2) (printf "  ~A~%~!" cmd))
     347     (if (>= (opt 'verbose) 2) (printf "  ~A~%~!" cmd))
    348348     (with-input-from-pipe (sprintf "~a" cmd) lam))
    349349   (smooth cmd)))
     
    614614   path (lambda (x)
    615615          (let ((canx (canonical-path x))
    616                 (cant (and opt_t (canonical-path opt_t))))
     616                (cant (and (opt 't) (canonical-path (opt 't)))))
    617617            (and (directory? x) (or (not cant) (not (string=? cant canx))))))
    618618   (lambda (x y) (let ((lst (string-split x dirsep)))
     
    940940                                       (img (@ (src ,(uri-encode-string thumbname)))) ,nl)
    941941                                    (div (@ (class "thumb-caption"))
    942                                          ,(cond (opt_u  `(p (@ (size "-2")) ,caption))
    943                                                 (opt_U  `(p (@ (size "-2")) ,sname))
     942                                         ,(cond ((opt 'u)  `(p (@ (size "-2")) ,caption))
     943                                                ((opt 'U)  `(p (@ (size "-2")) ,sname))
    944944                                                (else   ""))
    945                                          ,(cond (opt_a   `(p (@ (size "-2"))
    946                                                              ,(first sz) "x" ,(second sz) (br)
    947                                                              "(" ,(quotient (third sz) 1024) " KB" ")"))
    948                                                 (opt_ad  `(p (@ (size "-2")) ,(first sz) "x" ,(second sz)))
    949                                                 (opt_as  `(p (@ (size "-2")) ,(quotient (third sz) 1024) " KB"))
     945                                         ,(cond ((opt 'a)   `(p (@ (size "-2"))
     946                                                                ,(first sz) "x" ,(second sz) (br)
     947                                                                "(" ,(quotient (third sz) 1024) " KB" ")"))
     948                                                ((opt 'ad)  `(p (@ (size "-2")) ,(first sz) "x" ,(second sz)))
     949                                                ((opt 'as)  `(p (@ (size "-2")) ,(quotient (third sz) 1024) " KB"))
    950950                                                (else   ""))))))
    951951                          (take flst nthumbs) (take slst nthumbs) (take captions nthumbs)
     
    10801080         ;; read in files specified in the .captions file
    10811081         (let-values (((flst+captions subfolders)
    1082                        (if (or opt_c opt_C) (read-or-create-captions captionpath flst subfolders opt_C)
     1082                       (if (or (opt 'c) (opt 'C))
     1083                           (read-or-create-captions captionpath flst subfolders (opt 'C))
    10831084                           (values (map (lambda (x) (if (list? x) (append x (list "")) (list x ""))) flst)
    10841085                                   (map (lambda (x) (if (list? x) (append x (list "")) (list x ""))) subfolders)))))
     
    10951096                      ;; create the index files with all the thumbnails
    10961097                      (make-toplevel-index target-dir index-tmpl-file
    1097                                            opt_html-index opt_html-ext opt_g opt_author subfolders up)
     1098                                           (opt 'html-index) (opt 'html-ext) (opt 'g) (opt 'author) subfolders up)
    10981099                      (done)))
    10991100                   (flst+captions
     
    11091110                            ;; generate thumbnails
    11101111                            (if (commands 'thumbs?)
    1111                                 (make-thumbs image-dir target-dir flst opt_y opt_xy opt_f opt_con))
     1112                                (make-thumbs image-dir target-dir flst (opt 'y) (opt 'xy) (opt 'f) (opt 'con)))
    11121113                            ;; if slide-dir is true (e.g. when making a CD image),
    11131114                            ;; copy the slides to slide-dir
     
    11181119                                          (let ((ext (pathname-extension f))
    11191120                                                (is  (fmt #f (pad-char #\0 (fit/left 5 i)))))
    1120                                             (let ((fpath (s+ target-dir dirsep (if opt_yslide (s+ slideprefix f) f)))
     1121                                            (let ((fpath (s+ target-dir dirsep
     1122                                                             (if (opt 'yslide) (s+ slideprefix f) f)))
    11211123                                                  (rpath (s+ slide-dir dirsep is "." ext )))
    11221124                                              (run (cp  ,(fpesc fpath) ,(fpesc rpath)))
     
    11281130                                (begin
    11291131                                  ;; scale down images
    1130                                   (if opt_yslide
    1131                                       (scale-images image-dir target-dir flst opt_yslide opt_f opt_con))
     1132                                  (if (opt 'yslide)
     1133                                      (scale-images image-dir target-dir flst (opt 'yslide) (opt 'f) (opt 'con)))
     1134
    11321135                                  (let ((szlst  (read-image-sizes target-dir flst))
    1133                                         (hszlst (and opt_hls (read-image-sizes target-dir hflst)))
    1134                                         (slst  (if opt_in  ;; use image file names for slide html file names
    1135                                                    (map (lambda (n) (pathname-replace-extension n opt_html-ext)) flst)
    1136                                                    (map (lambda (n) (s+ n "." opt_html-ext))
     1136                                        (hszlst (and (opt 'hls) (read-image-sizes target-dir hflst)))
     1137                                        (slst  (if (opt 'in)  ;; use image file names for slide html file names
     1138                                                   (map (lambda (n) (pathname-replace-extension n (opt 'html-ext))) flst)
     1139                                                   (map (lambda (n) (s+ n "." (opt 'html-ext)))
    11371140                                                        (list-tabulate nfiles number->string))))
    1138                                         (hslst  (if opt_in 
     1141                                        (hslst  (if (opt 'in) 
    11391142                                                    (map (lambda (n)
    1140                                                            (s+ "hl" (pathname-replace-extension n opt_html-ext)))
     1143                                                           (s+ "hl" (pathname-replace-extension n (opt 'html-ext))))
    11411144                                                         hflst)
    1142                                                     (map (lambda (n) (s+ "hl" n "." opt_html-ext))
     1145                                                    (map (lambda (n) (s+ "hl" n "." (opt 'html-ext)))
    11431146                                                         (list-tabulate (length hflst) number->string)))))
    11441147                                    (clean-targetdir target-dir)
     
    11471150                                    (let ((slide-tmpl-path    (s+ target-dir dirsep slide-tmpl-file)))
    11481151                                      (let ((slidetmpl   (with-input-from-file slide-tmpl-path read))
    1149                                             (hindex      (s+ opt_html-hindex "." opt_html-ext))
    1150                                             (htitle      (list "Highlights of " '(br) opt_g)))
     1152                                            (hindex      (s+ (opt 'html-hindex) "." (opt 'html-ext)))
     1153                                            (htitle      (list "Highlights of " '(br) (opt 'g))))
    11511154                                        ;; create the individual slide show files
    11521155                                        (make-slides image-dir target-dir slidetmpl
    1153                                                      (if (and opt_hls-main (not (null? hflst))) hindex index)
    1154                                                      opt_g flst captions slst opt_k opt_x opt_yslide opt_author)
     1156                                                     (if (and (opt 'hls-main) (not (null? hflst))) hindex index)
     1157                                                     (opt 'g) flst captions slst (opt 'k) (opt 'x) (opt 'yslide)
     1158                                                     (opt 'author))
    11551159                                       
    1156                                         (if (and opt_hls (not (null? hflst)))
     1160                                        (if (and (opt 'hls) (not (null? hflst)))
    11571161                                            ;; create the slide show files for the highlight images
    1158                                             (make-slides image-dir target-dir slidetmpl (if opt_hls-main index hindex)
    1159                                                          htitle hflst hcaptions hslst opt_k opt_x opt_yslide opt_author))
     1162                                            (make-slides image-dir target-dir slidetmpl
     1163                                                         (if (opt 'hls-main) index hindex)
     1164                                                         htitle hflst hcaptions hslst
     1165                                                         (opt 'k) (opt 'x) (opt 'yslide) (opt 'author)))
    11601166                                        ;; locate and copy the index template file, if necessary
    11611167                                        (locate-and-copy-template SIGMA-DIR target-dir index-tmpl-file)
    11621168                                        ;; locate and copy the CSS file, if necessary
    11631169                                        (locate-and-copy-template SIGMA-DIR target-dir css-tmpl-file)
    1164                                         (cond ((and opt_hls-main (not (null? hflst)))
    1165                                                (let ((up-url (s+ ".." dirsep opt_html-index "." opt_html-ext)))
     1170                                        (cond ((and (opt 'hls-main) (not (null? hflst)))
     1171                                               (let ((up-url (s+ ".." dirsep (opt 'html-index) "." (opt 'html-ext))))
    11661172                                                 ;; create the index files with all the thumbnails
    11671173                                                 (make-index target-dir index-tmpl-file flst slst captions szlst
    1168                                                              nfiles opt_n opt_html-hindex opt_html-ext opt_g opt_author
     1174                                                             nfiles (opt 'n) (opt 'html-hindex) (opt 'html-ext)
     1175                                                             (opt 'g) (opt 'author)
    11691176                                                             subfolders (and up up-url)
    11701177                                                             `(("Highlights"
    1171                                                                 ,(s+ opt_html-index "." opt_html-ext))))
     1178                                                                ,(s+ (opt 'html-index) "." (opt 'html-ext)))))
    11721179                                                 (make-index target-dir index-tmpl-file hflst hslst hcaptions hszlst
    1173                                                              (length hflst) opt_n opt_html-index opt_html-ext
    1174                                                              htitle opt_author subfolders (and up up-url)
     1180                                                             (length hflst) (opt 'n) (opt 'html-index) (opt 'html-ext)
     1181                                                             htitle (opt 'author) subfolders (and up up-url)
    11751182                                                             `(("All images"
    1176                                                                 ,(s+ opt_html-hindex "." opt_html-ext))))))
    1177                                               ((and opt_hls (not (null? hflst)))
    1178                                                (let ((up-url (s+ ".." dirsep opt_html-index "." opt_html-ext)))
     1183                                                                ,(s+ (opt 'html-hindex) "." (opt 'html-ext)))))))
     1184
     1185                                              ((and (opt 'hls) (not (null? hflst)))
     1186                                               (let ((up-url (s+ ".." dirsep (opt 'html-index) "." (opt 'html-ext))))
    11791187                                                  ;; create the index files with all the thumbnails
    11801188                                                  (make-index target-dir index-tmpl-file flst slst captions szlst
    1181                                                               nfiles opt_n opt_html-index opt_html-ext opt_g opt_author
     1189                                                              nfiles (opt 'n) (opt 'html-index) (opt 'html-ext)
     1190                                                              (opt 'g) (opt 'author)
    11821191                                                              subfolders (and up up-url)
    11831192                                                              `(("Highlights"
    1184                                                                  ,(s+ opt_html-hindex "." opt_html-ext))))
     1193                                                                 ,(s+ (opt 'html-hindex) "." (opt 'html-ext)))))
    11851194                                                  (make-index target-dir index-tmpl-file hflst hslst hcaptions hszlst
    1186                                                               (length hflst) opt_n opt_html-hindex opt_html-ext
    1187                                                               htitle opt_author subfolders (and up up-url)
     1195                                                              (length hflst) (opt 'n) (opt 'html-hindex) (opt 'html-ext)
     1196                                                              htitle (opt 'author) subfolders (and up up-url)
    11881197                                                              `(("All images"
    1189                                                                  ,(s+ opt_html-index "." opt_html-ext))))))
     1198                                                                 ,(s+ (opt 'html-index) "." (opt 'html-ext)))))))
    11901199                                               (else
    11911200                                                (make-index target-dir index-tmpl-file flst slst captions szlst
    1192                                                               nfiles opt_n opt_html-index opt_html-ext opt_g opt_author
    1193                                                               subfolders up )))
     1201                                                              nfiles (opt 'n) (opt 'html-index) (opt 'html-ext)
     1202                                                              (opt 'g) (opt 'author) subfolders up )))
     1203
    11941204                                        ;; if --www was invoked make all images world-readable at the end
    1195                                         (if opt_www
     1205                                        (if (opt 'www)
    11961206                                            (begin
    11971207                                              (message "Making all gallery files world-readable for WWW publishing...")
    11981208                                              (run  (chmod a+r ,(s+ (fpesc target-dir) dirsep css-tmpl-file)))
    1199                                               (run  (chmod a+r ,(s+ (fpesc target-dir) dirsep "*." opt_html-ext)))
     1209                                              (run  (chmod a+r ,(s+ (fpesc target-dir) dirsep "*." (opt 'html-ext))))
    12001210                                              (run- (chmod a+r ,(s+ (fpesc target-dir) dirsep thumbprefix "*.*")))
    12011211                                              (run- (chmod a+r ,(s+ (fpesc target-dir) dirsep slideprefix "*.*")))
     
    12481258      (let-optionals rest
    12491259                     ((title        (make-up-volume-title dirs))
    1250                       (output-path  (s+ opt_cd-dir dirsep (or opt_gcd opt_cd-file) ".iso"))
    1251                       (preparer     opt_author)
    1252                       (publisher    opt_author))
     1260                      (output-path  (s+ (opt 'cd-dir) dirsep (or (opt 'gcd) (opt 'cd-file)) ".iso"))
     1261                      (preparer     (opt 'author))
     1262                      (publisher    (opt 'author)))
    12531263        (run (mkisofs -r -V ,(s+ "\"" title "\"") -p ,(s+ "\"" preparer "\"")
    12541264                      -P ,(s+ "\"" publisher "\"") -o ,(fpesc output-path) ,@dirs))
     
    12841294           (commands  (or commands (make-command-selector '(gallery))))
    12851295           ;; Strip any unnecessary slashes from the end of the given
    1286            ;; opt_d and opt_t directories
    1287            (image-dir  (let loop ((opt_d (string-chomp opt_d dirsep)))
     1296           ;; -d and -t directories
     1297           (image-dir  (let loop ((opt_d (string-chomp (opt 'd) dirsep)))
    12881298                         (let ((opt_d1 (string-chomp opt_d dirsep)))
    12891299                           (if (string=? opt_d1 opt_d) opt_d
    12901300                               (loop opt_d1)))))
    1291            (target-dir  (or (and opt_t
    1292                                  (let loop ((opt_t (string-chomp opt_t dirsep)))
     1301           (target-dir  (or (and (opt 't)
     1302                                 (let loop ((opt_t (string-chomp (opt 't) dirsep)))
    12931303                                   (let ((opt_t1 (string-chomp opt_t dirsep)))
    12941304                                     (if (string=? opt_t1 opt_t) opt_t
    12951305                                         (loop opt_t)))))
    12961306                            image-dir)))
    1297    
    1298     ;; sanity checks
    1299     (if (and opt_g opt_gcd)
    1300         (sigma:error "please specify only one of the -g and --gcd options"))
    1301     (if (and opt_y opt_xy)
    1302         (sigma:error "please specify only one of the -y and --xy options"))
    1303     (if (or (and opt_y (negative? opt_y)) (and opt_xy (negative? opt_xy)))
    1304         (sigma:error "please enter non-negative thumbnail dimensions" ))
    1305     (if (and opt_yslide (negative? opt_yslide))
    1306         (sigma:error "please enter non-negative maximum slide height" ))
    1307 
    1308     (let (;; construct the name of the main index file
    1309           (index  (s+ opt_html-index "." opt_html-ext))
    1310           ;; let users store their templates in a $HOME/.sigma directory, if it exists,
    1311           ;; instead of the site-wide /usr/share/sigma
    1312           (SIGMA-DIR   (if (directory? local-sigma-dir) local-sigma-dir SIGMA-DIR))
    1313           ;; makes a directory to store slides for a CD image
    1314           (slide-dir (and (commands 'cdimage?)
    1315                           (let* ((temp-dir-name (s+ image-dir dirsep ".sigma-cdimage.XXXXXX"))
    1316                                  (temp-dir      (mkdtemp temp-dir-name )))
    1317                             (if (not temp-dir)
    1318                                 (sigma:error 'main ": unable to create temporary directory " temp-dir-name))
     1307     
     1308      (if (opt 'help) (sigma:usage))
     1309     
     1310      ;; sanity checks
     1311      (if (and (opt 'g) (opt 'gcd))
     1312          (sigma:error "please specify only one of the -g and --gcd options"))
     1313      (if (and (opt 'y) (opt 'xy))
     1314          (sigma:error "please specify only one of the -y and --xy options"))
     1315      (if (or (and (opt 'y) (negative? (opt 'y)))
     1316              (and (opt 'xy) (negative? (opt 'xy))))
     1317          (sigma:error "please enter non-negative thumbnail dimensions" ))
     1318      (if (and (opt 'yslide) (negative? (opt 'yslide)))
     1319          (sigma:error "please enter non-negative maximum slide height" ))
     1320     
     1321      (let (;; construct the name of the main index file
     1322            (index  (s+ (opt 'html-index) "." (opt 'html-ext)))
     1323            ;; let users store their templates in a $HOME/.sigma directory, if it exists,
     1324            ;; instead of the site-wide /usr/share/sigma
     1325            (SIGMA-DIR   (if (directory? local-sigma-dir) local-sigma-dir SIGMA-DIR))
     1326            ;; makes a directory to store slides for a CD image
     1327            (slide-dir (and (commands 'cdimage?)
     1328                            (let* ((temp-dir-name (s+ image-dir dirsep ".sigma-cdimage.XXXXXX"))
     1329                                   (temp-dir      (mkdtemp temp-dir-name )))
     1330                              (if (not temp-dir)
     1331                                  (sigma:error 'main ": unable to create temporary directory " temp-dir-name))
    13191332                            temp-dir))))
    1320       (if opt_R
    1321           (let* ((image-dir-depth   (length (string-split image-dir dirsep)))
    1322                  (make-gallery
    1323                   (lambda (lev d . rest)
    1324                     (let-optionals rest ((subdirs (list)))
    1325                       (let* ((absolute?    (string=? dirsep (car d)))
    1326                              (image-dir    (if absolute?
    1327                                                (s+ (car d) (string-intersperse (cdr d) dirsep))
    1328                                                (string-intersperse d dirsep)))
    1329                              (target-dir   (string-intersperse
    1330                                             (cons target-dir (drop (if absolute? (cdr d) d) image-dir-depth))
    1331                                            dirsep)))
    1332                         (main-make-gallery SIGMA-DIR index image-dir target-dir commands
    1333                                            subdirs (or (positive? lev) opt_up) opt_top
    1334                                            slide-dir))))))
    1335             ;; make sure target dir exists
    1336             (if (not (file-exists? target-dir))
    1337                 (create-directory target-dir))
    1338             (let recur ((level  0)
    1339                         (dir    image-dir)
    1340                         (dirlst (read-subdirs image-dir))
    1341                         (null-handler (lambda (level dir) (sigma:error "no subdirectories found in " dir))))
    1342               (if (null? dirlst)
    1343                   (null-handler level dir)
    1344                   (for-each
    1345                    (lambda (d)
    1346                      (let ((sd (string-intersperse d dirsep)))
    1347                        (let ((subdirs (read-subdirs sd)))
    1348                          (recur (+ 1 level) d subdirs make-gallery))))
    1349                    dirlst)))
    1350             (main-make-gallery SIGMA-DIR index image-dir target-dir commands
    1351                                (read-subdirs target-dir) opt_up opt_top slide-dir))
    1352           (main-make-gallery SIGMA-DIR index image-dir target-dir commands (list) opt_up #f slide-dir))
    1353       (if (commands 'cdimage?)
    1354           (begin
    1355             (message "Creating CD image " (s+ opt_cd-dir dirsep (or opt_gcd opt_cd-file) ".iso") ": ")
    1356             (create-iso-image (list slide-dir) opt_g)
    1357             (done)))
    1358       (if slide-dir (run (rm -rf ,slide-dir)))
    1359       )))
    1360          
    1361 
    1362 (let-values (((options operands)  (args:parse args opts)))
    1363             (main options operands))
    1364 
    1365 )
     1333        (if (opt 'R)
     1334            (let* ((image-dir-depth   (length (string-split image-dir dirsep)))
     1335                   (make-gallery
     1336                    (lambda (lev d . rest)
     1337                      (let-optionals
     1338                       rest ((subdirs (list)))
     1339                       (let* ((absolute?    (string=? dirsep (car d)))
     1340                              (image-dir    (if absolute?
     1341                                                (s+ (car d) (string-intersperse (cdr d) dirsep))
     1342                                                (string-intersperse d dirsep)))
     1343                              (target-dir   (string-intersperse
     1344                                             (cons target-dir (drop (if absolute? (cdr d) d) image-dir-depth))
     1345                                             dirsep)))
     1346                         (main-make-gallery SIGMA-DIR index image-dir target-dir commands
     1347                                            subdirs (or (positive? lev) (opt 'up)) (opt 'top)
     1348                                            slide-dir))))))
     1349              ;; make sure target dir exists
     1350              (if (not (file-exists? target-dir))
     1351                  (create-directory target-dir))
     1352              (let recur ((level  0)
     1353                          (dir    image-dir)
     1354                          (dirlst (read-subdirs image-dir))
     1355                          (null-handler (lambda (level dir) (sigma:error "no subdirectories found in " dir))))
     1356                (if (null? dirlst)
     1357                    (null-handler level dir)
     1358                    (for-each
     1359                     (lambda (d)
     1360                       (let ((sd (string-intersperse d dirsep)))
     1361                         (let ((subdirs (read-subdirs sd)))
     1362                           (recur (+ 1 level) d subdirs make-gallery))))
     1363                     dirlst)))
     1364              (main-make-gallery SIGMA-DIR index image-dir target-dir commands
     1365                                 (read-subdirs target-dir) (opt 'up) (opt 'top slide-dir)))
     1366            (main-make-gallery SIGMA-DIR index image-dir target-dir commands (list) (opt 'up) #f slide-dir))
     1367        (if (commands 'cdimage?)
     1368            (begin
     1369              (message "Creating CD image "
     1370                       (s+ (opt 'cd-dir) dirsep (or (opt 'gcd) (opt 'cd-file)) ".iso") ": ")
     1371              (create-iso-image (list slide-dir) (opt 'g))
     1372              (done)))
     1373        (if slide-dir (run (rm -rf ,slide-dir)))
     1374        )))
     1375
     1376(main opts (opt '@))
     1377
  • release/4/sigma/trunk/sigma.setup

    r14850 r15628  
    1111
    1212  ; Assoc list with properties for the program:
    13   '((version 1.19)
     13  '((version 1.20)
    1414    (documentation "sigma.html")))
    1515
Note: See TracChangeset for help on using the changeset viewer.