source: project/release/3/stream-wiki/trunk/extensions/links.scm @ 12410

Last change on this file since 12410 was 12410, checked in by azul, 11 years ago

Fix.

File size: 2.6 KB
Line 
1(use html-stream)
2
3(define (link-digg-it env)
4  (svnwiki-file-action-link
5    env
6    (string-append "http://www.digg.com/submit?phase=2&url=" (env 'static-url) (env 'path))
7    "Digg it"))
8
9(define (link-reddit env)
10  (svnwiki-file-action-link
11    env
12    (string-append "http://reddit.com/submit?url=" (env 'static-url) (env 'path))
13    "Reddit"))
14
15(define (svnwiki-link-with-image name url-href code-onclick image-src)
16  (html-stream
17    ((a class "render-bottom-span render-bottom-span-delicious-links"
18        href url-href
19        onclick (or code-onclick ""))
20     ((img src image-src border 0 alt name)))))
21
22; Name is the name of the link.  It is used as Subversion property
23; “svnwiki:sociallinks:NAME”, so it should probably be just simple
24; alphanumerics.
25
26(define-record svnwiki-link-social name render)
27
28(define *svnwiki-links*
29  (stream
30
31    (make-svnwiki-link-social
32      "del.icio.us"
33      (lambda (url title)
34        (svnwiki-link-with-image
35          "Save to del.icio.us"
36          (format #f "http://del.icio.us/post?url=~A&title=~A" url title)
37          (format #f "window.open('http://del.icio.us/post?v=4&noui&jump=close&url=~A&title=~A', 'delicious','toolbar=no,width=700,height=400'); return false;" url title)
38          "http://images.del.icio.us/static/img/delicious.small.gif")))
39
40    (make-svnwiki-link-social
41      "digg"
42      (lambda (url title)
43        (svnwiki-link-with-image
44          "Submit Story to Digg"
45          (format #f "http://digg.com/submit?phase=2&url=~A&title=~A" url title)
46          #f
47          "http://digg.com/img/digg-guy-icon.gif")))))
48
49(define (svnwiki-social-links env)
50  (let-from-environment env (path-in static-url path db)
51    (let ((links (stream-filter
52                   (lambda (l)
53                     (get-props-parents-first-boolean env (format #f "svnwiki:sociallinks:~A" (svnwiki-link-social-name l)) #t))
54                   *svnwiki-links*)))
55      (unless (stream-null? links)
56        (svnwiki-render-bottom-span
57          env
58          (stream-concatenate
59            (stream-map
60              (let ((title (svnwiki-repository-property-get
61                             "svnwiki:title"
62                             (svnwiki-make-pathname path-in path)
63                             (last (cons "index" (string-split path "")))))
64                    (url (string-append static-url path)))
65                (lambda (l)
66                  ((svnwiki-link-social-render l) url title)))
67              links)))))))
68
69(set! *extensions*
70  `((digg   (files-actions-links ,link-digg-it))
71    (sociallinks (render-bottom-span ,svnwiki-social-links))
72    (reddit (files-actions-links ,link-reddit))))
Note: See TracBrowser for help on using the repository browser.