Automated build with Travis CI.

Author: larsbrinkhoff

.travis.yml

@@ -0,0 +1,15 @@
+# language: emacs-lisp
+dist: xenial
+sudo: required
+env:
+  - EMACS=emacs24
+#  - EMACS=emacs25
+#  - EMACS=emacs-snapshot
+install:
+  - lsb_release -a
+  - sudo add-apt-repository -y ppa:ubuntu-elisp
+  - sudo apt-get update -y
+  - sudo apt-get install $EMACS
+script: make -C src EMACS=$EMACS
+notifications:
+  email: [email protected]

src/Makefile

@@ -9,7 +9,7 @@ EMACS = emacs20
 EMACSEN = emacs20 emacs21 xemacs21 # ../emacs-19.34/src/emacs
 
 all:
-	$(EMACS) -batch -l load-cl.el -f compile-cl
+	$(EMACS) -Q -batch -l load-cl.el -f compile-cl
 
 #install:
 

src/cl-compile.el

@@ -93,11 +93,11 @@
     (MULTIPLE-VALUE-BIND (body decls) (parse-body forms)
       (eval-body body new-env))))
 
-(defun lexical-variable-p (var env)
+(defun emacs-cl--lexical-variable-p (var env)
   (eq (nth-value 0 (variable-information var env)) :lexical))
 
-(defun special-variable-p (var env)
-  (not (lexical-variable-p var env)))
+(defun emacs-cl--special-variable-p (var env)
+  (not (emacs-cl--lexical-variable-p var env)))
 
 ;;; TODO: let* bindings shouldn't be evaluated in an environment where
 ;;; succeeding bindings exist.
@@ -113,7 +113,7 @@
 						   (eval-with-env
 						    (second binding)
 						    (or old-env new-env))))
-	  (if (lexical-variable-p var new-env)
+	  (if (emacs-cl--lexical-variable-p var new-env)
 	      (setf (lexical-value var new-env) val)
 	      (progn
 		(push (if (boundp var) (symbol-value var) unbound) oldvals)
@@ -123,7 +123,7 @@
 	(setq oldvals (nreverse oldvals))
 	(dolist (binding bindings)
 	  (let ((var (if (symbolp binding) binding (first binding))))
-	    (unless (lexical-variable-p var new-env)
+	    (unless (emacs-cl--lexical-variable-p var new-env)
 	      (let ((val (pop oldvals)))
 		(if (eq val unbound)
 		    (makunbound var)
@@ -461,8 +461,6 @@
     (t
      (type-error fn 'FUNCTION))))
 
-(defsetf function-name set-function-name)
-
 (DEFSETF function-name set-function-name)
 
 (defun set-function-name (fn name)

src/cl-eval.el

@@ -50,6 +50,18 @@
 				(BLOCK ,(function-block-name name)
 				  ,@body))))))
 
+(eval-and-compile
+  (defsetf FDEFINITION (name) (fn)
+    `(cond
+       ((symbolp ,name)
+	(setf (SYMBOL-FUNCTION ,name) ,fn))
+       ((setf-name-p ,name)
+	(puthash (second ,name) ,fn *setf-definitions*))
+       (t
+	(not-function-name-error ,name)))))
+
+(defsetf function-name set-function-name)
+
 (defun set-fun (name fn)
   (setf (FDEFINITION name) fn)
   (setf (function-name fn) name)
@@ -80,15 +92,6 @@
     (t
      (not-function-name-error name))))
 
-(defsetf FDEFINITION (name) (fn)
-  `(cond
-    ((symbolp ,name)
-     (setf (SYMBOL-FUNCTION ,name) ,fn))
-    ((setf-name-p ,name)
-     (puthash (second ,name) ,fn *setf-definitions*))
-    (t
-     (not-function-name-error ,name))))
-
 (defun FBOUNDP (name)
   (cond
     ((symbolp name)

src/cl-flow.el

@@ -734,18 +734,18 @@
 ;;; TODO:
 (set-fun '(SETF DOCUMENTATION) (lambda (value object type) value))
 
-(cl:defmethod MAKE-LOAD-FORM  ((object T) &OPTIONAL env)
-  (built-in-make-load-form object env))
-(cl:defmethod MAKE-LOAD-FORM  ((object STANDARD-OBJECT) &OPTIONAL env)
-  (ERROR (QUOTE ERROR)))
-(cl:defmethod MAKE-LOAD-FORM  ((object STRUCTURE-OBJECT) &OPTIONAL env)
-  (ERROR (QUOTE ERROR)))
-(cl:defmethod MAKE-LOAD-FORM  ((object STRUCTURE-OBJECT) &OPTIONAL env)
-  (BACKQUOTE (FIND-CLASS (QUOTE (COMMA (CLASS-NAME object))))))
-
-(cl:defmethod PRINT-OBJECT ((object T) stream)
-  (built-in-print-object object stream))
-
-(cl:defmethod DOCUMENTATION ((object FUNCTION) type)
-  (WHEN (> (length object) 4)
-    (aref object 4)))
+;; (cl:defmethod MAKE-LOAD-FORM  ((object T) &OPTIONAL env)
+;;   (built-in-make-load-form object env))
+;; (cl:defmethod MAKE-LOAD-FORM  ((object STANDARD-OBJECT) &OPTIONAL env)
+;;   (ERROR (QUOTE ERROR)))
+;; (cl:defmethod MAKE-LOAD-FORM  ((object STRUCTURE-OBJECT) &OPTIONAL env)
+;;   (ERROR (QUOTE ERROR)))
+;; (cl:defmethod MAKE-LOAD-FORM  ((object STRUCTURE-OBJECT) &OPTIONAL env)
+;;   (BACKQUOTE (FIND-CLASS (QUOTE (COMMA (CLASS-NAME object))))))
+
+;; (cl:defmethod PRINT-OBJECT ((object T) stream)
+;;   (built-in-print-object object stream))
+
+;; (cl:defmethod DOCUMENTATION ((object FUNCTION) type)
+;;   (WHEN (> (length object) 4)
+;;     (aref object 4)))

src/cl-objects.el

@@ -227,7 +227,7 @@
   (if position
       ;; TODO: implement setting position
       (progn
-	(setf (STREAM-position stream))
+	(setf (STREAM-position stream) position)
 	T)
       (STREAM-position stream)))
 

src/cl-streams.el

@@ -138,7 +138,8 @@
 	(&REST
 	 (push `(,var ,rest-sym) bindings))
 	(&KEY
-	 (push `(,var ',unbound) bindings)
+	 ;;(push `(,var ',unbound) bindings)
+	 (push `(,var nil) bindings)
 	 (when supp
 	   (push `(,supp nil) bindings)))
 	(&AUX

src/func.el

@@ -5,6 +5,7 @@
 ;;; Loading this file also loads the system as a side effect.
 
 (require 'cl)
+(require 'cl-extra)
 (require 'byte-compile "bytecomp")
 
 (setq max-lisp-eval-depth 10000)
@@ -25,30 +26,30 @@
     "cl-evaluation"
     "cl-flow"
     "cl-numbers"
-    "cl-conses"
     "cl-characters"
     "cl-strings"
     "cl-arrays"
-    "cl-sequences"
     "cl-structures"
     "cl-iteration"
 
     "cl-symbols"
-    "cl-packages"
 
     "cl-types"
-    "cl-typep"
-    "cl-subtypep"
 
-    "cl-hash"
-    "cl-streams"
-    "cl-reader"
-    "cl-printer"
     "cl-environment"
-    "cl-filenames"
     "cl-files"
     "interaction"
     "cl-eval"
+    "cl-printer"
+    "cl-conses"
+    "cl-sequences"
+    "cl-packages"
+    "cl-filenames"
+    "cl-hash"
+    "cl-typep"
+    "cl-reader"
+    "cl-streams"
+    "cl-subtypep"
     "cl-system"
 
     "cl-loop"

src/load-cl.el

@@ -22,7 +22,7 @@
 
 (defun symcat (&rest string-designators)
   (let ((sym (intern (apply #'strcat string-designators))))
-    (when (fboundp 'SYMBOL-PACKAGE)
+    (when nil ;(fboundp 'SYMBOL-PACKAGE)
       (setf (SYMBOL-PACKAGE sym) *PACKAGE*))
     sym))