[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
Brian Mastenbrook
bmastenbrook at common-lisp.net
Sat Sep 25 20:20:28 UTC 2004
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")))
More information about the Lisppaste-cvs
mailing list