[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp

Brian Mastenbrook bmastenbrook at common-lisp.net
Thu Jun 24 15:02:58 UTC 2004


Update of /project/lisppaste/cvsroot/lisppaste2
In directory common-lisp.net:/home/bmastenbrook/lisppaste2

Modified Files:
	web-server.lisp 
Log Message:
Bit-o-refactoring, "main page"

Date: Thu Jun 24 08:02:58 2004
Author: bmastenbrook

Index: lisppaste2/web-server.lisp
diff -u lisppaste2/web-server.lisp:1.57 lisppaste2/web-server.lisp:1.58
--- lisppaste2/web-server.lisp:1.57	Thu Jun 17 05:46:59 2004
+++ lisppaste2/web-server.lisp	Thu Jun 24 08:02:58 2004
@@ -1,4 +1,4 @@
-;;;; $Id: web-server.lisp,v 1.57 2004/06/17 12:46:59 bmastenbrook Exp $
+;;;; $Id: web-server.lisp,v 1.58 2004/06/24 15:02:58 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -21,6 +21,8 @@
   `(progn
     (funcall 'make-instance 'paste , at arguments)))
 
+(defclass main-handler (araneida:handler) ())
+
 (defclass new-paste-handler (araneida:handler) ())
 
 (defclass list-paste-handler (araneida:handler) ())
@@ -37,6 +39,43 @@
 
 (defclass stats-handler (araneida:handler) ())
 
+(defun lisppaste-wrap-page (title &rest forms)
+  (let ((colorize:*css-background-class* "paste"))
+    `(html
+      (head (title ,title)
+       ((style :type "text/css")
+        ,(format nil "~A~%~A~%"
+                 (colorize:make-background-css "#F4F4F4")
+                 colorize:*coloring-css*))
+       ,(rss-link-header))
+      (body
+       (h2 ,title)
+       , at forms
+       ,@(bottom-links)))))
+
+(defun paste-display-url (paste)
+  (araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number paste)))))
+
+(defmethod araneida:handle-request-response ((handler main-handler) method request)
+  (araneida:request-send-headers request :expires 0)
+  (araneida:html-stream
+   (araneida:request-stream request)
+   (lisppaste-wrap-page
+    "Lisppaste"
+    `((table :width "100%" :border 0 :cellpadding 2)
+      (tr (td (b "Recent pastes"))
+       (td (center (b "Make a new paste"))))
+      (tr
+       ((td :valign top)
+        ,@(loop for i from 1 to 10
+                for j in *pastes*
+                appending `(
+                            ((a :href ,(paste-display-url j))
+                             ,(encode-for-pre (paste-title j)))
+                            " by " ,(encode-for-pre (paste-user j)) (br))))
+       ((td :valign top)
+        ,(generate-new-paste-form :width 40)))))))
+
 (defmethod araneida:handle-request-response :around
     ((handler submit-paste-handler) method request)
   (let ((forwarded-for (car (araneida:request-header request :x-forwarded-for))))
@@ -95,22 +134,17 @@
      (t (araneida:request-send-headers request :expires 0)
 	(araneida:html-stream
 	 (araneida:request-stream request)
-	 `(html
-	   (head
-	    (title "Select a channel")
-	    ,(rss-link-header))
-	   (body
-	    (h2 "Select a channel")
-	    ((form :method post :action ,(araneida:urlstring *new-paste-url*))
-             ((input :type "hidden" :name "annotate" :value ,annotate-string))
-	     "Please select a channel to lisppaste to: "
-	     ((select :name "channel")
-	      ((option :value ""))
-	      ,@(mapcar #'(lambda (e)
-			    `((option :value ,e)
-			      ,(encode-for-pre e))) *channels*))
-	     ((input :type submit :value "Submit")))
-	    ,@(bottom-links))))))))
+         (lisppaste-wrap-page
+          "Select a channel"
+          `((form :method post :action ,(araneida:urlstring *new-paste-url*))
+            ((input :type "hidden" :name "annotate" :value ,annotate-string))
+            "Please select a channel to lisppaste to: "
+            ((select :name "channel")
+             ((option :value ""))
+             ,@(mapcar #'(lambda (e)
+                           `((option :value ,e)
+                             ,(encode-for-pre e))) *channels*))
+            ((input :type submit :value "Submit")))))))))
 
 (defun bottom-links ()
   `((hr)
@@ -180,74 +214,70 @@
   (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">")
   (araneida:html-stream
    (araneida:request-stream request)
-   `(html
-     (head (title "Syndication options")
-      ,(rss-link-header))
-     (body
-      (h2 "Syndication options")
-      "Lisppaste can be syndicated in a variety of RSS formats for use
+   (lisppaste-wrap-page
+    "Syndication options"
+    "Lisppaste can be syndicated in a variety of RSS formats for use
 with your favorite RSS reader."
-      (p)
-      (table
-       (tr
-        ((th :align left) "All channels")
-        ((td :width 30))
-        (td ((a :href ,(araneida:urlstring *rss-url*)) "Basic"))
-        ((td :width 10))
-        (td ((a :href ,(araneida:urlstring *rss-full-url*)) "Full")))
-       ,@(if *no-channel-pastes*
-             `((tr
-                ((th :align left) "None")
-                ((td :width 30))
-                (td ((a :href ,(concatenate 'string
-                                            (araneida:urlstring *rss-url*)
-                                            "?none")) "Basic"))
-                ((td :width 10))
-                (td ((a :href ,(concatenate 'string
-                                            (araneida:urlstring *rss-full-url*)
-                                            "?none")) "Full")))))
-       ,@(mapcar #'(lambda (channel)
-                     `(tr
-                       ((th :align left) ,channel)
-                       ((td :width 30))
-                       (td ((a :href ,(concatenate 'string
-                                                   (araneida:urlstring *rss-url*)
-                                                   (substitute #\? #\# channel))) "Basic"))
-                       ((td :width 10))
-                       (td ((a :href ,(concatenate 'string
-                                                   (araneida:urlstring *rss-full-url*)
-                                                   (substitute #\? #\# channel))) "Full"))))
-                 *channels*))
-      ,@(bottom-links)))))
+    `(p)
+    `(table
+      (tr
+       ((th :align left) "All channels")
+       ((td :width 30))
+       (td ((a :href ,(araneida:urlstring *rss-url*)) "Basic"))
+       ((td :width 10))
+       (td ((a :href ,(araneida:urlstring *rss-full-url*)) "Full")))
+      ,@(if *no-channel-pastes*
+            `((tr
+               ((th :align left) "None")
+               ((td :width 30))
+               (td ((a :href ,(concatenate 'string
+                                           (araneida:urlstring *rss-url*)
+                                           "?none")) "Basic"))
+               ((td :width 10))
+               (td ((a :href ,(concatenate 'string
+                                           (araneida:urlstring *rss-full-url*)
+                                           "?none")) "Full")))))
+      ,@(mapcar #'(lambda (channel)
+                    `(tr
+                      ((th :align left) ,channel)
+                      ((td :width 30))
+                      (td ((a :href ,(concatenate 'string
+                                                  (araneida:urlstring *rss-url*)
+                                                  (substitute #\? #\# channel))) "Basic"))
+                      ((td :width 10))
+                      (td ((a :href ,(concatenate 'string
+                                                  (araneida:urlstring *rss-full-url*)
+                                                  (substitute #\? #\# channel))) "Full"))))
+                *channels*)))))
 
 (defmethod araneida:handle-request-response ((handler stats-handler) method request)
   (araneida:request-send-headers request :expires 0)
   (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">")
   (araneida:html-stream
    (araneida:request-stream request)
-   `(html
-     (head (title "Statistics")
-      ,(rss-link-header))
-     (body
-      (h2 "Statistics")
-      (b "Uptime: ") ,(time-delta *boot-time* :ago-p nil :level 3)
+   (lisppaste-wrap-page
+    "Statistics"
+    `(div
+      (b "Uptime: ")
+      ,(time-delta *boot-time* :ago-p nil :level 3)
       (p)
-      (b "Most popular channels:") (br)
+      (b "Most popular channels:")
+      (br)
       ((table :border 0)
        ,@(mapcar #'(lambda (pair)
-		     `(tr
-		       ((td :valign top)
-			,(car pair))
+                     `(tr
+                       ((td :valign top)
+                        ,(car pair))
                        ((td)
                         " ")
                        ((td :valign top)
-			,(cdr pair))))
+                        ,(cdr pair))))
                  (sort
-		  (loop for i in *channels*
-			collect (cons i (count i *pastes*
-					       :key #'paste-channel
-					       :test #'string=)))
-		  #'> :key #'cdr)))
+                  (loop for i in *channels*
+                        collect (cons i (count i *pastes*
+                                               :key #'paste-channel
+                                               :test #'string=)))
+                  #'> :key #'cdr)))
       (p)
       (b "Average rates of pasting:") (br)
       ((table :border 0)
@@ -300,7 +330,7 @@
 					 (- (paste-universal-time (first p))
 					      (paste-universal-time (car (last p)))))))
 		   #'> :key #'(lambda (e) (length (second e)))))))
-      ,@(bottom-links)))))
+      ))))
 
 (defmethod araneida:handle-request-response ((handler list-paste-handler) method request)
   (araneida:request-send-headers request :expires 0)
@@ -360,75 +390,73 @@
                          "> Older"))))))
         (araneida:html-stream
          (araneida:request-stream request)
-         `(html
-           (head (title "All pastes")
-            ,(rss-link-header))
-           (body
-            (center (h2 ,(if discriminate-channel
-                             (format nil "All pastes in channel ~A" discriminate-channel)
-                             "All pastes in system")))
+         (lisppaste-wrap-page
+          (if discriminate-channel
+              (format nil "All pastes in channel ~A" discriminate-channel)
+              "All pastes in system")
+          `(div
             ,@(if discriminate-channel
                   (if (not (member discriminate-channel *channels* :test #'string-equal))
                       `(((h2) ((font :color "red") ,(format nil "Warning: no channel named ~A found!"
-                                                            discriminate-channel))))))
-            (center
-             ((form :method post :action ,(araneida:urlstring *list-paste-url*))
-              (table
-               (tr ((td :align left) "View only: ")
-                   ((td :valign top :align center)
-                    ((select :name "channel")
-                     ((option :value "allchannels") "All channels")
-                     ,@(mapcar #'(lambda (e)
-                                   `((option :value ,e ,@(if (and discriminate-channel
-                                                                  (string-equal e discriminate-channel))
-                                                             '(:selected)))
-                                     ,(encode-for-pre e))) *channels*))
-                    ((input :type submit :value "Submit")))
-                   )
-               (tr ((td :align left)
-                    ,(if discriminate-channel "Syndicate this channel: " "Syndicate all channels: "))
-                   ((td :align center)
-                    ((a :href ,(concatenate 'string
-                                            (araneida:urlstring *rss-url*)
-                                            (if discriminate-channel
-                                                (or (and *no-channel-pastes*
-                                                         (string-equal discriminate-channel "none")
-                                                         "?none")
-                                                    (substitute #\? #\# discriminate-channel)) ""))) "Basic")
-                    " | "
-                    ((a :href ,(concatenate 'string
-                                            (araneida:urlstring *rss-full-url*)
-                                            (if discriminate-channel
-                                                (or (and *no-channel-pastes*
-                                                         (string-equal discriminate-channel "none")
-                                                         "?none")
-                                                    (substitute #\? #\# discriminate-channel))
-                                                ""))) "Full"))
-                   )
-               (tr ((td :align left)
-                    "Page: ")
-                   ((td :align center)
-                    , at page-links))
-               )))
-            (p)
-            ((table :width "100%" :cellpadding 2)
-             (tr (td) (td "By") (td "Where") (td "When") (td "Titled") (td "Ann."))
-             ,@(mapcar #'(lambda (paste)
-                           `(tr ((td :nowrap "nowrap") ((a :href ,(araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number paste)))))
-                                                        ,(concatenate 'string "#" (prin1-to-string (paste-number paste)))))
-                             ((td :nowrap "nowrap") ,(encode-for-pre (max-length (paste-user paste) 12)))
-                             ((td :nowrap "nowrap") ,(encode-for-pre (paste-channel paste)))
-                             ((td :nowrap "nowrap") ,(time-delta (paste-universal-time paste) :level 1 :ago-p nil))
-                             ((td :width "100%" :bgcolor "#F6F6F6" :nowrap "nowrap") ,(encode-for-pre (max-length (paste-title paste) 50)))
-                             ((td :nowrap "nowrap") ,(length (paste-annotations paste)))))
-                       (loop for i from 0
-                             to (- (* (1+ page) *pastes-per-page*) 1)
-                             for j in discriminated-pastes
-                             if (>= i (* page *pastes-per-page*))
-                             collect j)))
-            (center
-             "Page: " , at page-links)
-            ,@(bottom-links))))))))
+                                                            discriminate-channel)))))))
+          `(center
+            ((form :method post :action ,(araneida:urlstring *list-paste-url*))
+             (table
+              (tr ((td :align left) "View only: ")
+                  ((td :valign top :align center)
+                   ((select :name "channel")
+                    ((option :value "allchannels") "All channels")
+                    ,@(mapcar #'(lambda (e)
+                                  `((option :value ,e ,@(if (and discriminate-channel
+                                                                 (string-equal e discriminate-channel))
+                                                            '(:selected)))
+                                    ,(encode-for-pre e))) *channels*))
+                   ((input :type submit :value "Submit")))
+                  )
+              (tr ((td :align left)
+                   ,(if discriminate-channel "Syndicate this channel: " "Syndicate all channels: "))
+                  ((td :align center)
+                   ((a :href ,(concatenate 'string
+                                           (araneida:urlstring *rss-url*)
+                                           (if discriminate-channel
+                                               (or (and *no-channel-pastes*
+                                                        (string-equal discriminate-channel "none")
+                                                        "?none")
+                                                   (substitute #\? #\# discriminate-channel)) ""))) "Basic")
+                   " | "
+                   ((a :href ,(concatenate 'string
+                                           (araneida:urlstring *rss-full-url*)
+                                           (if discriminate-channel
+                                               (or (and *no-channel-pastes*
+                                                        (string-equal discriminate-channel "none")
+                                                        "?none")
+                                                   (substitute #\? #\# discriminate-channel))
+                                               ""))) "Full"))
+                  )
+              (tr ((td :align left)
+                   "Page: ")
+                  ((td :align center)
+                   , at page-links))
+              )))
+          `(p)
+          `((table :width "100%" :cellpadding 2)
+            (tr (td) (td "By") (td "Where") (td "When") (td "Titled") (td "Ann."))
+            ,@(mapcar #'(lambda (paste)
+                          `(tr ((td :nowrap "nowrap") ((a :href ,(paste-display-url paste))
+                                                       ,(concatenate 'string "#" (prin1-to-string (paste-number paste)))))
+                            ((td :nowrap "nowrap") ,(encode-for-pre (max-length (paste-user paste) 12)))
+                            ((td :nowrap "nowrap") ,(encode-for-pre (paste-channel paste)))
+                            ((td :nowrap "nowrap") ,(time-delta (paste-universal-time paste) :level 1 :ago-p nil))
+                            ((td :width "100%" :bgcolor "#F6F6F6" :nowrap "nowrap") ,(encode-for-pre (max-length (paste-title paste) 50)))
+                            ((td :nowrap "nowrap") ,(length (paste-annotations paste)))))
+                      (loop for i from 0
+                            to (- (* (1+ page) *pastes-per-page*) 1)
+                            for j in discriminated-pastes
+                            if (>= i (* page *pastes-per-page*))
+                            collect j)))
+          `(center
+            "Page: " , at page-links)
+          ))))))
 
 (defun handle-rss-request (request &key full)
   (araneida:request-send-headers request :expires 0 :content-type "application/rss+xml")
@@ -486,32 +514,11 @@
 (defmethod araneida:handle-request-response ((handler rss-full-handler) method request)
   (handle-rss-request request :full t))
 
-(defun new-paste-form (request &key (message "") (annotate nil) (default-channel "") (default-user "") (default-title "") (default-contents ""))
-  (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">")
-  (araneida:html-stream
-   (araneida:request-stream request)
-   `(html
-     (head (title ,(if annotate "Annotate" "Paste"))
-      ,(rss-link-header))
-     (body
-      (h2 ,(if annotate "Enter your annotation" "Enter your paste"))
-      ((font :color red) (h2 ,message))
-      ((form :method post :action ,(araneida:urlstring *submit-paste-url*))
-       (p "Enter a username, title, and paste contents into the fields below."
-          ,@(unless (and annotate
-                         *no-channel-pastes*
-                         (string-equal (paste-channel annotate) "None"))
-                    `("The paste will be announced on the selected channel @ " ,(irc:server-name *connection*) ".")))
-       ,@(if annotate
-             `((p "This paste will be used to annotate "
-                 ((a :href ,(araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number annotate))))) ,(concatenate 'string (paste-title annotate) ".")))
-               ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number annotate))))
-               ((input :type hidden :name "channel" :value ,(paste-channel annotate)))))
-       (hr)
-       (table
+(defun generate-new-paste-form (&key annotate (default-channel "None") (default-user "") (default-title "") (default-contents "") (width 80))
+  `(table
         ,@(if (not annotate)
               `((tr
-                 (th "Select a channel:")
+                 ((th :align left) "Select a channel:")
                  (td ((select :name "channel")
 		      ((option :value ""))
 		      ,@(mapcar #'(lambda (e)
@@ -519,16 +526,16 @@
 							      '(:selected "SELECTED")))
 				      ,(encode-for-pre e))) *channels*))))))
         (tr
-         (th "Enter your username:")
+         ((th :align left) "Enter your username:")
          (td ((input :type text :name "username"
                      :value ,(encode-for-pre default-user)))))
         (tr
-         (th "Enter a title:")
+         ((th :align left) "Enter a title:")
          (td ((input :type text :name "title"
                      :value ,(encode-for-pre default-title)))))
         ,@(if (not annotate)
               `((tr
-                 (th (i "(Optional) Colorize as: "))
+                 ((th :align left) (i "(Optional) Colorize as: "))
                  (td ((select :name "colorize")
                       ((option :value "" :selected "SELECTED") "Default for this channel")
                       ((option :value "None") "None")
@@ -537,13 +544,33 @@
                                       ,(cdr pair)))
                                 (colorize:coloring-types)))))))
         (tr
-         ((th :valign top) "Enter your paste:")
-         (td ((textarea :rows 24 :cols 80 :name "text")
+         ((th :align left :valign top) "Enter your paste:")
+         (td ((textarea :rows 24 :cols ,width :name "text")
               ,(encode-for-pre default-contents))))
         (tr
-         ((th) "Submit your paste:")
+         ((th :align left) "Submit your paste:")
          ((td) ((input :type submit :value "Submit paste")) " " ((input :type reset :value "Clear paste"))))))
-      ,@(bottom-links)))))
+
+(defun new-paste-form (request &key (message "") (annotate nil) (default-channel "") (default-user "") (default-title "") (default-contents ""))
+  (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">")
+  (araneida:html-stream
+   (araneida:request-stream request)
+   (lisppaste-wrap-page
+    (if annotate "Enter your annotation" "Enter your paste")
+    `((font :color red) (h2 ,message))
+    `((form :method post :action ,(araneida:urlstring *submit-paste-url*))
+      (p "Enter a username, title, and paste contents into the fields below."
+       ,@(unless (and annotate
+                      *no-channel-pastes*
+                      (string-equal (paste-channel annotate) "None"))
+                 `("The paste will be announced on the selected channel @ " ,(irc:server-name *connection*) ".")))
+      ,@(if annotate
+            `((p "This paste will be used to annotate "
+               ((a :href ,(araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number annotate))))) ,(concatenate 'string (paste-title annotate) ".")))
+              ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number annotate))))
+              ((input :type hidden :name "channel" :value ,(paste-channel annotate)))))
+      (hr)
+      ,(generate-new-paste-form :annotate annotate :default-channel default-channel :default-user default-user :default-title default-title :default-contents default-contents)))))
 
 (defmethod araneida:handle-request-response ((handler submit-paste-handler) method request)
   (let* ((username (araneida:body-param "username" (araneida:request-body request)))
@@ -608,20 +635,17 @@
           (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">")
           (araneida:html-stream
            (araneida:request-stream request)
-           `(html
-             (head (title "Paste number " ,paste-number)
-              ,(rss-link-header))
-             (body
-              (h2 "Pasted!")
-              (p ,(if annotate "Your annotation should be available at " "Your paste should be available at ") ((a :href ,url) ,url)
-               ,@(unless (and *no-channel-pastes*
-                              (string-equal channel "none"))
-                         `(", and was also sent to " ,channel " @ " ,(irc:server-name *connection*))) ".")
-              (h3 "Don't paste more junk; annotate!")
-	      ((form :method post :action ,(araneida:urlstring *new-paste-url*))
-	       ((input :type hidden :name "annotate" :value ,(prin1-to-string paste-number)))
-	       (center ((input :type submit :value "Annotate this paste"))))
-              ,@(bottom-links))))))))))
+           (lisppaste-wrap-page
+            (format nil "Paste number ~A pasted!" paste-number)
+            `(p ,(if annotate "Your annotation should be available at " "Your paste should be available at ") ((a :href ,url) ,url)
+              ,@(unless (and *no-channel-pastes*
+                             (string-equal channel "none"))
+                        `(", and was also sent to " ,channel " @ " ,(irc:server-name *connection*))) ".")
+            `(h3 "Don't paste more junk; annotate!")
+            `((form :method post :action ,(araneida:urlstring *new-paste-url*))
+              ((input :type hidden :name "annotate" :value ,(prin1-to-string paste-number)))
+              (center ((input :type submit :value "Annotate this paste"))))
+            ))))))))
 
 (defun ends-with (str end)
   (let ((l1 (length str))
@@ -630,17 +654,21 @@
       (string= (subseq str (- l1 l2) l1) end))))
 
 (defun format-paste (paste this-url paste-number &optional annotation colorize-as line-numbers)
-  (let ((n 0))
+  (let ((n 0) (next-first-char-nbsp nil))
     (labels
         ((line-number ()
            (format nil "<span class=\"paste\">~A</span>"
                    (encode-for-tt (format nil "~4D: " (incf n))
                                   :first-char-nbsp t)))
          (encode (str)
-           (encode-for-tt str
-                          :with-line-numbers
-                          (if line-numbers
-                              #'line-number))))
+           (multiple-value-bind (encoded last)
+               (encode-for-tt str
+                              :with-line-numbers
+                              (if line-numbers
+                                  #'line-number)
+                              :first-char-nbsp next-first-char-nbsp)
+             (prog1 encoded
+               (setf next-first-char-nbsp last)))))
       `((table :width "100%" :cellpadding 2)
         (tr ((td :align "left" :width "0%" :nowrap "nowrap")
              ,(if annotation
@@ -701,9 +729,10 @@
          (colorize:*css-background-class* "paste"))
     (and paste
          (log-event
-          (format nil "Serving paste number ~S to ~S.~%"
+          (format nil "Serving paste number ~S to ~S (referred by ~S).~%"
                   (paste-number paste)
-                  (car (araneida:request-header request :x-forwarded-for)))))
+                  (car (araneida:request-header request :x-forwarded-for))
+                  (car (araneida:request-header request :referer)))))
     (if paste
         (if raw
             (let ((p (position #\, (araneida::request-unhandled-part request) :test #'char=)))
@@ -725,16 +754,9 @@
             (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">")
             (araneida:html-stream
              (araneida:request-stream request)
-             `(html
-               (head
-                (title "Paste number " ,paste-number)
-                ((style :type "text/css")
-                 ,(format nil "~A~%~A~%"
-                          (colorize:make-background-css "#F4F4F4")
-                          colorize:*coloring-css*))
-                ,(rss-link-header))
-               (body
-                
+             (lisppaste-wrap-page
+              (format nil "Paste number ~A" paste-number)
+              `(div
                 ,@(if (paste-annotations paste)
                       `("Index of paste annotations: "
                         ,@(loop for ann in (reverse (paste-annotations paste))
@@ -749,17 +771,17 @@
                 ,(format-paste paste (araneida:urlstring (araneida:request-url request)) paste-number nil colorize-as
                                linenumbers)
                 ,@(if (paste-annotations paste)
-                     `((p)
-                       "Annotations for this paste: "
-                       ,@(reduce #'append
-                                 (mapcar #'(lambda (a)
-                                             `((hr)
-                                               ,(format-paste a
-                                                              (format nil "~A,~A"
-                                                                      (araneida:urlstring (araneida:request-url request))
-                                                                      (paste-number a)) (paste-number a) t colorize-as linenumbers)))
-                                         (reverse (paste-annotations paste)))))
-                     `((p) "This paste has no annotations."))
+                      `((p)
+                        "Annotations for this paste: "
+                        ,@(reduce #'append
+                                  (mapcar #'(lambda (a)
+                                              `((hr)
+                                                ,(format-paste a
+                                                               (format nil "~A,~A"
+                                                                       (araneida:urlstring (araneida:request-url request))
+                                                                       (paste-number a)) (paste-number a) t colorize-as linenumbers)))
+                                          (reverse (paste-annotations paste)))))
+                      `((p) "This paste has no annotations."))
                 (p)
                 ((form :method post :action ,(araneida:urlstring
                                               (araneida:merge-url
@@ -785,19 +807,15 @@
                 ((form :method post :action ,(araneida:urlstring *new-paste-url*))
                  ((input :type hidden :name "annotate" :value ,(prin1-to-string (paste-number paste))))
                  (center ((input :type submit :value "Annotate this paste"))))
-                ,@(bottom-links))))))
-      (progn
-        (araneida:request-send-headers request :expires 0)
-        (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">")
-        (araneida:html-stream
-         (araneida:request-stream request)
-         `(html
-           (head
-            (title "Invalid paste number" ,paste-number)
-            ,(rss-link-header))
-           (body
-            (h3 "No paste numbered " ,paste-number " could be found.")
-            ,@(bottom-links))))))))
+                )))))
+        (progn
+          (araneida:request-send-headers request :expires 0)
+          (format (araneida:request-stream request) "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.01 Transitional//EN\" \"http://www.w3.org/TR/html4/loose.dtd\">")
+          (araneida:html-stream
+           (araneida:request-stream request)
+           (lisppaste-wrap-page
+            (format nil "Invalid paste number ~A!" paste-number)
+            ))))))
 
 (araneida:install-handler
  (araneida:http-listener-handler *paste-listener*)
@@ -838,3 +856,8 @@
  (araneida:http-listener-handler *paste-listener*)
  (make-instance 'stats-handler)
  (araneida:urlstring *stats-url*) nil)
+
+(araneida:install-handler
+ (araneida:http-listener-handler *paste-listener*)
+ (make-instance 'main-handler)
+ (araneida:urlstring *paste-external-url*) t)





More information about the Lisppaste-cvs mailing list