source: project/release/3/svnwiki-metadata/trunk/svnwiki-metadata.scm @ 14924

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

Fixing list of requirements.

File size: 9.3 KB
Line 
1; $id$
2;
3; License: GPL-3
4
5(declare (export save-properties-simple))
6
7(use svnwiki-extensions-support srfi-40 stream-ext html-stream format-modular stream-wiki embedded-test)
8
9(define (tag-description-set env)
10  (let-from-environment env (output-format text)
11    (case output-format
12      ((description)
13       (let-from-environment env (return)
14         (return (stream-drop-while char-whitespace? text))
15         stream-null))
16      (else
17       (let-from-environment env (parse)
18         (parse text))))))
19
20(define (tag-description-load env)
21  (let-from-environment env (parse params path-in path)
22    (let ((path-target (assoc 'path params)))
23      (if path-target
24        (parse
25          (stream-translate
26            (stream-concatenate
27              (iterator->stream
28                (lambda (return stop)
29                  (let ((path (stream->string (link-canonical path (cdr path-target)))))
30                    (wiki-extension
31                      'description
32                      (wiki-open path-in path)
33                      stream-null
34                      path
35                      (constantly stream-null)
36                      (lambda (name tail) tail)
37                      (make-hash-table)
38                      (environment-capture env (return path)))))))
39            #\newline
40            #\space))
41        (html-stream "[listpage: error: param path missing]")))))
42
43(svnwiki-extension-define 'code-span 'description tag-description-set)
44(svnwiki-extension-define 'code-break 'description tag-description-load)
45
46; Now lets build an editor for Subversion properties.
47;
48; At the very minimal, most wikis should do the following:
49;
50; svn ps svnwiki:handler "$(svn pg svnwiki:handler .) properties" .
51; svn ps svnwiki:properties:list 'svnwiki:title svnwiki:tags' .
52; svn ps svnwiki:properties:name:svnwiki:title Title .
53; svn ps svnwiki:properties:name:svnwiki:tags Tags .
54; svn ps svnwiki:properties:help:svnwiki:title 'Title for this page, the filename will be used if empty' .
55; svn ps svnwiki:properties:help:svnwiki:tags 'Space-separated list of tags for this page' .
56;
57; If you have the googlemap extension, you may want to do this:
58;
59; svn ps svnwiki:properties:list 'svnwiki:title svnwiki:tags svnwiki:location' .
60; svn ps svnwiki:properties:type:svnwiki:location googlemap-location .
61; svn ps svnwiki:properties:name:svnwiki:location Location .
62; svn ps svnwiki:properties:help:svnwiki:location 'Location associated with this page' .
63
64; Return the list of properties that should be used for a given path.
65
66(test-group get-svn-properties
67  (test
68    (stream-null?
69      (get-svn-properties
70        (environment ((path-in "/repos")
71                      (path "foo/bar")))
72        (lambda (prop file default)
73          (unless (string=? prop "svnwiki:properties:list")
74            (error "Code asked for unexpected property" prop))
75          default))))
76
77  (test
78    (stream->list
79      (get-svn-properties
80        (environment ((path-in "/repos")
81                      (path "foo/bar")))
82        (lambda (prop file default)
83          (unless (string=? prop "svnwiki:properties:list")
84            (error "Code asked for unexpected property" prop))
85          (cond
86            ((string=? file "/repos/foo")
87             "  p1   p2  ")
88            ((string=? file "/repos/foo/bar")
89             "  p1   p3  ")
90            (else
91              (error "Code asked for property in unexpected file" file))))))
92    (map string->stream (list "p1" "p2" "p3"))))
93
94(define (get-svn-properties env . rest)
95  (let-optionals rest ((svnwiki-repository-property-get svnwiki-repository-property-get))
96    (let-from-environment env (path-in path)
97      (stream-delete-duplicates
98        (stream-concatenate
99          (stream-map
100            (lambda (path)
101              (stream-remove
102                stream-null?
103                (stream-split
104                  (string->stream
105                    (svnwiki-repository-property-get
106                      "svnwiki:properties:list"
107                      (svnwiki-make-pathname path-in path)
108                      ""))
109                  char-whitespace?)))
110            (list->stream
111              (svnwiki-list-with-parents path))))))))
112
113(define (get-value env property)
114  (let-from-environment env (user-input)
115    (user-input
116      (string->symbol (format #f "svnwiki-properties-~A" (stream->string property)))
117      (get-current-value env property))))
118
119(define (get-current-value env property)
120  (let-from-environment env (path-in path)
121    (string->stream
122      (svnwiki-repository-property-get
123        (stream->string property)
124        (svnwiki-repository-path env)
125        (get-props-parents-first
126          (format #f "svnwiki:properties:default:~A" (stream->string property))
127          path-in
128          path
129          "")))))
130
131(define (edit-properties-text env property)
132  (let-from-environment env (user-input)
133    (html-stream
134      ((input type "text"
135              name (format #f "svnwiki-properties-~A" (stream->string property))
136              value (get-value env property))))))
137
138(define (edit-properties-select env property)
139  (let-from-environment env (user-input path-in path)
140    (let ((default (get-value env property)))
141      (html-stream
142        ((select name (format #f "svnwiki-properties-~A" (stream->string property)))
143         (stream-concatenate
144           (stream-map
145             (lambda (line)
146               (if (stream= char=? line default)
147                 (html-stream ((option selected "true") line))
148                 (html-stream (option line))))
149             (stream-lines
150               (string->stream
151                 (get-props-parents-first
152                   (format #f "svnwiki:properties:select-values:~A" (stream->string property))
153                   path-in
154                   path
155                   ""))))))))))
156
157(define (save-properties-simple env property)
158  (let ((old-value (get-current-value env property))
159        (new-value (get-value env property)))
160    (and (not (stream= char=? old-value new-value))
161         (begin
162           (svnwiki-repository-property-set
163             property
164             (svnwiki-repository-path env)
165             new-value)
166           #t))))
167
168(define *edit-properties-default*
169  `(text ,edit-properties-text ,save-properties-simple))
170
171(define (metadata-edit-type-register env)
172  (let-from-environment env (return)
173    (return *edit-properties-default*)
174    (return `(select ,edit-properties-select ,save-properties-simple))))
175
176(svnwiki-extension-define 'metadata-edit-type-register 'properties metadata-edit-type-register)
177
178; If properties are defined for the file for this request and it is not a
179; discuss file, call proc passing the stream with all the properties as its
180; only argument.
181
182(define (call-with-properties env proc)
183  (let-from-environment env (path)
184    (unless (svnwiki-is-discuss? path)
185      (let ((properties (get-svn-properties env)))
186        (unless (stream-null? properties)
187          (proc properties))))))
188
189(define (edit-properties env)
190  (let-from-environment env (return path-in path user-input)
191    (when (stream-null? (user-input 'section stream-null))
192      (call-with-properties
193        env
194        (lambda (properties)
195          (return
196            (html-stream
197              (h2 "Properties")
198              (stream-concatenate
199                (stream-map
200                  (lambda (property)
201                    (html-stream
202                      (p (b (get-props-parents-first (format #f "svnwiki:properties:name:~A" (stream->string property)) path-in path property))
203                         (let ((help (get-props-parents-first (format #f "svnwiki:properties:help:~A" (stream->string property)) path-in path "")))
204                           (if (string=? help "")
205                             ""
206                             (html-stream " (" help ")")))
207                         ":"
208                         (br)
209                         ((cadr (find-property-editor env property))
210                          env
211                          property))))
212                  (get-svn-properties env))))))))))
213
214(define (find-property-editor env property)
215  (let-from-environment env (path-in path)
216    (or (and-let* ((type (string->symbol (get-props-parents-first (format #f "svnwiki:properties:type:~A" (stream->string property)) path-in path "")))
217                   (editors (stream->list (call-extensions-delay env 'metadata-edit-type-register))))
218          (assoc type editors))
219        *edit-properties-default*)))
220
221(svnwiki-extension-define 'edit-form-section 'properties edit-properties)
222
223(define (save-properties env)
224  (call-with-properties
225    env
226    (lambda (properties)
227      (let-from-environment env (return path-in path)
228        (let ((changes '()))
229          (stream-for-each
230            (lambda (property)
231              (when ((caddr (find-property-editor env property)) env property)
232                (set! changes (cons property changes))))
233            properties)
234          (unless (null? changes)
235            (svnwiki-commit-handler-info
236              env
237              (html-stream
238                (p "The following properties have been set:")
239                (stream->html-ul
240                  (stream-map
241                    (lambda (property)
242                      (get-props-parents-first (format #f "svnwiki:properties:name:~A" (stream->string property)) path-in path property))
243                    (list->stream changes)))))))))))
244
245(svnwiki-extension-define 'save-handler-pre 'properties save-properties)
Note: See TracBrowser for help on using the repository browser.