November 2004 - lisppaste-cvs@common-lisp.net

[Lisppaste-cvs] CVS update: lisppaste2/clhs-lookup.lisp lisppaste2/cocoa-lookup.lisp lisppaste2/elisp-lookup.lisp lisppaste2/r5rs-lookup.lisp
by bmastenbrook＠common-lisp.net 30 Nov '04

30 Nov '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: clhs-lookup.lisp cocoa-lookup.lisp elisp-lookup.lisp r5rs-lookup.lisp Log Message: MORE ROBUSTNESS Date: Tue Nov 30 20:16:13 2004 Author: bmastenbrook Index: lisppaste2/clhs-lookup.lisp diff -u lisppaste2/clhs-lookup.lisp:1.9 lisppaste2/clhs-lookup.lisp:1.10 --- lisppaste2/clhs-lookup.lisp:1.9 Fri Nov 12 15:47:00 2004 +++ lisppaste2/clhs-lookup.lisp Tue Nov 30 20:16:11 2004 @@ -15,7 +15,8 @@ ;;; AMOP. (defparameter *mop-map-file* - (merge-pathnames "Mop_Sym.txt" #.*compile-file-pathname*)) + (merge-pathnames "Mop_Sym.txt" + (or #.*compile-file-truename* *default-pathname-defaults*))) (defparameter *mop-root* "http://www.alu.org/mop/") Index: lisppaste2/cocoa-lookup.lisp diff -u lisppaste2/cocoa-lookup.lisp:1.1 lisppaste2/cocoa-lookup.lisp:1.2 --- lisppaste2/cocoa-lookup.lisp:1.1 Tue Nov 16 22:58:02 2004 +++ lisppaste2/cocoa-lookup.lisp Tue Nov 30 20:16:12 2004 @@ -7,11 +7,11 @@ (defparameter *appkit-file* (merge-pathnames "appkit.lisp-expr" - (or #.*compile-file-pathname* *default-pathname-defaults*))) + (or #.*compile-file-truename* *default-pathname-defaults*))) (defparameter *foundation-file* (merge-pathnames "foundation.lisp-expr" - (or #.*compile-file-pathname* *default-pathname-defaults*))) + (or #.*compile-file-truename* *default-pathname-defaults*))) (defvar *table* nil) Index: lisppaste2/elisp-lookup.lisp diff -u lisppaste2/elisp-lookup.lisp:1.2 lisppaste2/elisp-lookup.lisp:1.3 --- lisppaste2/elisp-lookup.lisp:1.2 Wed Jun 9 21:47:13 2004 +++ lisppaste2/elisp-lookup.lisp Tue Nov 30 20:16:12 2004 @@ -4,7 +4,9 @@ (defparameter *elisp-root* "http://www.gnu.org/software/emacs/elisp-manual/html_node/") -(defparameter *elisp-file* "elisp-symbols.lisp-expr") +(defparameter *elisp-file* + (merge-pathnames "elisp-symbols.lisp-expr" + (or #.*compile-file-truename* *default-pathname-defaults*))) (defvar *table* nil) Index: lisppaste2/r5rs-lookup.lisp diff -u lisppaste2/r5rs-lookup.lisp:1.2 lisppaste2/r5rs-lookup.lisp:1.3 --- lisppaste2/r5rs-lookup.lisp:1.2 Wed Jun 9 21:47:13 2004 +++ lisppaste2/r5rs-lookup.lisp Tue Nov 30 20:16:12 2004 @@ -4,7 +4,9 @@ (defparameter *r5rs-root* "http://www.schemers.org/Documents/Standards/R5RS/HTML/") -(defparameter *r5rs-file* "r5rs-symbols.lisp-expr") +(defparameter *r5rs-file* + (merge-pathnames "r5rs-symbols.lisp-expr" + (or #.*compile-file-truename* *default-pathname-defaults*))) (defvar *table* nil)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by bmastenbrook＠common-lisp.net 29 Nov '04

29 Nov '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: web-server.lisp Log Message: Oops: format t! Date: Mon Nov 29 21:45:32 2004 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.71 lisppaste2/web-server.lisp:1.72 --- lisppaste2/web-server.lisp:1.71 Mon Nov 29 21:41:55 2004 +++ lisppaste2/web-server.lisp Mon Nov 29 21:45:31 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.71 2004/11/29 20:41:55 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.72 2004/11/29 20:45:31 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -360,7 +360,6 @@ (weeks (* hours 487/16)) (months (* weeks 12)) (years (* hours (+ 365 1/4)))) - (format t "weeks is ~S, delta is ~S, floor w/weeks is ~S~%" weeks delta (floor delta weeks)) (let ((primitive (cond ((< delta seconds) (format nil "~D second~:P" delta))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp
by bmastenbrook＠common-lisp.net 29 Nov '04

29 Nov '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv11415 Modified Files: web-server.lisp Log Message: Bug fix to time-delta-primitive Date: Mon Nov 29 21:41:56 2004 Author: bmastenbrook Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.70 lisppaste2/web-server.lisp:1.71 --- lisppaste2/web-server.lisp:1.70 Mon Nov 29 16:47:52 2004 +++ lisppaste2/web-server.lisp Mon Nov 29 21:41:55 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.70 2004/11/29 15:47:52 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.71 2004/11/29 20:41:55 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -357,9 +357,10 @@ (minutes (* seconds 60)) (hours (* minutes 24)) (days (* hours 7)) - (weeks (* days 487/16)) + (weeks (* hours 487/16)) (months (* weeks 12)) (years (* hours (+ 365 1/4)))) + (format t "weeks is ~S, delta is ~S, floor w/weeks is ~S~%" weeks delta (floor delta weeks)) (let ((primitive (cond ((< delta seconds) (format nil "~D second~:P" delta)) @@ -368,7 +369,7 @@ ((< delta days) (format nil "~D day~:P" (floor delta hours))) ((< delta weeks) (format nil "~D week~:P" (floor delta days))) ((< delta months) (format nil "~D month~:P" (floor delta weeks))) - (t (format nil "~D years" (floor delta years)))))) + (t (format nil "~D years" (floor delta months)))))) (if (eql level 1) primitive (format nil "~A, ~A" primitive (time-delta-primitive

1 0

[Lisppaste-cvs] CVS update: lisppaste2/README.lisp lisppaste2/variable.lisp lisppaste2/web-server.lisp
by bmastenbrook＠common-lisp.net 29 Nov '04

29 Nov '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: README.lisp variable.lisp web-server.lisp Log Message: Random bug fixes Date: Mon Nov 29 16:47:53 2004 Author: bmastenbrook Index: lisppaste2/README.lisp diff -u lisppaste2/README.lisp:1.16 lisppaste2/README.lisp:1.17 --- lisppaste2/README.lisp:1.16 Sun Nov 7 22:01:43 2004 +++ lisppaste2/README.lisp Mon Nov 29 16:47:52 2004 @@ -1,4 +1,4 @@ -;;;; $Id: README.lisp,v 1.16 2004/11/07 21:01:43 bmastenbrook Exp $ +;;;; $Id: README.lisp,v 1.17 2004/11/29 15:47:52 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/README.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -42,8 +42,8 @@ "#growl" "#chicken" "#quicksilver" "#svn" "#slate" "#squeak" "#wiki" "#nebula" "#imgames") :nickname "lisppaste" - :server "orwell.freenode.net" + :server "niven.freenode.net" :port 6667) (lisppaste:start-irc-notification - :channels '("#lisppaste" "#pearpc" "#fpc" "#hprog") + :channels '("#lisppaste" "#pearpc" "#fpc" "#hprog" "#concatenative" "#slate-users") :nickname "lisppaste2")) Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.36 lisppaste2/variable.lisp:1.37 --- lisppaste2/variable.lisp:1.36 Sun Nov 7 22:01:43 2004 +++ lisppaste2/variable.lisp Mon Nov 29 16:47:52 2004 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.36 2004/11/07 21:01:43 bmastenbrook Exp $ +;;;; $Id: variable.lisp,v 1.37 2004/11/29 15:47:52 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -127,6 +127,9 @@ (defparameter *email-redirect-url* (araneida:merge-url *paste-external-url* "email")) + +(defparameter *channel-select-url* + (araneida:merge-url *paste-external-url* "channels")) (defparameter *main-system-server-url* (araneida:merge-url *paste-external-url* "system-server/")) Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.69 lisppaste2/web-server.lisp:1.70 --- lisppaste2/web-server.lisp:1.69 Sun Nov 7 22:01:43 2004 +++ lisppaste2/web-server.lisp Mon Nov 29 16:47:52 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.69 2004/11/07 21:01:43 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.70 2004/11/29 15:47:52 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -52,6 +52,8 @@ (defclass email-redirect-handler (lisppaste-basic-handler) ()) +(defclass channel-select-handler (lisppaste-basic-handler) ()) + (defvar *referer-hash* (make-hash-table :test #'equalp)) (defvar *referer-example-hash* (make-hash-table :test #'equalp)) @@ -83,33 +85,35 @@ (incf (gethash "Google" *referer-hash* 0) count))))) (defmethod araneida:handle-request-response :around ((handler lisppaste-basic-handler) method request) - (progn #+nil with-open-file #+nil (*trace-output* (times-file-for-class handler) + (with-open-file (*trace-output* (times-file-for-class handler) :direction :output :if-exists :append :if-does-not-exist :create) - (time - (progn - (let ((referer (car (araneida:request-header request :referer))) - (araneida::*default-url-defaults* (araneida:request-url request))) - (when (stringp referer) - (let ((url (araneida:parse-urlstring referer nil))) - (when 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))))) + (unwind-protect + (time + (progn + (let ((referer (car (araneida:request-header request :referer))) + (araneida::*default-url-defaults* (araneida:request-url request))) + (when (stringp referer) + (let ((url (araneida:parse-urlstring referer nil))) + (when 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))) + (force-output *trace-output*)))) (defun make-css () (let ((colorize:*css-background-class* "paste")) @@ -196,7 +200,7 @@ (araneida:html-stream (araneida:request-stream request) (lisppaste-wrap-page - *paste-site-name* + (format nil "~A pastebin" *paste-site-name*) `((table :width "100%" :border 0 :cellpadding 2) (tr (td ((div :class "small-header") "Recent pastes")) ((td :align right) ((div :class "small-header") "Make a new paste"))) @@ -271,14 +275,9 @@ (and (eql method :post) (araneida:body-param "channel" (araneida:request-body request))) + (substitute #\# #\/ (araneida::request-unhandled-part request) :test #'char=) (and *no-channel-pastes* - (or - (string-equal (araneida::request-unhandled-part request) "/none") - (string-equal (araneida:request-cookie request "CHANNEL") "None")) "None") - (substitute #\# #\/ (araneida::request-unhandled-part request) :test #'char=) - (concatenate 'string "#" - (araneida:request-cookie request "CHANNEL")) ))))) (cond ((and default-channel (or (and *no-channel-pastes* @@ -414,6 +413,36 @@ append)) "Full"))))) *channels*))))) +(defmethod araneida:handle-request-response ((handler channel-select-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) + (lisppaste-wrap-page + "Select a channel" + `((table :width "100%" :border 0 :cellpadding 2) + ((tr :valign top :align left) + ((td :style "width: 5em;") " ") + (td + ((table :class "info-table") + ,@(mapcar #'(lambda (channel) + `(tr + ((th :align left) + ((a :href ,(concatenate 'string + (araneida:urlstring *new-paste-url*) + "/" + (subseq channel 1))) ,channel) + ))) + (sort (copy-list (remove "None" *channels* :test #'string=)) #'string<)))) + ((td :style "width: 5em;") " ") + (td + ((div :class "info-text") + ,(format nil "Lisppaste is available in a number of channels on the IRC network ~A. Select a channel from the list below and bookmark its URL to paste with direct notification to your channel." *irc-network-name*) + (p) + "Questions? Comments? Want lisppaste in your channel? " ((a :href ,(araneida:urlstring *email-redirect-url*)) "Email me") ".")) + + ((td :style "width: 5em;") " ")))))) + (defun encode-beginning-of-month (month year &key next-month) (if next-month (encode-beginning-of-month (if (eql month 12) 1 (1+ month)) @@ -809,13 +838,22 @@ ,@(if (not annotate) `((tr ((th :align left :width "0%" :nowrap "nowrap") "Select a channel:") - (td ((select :name "channel") - ,@(if (not *no-channel-pastes*) - `(((option :value "")))) - ,@(mapcar #'(lambda (e) - `((option :value ,e ,@(if (string-equal e default-channel) - '(:selected "SELECTED"))) - ,(encode-for-pre e))) *channels*)))))) + (td ,@(if (or (string= default-channel "") + (string= default-channel "None")) + `(,(format nil "To paste to an IRC channel on the network ~A, select a channel from the " + *irc-network-name*) + ((input :type "hidden" :name "channel" :value ,default-channel))) + `(((select :name "channel") + ,@(mapcar #'(lambda (e) + `((option :value ,e ,@(if (string-equal e default-channel) + '(:selected "SELECTED"))) + ,(encode-for-pre e))) + (list* default-channel (if *no-channel-pastes* '("None"))))) + (br) + ,(format nil "To paste to a different IRC channel on the network ~A, select a channel from the " + *irc-network-name*))) + ((a :href ,(araneida:urlstring *channel-select-url*)) "channel list") + ".")))) (tr ((th :align left :width "0%" :nowrap "nowrap") "Enter your username:") (td ((input :type text :name "username" @@ -1042,9 +1080,10 @@ (colorize-string (or (araneida:body-param "colorize" (araneida:request-body request)) (and paste - (when (eql (paste-colorization-mode paste) :none) - (setf (paste-colorization-mode paste) "") - nil) + (if (eql (paste-colorization-mode paste) :none) + (progn (setf (paste-colorization-mode paste) "") + nil) + t) (> (length (paste-colorization-mode paste)) 0) (paste-colorization-mode paste)) )) @@ -1103,7 +1142,7 @@ (araneida:html-stream (araneida:request-stream request) (lisppaste-wrap-page - (format nil "Paste number ~A" paste-number) + (format nil "Paste number ~A: ~A" paste-number (encode-for-pre (paste-title paste))) `(div ((form :method post :action ,(araneida:urlstring *new-paste-url*)) (center @@ -1236,3 +1275,8 @@ (araneida:http-listener-handler *paste-listener*) (make-instance 'email-redirect-handler) (araneida:urlstring *email-redirect-url*) t) + +(araneida:install-handler + (araneida:http-listener-handler *paste-listener*) + (make-instance 'channel-select-handler) + (araneida:urlstring *channel-select-url*) t)

1 0

[Lisppaste-cvs] CVS update: lisppaste2/coloring-types.lisp lisppaste2/colorize.lisp
by Brian Mastenbrook 16 Nov '04

16 Nov '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv2665 Modified Files: coloring-types.lisp colorize.lisp Log Message: Smarter ObjC colorization Date: Tue Nov 16 23:27:31 2004 Author: bmastenbrook Index: lisppaste2/coloring-types.lisp diff -u lisppaste2/coloring-types.lisp:1.11 lisppaste2/coloring-types.lisp:1.12 --- lisppaste2/coloring-types.lisp:1.11 Tue Nov 16 22:55:51 2004 +++ lisppaste2/coloring-types.lisp Tue Nov 16 23:27:31 2004 @@ -268,7 +268,8 @@ "switch" "typedef" "union" "unsigned" "void" "volatile" "while" "__restrict" "_Bool")) -(defvar *c-terminators* '(#\space #\return #\tab #\newline #\. #\/ #\- #\* #\+ #\{ #\} #$ #$ #\' #\" #\[ #\] #\< #\> #\#)) +(defparameter *c-begin-word* "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789") +(defparameter *c-terminators* '(#\space #\return #\tab #\newline #\. #\/ #\- #\* #\+ #\{ #\} #$ #$ #\' #\" #\[ #\] #\< #\> #\#)) (define-coloring-type :basic-c "Basic C" :modes (:normal :comment :word-ish :paren-ish :string :char :single-escape :preprocessor) @@ -276,7 +277,7 @@ :invisible t :transitions ((:normal - ((scan-any "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789") + ((scan-any *c-begin-word*) (set-mode :word-ish :until (scan-any *c-terminators*) :advancing nil)) @@ -426,19 +427,64 @@ s) s))))) -(define-coloring-type :objective-c "Objective C" - :autodetect (lambda (text) (search "mac" text :test #'char=)) +(let ((terminate-next nil)) + (define-coloring-type :objective-c "Objective C" + :autodetect (lambda (text) (search "mac" text :test #'char=)) + :modes (:begin-message-send :end-message-send) + :transitions + ((:normal + ((scan #\[) + (set-mode :begin-message-send + :until (advance 1) + :advancing nil)) + ((scan #\]) + (set-mode :end-message-send + :until (advance 1) + :advancing nil)) + ((scan-any *c-begin-word*) + (set-mode :word-ish + :until (or + (and (peek-any '(#\:)) + (setf terminate-next t)) + (and terminate-next (progn + (setf terminate-next nil) + (advance 1))) + (scan-any *c-terminators*)) + :advancing nil))) + (:word-ish + #+nil + ((scan #\:) + (format t "hi~%") + (set-mode :word-ish :until (advance 1) :advancing nil) + (setf terminate-next t)))) :parent :c++ + :formatter-variables ((is-keyword nil) (in-message-send nil)) :formatters - ((:word-ish + ((:begin-message-send + (lambda (type s) + (setf is-keyword nil) + (setf in-message-send t) + (call-formatter (cons :paren-ish type) s))) + (:end-message-send + (lambda (type s) + (setf is-keyword nil) + (setf in-message-send nil) + (call-formatter (cons :paren-ish type) s))) + (:word-ish (lambda (type s) (declare (ignore type)) - (let ((result (if (find-package :cocoa-lookup) - (funcall (symbol-function (intern "SYMBOL-LOOKUP" :cocoa-lookup)) - s)))) - (if result - (format nil "<a href=\"~A\" class=\"symbol\">~A</a>" - result (call-parent-formatter)) - (if (member s *c-reserved-words* :test #'string=) - (format nil "~A" s) - s))))))) + (prog1 + (let ((result (if (find-package :cocoa-lookup) + (funcall (symbol-function (intern "SYMBOL-LOOKUP" :cocoa-lookup)) + s)))) + (if result + (format nil "<a href=\"~A\" class=\"symbol\">~A</a>" + result s) + (if (member s *c-reserved-words* :test #'string=) + (format nil "~A" s) + (if in-message-send + (if is-keyword + (format nil "~A" s) + s) + s)))) + (setf is-keyword (not is-keyword)))))))) \ No newline at end of file Index: lisppaste2/colorize.lisp diff -u lisppaste2/colorize.lisp:1.5 lisppaste2/colorize.lisp:1.6 --- lisppaste2/colorize.lisp:1.5 Thu Jul 15 14:36:49 2004 +++ lisppaste2/colorize.lisp Tue Nov 16 23:27:31 2004 @@ -64,7 +64,7 @@ `(labels ((advance (,num) (setf ,position-place (+ ,position-place ,num)) t) - (scan-any (,items &key ,not-preceded-by) + (peek-any (,items &key ,not-preceded-by) (incf *scan-calls*) (let* ((,items (if (stringp ,items) (coerce ,items 'list) ,items)) @@ -98,13 +98,16 @@ t) t) nil) - (progn - (advance (length ,item)) - t) + ,item (progn (and *reset-position* (setf ,position-place *reset-position*)) nil))))) + (scan-any (,items &key ,not-preceded-by) + (let ((,item (peek-any ,items :not-preceded-by ,not-preceded-by))) + (and ,item (advance (length ,item))))) + (peek (,item &key ,not-preceded-by) + (peek-any (list ,item) :not-preceded-by ,not-preceded-by)) (scan (,item &key ,not-preceded-by) (scan-any (list ,item) :not-preceded-by ,not-preceded-by))) (macrolet ((set-mode (,new-mode &key ,until (,advancing t))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/appkit.lisp-expr lisppaste2/cocoa-lookup.lisp lisppaste2/foundation.lisp-expr lisppaste2/lisppaste.asd
by Brian Mastenbrook 16 Nov '04

16 Nov '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv994 Modified Files: lisppaste.asd Added Files: appkit.lisp-expr cocoa-lookup.lisp foundation.lisp-expr Log Message: Cocoa lookup Date: Tue Nov 16 22:58:02 2004 Author: bmastenbrook Index: lisppaste2/lisppaste.asd diff -u lisppaste2/lisppaste.asd:1.18 lisppaste2/lisppaste.asd:1.19 --- lisppaste2/lisppaste.asd:1.18 Wed Oct 20 22:22:13 2004 +++ lisppaste2/lisppaste.asd Tue Nov 16 22:58:02 2004 @@ -1,5 +1,5 @@ ;;;; Silly emacs, this is -*- Lisp -*- -;;;; $Id: lisppaste.asd,v 1.18 2004/10/20 20:22:13 bmastenbrook Exp $ +;;;; $Id: lisppaste.asd,v 1.19 2004/11/16 21:58:02 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -33,11 +33,13 @@ (:file "abbrev") (:file "clhs-lookup" :depends-on ("encode-for-pre" "abbrev")) (:file "r5rs-lookup" :depends-on ("encode-for-pre")) + (:file "cocoa-lookup" :depends-on ("encode-for-pre")) (:file "elisp-lookup" :depends-on ("encode-for-pre")) #-lisppaste-no-irc (:file "irc-notification" :depends-on ("variable" "package")) (:file "lisppaste" :depends-on ("variable" "clhs-lookup" "r5rs-lookup" + "cocoa-lookup" "elisp-lookup" #-lisppaste-no-irc "irc-notification"))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/coloring-types.lisp
by Brian Mastenbrook 16 Nov '04

16 Nov '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv942 Modified Files: coloring-types.lisp Log Message: add Objective C coloring type Date: Tue Nov 16 22:55:52 2004 Author: bmastenbrook Index: lisppaste2/coloring-types.lisp diff -u lisppaste2/coloring-types.lisp:1.10 lisppaste2/coloring-types.lisp:1.11 --- lisppaste2/coloring-types.lisp:1.10 Sat Sep 25 22:20:27 2004 +++ lisppaste2/coloring-types.lisp Tue Nov 16 22:55:51 2004 @@ -268,6 +268,8 @@ "switch" "typedef" "union" "unsigned" "void" "volatile" "while" "__restrict" "_Bool")) +(defvar *c-terminators* '(#\space #\return #\tab #\newline #\. #\/ #\- #\* #\+ #\{ #\} #$ #$ #\' #\" #\[ #\] #\< #\> #\#)) + (define-coloring-type :basic-c "Basic C" :modes (:normal :comment :word-ish :paren-ish :string :char :single-escape :preprocessor) :default-mode :normal @@ -276,7 +278,7 @@ ((:normal ((scan-any "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ_0123456789") (set-mode :word-ish - :until (scan-any '(#\space #\return #\tab #\newline #\. #\/ #\- #\* #\+ #\{ #\} #$ #$ #\' #\" #\[ #\] #\< #\> #\#)) + :until (scan-any *c-terminators*) :advancing nil)) ((scan "/*") (set-mode :comment @@ -423,3 +425,20 @@ (format nil "~A" s) s))))) + +(define-coloring-type :objective-c "Objective C" + :autodetect (lambda (text) (search "mac" text :test #'char=)) + :parent :c++ + :formatters + ((:word-ish + (lambda (type s) + (declare (ignore type)) + (let ((result (if (find-package :cocoa-lookup) + (funcall (symbol-function (intern "SYMBOL-LOOKUP" :cocoa-lookup)) + s)))) + (if result + (format nil "<a href=\"~A\" class=\"symbol\">~A</a>" + result (call-parent-formatter)) + (if (member s *c-reserved-words* :test #'string=) + (format nil "~A" s) + s)))))))

1 0

[Lisppaste-cvs] CVS update: lisppaste2/clhs-lookup.lisp
by Brian Mastenbrook 12 Nov '04

12 Nov '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv9368 Modified Files: clhs-lookup.lisp Log Message: use (user-homedir-pathname) to be a little smarter about finding the HS Date: Fri Nov 12 15:47:00 2004 Author: bmastenbrook Index: lisppaste2/clhs-lookup.lisp diff -u lisppaste2/clhs-lookup.lisp:1.8 lisppaste2/clhs-lookup.lisp:1.9 --- lisppaste2/clhs-lookup.lisp:1.8 Sat Sep 25 22:20:27 2004 +++ lisppaste2/clhs-lookup.lisp Fri Nov 12 15:47:00 2004 @@ -3,14 +3,19 @@ :spec-lookup)) (in-package :clhs-lookup) -(defparameter *hyperspec-pathname* #p"/home/bmastenbrook/HyperSpec/") +(defparameter *hyperspec-pathname* + (merge-pathnames + (make-pathname :directory '(:relative "HyperSpec")) + (user-homedir-pathname))) -(defparameter *hyperspec-map-file* (merge-pathnames "Data/Map_Sym.txt" *hyperspec-pathname*)) +(defparameter *hyperspec-map-file* + (merge-pathnames "Data/Map_Sym.txt" *hyperspec-pathname*)) (defparameter *hyperspec-root* "http://www.lispworks.com/reference/HyperSpec/") ;;; AMOP. -(defparameter *mop-map-file* #p"Mop_Sym.txt") +(defparameter *mop-map-file* + (merge-pathnames "Mop_Sym.txt" #.*compile-file-pathname*)) (defparameter *mop-root* "http://www.alu.org/mop/")

1 0

[Lisppaste-cvs] CVS update: lisppaste2/README.lisp lisppaste2/irc-notification.lisp lisppaste2/package.lisp lisppaste2/variable.lisp lisppaste2/web-server.lisp
by Brian Mastenbrook 07 Nov '04

07 Nov '04

Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: README.lisp irc-notification.lisp package.lisp variable.lisp web-server.lisp Log Message: General fixes, fix pastes made by lisppaste.el Date: Sun Nov 7 22:01:44 2004 Author: bmastenbrook Index: lisppaste2/README.lisp diff -u lisppaste2/README.lisp:1.15 lisppaste2/README.lisp:1.16 --- lisppaste2/README.lisp:1.15 Wed Oct 20 22:37:50 2004 +++ lisppaste2/README.lisp Sun Nov 7 22:01:43 2004 @@ -1,4 +1,4 @@ -;;;; $Id: README.lisp,v 1.15 2004/10/20 20:37:50 bmastenbrook Exp $ +;;;; $Id: README.lisp,v 1.16 2004/11/07 21:01:43 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/README.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -35,11 +35,15 @@ (lisppaste:start-lisppaste) #-lisppaste-no-irc -(lisppaste:start-irc-notification - :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) +(progn + (lisppaste:start-irc-notification + :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) + (lisppaste:start-irc-notification + :channels '("#lisppaste" "#pearpc" "#fpc" "#hprog") + :nickname "lisppaste2")) Index: lisppaste2/irc-notification.lisp diff -u lisppaste2/irc-notification.lisp:1.3 lisppaste2/irc-notification.lisp:1.4 --- lisppaste2/irc-notification.lisp:1.3 Sun Oct 24 21:54:33 2004 +++ lisppaste2/irc-notification.lisp Sun Nov 7 22:01:43 2004 @@ -1,4 +1,4 @@ -;;;; $Id: irc-notification.lisp,v 1.3 2004/10/24 19:54:33 bmastenbrook Exp $ +;;;; $Id: irc-notification.lisp,v 1.4 2004/11/07 21:01:43 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/irc-notification.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -94,6 +94,14 @@ (setf (car (rassoc nickname *nicknames* :test #'string=)) (remove channel (car (rassoc nickname *nicknames* :test #'string=)) :test #'string=))) + +(defun quit-all-connections () + (mapc #'(lambda (e) + (ignore-errors (irc:quit e))) + (mapcar #'cdr *connections*))) + +(defun hup-all-connections () + (mapc #'hup-irc-connection (mapcar #'car *connections*))) (defun hup-irc-connection (nickname &optional (server *default-irc-server*)) (ignore-errors (irc:quit (nick-connection nickname))) Index: lisppaste2/package.lisp diff -u lisppaste2/package.lisp:1.9 lisppaste2/package.lisp:1.10 --- lisppaste2/package.lisp:1.9 Wed Oct 20 22:22:13 2004 +++ lisppaste2/package.lisp Sun Nov 7 22:01:43 2004 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.9 2004/10/20 20:22:13 bmastenbrook Exp $ +;;;; $Id: package.lisp,v 1.10 2004/11/07 21:01:43 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -10,6 +10,7 @@ (:use :cl #+sbcl :sb-bsd-sockets :html-encode) (:export :start-lisppaste :join-new-irc-channel :start-irc-notification :hup-irc-connection + :quit-all-connections :hup-all-connections :shut-up :un-shut-up :irc-say-help :kill-paste :kill-paste-annotations :kill-paste-annotation :display-paste-url :find-paste))) Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.35 lisppaste2/variable.lisp:1.36 --- lisppaste2/variable.lisp:1.35 Sun Oct 24 21:54:33 2004 +++ lisppaste2/variable.lisp Sun Nov 7 22:01:43 2004 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.35 2004/10/24 19:54:33 bmastenbrook Exp $ +;;;; $Id: variable.lisp,v 1.36 2004/11/07 21:01:43 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -23,12 +23,12 @@ (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* 8081 +(defparameter *external-http-port* 80 "Port lisppaste's araneida will listen on for requests from remote clients.") -(defparameter *paste-site-name* "www.unmutual.info" +(defparameter *paste-site-name* "paste.lisp.org" "Website we are running on (used for creating links).") (defparameter *paste-external-url* @@ -37,7 +37,7 @@ :host *paste-site-name* ;;; comment out this next line when running ;;; behind a proxying apache - :port *external-http-port* + #| :port *external-http-port* |# ) "/")) (defparameter *old-url* (araneida:merge-url @@ -53,6 +53,8 @@ ; be ignored when not running ; with an IRC connection +(defvar *owner-email* "chandler(a)unmutual.info") ; the owner of this lisppaste + (defvar *paste-maximum-size* 51200) ; in bytes (defvar *pastes-per-page* 50) ; for the paste list @@ -123,6 +125,9 @@ (defparameter *recent-url* (araneida:merge-url *paste-external-url* "recent")) +(defparameter *email-redirect-url* + (araneida:merge-url *paste-external-url* "email")) + (defparameter *main-system-server-url* (araneida:merge-url *paste-external-url* "system-server/")) @@ -153,7 +158,6 @@ (defvar *pastes* nil) (defvar *paste-counter* 0) - (defvar *channels* '("None")) (defvar *paste-file* Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.68 lisppaste2/web-server.lisp:1.69 --- lisppaste2/web-server.lisp:1.68 Wed Oct 20 22:37:50 2004 +++ lisppaste2/web-server.lisp Sun Nov 7 22:01:43 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.68 2004/10/20 20:37:50 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.69 2004/11/07 21:01:43 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -14,7 +14,7 @@ (annotations :initarg :annotations :initform nil :accessor paste-annotations) (annotation-counter :initarg :annotation-counter :initform 0 :accessor paste-annotation-counter) (channel :initarg :channel :initform "" :accessor paste-channel) - (colorization-mode :initarg :colorization-mode :initform :none :accessor paste-colorization-mode))) + (colorization-mode :initarg :colorization-mode :initform "" :accessor paste-colorization-mode))) (defun paste-display-url (paste) (araneida:urlstring (araneida:merge-url *display-paste-url* (prin1-to-string (paste-number paste))))) @@ -50,6 +50,8 @@ (defclass stats-handler (lisppaste-basic-handler) ()) +(defclass email-redirect-handler (lisppaste-basic-handler) ()) + (defvar *referer-hash* (make-hash-table :test #'equalp)) (defvar *referer-example-hash* (make-hash-table :test #'equalp)) @@ -81,7 +83,7 @@ (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) + (progn #+nil with-open-file #+nil (*trace-output* (times-file-for-class handler) :direction :output :if-exists :append :if-does-not-exist :create) (time @@ -225,6 +227,8 @@ "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)." + (p) + "Questions? Comments? Want lisppaste in your channel? " ((a :href ,(araneida:urlstring *email-redirect-url*)) "Email me") "." )) ((td :valign top :align right) ((form :method post :action ,(araneida:urlstring *submit-paste-url*)) @@ -1038,6 +1042,9 @@ (colorize-string (or (araneida:body-param "colorize" (araneida:request-body request)) (and paste + (when (eql (paste-colorization-mode paste) :none) + (setf (paste-colorization-mode paste) "") + nil) (> (length (paste-colorization-mode paste)) 0) (paste-colorization-mode paste)) )) @@ -1157,6 +1164,19 @@ (format nil "Invalid paste number ~A!" paste-number) )))))) +(defmethod araneida:handle-request-response ((handler email-redirect-handler) method request) + (let ((email-url (concatenate 'string "mailto:" *owner-email*))) + (araneida:request-send-headers + request + :location email-url + :expires "Fri, 30 Oct 1998 14:19:41 GMT" + :pragma "no-cache" + :response-code 302 :response-text "Redirected") + (araneida:html-stream + (araneida:request-stream request) + `(html (body (h1 "Redirected")))) + t)) + (araneida:install-handler (araneida:http-listener-handler *paste-listener*) (make-instance 'new-paste-handler) @@ -1211,3 +1231,8 @@ (araneida:http-listener-handler *paste-listener*) (make-instance 'recent-handler) (araneida:urlstring *recent-url*) t) + +(araneida:install-handler + (araneida:http-listener-handler *paste-listener*) + (make-instance 'email-redirect-handler) + (araneida:urlstring *email-redirect-url*) t)

1 0