Merge pull request #209 from gmpalter/master

Add support for Genera

Author: quicklisp

quicklisp/bundle.lisp

@@ -202,8 +202,12 @@
 
 (defmethod write-loader-script ((bundle bundle) stream)
   (let ((template-lines
-         (load-time-value
-          (with-open-file (stream #. (merge-pathnames "bundle-template"
+	 (load-time-value
+	  ;; On Genera, the semantics of Unix pathnames cause merging a filename with
+	  ;; no type against defaults with a type to leave the type as :UNSPECIFIC.
+	  ;; So, explicitly provide the type here to avoid that problem. (I'm not
+	  ;; sure what would happen if I were to change that behavior. --Palter)
+	  (with-open-file (stream #. (merge-pathnames "bundle-template.lisp"
                                                       (or *compile-file-truename*
                                                           *load-truename*)))
             (loop for line = (read-line stream nil)

quicklisp/http.lisp

@@ -24,6 +24,8 @@
          13)
         ((eql char :lf)
          10)
+	((eql char :tab)
+	 9)
         (t
          (let ((code (char-code char)))
            (if (<= 0 code 127)
@@ -32,7 +34,7 @@
                       char))))))
 
 (defvar *whitespace*
-  (list (acode #\Space) (acode #\Tab) (acode :cr) (acode :lf)))
+  (list (acode #\Space) (acode :tab) (acode :cr) (acode :lf)))
 
 (defun whitep (code)
   (member code *whitespace*))
@@ -74,6 +76,7 @@
                         (ecase key
                           (:cr 13)
                           (:lf 10)
+			  (:tab 9)
                           ((t) t)))))
                    (if (consp keys) keys (list keys)))))
     `(case ,value
@@ -550,7 +553,7 @@ the indexes in the header accordingly."
               (return-from process-header header))
              (in-new-line (code)
                (acase code
-                 ((#\Tab #\Space) (setf mark nil) #'in-value)
+                 ((:tab #\Space) (setf mark nil) #'in-value)
                  (t
                   (when mark
                     (save mark value-ends))
@@ -569,7 +572,7 @@ the indexes in the header accordingly."
                   #'in-value)
                  ((:cr :lf)
                   (finish))
-                 ((#\Tab #\Space)
+                 ((:tab #\Space)
                   (error "Unexpected whitespace in header field name"))
                  (t
                   (unless (<= 0 code 127)

quicklisp/impl-util.lisp

@@ -80,6 +80,8 @@
     ".cmucl-init.lisp")
   (:implementation scl
     ".scl-init.lisp")
+  (:implementation genera
+    "lispm-init.lisp")
   )
 
 (defun init-file-name-for (&optional implementation-designator)
@@ -174,7 +176,9 @@ quicklisp at CL startup."
   (:implementation t
     (file-write-date pathname))
   (:implementation clisp
-    (nth-value 2 (ql-clisp:probe-pathname pathname))))
+    (nth-value 2 (ql-clisp:probe-pathname pathname)))
+  (:implementation genera
+    (file-write-date (ql-genera:send pathname :directory-pathname-as-file))))
 
 
 ;;;
@@ -195,7 +199,12 @@ quicklisp at CL startup."
   (:implementation allegro
     (ql-allegro:file-directory-p entry :follow-symbolic-links nil))
   (:implementation lispworks
-    (ql-lispworks:file-directory-p entry)))
+    (ql-lispworks:file-directory-p entry))
+  (:implementation genera
+    (let ((path (if (call-next-method)
+		    (scl:send entry :directory-pathname-as-file)
+		    entry)))
+      (getf (cdr (ql-genera:file-properties path)) ':directory))))
 
 (definterface directory-entries (directory)
   (:documentation "Return all directory entries of DIRECTORY as a
@@ -247,6 +256,13 @@ quicklisp at CL startup."
                 #+ecl :resolve-symlinks #+ecl nil)
      (directory (merge-pathnames *wild-relative* directory)
                 #+ecl :resolve-symlinks #+ecl nil)))
+  (:implementation genera
+    (let ((entries (ql-genera:directory-list (merge-pathnames *wild-entry* directory))))
+      (loop for (pathname . properties) in (cdr entries)
+	    if (getf properties ':directory)
+	      collect (scl:send pathname :pathname-as-directory)
+	    else
+	      collect pathname)))
   (:implementation mezzano
     (directory (merge-pathnames *wild-entry* directory)))
   (:implementation mkcl
@@ -284,6 +300,8 @@ quicklisp at CL startup."
     (ql-scl:unix-rmdir (ql-scl:unix-namestring entry)))
   (:implementation ecl
     (ql-ecl:rmdir entry))
+  (:implementation genera
+    (ql-genera:delete-directory entry :confirm nil))
   (:implementation mkcl
     (ql-mkcl:rmdir entry))
   (:implementation lispworks

quicklisp/impl.lisp

@@ -307,3 +307,17 @@
                   #:host-ent-address
                   #:socket-connect
                   #:socket-make-stream))
+
+;;; Genera
+
+(define-implementation-package :genera #:ql-genera
+  (:documentation "Genera - https://github.com/SymbolicsGenera/IssuesAndWiki")
+  (:class genera)
+  (:reexport-from #:scl
+                  #:send)
+  (:reexport-from #:fs
+		  #:delete-directory
+                  #:directory-list
+                  #:file-properties)
+  (:reexport-from #:tcp
+                  #:open-tcp-stream))

quicklisp/network.lisp

@@ -98,7 +98,9 @@
                                   :element-type '(unsigned-byte 8)
                                   :input t
                                   :output t
-                                  :buffering :full))))
+                                  :buffering :full)))
+  (:implementation genera
+   (ql-genera:open-tcp-stream host port nil :direction :io :characters nil)))
 
 (definterface read-octets (buffer connection)
   (:documentation "Read from CONNECTION into BUFFER. Returns the

quicklisp/package.lisp

@@ -52,6 +52,7 @@
            #:cormanlisp
            #:ecl
            #:gcl
+	   #:genera
            #:lispworks
            #:mezzano
            #:mkcl

quicklisp/setup.lisp

@@ -5,8 +5,10 @@
        (*print-pretty* t)
        (*print-escape* nil)
        (prefix (make-string indent :initial-element #\Space)))
-   (pprint-logical-block (nil words :per-line-prefix prefix)
-     (pprint-fill *standard-output* (sort (copy-seq words) #'string<) nil))
+   ;; Genera doesn't implement pprint-logical-block et al...
+   #-genera (pprint-logical-block (nil words :per-line-prefix prefix)
+	      (pprint-fill *standard-output* (sort (copy-seq words) #'string<) nil))
+   #+genera (format *standard-output* "~&~A~{~S ~}~%" prefix (sort (copy-seq words) #'string<))
    (fresh-line)
    (finish-output)))
 
@@ -87,7 +89,7 @@
                    :quicklisp-systems (remove-duplicates quicklisp-systems))))
 
 (defun show-load-strategy (strategy)
-  (format t "To load ~S:~%" (name strategy))
+  (format t "~&To load ~S:~%" (name strategy))
   (let ((asdf-systems (asdf-systems strategy))
         (releases (quicklisp-releases strategy)))
     (when asdf-systems