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")))