- lisppaste-cvs@common-lisp.net - mailman3.common-lisp.net

[Lisppaste-cvs] CVS update: lisppaste2/README.lisp lisppaste2/variable.lisp
by Brian Mastenbrook 15 Oct '04

15 Oct '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: README.lisp variable.lisp Log Message: No clue Date: Fri Oct 15 20:23:15 2004 Author: bmastenbrook Index: lisppaste2/README.lisp diff -u lisppaste2/README.lisp:1.12 lisppaste2/README.lisp:1.13 --- lisppaste2/README.lisp:1.12 Fri Oct 1 01:55:43 2004 +++ lisppaste2/README.lisp Fri Oct 15 20:23:15 2004 @@ -1,4 +1,4 @@ -;;;; $Id: README.lisp,v 1.12 2004/09/30 23:55:43 bmastenbrook Exp $ +;;;; $Id: README.lisp,v 1.13 2004/10/15 18:23:15 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/README.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -28,7 +28,7 @@ (s-xml-rpc:start-xml-rpc-server :port 8185) -(lisppaste:start-lisppaste :channels '("#lisp" "#scheme" "#opendarwin" "#macdev" "#fink" "#jedit" "#dylan" "#emacs" "#xemacs" "#colloquy" "#adium" "#growl" "#chicken" "#quicksilver" "#svn" "#slate" "#squeak") +(lisppaste:start-lisppaste :channels '("#lisp" "#scheme" "#opendarwin" "#macdev" "#fink" "#jedit" "#dylan" "#emacs" "#xemacs" "#colloquy" "#adium" "#growl" "#chicken" "#quicksilver" "#svn" "#slate" "#squeak" "#wiki" "#nebula" "#imgames") :nickname "lisppaste" :server "orwell.freenode.net" :port 6667) Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.30 lisppaste2/variable.lisp:1.31 --- lisppaste2/variable.lisp:1.30 Fri Oct 1 01:44:49 2004 +++ lisppaste2/variable.lisp Fri Oct 15 20:23:15 2004 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.30 2004/09/30 23:44:49 bmastenbrook Exp $ +;;;; $Id: variable.lisp,v 1.31 2004/10/15 18:23:15 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -54,7 +54,8 @@ (defparameter *banned-ips* '("69.11.238.252" "168.143.113.138" - "64.236.227.6")) ; two examples of + "64.236.227.6" "83.216.146.102" + "206.159.155.203")) ; two examples of ; troublemakers affecting ; freenode's lisppaste

1 0

[Lisppaste-cvs] CVS update: lisppaste2/README.lisp
by Brian Mastenbrook 30 Sep '04

30 Sep '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: README.lisp Log Message: Add #squeak and #slate Date: Fri Oct 1 01:55:43 2004 Author: bmastenbrook Index: lisppaste2/README.lisp diff -u lisppaste2/README.lisp:1.11 lisppaste2/README.lisp:1.12 --- lisppaste2/README.lisp:1.11 Sat Sep 25 22:20:27 2004 +++ lisppaste2/README.lisp Fri Oct 1 01:55:43 2004 @@ -1,4 +1,4 @@ -;;;; $Id: README.lisp,v 1.11 2004/09/25 20:20:27 bmastenbrook Exp $ +;;;; $Id: README.lisp,v 1.12 2004/09/30 23:55:43 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/README.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -28,7 +28,7 @@ (s-xml-rpc:start-xml-rpc-server :port 8185) -(lisppaste:start-lisppaste :channels '("#lisp" "#scheme" "#opendarwin" "#macdev" "#fink" "#jedit" "#dylan" "#emacs" "#xemacs" "#colloquy" "#adium" "#growl" "#chicken" "#quicksilver" "#svn" "#lisp-es") +(lisppaste:start-lisppaste :channels '("#lisp" "#scheme" "#opendarwin" "#macdev" "#fink" "#jedit" "#dylan" "#emacs" "#xemacs" "#colloquy" "#adium" "#growl" "#chicken" "#quicksilver" "#svn" "#slate" "#squeak") :nickname "lisppaste" :server "orwell.freenode.net" :port 6667)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/variable.lisp lisppaste2/web-server.lisp
by Brian Mastenbrook 30 Sep '04

30 Sep '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: variable.lisp web-server.lisp Log Message: Remove donation link Date: Fri Oct 1 01:44:50 2004 Author: bmastenbrook Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.29 lisppaste2/variable.lisp:1.30 --- lisppaste2/variable.lisp:1.29 Sat Sep 25 22:20:27 2004 +++ lisppaste2/variable.lisp Fri Oct 1 01:44:49 2004 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.29 2004/09/25 20:20:27 bmastenbrook Exp $ +;;;; $Id: variable.lisp,v 1.30 2004/09/30 23:44:49 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -81,13 +81,6 @@ (defparameter *no-channel-pastes* t) ; whether to allow pastes that ; don't get announced on a ; channel - -(defparameter *show-donation-link* t) - -(defparameter *donation-link* - (format nil "https://www.paypal.com/xclick/business=chandler%40iddqd.org~ -&item_name=Support+Lisppaste%2C+SBCL/Darwin%2C+etc.&no_shipping=1~ -&no_note=1&tax=0&currency_code=USD")) (defparameter *serve-source* t) Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.65 lisppaste2/web-server.lisp:1.66 --- lisppaste2/web-server.lisp:1.65 Sat Sep 25 22:20:27 2004 +++ lisppaste2/web-server.lisp Fri Oct 1 01:44:49 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.65 2004/09/25 20:20:27 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.66 2004/09/30 23:44:49 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -225,11 +225,6 @@ "Lisppaste is graciously hosted by " (b ((a :href "http://www.common-lisp.net/") "common-lisp.net")) " - a hosting service for projects written in Common Lisp (like this one)." - ,@(if *show-donation-link* - `((p) - "Please consider " - (b ((a :href ,*donation-link*) "supporting Lisppaste development")) - " with your contributions. Thanks!")) )) ((td :valign top :align right) ((form :method post :action ,(araneida:urlstring *submit-paste-url*)) @@ -316,10 +311,7 @@ ((td :id "main-link") ((a :href ,(araneida:urlstring *paste-external-url*)) "Main page") - ,@(if *show-donation-link* - `(" | " - ((a :href ,*donation-link*) - "Support Lisppaste")))) + ) ((td :id "other-links") ((a :href ,(araneida:urlstring *new-paste-url*)) "New paste") " | " @@ -957,11 +949,7 @@ (td ((div :class "info-text") ((span :class "small-header") "Donations accepted") - ,@(if *show-donation-link* - `((br) - "If you appreciate Lisppaste, please consider " - (b ((a :href ,*donation-link*) "making a donation")) - " to support further development of the service. Thanks!")))))) + )))) )))))))) (defun ends-with (str end)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/README.lisp lisppaste2/clhs-lookup.lisp lisppaste2/coloring-css.lisp lisppaste2/coloring-types.lisp lisppaste2/variable.lisp lisppaste2/web-server.lisp
by Brian Mastenbrook 25 Sep '04

25 Sep '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: README.lisp clhs-lookup.lisp coloring-css.lisp coloring-types.lisp variable.lisp web-server.lisp Log Message: dunno Date: Sat Sep 25 22:20:27 2004 Author: bmastenbrook Index: lisppaste2/README.lisp diff -u lisppaste2/README.lisp:1.10 lisppaste2/README.lisp:1.11 --- lisppaste2/README.lisp:1.10 Tue Jul 27 20:47:10 2004 +++ lisppaste2/README.lisp Sat Sep 25 22:20:27 2004 @@ -1,4 +1,4 @@ -;;;; $Id: README.lisp,v 1.10 2004/07/27 18:47:10 bmastenbrook Exp $ +;;;; $Id: README.lisp,v 1.11 2004/09/25 20:20:27 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/README.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -24,10 +24,11 @@ (require :asdf) (asdf:operate 'asdf:load-op :lisppaste) +(load (compile-file "redirect-handler")) -(ignore-errors (s-xml-rpc:start-xml-rpc-server :port 8185)) +(s-xml-rpc:start-xml-rpc-server :port 8185) -(lisppaste:start-lisppaste :channels '("#lisp" "#scheme" "#clhs" "#opendarwin" "#macdev" "#fink" "#jedit" "#dylan" "#emacs" "#xemacs" "#colloquy" "#adium" "#growl") +(lisppaste:start-lisppaste :channels '("#lisp" "#scheme" "#opendarwin" "#macdev" "#fink" "#jedit" "#dylan" "#emacs" "#xemacs" "#colloquy" "#adium" "#growl" "#chicken" "#quicksilver" "#svn" "#lisp-es") :nickname "lisppaste" :server "orwell.freenode.net" :port 6667) Index: lisppaste2/clhs-lookup.lisp diff -u lisppaste2/clhs-lookup.lisp:1.7 lisppaste2/clhs-lookup.lisp:1.8 --- lisppaste2/clhs-lookup.lisp:1.7 Thu Jul 8 19:42:26 2004 +++ lisppaste2/clhs-lookup.lisp Sat Sep 25 22:20:27 2004 @@ -22,6 +22,8 @@ (defvar *format-table* (make-hash-table :test 'equalp)) +(defvar *read-macro-table* (make-hash-table :test 'equalp)) + (defvar *populated-p* nil) (defun add-clhs-section-to-table (&rest numbers) @@ -124,6 +126,50 @@ ((#\^) "Body/22_cib.htm") ((#\Newline) "Body/22_cic.htm") (t "Body/22_c.htm"))))) + ;; read macros + (loop for (char page) in '((#$ "a") + (#$ "b") + (#\' "c") + (#\; "d") + (#\" "e") + (#\` "f") + (#\, "g") + (#\# "h")) + do (setf (gethash (format nil "~A" char) *read-macro-table*) + (concatenate 'string + *hyperspec-root* + "Body/02_d" + page + ".htm"))) + (loop for code from 32 to 127 + do (setf (gethash (format nil "#~A" (code-char code)) *read-macro-table*) + (concatenate 'string + *hyperspec-root* + "Body/02_dh" + (case (code-char code) + ((#\\) "a") + ((#\') "b") + ((#$) "c") + ((#\*) "d") + ((#\:) "e") + ((#\.) "f") + ((#\b #\B) "g") + ((#\o #\O) "h") + ((#\x #\X) "i") + ((#\r #\R) "j") + ((#\c #\C) "k") + ((#\a #\A) "l") + ((#\s #\S) "m") + ((#\p #\P) "n") + ((#\=) "o") + ((#\#) "p") + ((#\+) "q") + ((#\-) "r") + ((#\|) "s") + ((#\<) "t") + ((#$) "v") + (t "")) + ".htm"))) ;; glossary. ) ;; MOP @@ -153,6 +199,7 @@ (or (gethash term *symbol-table*) (gethash term *section-table*) (gethash term *format-table*) + (gethash term *read-macro-table*) (abbrev-lookup term))) (:abbrev (abbrev-lookup term)) @@ -161,7 +208,9 @@ (:section (gethash term *section-table*)) (:format - (gethash term *format-table*)))) + (gethash term *format-table*)) + (:read-macro + (gethash term *read-macro-table*)))) (defun symbol-lookup (term) (spec-lookup term :type :symbol)) Index: lisppaste2/coloring-css.lisp diff -u lisppaste2/coloring-css.lisp:1.5 lisppaste2/coloring-css.lisp:1.6 --- lisppaste2/coloring-css.lisp:1.5 Thu Jul 15 14:36:49 2004 +++ lisppaste2/coloring-css.lisp Sat Sep 25 22:20:27 2004 @@ -29,8 +29,8 @@ thing)) (defun make-background-css (color &key (class *css-background-class*) (extra nil)) - (format nil ".~A { background-color: ~A; color: WindowText; ~{~A; ~}}~:*~:*~:* -.~A:hover { background-color: ~A; color: WindowText; ~{~A; ~}}~%" + (format nil ".~A { background-color: ~A; color: black; ~{~A; ~}}~:*~:*~:* +.~A:hover { background-color: ~A; color: black; ~{~A; ~}}~%" class color (mapcar #'(lambda (extra) (format nil "~A : ~{~A ~}" Index: lisppaste2/coloring-types.lisp diff -u lisppaste2/coloring-types.lisp:1.9 lisppaste2/coloring-types.lisp:1.10 --- lisppaste2/coloring-types.lisp:1.9 Thu Jul 15 14:36:49 2004 +++ lisppaste2/coloring-types.lisp Sat Sep 25 22:20:27 2004 @@ -179,7 +179,9 @@ (define-coloring-type :scheme "Scheme" :autodetect (lambda (text) - (search "scheme" text :test #'char-equal)) + (or + (search "scheme" text :test #'char-equal) + (search "chicken" text :test #'char-equal))) :parent :lisp :transitions (((:normal :in-list) Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.28 lisppaste2/variable.lisp:1.29 --- lisppaste2/variable.lisp:1.28 Thu Jul 15 14:36:49 2004 +++ lisppaste2/variable.lisp Sat Sep 25 22:20:27 2004 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.28 2004/07/15 12:36:49 bmastenbrook Exp $ +;;;; $Id: variable.lisp,v 1.29 2004/09/25 20:20:27 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -23,7 +23,7 @@ (in-package :lisppaste) -(defparameter *internal-http-port* 8081 +(defparameter *internal-http-port* 8080 "Port lisppaste's araneida will listen on for requests from Apache.") (defparameter *external-http-port* 80 "Port lisppaste's araneida will listen on for requests from remote clients.") @@ -53,7 +53,8 @@ (defvar *pastes-per-page* 50) ; for the paste list (defparameter *banned-ips* - '("69.11.238.252" "168.143.113.138")) ; two examples of + '("69.11.238.252" "168.143.113.138" + "64.236.227.6")) ; two examples of ; troublemakers affecting ; freenode's lisppaste @@ -133,6 +134,8 @@ (let ((fwd-url (araneida:copy-url *paste-external-url*)) (fwd-old-url (araneida:copy-url *old-url*))) (setf (araneida:url-port fwd-url) *internal-http-port*) + ;; temporary fix! + (setf (araneida:url-host fwd-url) "127.0.0.1") (setf (araneida:url-port fwd-old-url) *internal-http-port*) (make-instance #+sbcl 'araneida:serve-event-reverse-proxy-listener #-sbcl 'araneida:threaded-reverse-proxy-listener @@ -141,7 +144,7 @@ ,(araneida:urlstring fwd-url)) (,(araneida:urlstring *old-url*) ,(araneida:urlstring fwd-old-url))) - :address #(0 0 0 0) + :address #(127 0 0 1) :port (araneida:url-port fwd-url)))) (defvar *default-nickname* "devpaste") Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.64 lisppaste2/web-server.lisp:1.65 --- lisppaste2/web-server.lisp:1.64 Tue Jul 27 20:47:11 2004 +++ lisppaste2/web-server.lisp Sat Sep 25 22:20:27 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.64 2004/07/27 18:47:11 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.65 2004/09/25 20:20:27 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -59,6 +59,27 @@ (symbol-name (class-name (class-of class)))) *times-file-root*)) +(defun referer-list () + (loop for link being the hash-values of *referer-example-hash* using (hash-key host) + collect (cons host link))) + +(defun fix-referers () + (loop for count being the hash-values of *referer-hash* using (hash-key host) + do (let ((split-host (split-sequence:split-sequence #\. host))) + (when (or + (and (eql (length split-host) 3) + (string-equal (first split-host) "www") + (string-equal (second split-host) "google")) + (and (eql (length split-host) 4) + (string-equal (first split-host) "www") + (string-equal (second split-host) "google") + (or + (string-equal (third split-host) "co") + (string-equal (third split-host) "com")) + (eql (length (fourth split-host)) 2))) + (remhash host *referer-hash*) + (incf (gethash "Google" *referer-hash* 0) count))))) + (defmethod araneida:handle-request-response :around ((handler lisppaste-basic-handler) method request) (with-open-file (*trace-output* (times-file-for-class handler) :direction :output @@ -70,8 +91,22 @@ (when (stringp referer) (let ((url (araneida:parse-urlstring referer nil))) (when url - (incf (gethash (araneida:url-host url) *referer-hash* 0)) - (setf (gethash (araneida:url-host url) *referer-example-hash*) url))))) + (let ((real-host (araneida:url-host url)) + (split-host (split-sequence:split-sequence #\. (araneida:url-host url)))) + (if (or + (and (eql (length split-host) 3) + (string-equal (first split-host) "www") + (string-equal (second split-host) "google")) + (and (eql (length split-host) 4) + (string-equal (first split-host) "www") + (string-equal (second split-host) "google") + (or + (string-equal (third split-host) "co") + (string-equal (third split-host) "com")) + (eql (length (fourth split-host)) 2))) + (setf real-host "Google")) + (incf (gethash real-host *referer-hash* 0)) + (setf (gethash real-host *referer-example-hash*) url)))))) (call-next-method))))) (defun make-css () @@ -169,6 +204,8 @@ (p) ((div :class "small-header") "About lisppaste") ((div :class "info-text") + "Lisppaste is a pastebot / pastebin / nopaste service with syntax highlighting, XML-RPC support, annotations, and more." + (p) "Many times when working via IRC, people want to share a snippet of code with somebody else. However, just pasting the code into IRC creates a flood of text which is hard to read and scrolls by @@ -444,6 +481,7 @@ (last (sort (loop for count being the hash-values of *referer-hash* using (hash-key host) + if (not (search "sexnet" host)) collect (cons host count)) #'< :key #'cdr) 20)))) (p) ((span :class "small-header") "Most popular channels:") @@ -776,7 +814,8 @@ `((tr ((th :align left :width "0%" :nowrap "nowrap") "Select a channel:") (td ((select :name "channel") - ((option :value "")) + ,@(if (not *no-channel-pastes*) + `(((option :value "")))) ,@(mapcar #'(lambda (e) `((option :value ,e ,@(if (string-equal e default-channel) '(:selected "SELECTED")))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/README.lisp lisppaste2/lisppaste.asd lisppaste2/lisppaste.lisp lisppaste2/persistent-pastes.lisp lisppaste2/web-server.lisp
by Brian Mastenbrook 27 Jul '04

27 Jul '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: README.lisp lisppaste.asd lisppaste.lisp persistent-pastes.lisp web-server.lisp Log Message: Don't remember Date: Tue Jul 27 11:47:11 2004 Author: bmastenbrook Index: lisppaste2/README.lisp diff -u lisppaste2/README.lisp:1.9 lisppaste2/README.lisp:1.10 --- lisppaste2/README.lisp:1.9 Thu Jul 15 05:36:49 2004 +++ lisppaste2/README.lisp Tue Jul 27 11:47:10 2004 @@ -1,4 +1,4 @@ -;;;; $Id: README.lisp,v 1.9 2004/07/15 12:36:49 bmastenbrook Exp $ +;;;; $Id: README.lisp,v 1.10 2004/07/27 18:47:10 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/README.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -24,10 +24,8 @@ (require :asdf) (asdf:operate 'asdf:load-op :lisppaste) -(asdf:operate 'asdf:load-op :xml-rpc) -(load "xml-paste") -(s-xml-rpc:start-xml-rpc-server :port 8185) +(ignore-errors (s-xml-rpc:start-xml-rpc-server :port 8185)) (lisppaste:start-lisppaste :channels '("#lisp" "#scheme" "#clhs" "#opendarwin" "#macdev" "#fink" "#jedit" "#dylan" "#emacs" "#xemacs" "#colloquy" "#adium" "#growl") :nickname "lisppaste" Index: lisppaste2/lisppaste.asd diff -u lisppaste2/lisppaste.asd:1.16 lisppaste2/lisppaste.asd:1.17 --- lisppaste2/lisppaste.asd:1.16 Thu Jul 15 05:36:49 2004 +++ lisppaste2/lisppaste.asd Tue Jul 27 11:47:10 2004 @@ -1,5 +1,5 @@ ;;;; Silly emacs, this is -*- Lisp -*- -;;;; $Id: lisppaste.asd,v 1.16 2004/07/15 12:36:49 bmastenbrook Exp $ +;;;; $Id: lisppaste.asd,v 1.17 2004/07/27 18:47:10 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -42,6 +42,7 @@ (:file "web-server" :depends-on ("encode-for-pre" "lisppaste" "colorize-package" + "colorize" "coloring-css")) (:file "system-server" :depends-on ("variable" "encode-for-pre" Index: lisppaste2/lisppaste.lisp diff -u lisppaste2/lisppaste.lisp:1.23 lisppaste2/lisppaste.lisp:1.24 --- lisppaste2/lisppaste.lisp:1.23 Thu Jul 15 05:36:49 2004 +++ lisppaste2/lisppaste.lisp Tue Jul 27 11:47:10 2004 @@ -1,4 +1,4 @@ -;;;; $Id: lisppaste.lisp,v 1.23 2004/07/15 12:36:49 bmastenbrook Exp $ +;;;; $Id: lisppaste.lisp,v 1.24 2004/07/27 18:47:10 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -55,7 +55,7 @@ (setf *channels* channels) (if *no-channel-pastes* (pushnew "None" *channels* :test #'string-equal)) - (read-pastes-from-file *paste-file*) + (read-xml-pastes) (format t "Populating lookup table...~%") (clhs-lookup:populate-table) (r5rs-lookup:populate-table) Index: lisppaste2/persistent-pastes.lisp diff -u lisppaste2/persistent-pastes.lisp:1.12 lisppaste2/persistent-pastes.lisp:1.13 --- lisppaste2/persistent-pastes.lisp:1.12 Thu Jul 15 05:36:49 2004 +++ lisppaste2/persistent-pastes.lisp Tue Jul 27 11:47:10 2004 @@ -94,7 +94,7 @@ :type "xml" :defaults *paste-path*)) #'< :key #'(lambda (e) - (parse-integer (pathname-name e) :Junk-allowed t))))) + (parse-integer (pathname-name e) :junk-allowed t))))) (defun write-all-xml-pastes () Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.63 lisppaste2/web-server.lisp:1.64 --- lisppaste2/web-server.lisp:1.63 Thu Jul 15 05:36:49 2004 +++ lisppaste2/web-server.lisp Tue Jul 27 11:47:11 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.63 2004/07/15 12:36:49 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.64 2004/07/27 18:47:11 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -88,6 +88,9 @@ table.info-table { border-collapse: collapse; border : 1px solid #AAA ; background-color: #F9E9F9; empty-cells: hide; } table.info-table td { border : 1px dotted #AAA; background-color: transparent; padding-left: 2em; padding-right: 2em; } table.info-table th { border : 1px dotted #AAA; background-color: transparent; text-align: left; padding-right: 1em; } +table.rate-table { border-collapse: collapse; border : 1px solid #AAA ; background-color: #F9E9F9; empty-cells: hide; } +table.rate-table td { border : 1px dotted #AAA; background-color: transparent; padding: 2pt; } +table.rate-table th { border : 1px dotted #AAA; background-color: transparent; text-align: left; padding: 1pt; } .new-paste-form { background-color : #FFE9E9 ; border: 2px solid #D99; padding : 4px; } .paste-header { background-color : #E9F9F9 ; border: 2px solid #9DD; padding : 4px; margin-bottom : 4px; } .info-text { background-color : #E9F9F9 ; border: 2px solid #9DD; padding : 4px; margin-top : 4px; text-align: justify; } @@ -378,6 +381,41 @@ append)) "Full"))))) *channels*))))) +(defun encode-beginning-of-month (month year &key next-month) + (if next-month + (encode-beginning-of-month (if (eql month 12) 1 (1+ month)) + (if (eql month 12) (1+ year) year)) + (encode-universal-time 0 0 0 1 month year))) + +(defun mix-red-green (n) + (format nil "#~2,'0X~2,'0X00" + (truncate (* (- 1 n) #xAA)) + (truncate (* n #xAA)))) + +(defun paste-rate-divs () + (let* ((rates (loop for i in (reverse *pastes*) + for count from 1 + with j = (paste-universal-time (car (last *pastes*))) + with time = 0 + appending (when (>= (- (paste-universal-time i) + (* 60 60 24 7)) + j) + (setf j (paste-universal-time i)) + (incf time (* 60 60 24 7)) + `( + ,(/ count time))))) + (min-rate (loop for i in rates minimizing i)) + (max-rate (loop for i in rates maximizing i))) + (when (> max-rate min-rate) + (loop for i in rates + for rate = (/ (- i min-rate) (- max-rate min-rate)) + appending `(((div :style + ,(format nil "height: 1ex; padding: 0pt; margin: 2pt; background-color: ~A; width: ~A%;" + (mix-red-green rate) + (truncate (+ 10 (* 90 rate)))) + ))))))) + + (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\">") @@ -425,7 +463,7 @@ #'> :key #'cdr))) (p) ((span :class "small-header") "Average rates of pasting:") (p) - ((table :border 0 :class "info-table") + ((table :class "info-table") ,@(mapcar #'(lambda (pair) `(tr #+(or) (td ,(length (second pair))) @@ -438,42 +476,117 @@ (third pair) (length (second pair)))) :ago-p nil) " between pastes"))) - (list* - (list "Overall" *pastes* (- (paste-universal-time (first *pastes*)) - (paste-universal-time (car (last *pastes*))))) - (list "Last 30 days" - (remove-if #'(lambda (e) - (< (paste-universal-time e) - (- (get-universal-time) - (* 60 60 24 30)))) - *pastes*) - (* 60 60 24 30)) - (list "Last week" - (remove-if #'(lambda (e) - (< (paste-universal-time e) - (- (get-universal-time) - (* 60 60 24 7)))) - *pastes*) - (* 60 60 24 7)) - (list "Last day" - (remove-if #'(lambda (e) - (< (paste-universal-time e) - (- (get-universal-time) - (* 60 60 24)))) - *pastes*) - (* 60 60 24)) - (sort - (loop for i in *channels* - if (find i *pastes* :key #'paste-channel - :test #'string=) - collect (let ((p (remove i *pastes* - :key #'paste-channel - :test-not #'string=))) - (list (format nil "In ~A" i) - p - (- (paste-universal-time (first p)) - (paste-universal-time (car (last p))))))) - #'> :key #'(lambda (e) (length (second e))))))) + (list* + (list "Overall" *pastes* (- (get-universal-time) + (paste-universal-time (car (last *pastes*))))) + (list "Last 30 days" + (remove-if #'(lambda (e) + (< (paste-universal-time e) + (- (get-universal-time) + (* 60 60 24 30)))) + *pastes*) + (* 60 60 24 30)) + (list "Last week" + (remove-if #'(lambda (e) + (< (paste-universal-time e) + (- (get-universal-time) + (* 60 60 24 7)))) + *pastes*) + (* 60 60 24 7)) + (list "Last day" + (remove-if #'(lambda (e) + (< (paste-universal-time e) + (- (get-universal-time) + (* 60 60 24)))) + *pastes*) + (* 60 60 24)) + (sort + (loop for i in *channels* + if (find i *pastes* :key #'paste-channel + :test #'string=) + collect (let ((p (remove i *pastes* + :key #'paste-channel + :test-not #'string=))) + (list (format nil "In ~A" i) + p + (- (get-universal-time) + (paste-universal-time (car (last p))))))) + #'< :key #'(lambda (pair) + (truncate (/ + (third pair) + (length (second pair))))))) + )) + (p) + ((span :class "small-header") "Trends in paste rates:") (p) + ((table :class "rate-table") + ,@(let ((first-paste (car (last *pastes*))) + (this-year (date:with-date (get-universal-time) nil date:year)) + (this-month (date:with-date (get-universal-time) nil date:month))) + `((tr + (th) + ,@(date:with-date + (paste-universal-time first-paste) nil + (loop for year from date:year to this-year + appending + (loop for month from (if (eql year date:year) + date:month + 1) + to (if (eql year this-year) + this-month + 12) + collecting + `((td :nowrap "NOWRAP") + (b + ,(format nil "~/date:monthname/ ~A" month year))))))) + (tr + (th "Count:") + ,@(date:with-date + (paste-universal-time first-paste) nil + (loop for year from date:year to this-year + appending + (loop for month from (if (eql year date:year) + date:month + 1) + to (if (eql year this-year) + this-month + 12) + collecting + `(td + ,(format nil "~A" + (count-if #'(lambda (e) + (<= (encode-beginning-of-month month year) + (paste-universal-time e) + (encode-beginning-of-month month year :next-month t))) *pastes*))))))) + (tr + ((th :nowrap "NOWRAP") "Total avg. rate per month:") + ,@(date:with-date + (paste-universal-time first-paste) nil + (loop for year from date:year to this-year + appending + (loop for month from (if (eql year date:year) + date:month + 1) + for count from 1 + to (if (eql year this-year) + this-month + 12) + collecting + `(td + ,(let ((ml (count-if #'(lambda (e) + (<= + (paste-universal-time e) + (encode-beginning-of-month month year :next-month t))) *pastes*))) + (format nil "~,2F" + (/ ml (if (eql month this-month) + (+ (1- count) + (/ (- (get-universal-time) + (encode-beginning-of-month this-month this-year)) + (- (encode-beginning-of-month this-month this-year :next-month t) + (encode-beginning-of-month this-month this-year)))) + count)))))))))))) + (p) + ((span :class "small-header") "Rise in overall pasting rate by week:") (p) + ,@(paste-rate-divs) )))) (defmethod araneida:handle-request-response ((handler list-paste-handler) method request)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/system-server.lisp
by Brian Mastenbrook 15 Jul '04

15 Jul '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Added Files: system-server.lisp Log Message: Da system server Date: Thu Jul 15 05:37:35 2004 Author: bmastenbrook

1 0

[Lisppaste-cvs] CVS update: lisppaste2/lisppaste.asd
by Brian Mastenbrook 08 Jul '04

08 Jul '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: lisppaste.asd Log Message: fix the depends so that web-server knows about the specialness of some CSS variable Date: Thu Jul 8 11:01:12 2004 Author: bmastenbrook Index: lisppaste2/lisppaste.asd diff -u lisppaste2/lisppaste.asd:1.14 lisppaste2/lisppaste.asd:1.15 --- lisppaste2/lisppaste.asd:1.14 Thu Jul 8 10:42:26 2004 +++ lisppaste2/lisppaste.asd Thu Jul 8 11:01:11 2004 @@ -1,5 +1,5 @@ ;;;; Silly emacs, this is -*- Lisp -*- -;;;; $Id: lisppaste.asd,v 1.14 2004/07/08 17:42:26 bmastenbrook Exp $ +;;;; $Id: lisppaste.asd,v 1.15 2004/07/08 18:01:11 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -40,6 +40,7 @@ (:file "coloring-types" :depends-on ("colorize" "clhs-lookup")) (:file "web-server" - :depends-on ("encode-for-pre" "lisppaste" "colorize-package")) + :depends-on ("encode-for-pre" "lisppaste" "colorize-package" + "coloring-css")) (:file "persistent-pastes" :depends-on ("web-server"))))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/variable.lisp
by Brian Mastenbrook 08 Jul '04

08 Jul '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/test/lisppaste2 Modified Files: variable.lisp Log Message: recent paste list Date: Thu Jul 8 10:43:37 2004 Author: bmastenbrook Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.26 lisppaste2/variable.lisp:1.27 --- lisppaste2/variable.lisp:1.26 Tue Jul 6 09:59:59 2004 +++ lisppaste2/variable.lisp Thu Jul 8 10:43:37 2004 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.26 2004/07/06 16:59:59 bmastenbrook Exp $ +;;;; $Id: variable.lisp,v 1.27 2004/07/08 17:43:37 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -105,6 +105,9 @@ (defparameter *css-url* (araneida:merge-url *paste-external-url* "lisppaste.css")) + +(defparameter *recent-url* + (araneida:merge-url *paste-external-url* "recent")) (defvar *paste-listener* (let ((fwd-url (araneida:copy-url *paste-external-url*)))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by Brian Mastenbrook 08 Jul '04

08 Jul '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: web-server.lisp Log Message: recent paste list Date: Thu Jul 8 10:42:40 2004 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.61 lisppaste2/web-server.lisp:1.62 --- lisppaste2/web-server.lisp:1.61 Tue Jul 6 09:58:13 2004 +++ lisppaste2/web-server.lisp Thu Jul 8 10:42:40 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.61 2004/07/06 16:58:13 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.62 2004/07/08 17:42:40 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -31,6 +31,8 @@ (defclass main-handler (lisppaste-basic-handler) ()) +(defclass recent-handler (lisppaste-basic-handler) ()) + (defclass css-handler (lisppaste-basic-handler) ()) (defclass new-paste-handler (lisppaste-basic-handler) ()) @@ -118,6 +120,31 @@ ,@forms ,@(bottom-links)))) +(defun recent-paste-list-div (&key (count 10)) + `((div :class "simple-paste-list") + (table + ,@(loop for i from 1 to count + for j in *pastes* + collect `(tr + ((td :valign center) ((a :href ,(paste-display-url j)) + ,(encode-for-pre (paste-title j)))) + ((td :valign bottom) " by " ,(encode-for-pre (paste-user j))) + ((td :valign bottom) ,(encode-for-pre (paste-channel j))))) + (tr + ((td :colspan 3) + (center + (b + ((a :href ,(araneida:urlstring *list-paste-url*)) + "More recent pastes...")))))))) + +(defmethod araneida:handle-request-response ((handler recent-handler) method request) + (araneida:request-send-headers request :expires 0) + (araneida:html-stream + (araneida:request-stream request) + (lisppaste-wrap-page + "Recent Pastes" + (recent-paste-list-div :count 20)))) + (defmethod araneida:handle-request-response ((handler main-handler) method request) (araneida:request-send-headers request :expires 0) (araneida:html-stream @@ -129,21 +156,7 @@ ((td :align right) ((div :class "small-header") "Make a new paste"))) (tr ((td :valign top :width "40%") - ((div :class "simple-paste-list") - (table - ,@(loop for i from 1 to 10 - for j in *pastes* - collect `(tr - ((td :valign center) ((a :href ,(paste-display-url j)) - ,(encode-for-pre (paste-title j)))) - ((td :valign bottom) " by " ,(encode-for-pre (paste-user j))) - ((td :valign bottom) ,(encode-for-pre (paste-channel j))))) - (tr - ((td :colspan 3) - (center - (b - ((a :href ,(araneida:urlstring *list-paste-url*)) - "More recent pastes..."))))))) + ,(recent-paste-list-div) (p) ((div :class "small-header") "About lisppaste") ((div :class "info-text") @@ -168,7 +181,7 @@ " - a hosting service for projects written in Common Lisp (like this one)." (p) "Please consider " - (b ((a :href "https://www.paypal.com/xclick/business=bmastenb%40indiana.edu&item_name…") "supporting Lisppaste development")) + (b ((a :href "https://www.paypal.com/xclick/business=chandler%40iddqd.org&item_name=S…") "supporting Lisppaste development")) " with your contributions. Thanks!" )) ((td :valign top :align right) @@ -257,7 +270,7 @@ ((a :href ,(araneida:urlstring *paste-external-url*)) "Main page") " | " - ((a :href "https://www.paypal.com/xclick/business=bmastenb%40indiana.edu&item_name…") + ((a :href "https://www.paypal.com/xclick/business=chandler%40iddqd.org&item_name=S…") "Support Lisppaste")) ((td :id "other-links") ((a :href ,(araneida:urlstring *new-paste-url*)) "New paste") @@ -381,7 +394,7 @@ (last (sort (loop for count being the hash-values of *referer-hash* using (hash-key host) - collect (cons host count)) #'< :key #'cdr) 10)))) + collect (cons host count)) #'< :key #'cdr) 20)))) (p) ((span :class "small-header") "Most popular channels:") (p) @@ -782,7 +795,7 @@ ((span :class "small-header") "Donations accepted") (br) "If you appreciate Lisppaste, please consider " - (b ((a :href "https://www.paypal.com/xclick/business=bmastenb%40indiana.edu&item_name…") "making a donation")) + (b ((a :href "https://www.paypal.com/xclick/business=chandler%40iddqd.org&item_name=S…") "making a donation")) " to support further development of the service. Thanks!")))) )))))))) @@ -1020,3 +1033,8 @@ (araneida:http-listener-handler *paste-listener*) (make-instance 'css-handler) (araneida:urlstring *css-url*) t) + +(araneida:install-handler + (araneida:http-listener-handler *paste-listener*) + (make-instance 'recent-handler) + (araneida:urlstring *recent-url*) t)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/abbrev.lisp lisppaste2/lisppaste.asd lisppaste2/clhs-lookup.lisp
by Brian Mastenbrook 08 Jul '04

08 Jul '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: lisppaste.asd clhs-lookup.lisp Added Files: abbrev.lisp Log Message: Abbreviations for CLHS lookup Date: Thu Jul 8 10:42:27 2004 Author: bmastenbrook Index: lisppaste2/lisppaste.asd diff -u lisppaste2/lisppaste.asd:1.13 lisppaste2/lisppaste.asd:1.14 --- lisppaste2/lisppaste.asd:1.13 Thu Jun 17 06:10:04 2004 +++ lisppaste2/lisppaste.asd Thu Jul 8 10:42:26 2004 @@ -1,5 +1,5 @@ ;;;; Silly emacs, this is -*- Lisp -*- -;;;; $Id: lisppaste.asd,v 1.13 2004/06/17 13:10:04 bmastenbrook Exp $ +;;;; $Id: lisppaste.asd,v 1.14 2004/07/08 17:42:26 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -29,7 +29,8 @@ (:file "colorize-package") (:file "coloring-css" :depends-on ("colorize-package")) (:file "colorize" :depends-on ("colorize-package" "coloring-css")) - (:file "clhs-lookup" :depends-on ("encode-for-pre")) + (:file "abbrev") + (:file "clhs-lookup" :depends-on ("encode-for-pre" "abbrev")) (:file "r5rs-lookup" :depends-on ("encode-for-pre")) (:file "elisp-lookup" :depends-on ("encode-for-pre")) (:file "lisppaste" Index: lisppaste2/clhs-lookup.lisp diff -u lisppaste2/clhs-lookup.lisp:1.6 lisppaste2/clhs-lookup.lisp:1.7 --- lisppaste2/clhs-lookup.lisp:1.6 Thu Jun 17 05:59:17 2004 +++ lisppaste2/clhs-lookup.lisp Thu Jul 8 10:42:26 2004 @@ -3,7 +3,7 @@ :spec-lookup)) (in-package :clhs-lookup) -(defparameter *hyperspec-pathname* #p"/home/chandler/public_html/HyperSpec/") +(defparameter *hyperspec-pathname* #p"/home/bmastenbrook/HyperSpec/") (defparameter *hyperspec-map-file* (merge-pathnames "Data/Map_Sym.txt" *hyperspec-pathname*)) @@ -16,6 +16,8 @@ (defvar *symbol-table* (make-hash-table :test 'equalp)) +(defvar *abbrev-table* (make-hash-table :test 'equalp)) + (defvar *section-table* (make-hash-table :test 'equalp)) (defvar *format-table* (make-hash-table :test 'equalp)) @@ -43,10 +45,16 @@ (format *trace-output* "Warning: could not find hyperspec map file. Adjust the path at the top of clhs-lookup.lisp to get links to the HyperSpec.~%") (setf *last-warn-time* (get-universal-time))) (return-from populate-table nil)) - (do ((symbol-name (read-line s nil s) (read-line s nil s)) - (url (read-line s nil s) (read-line s nil s))) - ((eq url s) 'done) - (setf (gethash symbol-name *symbol-table*) (concatenate 'string *hyperspec-root* (subseq url 3)))) + (flet ((set-symbol (sym url) + (setf (gethash sym *symbol-table*) url) + (let ((abbrev (abbrev:abbrev sym))) + (and abbrev + (pushnew sym (gethash abbrev *abbrev-table* nil) + :test #'string-equal))))) + (do ((symbol-name (read-line s nil s) (read-line s nil s)) + (url (read-line s nil s) (read-line s nil s))) + ((eq url s) 'done) + (set-symbol symbol-name (concatenate 'string *hyperspec-root* (subseq url 3))))) ;; add in section references. (let ((*default-pathname-defaults* *hyperspec-pathname*)) ;; Yuk. I know. Fixes welcome. @@ -126,6 +134,17 @@ (setf (gethash (concatenate 'string "MOP:" symbol-name) *symbol-table*) (concatenate 'string *mop-root* url)))) (setf *populated-p* t))) +(defun abbrev-lookup (term) + (let ((abbrevs (gethash term *abbrev-table* nil))) + (if (eql (length abbrevs) 0) + nil + (if (eql (length abbrevs) 1) + (format nil "~A: ~A" + (car abbrevs) + (gethash (car abbrevs) *symbol-table*)) + (format nil "Matches: ~{~A~^ ~}" + abbrevs))))) + (defun spec-lookup (term &key (type :all)) (unless *populated-p* (populate-table)) @@ -133,7 +152,10 @@ (:all (or (gethash term *symbol-table*) (gethash term *section-table*) - (gethash term *format-table*))) + (gethash term *format-table*) + (abbrev-lookup term))) + (:abbrev + (abbrev-lookup term)) (:symbol (gethash term *symbol-table*)) (:section

1 0