source: project/release/3/svnwiki-links/trunk/svnwiki-links.scm @ 12533

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

Importing svnwiki extensions.

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