Changeset 2651

Show
Ignore:
Timestamp:
03/04/08 12:43:58 (10 months ago)
Author:
hans
Message:

Revive blog - Depends on tiny_mce for editing now.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/bknr/modules/text/article-handlers.lisp

    r2424 r2651  
    2525 
    2626(defclass edit-article-handler (edit-object-handler) 
    27   ()) 
    28  
    29 (defmethod object-handler-get-object ((handler edit-article-handler)) 
    30   (find-store-object (parse-url) :class 'article)) 
     27  () 
     28  (:default-initargs :object-class 'article)) 
    3129 
    3230(defmethod handle-object-form ((handler edit-article-handler) 
    …… 
    3634 
    3735(defmethod handle-object-form ((handler edit-article-handler) 
    38                                (action (eql :save)) article) 
     36                               (action (eql :save)) 
     37                               (article article)) 
    3938  (with-query-params (subject text) 
    40     (if article 
    41         (progn (change-slot-values article 'subject subject 'text text) 
    42                (index-article article)) 
    43         (setf article (make-object 'article 
    44                                    :author (bknr-session-user) 
    45                                    :subject subject 
    46                                    :text text))) 
    47     (redirect (edit-object-url article)))) 
     39    (with-transaction (:update-article) 
     40      (setf (article-text article) text 
     41            (article-subject article) subject)) 
     42    (index-article article)) 
     43  (redirect (edit-object-url article))) 
     44 
     45(defmethod handle-object-form ((handler edit-article-handler) 
     46                               (action (eql :save)) 
     47                               (article (eql nil))) 
     48  (with-query-params (subject text) 
     49    (redirect (edit-object-url (make-object 'article 
     50                                            :author (bknr-session-user) 
     51                                            :subject subject 
     52                                            :text text))))) 
    4853 
    4954;;; snippets 
    …… 
    5257 
    5358(defclass edit-snippet-handler (edit-object-handler) 
    54   ()) 
    55  
    56 (defmethod object-handler-get-object ((handler edit-snippet-handler)) 
    57   (find-store-object (parse-url) :class 'snippet)) 
     59  () 
     60  (:default-initargs :object-class 'snippet)) 
    5861 
    5962(defmethod handle-object-form ((handler edit-snippet-handler) 
    …… 
    6770 
    6871(defmethod handle-object-form ((handler edit-snippet-handler) 
    69                                (action (eql :delete)) snippet) 
    70   (when snippet 
    71       (delete-object snippet)) 
     72                               action (snippet (eql nil))) 
    7273  (redirect "/edit-snippet")) 
    7374 
    7475(defmethod handle-object-form ((handler edit-snippet-handler) 
    75                                (action (eql :remove-keywords)) snippet) 
    76   (if snippet 
    77       (let ((keywords (keywords-from-query-param-list (query-param-list "keyword")))) 
    78         (store-object-remove-keywords snippet 'keywords keywords) 
    79         (redirect (edit-object-url snippet))) 
    80       (redirect "/edit-snippet"))) 
     76                               (action (eql :delete)) (snippet snippet)) 
     77  (delete-object snippet) 
     78  (call-next-method)) 
    8179 
    8280(defmethod handle-object-form ((handler edit-snippet-handler) 
    83                                (action (eql :add-keywords)) snippet) 
    84   (if snippet 
    85       (let ((keywords (keywords-from-query-param-list (query-param-list "keyword")))) 
    86         (store-object-add-keywords snippet 'keywords keywords) 
    87         (redirect (edit-object-url snippet))) 
    88       (redirect "/edit-snippet"))) 
     81                               (action (eql :remove-keywords)) (snippet snippet)) 
     82  (let ((keywords (keywords-from-query-param-list (query-param-list "keyword")))) 
     83    (store-object-remove-keywords snippet 'keywords keywords) 
     84    (redirect (edit-object-url snippet)))) 
    8985 
    9086(defmethod handle-object-form ((handler edit-snippet-handler) 
    91                                (action (eql :save)) snippet) 
    92   (if snippet 
    93       (with-query-params (subject text layout) 
    94         (unless subject (setf subject "")) 
    95         (let ((expires (parse-date-field "expiration"))) 
    96           (change-slot-values snippet 'subject subject 'text text 
    97                               'expires expires 'layout (make-keyword-from-string layout)) 
    98           (index-article snippet) 
    99           (redirect (edit-object-url snippet)))) 
    100       (redirect "/edit-snippet"))) 
     87                               (action (eql :add-keywords)) (snippet snippet)) 
     88  (let ((keywords (keywords-from-query-param-list (query-param-list "keyword")))) 
     89    (store-object-add-keywords snippet 'keywords keywords) 
     90    (redirect (edit-object-url snippet)))) 
     91 
     92(defmethod handle-object-form ((handler edit-snippet-handler) 
     93                               (action (eql :save)) (snippet snippet)) 
     94  (with-query-params (subject text layout) 
     95    (unless subject (setf subject "")) 
     96    (let ((expires (parse-date-field "expiration"))) 
     97      (with-transaction (:update-snippet) 
     98        (setf (article-subject snippet) subject 
     99              (article-text snippet) text 
     100              (snippet-expires snippet) expires 
     101              (snippet-layout snippet) (make-keyword-from-string layout))) 
     102      (index-article snippet) 
     103      (redirect (edit-object-url snippet))))) 
    101104 
    102105(defmethod handle-object-form ((handler edit-snippet-handler) 
    …… 
    112115                                  :layout (make-keyword-from-string layout) 
    113116                                  :expires expires))) 
    114         (if snippet 
    115             (redirect (edit-object-url snippet)) 
    116             (redirect "/edit-snippet")))))) 
     117        (redirect (edit-object-url snippet)))))) 

  • trunk/bknr/modules/text/article-tags.lisp

    r2430 r2651  
    55(defun article-blog-headline (article) 
    66  (html ((:div :class "headline") 
    7          (:princ-safe (or (article-subject article) "")) 
     7         ((:span :class "subject") 
     8          (:princ-safe (or (article-subject article) ""))) 
    89         " " 
    910         ((:span :class "date") 
    …… 
    1415           (html ((:span :class "author") (:princ-safe (user-login (article-author article))))))))) 
    1516 
    16 (define-bknr-tag article (&key id (class "textbox_3")) 
     17(define-bknr-tag article (&key id (class "article")) 
    1718  (let ((article (when id (find-store-object id :class 'article)))) 
    1819    (html ((:div :class class) 
    1920           (unless (string-equal (article-subject article) "") 
    20              ;; XXX der hier folgende dispatch auf den css-klassennamen ist mehr als unhygienisch. 
    21              ;; article-blog-headline gibt datum/uhrzeit/autor mit aus. 
    22              (if (find class '("textbox_shop" "textbox_2") :test #'string-equal) 
    23                  (html ((:div :class "inhead") 
    24                         (:princ-safe (article-subject article)) 
    25                         ": ")) 
    26                  (article-blog-headline article))) 
     21             (article-blog-headline article)) 
    2722           (when (article-text article) 
    28              (html (:princ (article-html-text article)))))) 
    29     (unless (user-has-flag *user* :locked) 
    30       (user-has-read-article article *user*)))) 
     23             (html 
     24              ((:div :class "text") 
     25               (:princ (article-text article))))))) 
     26    (unless (user-has-flag (bknr-session-user) :locked) 
     27      (user-has-read-article article (bknr-session-user))))) 
    3128 
    3229(define-bknr-tag wiki-article (&key id (edit-url "/edit-wiki")) 
    …… 
    5855(define-bknr-tag article-form (&key id) 
    5956  (let ((article (when id (find-store-object id :class 'article)))) 
    60     (html ((:form :method "post") 
    61            (when article 
    62              (html ((:input :type "hidden" :name "article-id" :value (store-object-id article))))) 
    63            (:table (:tr (:td "subject") 
    64                         (:td ((:input :type "text" :size "50" :name "subject" 
    65                                       :value (if article 
    66                                                  (article-subject article) 
    67                                                  ""))))) 
    68                    (:tr (:td "message") 
    69                         (:td ((:textarea :name "text" :rows "15" :cols "60") 
    70                               (if article 
    71                                   (html (:princ (article-text article))) 
    72                                   (html " "))))) 
    73                    (:tr (:td (submit-button "save" "save")))))))) 
     57    (html 
     58     ((:script :language "JavaScript") "initEditor();") 
     59     ((:form :method "post") 
     60      (when article 
     61        (html ((:input :type "hidden" :name "article-id" :value (store-object-id article))))) 
     62      (:table (:tr (:td "subject") 
     63                   (:td ((:input :type "text" :size "50" :name "subject" 
     64                                 :value (if article 
     65                                            (article-subject article) 
     66                                            ""))))) 
     67              (:tr (:td "message") 
     68                   (:td ((:textarea :name "text" :rows "15" :cols "60") 
     69                         (if article 
     70                             (html (:princ (article-text article))) 
     71                             (html " "))))) 
     72              (:tr (:td (submit-button "save" "save")))))))) 
    7473 
    7574(define-bknr-tag wiki-article-form (&key id keyword) 
    …… 
    162161        (progn (unless suppress-title 
    163162                 (html (:h3 (:princ-safe (blog-name blog))) 
    164                        (html (when (admin-p *user*) 
     163                       (html (when (admin-p (bknr-session-user)) 
    165164                               (html-edit-link blog)) 
    166                              ((:a :href (format nil "/blog-rss/~a" name)) 
    167                               " rss ")))) 
     165                             ((:a :href (format nil "/rss/~a" name)) 
     166                              (:princ " rss "))))) 
    168167               (loop for article in (sort (copy-list (blog-articles blog)) 
    169168                                          #'> :key #'article-time) 
    170                      do (if (and (not (equal "anonymous" (user-login *user*))) 
    171                                  (article-read article *user*)) 
     169                     do (if (and (not (equal "anonymous" (user-login (bknr-session-user)))) 
     170                                 (article-read article (bknr-session-user))) 
    172171                            (html ((:div :class "textbox_3") 
    173172                                   ((:a :href (object-url article)) 
    …… 
    179178  (let ((url (format nil "/blog/~A" (blog-name blog)))) 
    180179    (html (:h3 (:princ-safe (blog-name blog))) 
    181           (when (admin-p *user*) 
     180          (when (admin-p (bknr-session-user)) 
    182181            (html-edit-link blog)) 
    183           ((:a :href (format nil "/blog-rss/~A" (blog-name blog))) 
    184            "rss") " " 
     182          ((:a :href (format nil "/rss/~A" (blog-name blog))) 
     183           "rss") 
    185184          ((:a :href (format nil "/search-blog/~A" (blog-name blog))) 
    186185           "search") 
    …… 
    194193                                                      :show-seconds nil))) 
    195194                  (dolist (article (sort (cdr grouped-article) #'> :key #'article-time)) 
    196                     (if (and (not (equal "anonymous" (user-login *user*))) 
    197                              (article-read article *user*)) 
     195                    (if (and (not (equal "anonymous" (user-login (bknr-session-user)))) 
     196                             (article-read article (bknr-session-user))) 
    198197                        (html ((:div :class "textbox_3") 
    199198                               ((:a :href (object-url article)) 
    …… 
    212211  (let* ((page (parse-integer (or (query-param "page") "0"))) 
    213212         (num-pages (ceiling (/ (length (session-value :blog-search-results)) 10))) 
    214          (results (subseq (session-value :blog-search-results) 
    215                          (* page 10) 
    216                          (* (1+ page) 10)))) 
     213         (results (subseq* (session-value :blog-search-results) 
     214                           (* page 10) 
     215                           (* (1+ page) 10)))) 
    217216    (when results 
    218217      (html (:h3 "Results for \"" (:princ-safe (session-value :blog-search)) "\":")) 

  • trunk/bknr/modules/text/article.lisp

    r2417 r2651  
    55   (time :update :initform (get-universal-time)) 
    66   (subject :update :initform "") 
    7    (text :read :initform "") 
     7   (text :update :initform "") 
    88   (read-by :update :initform nil) 
    99   (search-vector :update :initform nil)) 

  • trunk/bknr/modules/text/blog-handlers.lisp

    r2424 r2651  
    123123    (handle-form handler t))) 
    124124 
     125(define-bknr-webserver-module blog 
     126    ("/blog" blog-handler) 
     127  ("/edit-blog" edit-blog-handler) 
     128  ("/edit-article" edit-article-handler) 
     129  ("/search-blog" search-blog-handler)) 

  • trunk/bknr/modules/text/blog.lisp

    r1542 r2651  
    11(in-package :bknr.text) 
    22 
    3 (define-persistent-class blog-article (article) 
     3(define-persistent-class blog-article (article rss-item) 
    44  ((keywords :read :initform nil 
    5              :index-type hash-list-index))) 
     5             :index-type hash-list-index) 
     6   (blog :update :initform nil))) 
    67 
    7 (define-persistent-class blog () 
    8   ((name :read 
    9          :index-type string-unique-index 
    10          :index-reader blog-with-name 
    11          :index-values all-blogs) 
    12     
     8(defmethod rss-item-channel ((article blog-article)) 
     9  (blog-article-blog article)) 
     10 
     11(define-persistent-class blog (rss-channel) 
     12  ((bknr.rss::name :read 
     13                   :index-type string-unique-index 
     14                   :index-reader blog-with-name 
     15                   :index-values all-blogs) 
    1316   (articles :update :initform nil) 
    1417   (owners :update :initform nil))) 
     18 
     19(defmethod rss-channel-items ((blog blog)) 
     20  (blog-articles blog)) 
    1521 
    1622(defmethod print-object ((object blog) stream) 
    …… 
    2733  (pushnew (blog-owners blog) owner)) 
    2834 
    29 (deftransaction blog-add-article (blog blog-article) 
    30   (setf (slot-value blog 'articles) 
    31         (push blog-article (slot-value blog 'articles)))) 
     35(deftransaction blog-add-article (blog article) 
     36  (setf (blog-article-blog article) blog) 
     37  (push article (blog-articles blog))) 
     38 
     39(defmethod rss-item-title ((article article)) 
     40  (article-subject article)) 
     41 
     42(defmethod rss-item-description ((article article)) 
     43  (article-text article)) 
     44 
     45(defmethod rss-item-pub-date ((article article)) 
     46  (article-time article)) 

  • trunk/bknr/modules/text/package.lisp

    r2417 r2651  
    1515        :bknr.datastore 
    1616        :bknr.impex 
    17         :xhtml-generator) 
     17        :xhtml-generator 
     18        :alexandria) 
     19  (:shadowing-import-from :bknr.indices array-index) 
    1820  (:shadowing-import-from :cl-interpol quote-meta-chars) 
    1921  (:export