Changeset 14925 in project


Ignore:
Timestamp:
06/06/09 19:09:22 (10 years ago)
Author:
azul
Message:

Added support for extensions that want to add code to the <weblogabout/> tag. Added some memoization and profiling. Small fixes.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/3/svnwiki-weblog/trunk/svnwiki-weblog.scm

    r12663 r14925  
    44
    55(declare (export))
    6 (use svnwiki-extensions-support srfi-40 svn-post-commit-hooks orders format-modular html-stream srfi-1 stream-ext svn-client)
     6(use svnwiki-extensions-support srfi-40 svn-post-commit-hooks orders format-modular html-stream srfi-1 stream-ext svn-client simple-profiler memoize)
    77
    88(define (weblog-update env)
    99  (let-from-environment env (path-in path path-out)
    10     (svnwiki-report-progress env "Weblog update start: ~A, ~A, ~A~%" path-in path path-out)
     10    (svnwiki-report-progress env "Weblog update start: ~A~%" path)
    1111    (let ((weblog-index (get-weblog-index env)))
    1212      (stream-for-each
     
    1818        (stream-delete-duplicates
    1919          (stream-map svnwiki-file-language
    20                       (stream-map car (list-all-posts env)))
     20                      (stream-map car (weblog-list-all-posts env)))
    2121          (lambda (a b)
    2222            (or (and (not a) (not b))
     
    3131      (svnwiki-make-pathname (svnwiki-dirname path)))))
    3232
    33 (define (list-all-posts env)
    34   (let-from-environment env (path-in base user password)
    35     (let ((dir-path (weblog-dir-path env)))
    36       (list->stream
    37         (sort-key-cache
    38           (let ((path-real (svnwiki-make-pathname path-in dir-path)))
    39             (remove
    40               (lambda (post)
    41                 (weblog-entry-ignore? path-real post))
    42               (hash-table->alist
    43                 (entry-subs
    44                   (post-commit-changed-files path-real (string-append base "/" dir-path) user password)))))
    45           >
    46           (lambda (x)
    47             (post-seconds path-in (svnwiki-make-pathname dir-path (car x)) x)))))))
     33(define weblog-list-all-posts
     34  (memoize-proc 10
     35    (lambda (env)
     36      (let-from-environment env (path-in base user password path)
     37        (values
     38          path
     39          (lambda ()
     40            (let ((dir-path (weblog-dir-path env)))
     41              (list->stream
     42                (sort-key-cache
     43                  (let ((path-real (svnwiki-make-pathname path-in dir-path)))
     44                    (remove
     45                      (lambda (post)
     46                        (weblog-entry-ignore? path-real post))
     47                      (hash-table->alist
     48                        (entry-subs
     49                          (post-commit-changed-files path-real (string-append base "/" dir-path) user password)))))
     50                  >
     51                  (lambda (x)
     52                    (post-seconds path-in (svnwiki-make-pathname dir-path (car x)) x)))))))))))
     53
     54(profile-set! weblog-list-all-posts)
    4855
    4956(define (post-seconds path-in path post)
     
    5259    path
    5360    (change-seconds (last (entry-changes (cdr post))))))
     61
     62(profile-set! post-seconds)
    5463
    5564(define (post-seconds-default-time path-in path default-time)
     
    7180(define (render-post env post)
    7281  (let-from-environment env (path path-out-real path-in)
     82    (svnwiki-report-progress env "Rendering file for weblog: ~A: ~A~%" (weblog-dir-path env) (car post))
    7383    (let ((path-post (svnwiki-make-pathname (weblog-dir-path env) (car post))))
    7484      (html-stream
     
    111121                  svnwiki-file-language
    112122                  car)
    113                 (list-all-posts env))
     123                (weblog-list-all-posts env))
    114124              (get-posts-number env))))))))
     125
     126(profile-set! webloc-content-posts)
    115127
    116128(define (get-posts-number env)
     
    133145    (let ((author (get-props-parents-first "svnblog:author" path-in path-out-real #f))
    134146          (index (get-weblog-index env))
    135           (file (last (string-split path-out-real "/")))
    136           (path-weblog (svnwiki-make-pathname (butlast (string-split path-out-real "/")))))
     147          (file (svnwiki-basename path-out-real))
     148          (path-weblog (svnwiki-dirname path-out-real)))
    137149      (cond
    138150        ((svnwiki-is-discuss? path-out-real)
     
    151163                    ((a href "../..")
    152164                     "this weblog's main page")))
    153                 "."))))
     165                ".")
     166             (extensions-link env))))
    154167        ((not (file-exists? (svnwiki-make-pathname path-in path-out-real)))
    155168         (html-stream
     
    174187                 (html-stream "the weblog of " (b author))
    175188                 "this weblog"))
    176               "."
    177               (rss-link env))))
     189              ".")
     190           (extensions-link env)))
    178191        ((svnwiki-is-special? #f path-out-real)
    179192         stream-null)
     
    212225                        (b last-change)))
    213226                    ".")))))
    214            (let loop ((posts (stream-map car (list-all-posts (environment env ((path path-weblog))))))
     227           (let loop ((posts (stream-map car (weblog-list-all-posts (environment env ((path path-weblog))))))
    215228                      (next #f))
    216229             ; I used to think posts would not be null the first time (in which
     
    242255                          "."))
    243256                     stream-null))
    244                  (loop (stream-cdr posts) (stream-car posts)))))))
     257                 (loop (stream-cdr posts) (stream-car posts)))))
     258           (extensions-link env)))
    245259        (author
    246           (let ((posts-count (stream-length (list-all-posts (environment env ((path path-weblog))))))
     260          (let ((posts-count (stream-length (weblog-list-all-posts (environment env ((path path-weblog))))))
    247261                (number (get-posts-number env)))
    248262            (html-stream
     
    258272                   (else
    259273                     (html-stream
    260                        "This file contains the " number " most recent posts.")))
    261                  (rss-link env)))))
     274                       "This file contains the " number " most recent posts."))))
     275              (extensions-link env))))
    262276        (else
    263277          stream-null)))))
    264278
    265 (define (rss-link env)
    266   (let-from-environment env (path-out path-out-real)
    267     (let* ((link (svnwiki-make-pathname "xsvnwiki-atom" "xsvnwiki-dir"))
    268            (file (svnwiki-make-pathname
    269                    (cons path-out
    270                          (butlast (string-split path-out-real "/")))
    271                    link
    272                    "xml")))
    273       (if (file-exists? file)
    274         (html-stream
    275           " Subscribe to the "
    276           ((a href link) "RSS")
    277           " to be notified when new posts are made.")
    278         stream-null))))
    279    
     279(profile-set! weblog-about)
     280
     281(define (extensions-link env)
     282  (stream-append
     283    (let ((links (call-extensions-delay env 'weblog-about-link)))
     284      (if (stream-null? links)
     285        stream-null
     286        (stream->html-ul links)))
     287    (stream-concatenate (call-extensions-delay env 'weblog-about-bottom-div))))
     288
    280289(svnwiki-extension-define 'update-notify 'weblog weblog-update)
    281290(svnwiki-extension-define 'code-break 'weblogabout weblog-about)
Note: See TracChangeset for help on using the changeset viewer.