source: project/release/4/sxml-fu/sxml-shortcuts.scm @ 12365

Last change on this file since 12365 was 12365, checked in by sjamaan, 13 years ago

Import sxml-fu, which consists of the SXML stuff that used to be in spiffy-utils, made independent of Spiffy. Very early stuff, do not use yet!

File size: 2.8 KB
Line 
1;;; sxml-shortcuts.scm
2;
3; Copyright (c) 2004-2008 Peter Bex (Peter.Bex@xs4all.nl)
4; All rights reserved.
5;
6; Redistribution and use in source and binary forms, with or without
7; modification, are permitted provided that the following conditions
8; are met:
9; 1. Redistributions of source code must retain the above copyright
10;    notice, this list of conditions and the following disclaimer.
11; 2. Redistributions in binary form must reproduce the above copyright
12;    notice, this list of conditions and the following disclaimer in the
13;    documentation and/or other materials provided with the distribution.
14; 3. Neither the name of Peter Bex nor the names of any contributors may
15;    be used to endorse or promote products derived from this software
16;    without specific prior written permission.
17;
18; THIS SOFTWARE IS PROVIDED BY PETER BEX AND CONTRIBUTORS ``AS IS'' AND ANY
19; EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
20; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
21; DISCLAIMED.  IN NO EVENT SHALL THE FOUNDATION OR CONTRIBUTORS BE LIABLE
22; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
23; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
24; SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
25; CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
26; LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
27; OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
28; SUCH DAMAGE.
29
30(module sxml-shortcuts
31  (shortcut-rules)
32
33(import chicken scheme)
34
35(require-extension srfi-1)
36
37(define shortcut-rules
38  `((url *macro* . ,(lambda (tag href . contents)
39                      `(a (@ (href ,href))
40                          ,@(if (not (null? contents))
41                                contents
42                                (list href)))))
43    (pic *macro* . ,(lambda (tag src alt . rest)
44                      (let-optionals* rest ((title alt) more)
45                                      `(img (@ ,@(append `((src ,src)
46                                                           (alt ,alt)
47                                                           (title ,title)
48                                                           ,@more)))))))
49    (movie *macro* . ,(lambda (tag src title . rest)
50                        `(object (@ (type "video/quicktime"))
51                                 (param (@ (name "src") (value ,src)))
52                                 (param (@ (name "controller") (value "true")))
53                                 ,@rest
54                                 ;; Fallback if no viewer
55                                 (url ,src ,title))))
56    (*text* . ,(lambda (tag str) str))
57    (*default* . ,(lambda x x)))))
58
Note: See TracBrowser for help on using the repository browser.