From bknr at bknr.net  Fri Sep 15 14:21:24 2006
From: bknr at bknr.net (bknr at bknr.net)
Date: Fri, 15 Sep 2006 10:21:24 -0400 (EDT)
Subject: [bknr-cvs] r1983 - branches/xml-class-rework/bknr/src/skip-list
Message-ID: <20060915142124.C324358318@common-lisp.net>

Author: hhubner
Date: 2006-09-15 10:21:24 -0400 (Fri, 15 Sep 2006)
New Revision: 1983

Modified:
   branches/xml-class-rework/bknr/src/skip-list/skip-list.lisp
Log:
Workaround for Kamen Tomov's problem with multiple inheritance.


Modified: branches/xml-class-rework/bknr/src/skip-list/skip-list.lisp
===================================================================
--- branches/xml-class-rework/bknr/src/skip-list/skip-list.lisp	2006-08-18 16:38:52 UTC (rev 1982)
+++ branches/xml-class-rework/bknr/src/skip-list/skip-list.lisp	2006-09-15 14:21:24 UTC (rev 1983)
@@ -159,7 +159,7 @@
   (multiple-value-bind (update node)
       (make-update sl key)
 
-    (when (= (node-key node) key)
+    (when (and node (= (node-key node) key))
       (do ((level 0 (1+ level)))
 	  ((= level (skip-list-level sl)))
 	(let ((next (node-forward update level)))



From bknr at bknr.net  Sun Sep 24 19:13:32 2006
From: bknr at bknr.net (bknr at bknr.net)
Date: Sun, 24 Sep 2006 15:13:32 -0400 (EDT)
Subject: [bknr-cvs] r1984 - branches/xml-class-rework/thirdparty/cl-mime
Message-ID: <20060924191332.4FB181D0C1@common-lisp.net>

Author: hhubner
Date: 2006-09-24 15:13:31 -0400 (Sun, 24 Sep 2006)
New Revision: 1984

Added:
   branches/xml-class-rework/thirdparty/cl-mime/README
   branches/xml-class-rework/thirdparty/cl-mime/cl-mime.asd
   branches/xml-class-rework/thirdparty/cl-mime/encoding.lisp
   branches/xml-class-rework/thirdparty/cl-mime/package.lisp
Removed:
   branches/xml-class-rework/thirdparty/cl-mime/fundamentals.lisp
   branches/xml-class-rework/thirdparty/cl-mime/mime.asd
Modified:
   branches/xml-class-rework/thirdparty/cl-mime/classes.lisp
   branches/xml-class-rework/thirdparty/cl-mime/headers.lisp
   branches/xml-class-rework/thirdparty/cl-mime/parse-mime.lisp
   branches/xml-class-rework/thirdparty/cl-mime/print-mime.lisp
   branches/xml-class-rework/thirdparty/cl-mime/utilities.lisp
Log:
Update to cl-mime 0.5.1


Added: branches/xml-class-rework/thirdparty/cl-mime/README
===================================================================
--- branches/xml-class-rework/thirdparty/cl-mime/README	2006-09-15 14:21:24 UTC (rev 1983)
+++ branches/xml-class-rework/thirdparty/cl-mime/README	2006-09-24 19:13:31 UTC (rev 1984)
@@ -0,0 +1,9 @@
+This is a library for reading and printing MIME content. It supports
+automatic conversion between 7bit, quoted-printable and base64
+encodings via cl-base64 and cl-qprint libraries.
+
+The required libraries can be found at:
+http://files.b9.com/cl-base64/cl-base64-latest.tar.gz
+http://www.bobturf.org/software/cl-qprint
+http://weitz.de/cl-ppcre/
+

Added: branches/xml-class-rework/thirdparty/cl-mime/cl-mime.asd
===================================================================
--- branches/xml-class-rework/thirdparty/cl-mime/cl-mime.asd	2006-09-15 14:21:24 UTC (rev 1983)
+++ branches/xml-class-rework/thirdparty/cl-mime/cl-mime.asd	2006-09-24 19:13:31 UTC (rev 1984)
@@ -0,0 +1,42 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; cl-mime.asd: System Definition
+;;;; Copyright (C) 2004 Robert Marlow <bobstopper at bobturf.org>
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Library General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 2 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Library General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Library General Public
+;;;; License along with this library; if not, write to the
+;;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;;; Boston, MA  02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+
+(defpackage :cl-mime-system
+  (:use :asdf :cl))
+
+(in-package :cl-mime-system)
+
+(defsystem :cl-mime
+  :name "MIME"
+  :author "Robert Marlow <bobstopper at bobturf.org>"
+  :version "0.5.1"
+  :maintainer "Robert Marlow <bobstopper at bobturf.org>"
+  :depends-on (:cl-ppcre :cl-base64 :cl-qprint)
+  :serial t
+  :components
+  ((:file "package")
+   (:file "utilities")
+   (:file "classes")
+   (:file "headers")
+   (:file "encoding")
+   (:file "parse-mime")
+   (:file "print-mime")))

Modified: branches/xml-class-rework/thirdparty/cl-mime/classes.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cl-mime/classes.lisp	2006-09-15 14:21:24 UTC (rev 1983)
+++ branches/xml-class-rework/thirdparty/cl-mime/classes.lisp	2006-09-24 19:13:31 UTC (rev 1984)
@@ -47,7 +47,16 @@
    (content-transfer-encoding
     :accessor content-transfer-encoding
     :initarg :encoding
-    :initform "7bit")
+    :initform :7bit
+    :documentation
+    "Encoding to use when printing the MIME content.
+May be :7BIT :BASE64 or :QUOTED-PRINTABLE")
+   (content-encoding
+    :accessor content-encoding
+    :initarg :content-encoding
+    :initform :7bit
+    :documentation "Encoding the MIME content is currently in.
+May be :7BIT :BASE64 or :QUOTED-PRINTABLE")
    (content-disposition
     :accessor content-disposition
     :initarg :disposition

Added: branches/xml-class-rework/thirdparty/cl-mime/encoding.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cl-mime/encoding.lisp	2006-09-15 14:21:24 UTC (rev 1983)
+++ branches/xml-class-rework/thirdparty/cl-mime/encoding.lisp	2006-09-24 19:13:31 UTC (rev 1984)
@@ -0,0 +1,46 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; encoding.lisp: Tools for converting content encoding
+;;;; Copyright (C) 2004 Robert Marlow <bobstopper at bobturf.org>
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Library General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 2 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Library General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Library General Public
+;;;; License along with this library; if not, write to the
+;;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;;; Boston, MA  02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+
+(in-package :mime)
+
+
+(defun encode-content (mime)
+  (if (eql (content-transfer-encoding mime)
+	   (content-encoding mime))
+      (content mime)
+      (let ((content (decode-content mime)))
+	(ecase (content-transfer-encoding mime)
+	  (:7bit content)
+	  (:base64 
+	   (typecase content
+	     (string (string-to-base64-string content :columns 75))
+	     ((array (unsigned-byte 8))
+	      (usb8-array-to-base64-string content :columns 75))))
+	  (:quoted-printable (qprint:encode content 75))))))
+
+
+(defun decode-content (mime)
+  (ecase (content-encoding mime)
+    (:7bit (content mime))
+    (:base64 (base64-string-to-usb8-array (content mime)))
+    (:quoted-printable (qprint:decode (content mime)))))
+

Deleted: branches/xml-class-rework/thirdparty/cl-mime/fundamentals.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cl-mime/fundamentals.lisp	2006-09-15 14:21:24 UTC (rev 1983)
+++ branches/xml-class-rework/thirdparty/cl-mime/fundamentals.lisp	2006-09-24 19:13:31 UTC (rev 1984)
@@ -1,58 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;; fundamentals.lisp: Package definition and any globals
-;;;; Copyright (C) 2004 Robert Marlow <bobstopper at bobturf.org>
-;;;;
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Library General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 2 of the License, or (at your option) any later version.
-;;;;
-;;;; This library is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Library General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU Library General Public
-;;;; License along with this library; if not, write to the
-;;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;;;; Boston, MA  02111-1307, USA.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-
-(defpackage :mime
-  (:documentation "A package for constructing MIME objects for printing and
-parsing MIME formatted strings or streams.")
-  (:nicknames :cl-mime)
-  (:use :cl :kmrcl :cl-ppcre)
-  (:shadow :read-stream-to-string)
-  (:export :text-mime
-	   :multipart-mime
-	   :mime
-	   :make-content-id
-	   :content-type
-	   :content-subtype
-	   :content-type-parameters
-	   :content-id
-	   :content-description
-	   :content-transfer-encoding
-	   :content-disposition
-	   :content-disposition-parameters
-	   :mime-version
-	   :charset
-	   :boundary
-	   :prologue
-	   :epilogue
-	   :content
-	   :get-header
-	   :get-mime-headers
-	   :get-content-type-parameter
-	   :get-content-disposition-parameter
-	   :print-headers
-	   :header-value
-	   :header-parms
-	   :header-comments
-	   :print-mime
-	   :parse-mime))
-
-(in-package :mime)

Modified: branches/xml-class-rework/thirdparty/cl-mime/headers.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cl-mime/headers.lisp	2006-09-15 14:21:24 UTC (rev 1983)
+++ branches/xml-class-rework/thirdparty/cl-mime/headers.lisp	2006-09-24 19:13:31 UTC (rev 1984)
@@ -51,16 +51,16 @@
 
 
 (defmethod get-header ((mime-obj mime) (header (eql :content-disposition)))
-  (aif (slot-value mime-obj (intern (string header) :mime))
-       (cons header
-	     (format nil "~A~A"
-		     (content-disposition mime-obj)
-		     (format nil "~{~{;~%~5,5T~A=\"~A\"~}~}"
-			     (mapcar
-			      (lambda (parm-pair)
-				(cons (string-downcase (symbol-name (car parm-pair)))
-				 (cdr parm-pair)))
-			      (content-disposition-parameters mime-obj)))))))
+  (when (content-disposition mime-obj)
+    (cons header
+	  (format nil "~A~A"
+		  (content-disposition mime-obj)
+		  (format nil "~{~{;~%~5,5T~A=\"~A\"~}~}"
+			  (mapcar
+			   (lambda (parm-pair)
+			     (cons (string-downcase (symbol-name (car parm-pair)))
+				   (cdr parm-pair)))
+			   (content-disposition-parameters mime-obj)))))))
 
 
 (defmethod get-header ((mime-obj mime) (header symbol))

Deleted: branches/xml-class-rework/thirdparty/cl-mime/mime.asd
===================================================================
--- branches/xml-class-rework/thirdparty/cl-mime/mime.asd	2006-09-15 14:21:24 UTC (rev 1983)
+++ branches/xml-class-rework/thirdparty/cl-mime/mime.asd	2006-09-24 19:13:31 UTC (rev 1984)
@@ -1,41 +0,0 @@
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;; mime.asd: System Definition
-;;;; Copyright (C) 2004 Robert Marlow <bobstopper at bobturf.org>
-;;;;
-;;;; This library is free software; you can redistribute it and/or
-;;;; modify it under the terms of the GNU Library General Public
-;;;; License as published by the Free Software Foundation; either
-;;;; version 2 of the License, or (at your option) any later version.
-;;;;
-;;;; This library is distributed in the hope that it will be useful,
-;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
-;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;;;; Library General Public License for more details.
-;;;;
-;;;; You should have received a copy of the GNU Library General Public
-;;;; License along with this library; if not, write to the
-;;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;;;; Boston, MA  02111-1307, USA.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-
-(defpackage :mime-system
-  (:use :asdf :cl))
-
-(in-package :mime-system)
-
-(defsystem :mime
-  :name "MIME"
-  :author "Robert Marlow <rob at bobturf.org>"
-  :version "0.3.0"
-  :maintainer "Robert Marlow <rob at bobturf.org>"
-  :depends-on (:kmrcl :cl-ppcre)
-  :serial t
-  :components
-  ((:file "fundamentals")
-   (:file "utilities")
-   (:file "classes")
-   (:file "headers")
-   (:file "parse-mime")
-   (:file "print-mime")))

Added: branches/xml-class-rework/thirdparty/cl-mime/package.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cl-mime/package.lisp	2006-09-15 14:21:24 UTC (rev 1983)
+++ branches/xml-class-rework/thirdparty/cl-mime/package.lisp	2006-09-24 19:13:31 UTC (rev 1984)
@@ -0,0 +1,62 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; package.lisp: Package definition
+;;;; Copyright (C) 2004 Robert Marlow <bobstopper at bobturf.org>
+;;;;
+;;;; This library is free software; you can redistribute it and/or
+;;;; modify it under the terms of the GNU Library General Public
+;;;; License as published by the Free Software Foundation; either
+;;;; version 2 of the License, or (at your option) any later version.
+;;;;
+;;;; This library is distributed in the hope that it will be useful,
+;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;;; Library General Public License for more details.
+;;;;
+;;;; You should have received a copy of the GNU Library General Public
+;;;; License along with this library; if not, write to the
+;;;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;;;; Boston, MA  02111-1307, USA.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+
+(defpackage :cl-mime
+  (:documentation "A package for constructing MIME objects for printing and
+parsing MIME formatted strings or streams.")
+  (:nicknames :mime)
+  (:use :cl :cl-ppcre :base64)
+  (:export :text-mime
+	   :multipart-mime
+	   :mime
+	   :lookup-mime
+	   :make-content-id
+	   :content-type
+	   :content-subtype
+	   :content-type-parameters
+	   :content-id
+	   :content-description
+	   :content-transfer-encoding
+	   :content-disposition
+	   :content-disposition-parameters
+	   :mime-version
+	   :charset
+	   :boundary
+	   :prologue
+	   :epilogue
+	   :content
+	   :get-header
+	   :get-mime-headers
+	   :get-content-type-parameter
+	   :get-content-disposition-parameter
+	   :header-value
+	   :header-parms
+	   :header-comments
+	   :print-mime
+	   :print-headers
+	   :parse-mime
+	   :parse-body
+	   :parse-headers
+	   :decode-content
+	   :encode-content))
+
+(in-package :mime)

Modified: branches/xml-class-rework/thirdparty/cl-mime/parse-mime.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cl-mime/parse-mime.lisp	2006-09-15 14:21:24 UTC (rev 1983)
+++ branches/xml-class-rework/thirdparty/cl-mime/parse-mime.lisp	2006-09-24 19:13:31 UTC (rev 1984)
@@ -29,8 +29,7 @@
 
 
 (defmethod parse-mime ((mime string) &optional headers)
-  (declare (ignore headers))
-  (parse-mime (make-string-input-stream mime)))
+  (parse-mime (make-string-input-stream mime) headers))
 
 
 (defmethod parse-mime ((mime stream) &optional headers)
@@ -56,19 +55,23 @@
 
       (if (equal mime-version "1.0")
 	
-	  (let ((mime-obj-gen
-		 (list
-		  mime-type
-		  :type content-type
-		  :subtype content-subtype
-					;		:parameters content-parm
-		  :encoding (cdr (assoc :content-transfer-encoding
-					headers))
-		  :description (cdr (assoc :content-description
-					   headers))
-		  :id (remove #\< (remove #\> (cdr (assoc :content-id headers))))
-		  :disposition content-disposition
-		  :disposition-parameters content-disposition-parm)))
+	  (let* ((encoding (intern (or (string-upcase 
+					(cdr (assoc :content-transfer-encoding
+						    headers)))
+				       "7BIT")
+				   :keyword))
+		 (mime-obj-gen
+		  (list
+		   mime-type
+		   :type content-type
+		   :subtype content-subtype
+		   :encoding encoding
+		   :content-encoding encoding
+		   :description (cdr (assoc :content-description
+					    headers))
+		   :id (remove #\< (remove #\> (cdr (assoc :content-id headers))))
+		   :disposition content-disposition
+		   :disposition-parameters content-disposition-parm)))
 	      
 	    (case mime-type
 	      ((text-mime)
@@ -289,3 +292,31 @@
 	       (setq end-type 'end-mime))))
      end-type)))
  
+
+(defparameter *mime-types-file* 
+  (make-pathname :directory '(:absolute "etc")
+		 :name "mime"
+		 :type "types"))
+
+
+(defun lookup-mime (pathname &optional mime-types-file)
+  "Takes a PATHNAME argument and uses MIME-TYPES-FILE (or the system 
+default) to determine the mime type of PATHNAME. Returns two values:
+the content type and the the content subtype"
+  (let ((extension (pathname-type pathname)))
+    (with-open-file
+	(mime (or mime-types-file *mime-types-file*) :direction :input)
+      (read-lines
+	  (line mime)
+	  ((register-groups-bind
+	       (extensions)
+	       ("^[^#\\s]+\\s+([^#]+)" line)
+	     (find extension (split "\\s+" extensions)
+		   :test #'string-equal))
+	   (if (eq line 'eof)
+	       (values "application" "octet-stream")
+	       (register-groups-bind
+		   (content-type content-subtype)
+		   ("^([^\/]+)\/([^\\s]+)" line)
+		 (values (or content-type "application")
+			 (or content-subtype "octet-stream")))))))))

Modified: branches/xml-class-rework/thirdparty/cl-mime/print-mime.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cl-mime/print-mime.lisp	2006-09-15 14:21:24 UTC (rev 1983)
+++ branches/xml-class-rework/thirdparty/cl-mime/print-mime.lisp	2006-09-24 19:13:31 UTC (rev 1984)
@@ -30,10 +30,14 @@
 		    (format nil "~A: ~A~%"
 			    (if (eql :mime-version (car it))
 				"MIME-Version"
-			      (string-capitalize (symbol-name (car it))))
-			    (if (eql :content-id (car it))
-				(format nil "<~A>" (cdr it))
-			      (cdr it))))
+				(string-capitalize (symbol-name (car it))))
+			    (cond
+			      ((eql :content-id (car it))
+			       (format nil "<~A>" (cdr it)))
+			      ((eql :content-transfer-encoding (car it))
+			       (string-downcase (symbol-name (cdr it))))
+			      (t
+			       (cdr it)))))
        headers-out))
 
 
@@ -68,6 +72,7 @@
   (:documentation
    "Prints a mime object's contents, optionally with headers"))
 
+
 (defmethod print-mime (stream (mime-obj mime) headers-p version-p)
   (format stream "~A~A"
 	  (if headers-p
@@ -75,8 +80,8 @@
 			   (print-headers nil (get-mime-headers mime-obj)
 					  version-p)
 			   (string #\newline))
-	    "")
-	  (content mime-obj)))
+	      "")
+	  (encode-content mime-obj)))
 
 
 (defmethod print-mime (stream (mime-obj multipart-mime) headers-p version-p)

Modified: branches/xml-class-rework/thirdparty/cl-mime/utilities.lisp
===================================================================
--- branches/xml-class-rework/thirdparty/cl-mime/utilities.lisp	2006-09-15 14:21:24 UTC (rev 1983)
+++ branches/xml-class-rework/thirdparty/cl-mime/utilities.lisp	2006-09-24 19:13:31 UTC (rev 1984)
@@ -47,3 +47,18 @@
 		   (,exit-clause t)
 		   (princ ,line-var ,string-stream)
 		   (terpri ,string-stream)))))
+
+
+;;; These macros stolen from KMRCL
+(defmacro aif (test then &optional else)
+  `(let ((it ,test))
+    (if it ,then ,else)))
+
+
+(defun ensure-keyword (name)
+  "Returns keyword for a name"
+  (etypecase name
+    (keyword name)
+    (string (nth-value 0 (intern (string-upcase name) :keyword)))
+    (symbol (nth-value 0 (intern (symbol-name name) :keyword)))))
+