;;;; $Id$
;;;; $URL$

;;;; See the LICENSE file for licensing information.

(in-package :cl-user)

#+lispworks (require "comm")

(eval-when (:execute :load-toplevel :compile-toplevel)
  (defpackage :usocket
      (:use :cl)
    (:export #:socket-connect ; socket constructors and methods
             #:socket-listen
             #:socket-accept
             #:socket-close
             #:get-local-address
             #:get-peer-address
             #:get-local-port
             #:get-peer-port
             #:get-local-name
             #:get-peer-name

             #:with-connected-socket ; macros

             #:usocket ; socket object and accessors
             #:stream-usocket
             #:stream-server-usocket
             #:socket
             #:socket-stream

             #:host-byte-order ; IPv4 utility functions
             #:hbo-to-dotted-quad
             #:hbo-to-vector-quad
             #:vector-quad-to-dotted-quad
             #:dotted-quad-to-vector-quad

             #:socket-condition ; conditions
             #:socket-error ; errors
             #:unknown-condition
             #:unknown-error)))

Add the 'with-server-socket' macro to the list of exported symbols.

;;;; $Id$
;;;; $URL$

;;;; See the LICENSE file for licensing information.

(in-package :cl-user)

#+lispworks (require "comm")

(eval-when (:execute :load-toplevel :compile-toplevel)
  (defpackage :usocket
      (:use :cl)
    (:export #:socket-connect ; socket constructors and methods
             #:socket-listen
             #:socket-accept
             #:socket-close
             #:get-local-address
             #:get-peer-address
             #:get-local-port
             #:get-peer-port
             #:get-local-name
             #:get-peer-name

             #:with-connected-socket ; macros
             #:with-server-socket

             #:usocket ; socket object and accessors
             #:stream-usocket
             #:stream-server-usocket
             #:socket
             #:socket-stream

             #:host-byte-order ; IPv4 utility functions
             #:hbo-to-dotted-quad
             #:hbo-to-vector-quad
             #:vector-quad-to-dotted-quad
             #:dotted-quad-to-vector-quad

             #:socket-condition ; conditions
             #:socket-error ; errors
             #:unknown-condition
             #:unknown-error)))


(cl:in-package #:sicl-boot)

(defun customize-r2 (boot)
  (define-make-instance boot)
  (define-direct-slot-definition-class boot)
  (define-find-class boot))

Load a file containing support code for ENSURE-GENERIC-FUNCTION-USING-CLASS.

(cl:in-package #:sicl-boot)

(defun customize-r2 (boot)
  (let ((c (c1 boot))
	(r (r2 boot)))
    (define-make-instance boot)
    (define-direct-slot-definition-class boot)
    (define-find-class boot)
    (ld "../CLOS/ensure-generic-function-using-class-support.lisp" c r)))


(cl:in-package #:sicl-read)

(defmethod cleavir-i18n:report-condition
    ((condition unmatched-right-parenthesis)
     stream
     (language cleavir-i18n:english))
  (format stream "Unmatched right parenthesis found."))

(defmethod cleavir-i18n:report-condition
    ((condition only-dots-in-token)
     stream
     (language cleavir-i18n:english))
  (format stream "A token with only dots in it was found"))

(defmethod cleavir-i18n:report-condition
    ((condition single-dot-token)
     stream
     (language cleavir-i18n:english))
  (format stream "A token consisting of a single dot was found ~@
                  in a context that does not permit such a token."))

(defmethod cleavir-i18n:report-condition
    ((condition no-object-preceding-dot)
     stream
     (language cleavir-i18n:english))
  (format stream "A left parenthesis cannot be ~
                  immediately followed by a dot"))

Add method on REPORT-CONDITION specialized to MULTIPLE-OBJECTS-FOLLOWING-DOT.

(cl:in-package #:sicl-read)

(defmethod cleavir-i18n:report-condition
    ((condition unmatched-right-parenthesis)
     stream
     (language cleavir-i18n:english))
  (format stream "Unmatched right parenthesis found."))

(defmethod cleavir-i18n:report-condition
    ((condition only-dots-in-token)
     stream
     (language cleavir-i18n:english))
  (format stream "A token with only dots in it was found"))

(defmethod cleavir-i18n:report-condition
    ((condition single-dot-token)
     stream
     (language cleavir-i18n:english))
  (format stream "A token consisting of a single dot was found ~@
                  in a context that does not permit such a token."))

(defmethod cleavir-i18n:report-condition
    ((condition no-object-preceding-dot)
     stream
     (language cleavir-i18n:english))
  (format stream "A left parenthesis cannot be ~
                  immediately followed by a dot"))

(defmethod cleavir-i18n:report-condition
    ((condition multiple-objects-following-dot)
     stream
     (language cleavir-i18n:english))
  (format stream "A second expression following a dot~@
                  inside a list was found: ~S."
	  (offending-expression condition)))


;;; Common functions for solving problems

(defun primep (n)
  "Predicate to test the primality of N. If composite, the second
return value is the lowest factor."
  (loop for i from 2 to (sqrt n)
     when (= 0 (mod n i)) return (values nil i) finally (return t)))

(defun factors (n)
  "Return the prime factors of N."
  (multiple-value-bind (prime f) (primep n)
    (if prime
        (list n)
        (cons f (factors (/ n f))))))

(defun curry (function &rest args)
  "Partially apply FUNCTION to ARGS."
  (lambda (&rest more-args)
    (apply function (append args more-args))))

(defun rcurry (function &rest args)
  "Partially apply FUNCTION to ARGS as the rightmost arguments."
  (lambda (&rest more-args)
    (apply function (append more-args args))))

Fix definition of primep for 1.

;;; Common functions for solving problems

(defun primep (n)
  "Predicate to test the primality of N. If composite, the second
return value is the lowest factor."
  (when (> n 1)
    (loop for i from 2 to (sqrt n)
       when (= 0 (mod n i)) return (values nil i) finally (return t))))

(defun factors (n)
  "Return the prime factors of N."
  (multiple-value-bind (prime f) (primep n)
    (if prime
        (list n)
        (cons f (factors (/ n f))))))

(defun curry (function &rest args)
  "Partially apply FUNCTION to ARGS."
  (lambda (&rest more-args)
    (apply function (append args more-args))))

(defun rcurry (function &rest args)
  "Partially apply FUNCTION to ARGS as the rightmost arguments."
  (lambda (&rest more-args)
    (apply function (append more-args args))))


;; -*- mode: common-lisp -*-
(defsystem lispkit
  :version "0.0.1"
  :description "Lispy browser"
  :licence "BSD"
  :components ((:file "lispkit" :depends-on ("macros" "packages" "keys"))
               (:file "keys" :depends-on ("packages" "browser" "events" "commands"))
               (:file "browser" :depends-on ("packages" "events" "jumps" "commands" "settings"))
               (:file "events" :depends-on ("packages"))
               (:file "jumps" :depends-on ("packages"))
               (:file "macros" :depends-on ("packages"))
               (:file "commands" :depends-on ("packages" "user"))
               (:file "user" :depends-on ("packages"))
               (:file "settings")
               (:file "packages"))
  :depends-on (:asdf
               :cl-cffi-gtk
               :cl-webkit2
               :cl-xkeysym
               :djula
               :parenscript
               :purl
               :split-sequence)
  :in-order-to ((test-op (test-op :lispkit-test))))

(defsystem lispkit-test
  :version "0.0.1"
  :description "Lispy browser"
  :licence "BSD"
  :components ((:module "test"
                        :components
                        ((:file "tests"))))
  :depends-on (:lispkit :lisp-unit :alexandria)
  :perform (test-op (o s)
                    ;; LISP-UNIT:RUN-ALL-TESTS is a macro, so it can't be called
                    ;; like a function.
                    (eval `(,(intern "RUN-ALL-TESTS" :lisp-unit)
                            :lispkit-test))))

Use the :serial option in the asd file

;; -*- mode: common-lisp -*-
(defsystem lispkit
  :version "0.0.1"
  :description "Lispy browser"
  :licence "BSD"
  :serial t
  :components ((:file "packages")
               (:file "user")
               (:file "settings")
               (:file "commands")
               (:file "macros")
               (:file "jumps")
               (:file "events")
               (:file "browser")
               (:file "keys")
               (:file "lispkit"))
  :depends-on (:asdf
               :cl-cffi-gtk
               :cl-webkit2
               :cl-xkeysym
               :djula
               :parenscript
               :purl
               :split-sequence)
  :in-order-to ((test-op (test-op :lispkit-test))))

(defsystem lispkit-test
  :version "0.0.1"
  :description "Lispy browser"
  :licence "BSD"
  :components ((:module "test"
                        :components
                        ((:file "tests"))))
  :depends-on (:lispkit :lisp-unit :alexandria)
  :perform (test-op (o s)
                    ;; LISP-UNIT:RUN-ALL-TESTS is a macro, so it can't be called
                    ;; like a function.
                    (eval `(,(intern "RUN-ALL-TESTS" :lisp-unit)
                            :lispkit-test))))


(cl:in-package #:asdf-user)

(defsystem :clobber
  :components
  ((:file "packages")
   (:file "clobber" :depends-on ("packages"))
   (:file "demo" :depends-on ("clobber"))
   (:file "demo2" :depends-on ("clobber"))))

Use option :SERIAL T to simplify system definition.

(cl:in-package #:asdf-user)

(defsystem :clobber
  :serial t
  :components
  ((:file "packages")
   (:file "clobber")
   (:file "demo")
   (:file "demo2")))


;;; -*- Lisp -*-

(defsystem :split-sequence
  :version "1.0"
  :maintainer "Sharp Lispers <sharplispers@googlegroups.com>"
  :components ((:file "split-sequence"))
  :in-order-to ((asdf:test-op (asdf:load-op :split-sequence-tests)))
  :perform (asdf:test-op :after (op c)
             (funcall (intern (symbol-name '#:run!) '#:5am) :split-sequence)))

(defsystem :split-sequence-tests
  :depends-on (:split-sequence :fiveam)
  :components ((:file "tests")))

Add :description to system definition.

;;; -*- Lisp -*-

(defsystem :split-sequence
  :version "1.0"
  :description "Splits a sequence into a list of subsequences
  delimited by objects satisfying a test."
  :maintainer "Sharp Lispers <sharplispers@googlegroups.com>"
  :components ((:file "split-sequence"))
  :in-order-to ((asdf:test-op (asdf:load-op :split-sequence-tests)))
  :perform (asdf:test-op :after (op c)
             (funcall (intern (symbol-name '#:run!) '#:5am) :split-sequence)))

(defsystem :split-sequence-tests
  :depends-on (:split-sequence :fiveam)
  :components ((:file "tests")))


;;; -*- Mode: Lisp ; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
(defsystem "fare-memoization"
  :description "memoizing functions the correct, portable way"
  :long-description "define memoized functions and memoize previously defined functions"
  :license "MIT"
  :author "Francois-Rene Rideau"
  :version "1.0.0"
  :components
  ((:file "memoization"))
  :in-order-to ((test-op (load-op "fare-memoization/test")))
  :perform (test-op :after (o c)
             (symbol-call :fare-memoization-test :test-memoization)))

(defsystem "fare-memoization/test"
  :description "memoizing functions the correct, portable way"
  :license "MIT"
  :author "Francois-Rene Rideau"
  :version "1.0.0"
  :depends-on ("fare-memoization" "hu.dwim.stefil")
  :components
  ((:file "memoization-test")))

Make .asd file nicer for ASDF 3

;;; -*- Mode: Lisp ; Base: 10 ; Syntax: ANSI-Common-Lisp -*-
(defsystem "fare-memoization"
  :description "memoizing functions the correct, portable way"
  :long-description "define memoized functions and memoize previously defined functions"
  :license "MIT"
  :author "Francois-Rene Rideau"
  :version "1.0.0"
  :components ((:file "memoization"))
  :in-order-to ((test-op (test-op "fare-memoization/test"))))

(defsystem "fare-memoization/test"
  :description "memoizing functions the correct, portable way"
  :license "MIT"
  :author "Francois-Rene Rideau"
  :version "1.0.0"
  :depends-on ("fare-memoization" "hu.dwim.stefil")
  :components ((:file "memoization-test"))
  :perform (test-op (o c) (symbol-call :fare-memoization-test :test-memoization)))


(cl:in-package #:clump-2-3-tree)

(defgeneric delete (leaf))

(defgeneric delete-child (parent child))

Define method on DELETE specialized to LEAF.

(cl:in-package #:clump-2-3-tree)

(defgeneric delete (leaf))

(defgeneric delete-child (parent child))

(defmethod delete ((leaf leaf))
  (delete-child (parent leaf) leaf))


(defsystem :eval-bot
  :depends-on (:bordeaux-threads :trivial-irc :alexandria :split-sequence
                                 :babel)
  :components
  ((:file "sandbox-impl" :depends-on ("common"))
   (:file "sandbox-extra" :depends-on ("common" "sandbox-impl" "sandbox-cl"))
   (:file "sandbox-cl" :depends-on ("sandbox-impl"))
   (:file "common")
   (:file "eval-bot" :depends-on ("common" "sandbox-impl"))))

Add description, author and licence information to .asd file

(defsystem "eval-bot"
  :description "An IRC bot for Common Lisp code evaluation"
  :author "Teemu Likonen <tlikonen@iki.fi>"
  :licence "GNU Affero General Public License version 3"
  :depends-on ("bordeaux-threads"
               "trivial-irc" "alexandria" "split-sequence" "babel")
  :components
  ((:file "sandbox-impl" :depends-on ("common"))
   (:file "sandbox-extra" :depends-on ("common" "sandbox-impl" "sandbox-cl"))
   (:file "sandbox-cl" :depends-on ("sandbox-impl"))
   (:file "common")
   (:file "eval-bot" :depends-on ("common" "sandbox-impl"))))


(cl:in-package #:cleavir-cst)

(defclass cst ()
  (;; This slot contains the Common Lisp expression that is
   ;; represented by the CST.  It is guaranteed that there is sharing
   ;; between the expression of a CST and the expression of each child
   ;; of the CST.
   (%expression :initarg :expression :reader expression)
   ;; This slot contains the source location of the expression
   ;; represented by the CST, or NIL if such source location is not
   ;; available.  The nature of the contents of this slot is not
   ;; determined by Cleavir, but by client code.  It is just used to
   ;; pass on information from the CST to the AST, and then to HIR.
   (%location :initarg :location :reader location)
   ;; This slot contains a list of child CSTs.  If this slot contains
   ;; the empty list, then the expression represented by this CST is
   ;; an atom.  If the expression represented by this CST is a dotted
   ;; list, then this slot contains a dotted list where the CDR of the
   ;; last CONS cell contains a CST.  If the expression represented by
   ;; this CST is a circular list, then this slot also contains a
   ;; circular list.
   (%children :initarg :children :reader children)))

Add writer for the EXPRESSION slot.

(cl:in-package #:cleavir-cst)

(defclass cst ()
  (;; This slot contains the Common Lisp expression that is
   ;; represented by the CST.  It is guaranteed that there is sharing
   ;; between the expression of a CST and the expression of each child
   ;; of the CST.
   (%expression :initarg :expression :accessor expression)
   ;; This slot contains the source location of the expression
   ;; represented by the CST, or NIL if such source location is not
   ;; available.  The nature of the contents of this slot is not
   ;; determined by Cleavir, but by client code.  It is just used to
   ;; pass on information from the CST to the AST, and then to HIR.
   (%location :initarg :location :reader location)
   ;; This slot contains a list of child CSTs.  If this slot contains
   ;; the empty list, then the expression represented by this CST is
   ;; an atom.  If the expression represented by this CST is a dotted
   ;; list, then this slot contains a dotted list where the CDR of the
   ;; last CONS cell contains a CST.  If the expression represented by
   ;; this CST is a circular list, then this slot also contains a
   ;; circular list.
   (%children :initarg :children :reader children)))


(cl:in-package #:sicl-boot)

(defun create-bridge-classes (boot)
  (let ((c (c1 boot))
	(r (r2 boot)))
    (ld "../CLOS/t-defclass.lisp" c r)))

Load a file containing the definition of the class STANDARD-OBJECT.

(cl:in-package #:sicl-boot)

(defun create-bridge-classes (boot)
  (let ((c (c1 boot))
	(r (r2 boot)))
    (ld "../CLOS/t-defclass.lisp" c r)
    (ld "../CLOS/standard-object-defclass.lisp" c r)))


;;;; System definition for ERLANGEN.

(defsystem erlangen
  :description
  "Distributed asychronous message passing system for Common Lisp."
  :author "Max Rottenkolber <max@mr.gy>"
  :license "Not licensed"
  :components ((:file "conditions")
               (:file "mailbox")
               (:file "algorithms")
               (:file "agent"
                      :depends-on ("mailbox" "algorithms" "conditions"))
               (:file "registry"
                      :depends-on ("agent"))
               (:file "erlangen"
                      :depends-on ("agent" "registry" "conditions"))
               ;; Tests
               (:file "test/agent-test"
                      :depends-on ("agent"))))

Add missing dependencies to ERLANGEN system.

;;;; System definition for ERLANGEN.

(defsystem erlangen
  :description
  "Distributed asychronous message passing system for Common Lisp."
  :author "Max Rottenkolber <max@mr.gy>"
  :license "Not licensed"
  :components ((:file "conditions")
               (:file "mailbox")
               (:file "algorithms")
               (:file "agent"
                      :depends-on ("mailbox" "algorithms" "conditions"))
               (:file "registry"
                      :depends-on ("agent"))
               (:file "erlangen"
                      :depends-on ("agent" "registry" "conditions"))
               ;; Tests
               (:file "test/agent-test"
                      :depends-on ("agent")))
  :depends-on ("jpl-queues"
               "bordeaux-threads"))


(cl:in-package :%open-asset-import-library)

(define-foreign-library assimp
  (:windows "assimp.dll" );; :calling-convention :stdcall ?
  #++(:unix "libassimp.so")
  (:unix (:or "libassimp.so.3" "libassimp3.0.so" "libassimp.so")))

(use-foreign-library assimp)

Add support for OS X

(cl:in-package :%open-asset-import-library)

(define-foreign-library assimp
  (:darwin "libassimp.dylib")
  (:windows "assimp.dll" );; :calling-convention :stdcall ?
  #++(:unix "libassimp.so")
  (:unix (:or "libassimp.so.3" "libassimp3.0.so" "libassimp.so")))

(use-foreign-library assimp)


;;;; Copyright (c) 2014
;;;;
;;;;     Robert Strandh (robert.strandh@gmail.com)
;;;;
;;;; all rights reserved.
;;;;
;;;; Permission is hereby granted to use this software for any
;;;; purpose, including using, modifying, and redistributing it.
;;;;
;;;; The software is provided "as-is" with no warranty.  The user of
;;;; this software assumes any responsibility of the consequences.

(cl:in-package #:sicl-loop)

(defclass thereis-clause (termination-test-clause)
  ((%form :initarg :form :reader form)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Parsers.

(define-parser thereis-clause-parser
  (consecutive (lambda (thereis form)
		 (declare (ignore thereis))
		 (make-instance 'thereis-clause
		   :form form))
	       (keyword-parser 'thereis)
	       'anything-parser))

(add-clause-parser 'thereis-clause-parser)

Use existing FORM-MIXIN class as a superclass.

;;;; Copyright (c) 2014
;;;;
;;;;     Robert Strandh (robert.strandh@gmail.com)
;;;;
;;;; all rights reserved.
;;;;
;;;; Permission is hereby granted to use this software for any
;;;; purpose, including using, modifying, and redistributing it.
;;;;
;;;; The software is provided "as-is" with no warranty.  The user of
;;;; this software assumes any responsibility of the consequences.

(cl:in-package #:sicl-loop)

(defclass thereis-clause (termination-test-clause form-mixin) ())

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
;;; Parsers.

(define-parser thereis-clause-parser
  (consecutive (lambda (thereis form)
		 (declare (ignore thereis))
		 (make-instance 'thereis-clause
		   :form form))
	       (keyword-parser 'thereis)
	       'anything-parser))

(add-clause-parser 'thereis-clause-parser)


(cl:in-package #:common-lisp-user)

(asdf:defsystem #:cleavir-eliminate-typeq
  :depends-on (:cleavir-mir)
  :serial t
  :components
  ((:file "packages")
   (:file "eliminate-typeq")))

Use keyword symbol to name system.

(cl:in-package #:common-lisp-user)

(asdf:defsystem :cleavir-eliminate-typeq
  :depends-on (:cleavir-mir)
  :serial t
  :components
  ((:file "packages")
   (:file "eliminate-typeq")))


(defpackage #:info.isoraqathedh.umpns.asdf
  (:use #:cl #:asdf))
(in-package #:info.isoraqathedh.umpns.asdf)

(defsystem umpns
  :name "UMPNS-based Minor Planet Namer"
  :version "0.1"
  :license "MIT"
  :components ((:file "unified-minor-planet-naming-system"))
  :depends-on (:cl-ppcre :cl-sqlite))

Add :iterate as an explicit dep

(defpackage #:info.isoraqathedh.umpns.asdf
  (:use #:cl #:asdf))
(in-package #:info.isoraqathedh.umpns.asdf)

(defsystem umpns
  :name "UMPNS-based Minor Planet Namer"
  :version "0.1"
  :license "MIT"
  :components ((:file "unified-minor-planet-naming-system"))
  :depends-on (:cl-ppcre :sqlite :iterate))


(in-package :cl-user)
(defpackage :dipper.uri
  (:use :cl :alexandria :dipper.util)
  (:export :database-uri
           :parse-database-uri
           :database-uri-scheme
           :database-uri-subprotocol
           :database-uri-host
           :database-uri-port
           :database-uri-path
           :database-uri-username
           :database-uri-password
           :database-uri-raw))

(in-package :dipper.uri)

(defstruct database-uri scheme subprotocol host port path username password raw)

(defparameter *database-uri-regex*
  (concatenate 'string
               "^([^:/]+):"                  ; scheme
               "(?:([^:/]+):)?"              ; subprotocol
               "(?://"                       ; the whole authority thing...
               "(?:([^@]+?)(?::([^@]+))?@)?" ;   user:passwd
               "(?:([^@/:]+)(?::(\\d+))?)?"  ;   host:port
               ")?"                          ; end
               "(?:(/?[^/][^:]+))?$"))       ; path

(defun parse-database-uri (uri)
  (with-re-match ((scheme subprotocol username password host port path)
                  *database-uri-regex* uri)
    (make-database-uri :scheme scheme
                       :subprotocol subprotocol
                       :host host
                       :port port
                       :path path
                       :password password
                       :username username
                       :raw uri)))

Add an ability to override parsed URI component values.

(in-package :cl-user)
(defpackage :dipper.uri
  (:use :cl :alexandria :dipper.util)
  (:export :database-uri
           :parse-database-uri
           :database-uri-scheme
           :database-uri-subprotocol
           :database-uri-host
           :database-uri-port
           :database-uri-path
           :database-uri-username
           :database-uri-password
           :database-uri-raw))

(in-package :dipper.uri)

(defstruct database-uri scheme subprotocol host port path username password raw)

(defparameter *database-uri-regex*
  (concatenate 'string
               "^([^:/]+):"                  ; scheme
               "(?:([^:/]+):)?"              ; subprotocol
               "(?://"                       ; the whole authority thing...
               "(?:([^@]+?)(?::([^@]+))?@)?" ;   user:passwd
               "(?:([^@/:]+)(?::(\\d+))?)?"  ;   host:port
               ")?"                          ; end
               "(?:(/?[^/][^:]+))?$"))       ; path

(defun parse-database-uri (uri &key override)
  (with-re-match ((scheme subprotocol username password host port path)
                  *database-uri-regex* uri)
    (macrolet ((getv (var)
                 `(or (getf override ,(string-to-keyword (symbol-name var)))
                      ,var)))
      (make-database-uri :scheme (getv scheme)
                         :subprotocol (getv subprotocol)
                         :host (getv host)
                         :port (getv port)
                         :path (getv path)
                         :password (getv password)
                         :username (getv username)
                         :raw (getv uri)))))


(in-package :brreg)

(push (cons "application" "json") drakma:*text-content-types*)

(defun get-jsonhash (orgnummer)
  (when (and (every #'digit-char-p orgnummer)
             (= (length orgnummer) 9))
    (multiple-value-bind (response status)
        (drakma:http-request
         (format nil "http://data.brreg.no/enhetsregisteret/enhet/~A.json"
                 orgnummer))
      (when (eql status 200)
        (yason:parse response)))))

(defun get-orgfeature (feature orgnummer)
  (ignore-errors
   (let ((hash (get-jsonhash orgnummer)))
     (if hash
         (gethash feature hash)
         (make-hash-table)))))

(defun get-org-name (orgnummer)
  (let ((navn (get-orgfeature "navn" orgnummer)))
    (when (stringp navn)
      navn)))

(defun get-org-address (orgnummer)
  (gethash "adresse" (get-orgfeature "forretningsadresse" orgnummer)))

(defun get-org-postnummer (orgnummer)
  (gethash "postnummer" (get-orgfeature "forretningsadresse" orgnummer)))

(defun get-org-poststed (orgnummer)
  (gethash "poststed" (get-orgfeature "forretningsadresse" orgnummer)))

Return NIL for all error situations.

(in-package :brreg)

(push (cons "application" "json") drakma:*text-content-types*)

(defun get-jsonhash (orgnummer)
  (when (and (every #'digit-char-p orgnummer)
             (= (length orgnummer) 9))
    (multiple-value-bind (response status)
        (drakma:http-request
         (format nil "http://data.brreg.no/enhetsregisteret/enhet/~A.json"
                 orgnummer))
      (when (eql status 200)
        (yason:parse response)))))

(defun get-orgfeature (feature orgnummer)
  (ignore-errors
   (let ((hash (get-jsonhash orgnummer)))
     (if hash
         (gethash feature hash)
         (make-hash-table)))))

(defun get-org-name (orgnummer)
  (let ((navn (get-orgfeature "navn" orgnummer)))
    (when (stringp navn)
      navn)))

(defun get-org-address (orgnummer)
  (ignore-errors
   (gethash "adresse" (get-orgfeature "forretningsadresse" orgnummer))))

(defun get-org-postnummer (orgnummer)
  (ignore-errors
   (gethash "postnummer" (get-orgfeature "forretningsadresse" orgnummer))))

(defun get-org-poststed (orgnummer)
  (ignore-errors
   (gethash "poststed" (get-orgfeature "forretningsadresse" orgnummer))))


;;;; Copyright (c) 2014, 2015
;;;;
;;;;     Robert Strandh (robert.strandh@gmail.com)
;;;;
;;;; all rights reserved.
;;;;
;;;; Permission is hereby granted to use this software for any
;;;; purpose, including using, modifying, and redistributing it.
;;;;
;;;; The software is provided "as-is" with no warranty.  The user of
;;;; this software assumes any responsibility of the consequences.

;;;; This file is part of the string module of the SICL project.
;;;; See the file SICL.text for a description of the project.
;;;; See the file string.text for a description of the module.

(cl:in-package #:sicl-string)

(define-condition bag-is-dotted-list
    (type-error cleavir-i18n:condition)
  ())

(define-condition bag-is-circular-list
    (type-error cleavir-i18n:condition)
  ())

(define-condition bag-contains-non-character
    (type-error cleavir-i18n:condition)
  ()
  (:report report-string-condition))

(define-condition invalid-bounding-indices
    (error cleavir-i18n:condition)
  ((%target :initarg :target :reader target)
   (%start :initarg start :reader start)
   (%end :initarg end :reader end)))

Remove obsolete :REPORT option from condition BAG-CONTAINS-NON-CHARACTER.

;;;; Copyright (c) 2014, 2015
;;;;
;;;;     Robert Strandh (robert.strandh@gmail.com)
;;;;
;;;; all rights reserved.
;;;;
;;;; Permission is hereby granted to use this software for any
;;;; purpose, including using, modifying, and redistributing it.
;;;;
;;;; The software is provided "as-is" with no warranty.  The user of
;;;; this software assumes any responsibility of the consequences.

;;;; This file is part of the string module of the SICL project.
;;;; See the file SICL.text for a description of the project.
;;;; See the file string.text for a description of the module.

(cl:in-package #:sicl-string)

(define-condition bag-is-dotted-list
    (type-error cleavir-i18n:condition)
  ())

(define-condition bag-is-circular-list
    (type-error cleavir-i18n:condition)
  ())

(define-condition bag-contains-non-character
    (type-error cleavir-i18n:condition)
  ())

(define-condition invalid-bounding-indices
    (error cleavir-i18n:condition)
  ((%target :initarg :target :reader target)
   (%start :initarg start :reader start)
   (%end :initarg end :reader end)))


(when (asdf:find-system :local-time nil) (pushnew :js-dates *features*))

(asdf:defsystem :cl-js
  :depends-on (:parse-js :cl-ppcre #+js-dates :local-time)
  :serial t
  :components
  ((:file "package")
   (:file "utils")
   (:file "js")
   (:file "jsos")
   (:file "url-encode")
   (:file "json")
   (:file "deflib")
   (:file "runtime")
   (:file "infer")
   (:file "inline-op")
   (:file "translate")
   (:file "operators")
   (:file "api")))

Add :description to .asd file

(when (asdf:find-system :local-time nil) (pushnew :js-dates *features*))

(asdf:defsystem :cl-js
  :description "JavaScript-to-CL compiler and runtime"
  :depends-on (:parse-js :cl-ppcre #+js-dates :local-time)
  :serial t
  :components
  ((:file "package")
   (:file "utils")
   (:file "js")
   (:file "jsos")
   (:file "url-encode")
   (:file "json")
   (:file "deflib")
   (:file "runtime")
   (:file "infer")
   (:file "inline-op")
   (:file "translate")
   (:file "operators")
   (:file "api")))


(cl:in-package #:clump-test)

(defclass size-mixin ()
  ((%size :initarg :size :reader size)))

(defclass leaf-size (size-mixin clump-2-3-tree:leaf)
  ()
  (:default-initargs :size 1))

(defclass 2-node-size (size-mixin clump-2-3-tree:2-node)
  ())

(defmethod initialize-instance :after ((object 2-node-size) &key)
  (reinitialize-instance
   object
   :size (+ (size (clump-2-3-tree:left object))
	    (size (clump-2-3-tree:right object)))))

(defclass 3-node-size (size-mixin clump-2-3-tree:3-node)
  ())

(defclass size-tree (clump-2-3-tree:tree)
  ()
  (:default-initargs
   :2-node-class '2-node-size
   :3-node-class '3-node-size))

Define :AFTER method on 3-NODE-SIZE that computes sum of child sizes.

(cl:in-package #:clump-test)

(defclass size-mixin ()
  ((%size :initarg :size :reader size)))

(defclass leaf-size (size-mixin clump-2-3-tree:leaf)
  ()
  (:default-initargs :size 1))

(defclass 2-node-size (size-mixin clump-2-3-tree:2-node)
  ())

(defmethod initialize-instance :after ((object 2-node-size) &key)
  (reinitialize-instance
   object
   :size (+ (size (clump-2-3-tree:left object))
	    (size (clump-2-3-tree:right object)))))

(defclass 3-node-size (size-mixin clump-2-3-tree:3-node)
  ())

(defmethod initialize-instance :after ((object 3-node-size) &key)
  (reinitialize-instance
   object
   :size (+ (size (clump-2-3-tree:left object))
	    (size (clump-2-3-tree:middle object))
	    (size (clump-2-3-tree:right object)))))

(defclass size-tree (clump-2-3-tree:tree)
  ()
  (:default-initargs
   :2-node-class '2-node-size
   :3-node-class '3-node-size))


(cl:in-package #:asdf-user)

(defsystem :sicl-sequences
  :depends-on (:lisp-unit)
  :serial t
  :components
  ((:file "packages")
   (:file "conditions")
   (:file "sequences")
   (:file "condition-reporters-en")
   (:file "docstrings-en")))

Change system name to correspond to file name.

(cl:in-package #:asdf-user)

(defsystem :sicl-sequence
  :depends-on (:lisp-unit)
  :serial t
  :components
  ((:file "packages")
   (:file "conditions")
   (:file "sequences")
   (:file "condition-reporters-en")
   (:file "docstrings-en")))


; find the shortest path between two nodes in an unweighted graph
; ie perform a breadth first search

; the graph is a list of nodes
; a node is a list whose first element is the name of the node
; and whose remaining elements are the names of any neighbours
; (set-graph '((a b c) (b a) (c a)))

(setq graph nil)
(defun set-graph (graph-as-list)
  (setf graph graph-as-list))

(defun find-node (node-name)
  (defun next-node (unchecked-graph)
    (cond ((null unchecked-graph) nil)
          ((equal node-name (caar unchecked-graph)) (car unchecked-graph))
          (t (next-node (cdr unchecked-graph)))))
  (next-node graph))

(defun neighbours (node-name)
  (cdr (find-node node-name)))

(defun appears-in (target llist)
  (cond ((null llist) nil)
        ((equal (car llist) target) t)
        (t (appears-in (cdr llist)))))

Add predicate to determine if two nodes are neighbours

; find the shortest path between two nodes in an unweighted graph
; ie perform a breadth first search

; the graph is a list of nodes
; a node is a list whose first element is the name of the node
; and whose remaining elements are the names of any neighbours
; (set-graph '((a b c) (b a) (c a)))

(setq graph nil)
(defun set-graph (graph-as-list)
  (setf graph graph-as-list))

(defun find-node (node-name)
  (defun next-node (unchecked-graph)
    (cond ((null unchecked-graph) nil)
          ((equal node-name (caar unchecked-graph)) (car unchecked-graph))
          (t (next-node (cdr unchecked-graph)))))
  (next-node graph))

(defun neighbours (node-name)
  (cdr (find-node node-name)))

(defun appears-in (target llist)
  (cond ((null llist) nil)
        ((equal (car llist) target) t)
        (t (appears-in (cdr llist)))))

(defun is-neighbour (desired given)
  ; (member desired (find-node given)))
  (appears-in desired (find-node given)))


;;;; site-generator.asd

(asdf:defsystem #:site-generator
  :serial t
  :description "Describe site-generator here"
  :author "Alex Charlton <alex.n.charlton@gmail.com>"
  :license "BSD-2"
  :depends-on (:let-plus :alexandria :iterate :hunchentoot :com.dvlsoft.clon :inferior-shell :cl-ppcre :cl-fad)
  :components ((:file "package")
	       (:file "utility")
	       (:file "content")
	       (:file "templates")
	       (:file "publish")
	       (:file "preview")
               (:file "site-generator"))
  :in-order-to ((test-op (load-op :site-generator-test)))
  :perform (test-op :after (op c)
		    (funcall (intern (string '#:run!) :it.bese.fiveam)
			     :site-generator)))

(asdf:defsystem :site-generator-test
  :author "Alex Charlton <alex.n.charlton@gmail.com>"
  :licence "BSD-3"
  :depends-on (:fiveam)
  :pathname "tests/"
  :serial t
  :components ((:file "suite")
	       (:file "tests")))

Update asdf file for test-server

;;;; site-generator.asd

(asdf:defsystem #:site-generator
  :serial t
  :description "Describe site-generator here"
  :author "Alex Charlton <alex.n.charlton@gmail.com>"
  :license "BSD-2"
  :depends-on (:let-plus :alexandria :iterate :hunchentoot :com.dvlsoft.clon :inferior-shell :cl-ppcre :cl-fad :bordeaux-threads :osicat)
  :components ((:file "package")
	       (:file "utility")
	       (:file "content")
	       (:file "templates")
	       (:file "publish")
	       (:file "test-server")
               (:file "site-generator"))
  :in-order-to ((test-op (load-op :site-generator-test)))
  :perform (test-op :after (op c)
		    (funcall (intern (string '#:run!) :it.bese.fiveam)
			     :site-generator)))

(asdf:defsystem :site-generator-test
  :author "Alex Charlton <alex.n.charlton@gmail.com>"
  :licence "BSD-3"
  :depends-on (:fiveam)
  :pathname "tests/"
  :serial t
  :components ((:file "suite")
	       (:file "tests")))


(defsystem "lem-js-mode"
  :depends-on ("lem-core")
  :serial t
  :components ((:file "js-mode")))

Add a dependency to js-mode on xml-mode.

(defsystem "lem-js-mode"
  :depends-on ("lem-core"
               "lem-xml-mode")
  :serial t
  :components ((:file "js-mode")))


(in-package :cl-user)

(defpackage #:lisp-interface
  (:use #:cl #:cl-neovim)
  (:shadowing-import-from #:cl #:defun #:eval))
(in-package :lisp-interface)

(defmacro echo-output (&body forms)
  (let ((output (gensym)))
    `(let ((,output (with-output-to-string (*standard-output*)
                     ,@forms)))
       (nvim:command (format nil "echo '~A'" ,output)))))

(defun eval-string (str)
  (eval (read-from-string str)))

(nvim:defcommand/s lisp (&rest form)
  (declare (opts nargs))
  (echo-output (eval-string (format nil "~{~A~^ ~}" form))))

(in-package :cl-user)

Add :Lispdo command (lisp equivalent of :pydo)

(in-package :cl-user)

(defpackage #:lisp-interface
  (:use #:cl #:cl-neovim)
  (:shadowing-import-from #:cl #:defun #:eval))
(in-package :lisp-interface)

(defmacro echo-output (&body forms)
  (let ((output (gensym)))
    `(let ((,output (with-output-to-string (*standard-output*)
                     ,@forms)))
       (nvim:command (format nil "echo '~A'" ,output)))))

(defun eval-string (str)
  (eval (read-from-string str)))

(nvim:defcommand/s lisp (&rest form)
  (declare (opts nargs))
  (echo-output (eval-string (format nil "~{~A~^ ~}" form))))

(nvim:defcommand/s lispdo (&rest form &opts range)
  (declare (opts nargs range))
  (let ((fn (eval-string
              (format nil "#'(lambda (line line-nr)
                               (declare (ignorable line line-nr))
                               ~{~A~^ ~})"
                      form)))
        (start (1- (first range)))
        (end (second range)))
    (echo-output
      (let ((new-lines (mapcar #'(lambda (line line-nr)
                                   (or (let ((new-line (funcall fn line line-nr)))
                                         (if (or (stringp new-line) (null new-line))
                                           new-line
                                           (error "Function must return either string or NIL.")))
                                       line))
                               (nvim:buffer-lines (nvim:current-buffer) start end T)
                               (loop for line-nr from start upto end collect (1+ line-nr)))))
        (setf (nvim:buffer-lines (nvim:current-buffer) start end T) new-lines)))))

(in-package :cl-user)


(fn object? (x)
  (is_object x))

(fn assoc-array? (x)
  (& (not (array? x))
     (is_array x)
     (is_int (key x))))

Test if first item has a string key.

(fn object? (x)
  (is_object x))

(fn assoc-array? (x)
  (& (is_array x)
     (is_string (key x))))


;;;; nix operating system project
;;;; list processor environment
;;;; Copyright (C) 2005-2008 Sven Klose <pixel@copei.de>

(defmacro with (alst &rest body)
  ; Make new WITH for rest of assignment list.
  (labels ((sub ()
             (if (cddr alst)
                 `((with ,(cddr alst) ,@body))
                 body)))

	; Get first pair.
    (let ((plc (first alst))
          (val (second alst)))

	  ; MULTIPLE-VALUE-BIND if place is a cons.
      (if (consp plc)
          `(multiple-value-bind ,plc ,val
			 ,@(sub))

		  ; Place function is set of value is a function.
		  (if (and (consp val) (eq (first val) 'FUNCTION))
			  `(labels ((,plc ,@(second val)))
				 ,@(sub))

			  ; Value assignment to variable.
          	  `(let ((,plc ,val))
				 ,@(sub)))))))

Allow LAMBDA keyword in function value.

;;;; nix operating system project
;;;; list processor environment
;;;; Copyright (C) 2005-2008 Sven Klose <pixel@copei.de>

(defmacro with (alst &rest body)
  ; Make new WITH for rest of assignment list.
  (labels ((sub ()
             (if (cddr alst)
                 `((with ,(cddr alst) ,@body))
                 body)))

	; Get first pair.
    (let ((plc (first alst))
          (val (second alst)))

	  ; MULTIPLE-VALUE-BIND if place is a cons.
      (if (consp plc)
          `(multiple-value-bind ,plc ,val
			 ,@(sub))

		  ; Place function is set of value is a function.
		  (if (is-lambda? val)
			  `(labels ((,plc ,@(past-lambda (second val))))
				 ,@(sub))

			  ; Value assignment to variable.
          	  `(let ((,plc ,val))
				 ,@(sub)))))))


;;
;; Copyright (c) 2009-2010, Gigamonkeys Consulting All rights reserved.
;;

(defsystem com.gigamonkeys.json
  :author "Peter Seibel <peter@gigamonkeys.com>"
  :components
  ((:file "packages")
   (:file "json"               :depends-on ("packages"))
   (:file "json-builder"       :depends-on ("packages")))
  :depends-on
  (:com.gigamonkeys.foo
   :com.gigamonkeys.pathnames
   :com.gigamonkeys.parser
   :com.gigamonkeys.utilities))

Add description to .asd file.

;;; Copyright (c) 2009-2011, Peter Seibel.
;;; All rights reserved. See COPYING for details.

(defsystem com.gigamonkeys.json
  :author "Peter Seibel <peter@gigamonkeys.com>"
  :description "Library for reading and writing JSON-formatted data."
  :components
  ((:file "packages")
   (:file "json"               :depends-on ("packages"))
   (:file "json-builder"       :depends-on ("packages")))
  :depends-on
  (:com.gigamonkeys.foo
   :com.gigamonkeys.pathnames
   :com.gigamonkeys.parser
   :com.gigamonkeys.utilities))


;;; -*- mode: Lisp; syntax: Common-Lisp; -*-

(in-package :asdf)

(cl:eval-when (:load-toplevel :execute)
  (asdf:operate 'asdf:load-op 'cffi-grovel))

(defsystem :libssh2
  :description "Trivial libssh2 bindings"
  :version      "0.1"
  :author       "Oleksii Shevchuk <alxchk@gmail.com>"
  :license      "Public Domain"
  :depends-on   (:babel
                 :cffi
                 :cl-fad
                 :hu.dwim.logger
                 :split-sequence
                 :trivial-gray-streams
                 :usocket)
  :serial       t
  :components   ((:module "src"
                  :serial t
                  :components ((:file "package")
                               (:file "logging")
                               (:file "types")
                               (cffi-grovel:grovel-file "libssh2-libc-cffi")
                               (:file "util")
                               (:file "libssh2-cffi")
                               (:file "streams")
                               (:file "scp")
                               (:file "sftp")
                               (:file "solutions")))))

Use :defsystem-depends-on in asd file

;;; -*- mode: Lisp; syntax: Common-Lisp; -*-

(in-package :asdf)

(eval-when (:compile-toplevel :load-toplevel :execute)
  (asdf:load-system "cffi-grovel"))

(defsystem :libssh2
  :description "Trivial libssh2 bindings"
  :version      "0.1"
  :author       "Oleksii Shevchuk <alxchk@gmail.com>"
  :license      "Public Domain"
  :defsystem-depends-on (:cffi-grovel)
  :depends-on   (:babel
                 :cffi
                 :cl-fad
                 :hu.dwim.logger
                 :split-sequence
                 :trivial-gray-streams
                 :usocket)
  :serial       t
  :components   ((:module "src"
                  :serial t
                  :components ((:file "package")
                               (:file "logging")
                               (:file "types")
                               (:grovel-file "libssh2-libc-cffi")
                               (:file "util")
                               (:file "libssh2-cffi")
                               (:file "streams")
                               (:file "scp")
                               (:file "sftp")
                               (:file "solutions")))))


;;; -*- Mode: Lisp -*-

(defpackage #:bencode-system (:use #:asdf #:cl))
(in-package #:bencode-system)

(defsystem #:bencode
  :description "Bencode"
  :version "3.0.0"
  :author "Johan Andersson <nilsjohanandersson@gmail.com>"
  :license "MIT"
  :components ((:file "package")
               (:file "dictionary" :depends-on ("package"))
               (:file "encode" :depends-on ("package" "dictionary"))
	       (:file "decode" :depends-on ("package" "dictionary")))
  :depends-on (#:flexi-streams)
  :in-order-to ((test-op (test-op #:bencode-test))))

(defsystem #:bencode-test
  :serial t
  :depends-on (#:bencode #:hu.dwim.stefil)
  :components ((:file "test")))

(defmethod perform ((o test-op) (c (eql (find-system :bencode-test))))
  (funcall (intern (symbol-name :test-all) (find-package :bencode-test))))

Bump patch version for accurate doc and use of digit-char-p.

;;; -*- Mode: Lisp -*-

(defpackage #:bencode-system (:use #:asdf #:cl))
(in-package #:bencode-system)

(defsystem #:bencode
  :description "Bencode"
  :version "3.0.1"
  :author "Johan Andersson <nilsjohanandersson@gmail.com>"
  :license "MIT"
  :components ((:file "package")
               (:file "dictionary" :depends-on ("package"))
               (:file "encode" :depends-on ("package" "dictionary"))
	       (:file "decode" :depends-on ("package" "dictionary")))
  :depends-on (#:flexi-streams)
  :in-order-to ((test-op (test-op #:bencode-test))))

(defsystem #:bencode-test
  :serial t
  :depends-on (#:bencode #:hu.dwim.stefil)
  :components ((:file "test")))

(defmethod perform ((o test-op) (c (eql (find-system :bencode-test))))
  (funcall (intern (symbol-name :test-all) (find-package :bencode-test))))


(defsystem #:lindsey
  ;;:depends-on ()
  :serial t
  :components ((:file "package")
	       (:file "Point2D")
	       ;(:file "Vector2D")
	       ;(:file "Polynomial")
	       ;(:file "Intersections")
	       ))

Rename files to lower case and add vector2d file

(defsystem #:lindsey
  ;;:depends-on ()
  :serial t
  :components ((:file "package")
	       (:file "point2d")
	       (:file "vector2d")
	       ;;(:file "Polynomial")
	       ;;(:file "Intersections")
	       ))


;;;;; TRE transpiler
;;;;; Copyright (c) 2009 Sven Klose <pixel@copei.de>

(defun number-sym (x)
  (with (digit
		  (fn (if (< _ 24)
				  (+ #\a _)
				  (+ (- #\0 24) _)))
		 rec
		   (fn (unless (= 0 _)
				 (with (m (mod _ 34))
				   (cons (digit m)
						 (rec (/ (- _ m) 34)))))))
	(make-symbol (list-string (cons #\_ (rec x))))))

Work around Firefox hash bug.

;;;;; TRE transpiler
;;;;; Copyright (c) 2010 Sven Klose <pixel@copei.de>

(defun number-sym (x)
  (with (digit
		  (fn (if (< _ 24)
				  (+ #\a _)
				  (+ (- #\0 24) _)))
		 rec
		   (fn (unless (= 0 _)
				 (with (m (mod _ 34))
				   (cons (digit m)
						 (rec (/ (- _ m) 34)))))))
	(make-symbol (list-string (nconc (rec x)
									 (list #\_))))))


(sys.int::cal "home/me/package.lisp")
(sys.int::cal "home/me/line.lisp")
(sys.int::cal "home/me/mark.lisp")
(sys.int::cal "home/me/editor.lisp")
(sys.int::cal "home/me/buffer.lisp")
(sys.int::cal "home/me/point.lisp")
(sys.int::cal "home/me/minibuffer.lisp")
(sys.int::cal "home/me/redisplay.lisp")
(sys.int::cal "home/me/commands.lisp")
(sys.int::cal "home/me/main.lisp")

Delete :me package before compiling and loading.

(delete-package :me)

(sys.int::cal "home/me/package.lisp")
(sys.int::cal "home/me/line.lisp")
(sys.int::cal "home/me/mark.lisp")
(sys.int::cal "home/me/editor.lisp")
(sys.int::cal "home/me/buffer.lisp")
(sys.int::cal "home/me/point.lisp")
(sys.int::cal "home/me/minibuffer.lisp")
(sys.int::cal "home/me/redisplay.lisp")
(sys.int::cal "home/me/commands.lisp")
(sys.int::cal "home/me/keybindings.lisp")
(sys.int::cal "home/me/main.lisp")


(in-package :sdl2)

(defctype sdl2-ffi::size-t :unsigned-int)

(define-foreign-library libsdl2
  (t (:default "libSDL2")))

#+-(use-foreign-library libsdl2)

Load using specific SONAME in :unix

(in-package :sdl2)

(defctype sdl2-ffi::size-t :unsigned-int)

(define-foreign-library libsdl2
  (:unix (:or "libSDL2-2.0.so.0" "libSDL2"))
  (t (:default "libSDL2")))

(use-foreign-library libsdl2)


(cl:defpackage #:definitions-systems_tests
  (:use #:cl #:parachute))

(cl:in-package #:definitions-systems_tests)

(defmacro are (comp expected form &optional description &rest format-args)
  `(is ,comp ,expected (multiple-value-list ,form) ,description ,@format-args))

(define-test "main"
  (flet ((basic-tests (system)
           (flet ((check-unbound ()
                    (is eq nil
                        (defsys:locate system 'key :errorp nil))
                    (fail (defsys:locate system 'key))
                    (is eq nil
                        (defsys:boundp system 'key))
                    (is = 0
                        (defsys:count system))))
             (check-unbound)
             (setf (defsys:locate system 'key) 'value)
             (is eq 'value
                 (defsys:locate system 'key))
             (defsys:map (let ((count 0))
                           (lambda (key value)
                             (incf count)
                             (are equal '(1 key value)
                                  (values count key value))))
                         system)
             (defsys:unbind system 'key)
             (check-unbound))))
    (basic-tests (make-instance 'defsys:hash-table-mixin))
    (basic-tests (make-instance 'defsys:standard-system :base-definition-class t))))

; base-definition-class-mixin
; primary-binding-mixin
; alias-bindings-mixin
; map-aliasing-systems
; ensure, expand, define, map, count
; simple-expansion-mixin

Use FALSE instead of (is eq nil)

(cl:defpackage #:definitions-systems_tests
  (:use #:cl #:parachute))

(cl:in-package #:definitions-systems_tests)

(defmacro are (comp expected form &optional description &rest format-args)
  `(is ,comp ,expected (multiple-value-list ,form) ,description ,@format-args))

(define-test "main"
  (flet ((basic-tests (system)
           (flet ((check-unbound ()
                    (false (defsys:locate system 'key :errorp nil))
                    (fail (defsys:locate system 'key))
                    (false (defsys:boundp system 'key))
                    (is = 0
                        (defsys:count system))))
             (check-unbound)
             (setf (defsys:locate system 'key) 'value)
             (is eq 'value
                 (defsys:locate system 'key))
             (defsys:map (let ((count 0))
                           (lambda (key value)
                             (incf count)
                             (are equal '(1 key value)
                                  (values count key value))))
                         system)
             (defsys:unbind system 'key)
             (check-unbound))))
    (basic-tests (make-instance 'defsys:hash-table-mixin))
    (basic-tests (make-instance 'defsys:standard-system :base-definition-class t))))

; base-definition-class-mixin
; primary-binding-mixin
; alias-bindings-mixin
; map-aliasing-systems
; ensure, expand, define, map, count
; simple-expansion-mixin


;;; -*- lisp -*-

(defpackage :clouseau.system
  (:use :cl :asdf))

(in-package :clouseau.system)

(defsystem :clouseau
    :depends-on (:mcclim)
    :serial t
    :components
    ((:module "Apps/Inspector"
              :pathname #.(make-pathname :directory '(:relative "Apps" "Inspector"))
              :components
	      ((:file "package")
	       (:file "disassembly" :depends-on ("package"))
	       (:file "inspector" :depends-on ("disassembly"))))))

Define system in package ASDF-USER.

;;; -*- lisp -*-

(cl:in-package :asdf-user)

(defsystem :clouseau
    :depends-on (:mcclim)
    :serial t
    :components
    ((:module "Apps/Inspector"
              :pathname #.(make-pathname :directory '(:relative "Apps" "Inspector"))
              :components
	      ((:file "package")
	       (:file "disassembly" :depends-on ("package"))
	       (:file "inspector" :depends-on ("disassembly"))))))


(in-package #:sicl-compiler)

(defun compile-file (input-file &key
				(output-file nil output-file-p)
				(verbose *compile-verbose*)
				(print *compile-print*)
				(external-format :default))

  (with-open-file (stream input-file
			  :direction :input
			  :external-format external-format)
    (let* ((*compile-file-pathname* (merge-pathnames input-file))
	   (*compile-file-truename* (truename *compile-file-pathname*))
	   (*package* *package*)
	   (*readtable* *readtable*)
	   (sicl-compiler-phase-1:*compile-file* t))
      (loop with eof-value = (list nil)
	    for form = (read stream nil eof-value)
	    until (eq form eof-value)
	    for result = (sicl-compiler-phase-1:convert form nil)
	    unless (null result)
	      collect result))))

Use new convert entry point.

(in-package #:sicl-compiler)

(defun compile-file (input-file &key
				(output-file nil output-file-p)
				(verbose *compile-verbose*)
				(print *compile-print*)
				(external-format :default))

  (with-open-file (stream input-file
			  :direction :input
			  :external-format external-format)
    (let* ((*compile-file-pathname* (merge-pathnames input-file))
	   (*compile-file-truename* (truename *compile-file-pathname*))
	   (*package* *package*)
	   (*readtable* *readtable*)
	   (sicl-compiler-phase-1:*compile-file* t))
      (loop with eof-value = (list nil)
	    for form = (read stream nil eof-value)
	    until (eq form eof-value)
	    for result = (sicl-compiler-phase-1:convert-initial form)
	    unless (null result)
	      collect result))))


(cl:in-package #:sicl-boot)

(defclass header ()
  ((%class :initarg :class :accessor class)
   (%rack :initarg :rack :reader rack)))

(defun define-allocate-general-instance (env)
  (setf (sicl-genv:fdefinition 'sicl-clos:allocate-general-instance env)
	(lambda (class size)
	  (make-instance 'header
	    :class class
	    :rack (make-array size)))))

(defun phase3 ()
  (let ((r2 *phase2-mop-class-env*)
	(r3 *phase2-mop-accessor-env*))
    (message "Start of phase 3~%")
    (ld "../CLOS/class-finalization-support.lisp" r2 r2)
    (define-allocate-general-instance r3)
    (message "End of phase 3~%")))

Load a file containing function definitions for class finalization.

(cl:in-package #:sicl-boot)

(defclass header ()
  ((%class :initarg :class :accessor class)
   (%rack :initarg :rack :reader rack)))

(defun define-allocate-general-instance (env)
  (setf (sicl-genv:fdefinition 'sicl-clos:allocate-general-instance env)
	(lambda (class size)
	  (make-instance 'header
	    :class class
	    :rack (make-array size)))))

(defun phase3 ()
  (let ((r2 *phase2-mop-class-env*)
	(r3 *phase2-mop-accessor-env*))
    (message "Start of phase 3~%")
    (ld "../CLOS/class-finalization-support.lisp" r2 r2)
    (ld "../CLOS/class-finalization-defuns.lisp" r2 r2)
    (define-allocate-general-instance r3)
    (message "End of phase 3~%")))


(in-package :de.anvi.croatoan)

;; first attempt to create add-string with attributes and colors
;; without adding a complex-string type first.
(defun add-string (window string &key attributes color-pair y x n)
  "Add the unrendered string to the window.

If n is given, write at most n chars from the string. If n is -1, as
many chars will be added that will fit on the line.

If the coordinates y and x are given, move to the destination first
and then add the string."
  (when (and y x) (move window y x))
  (typecase string
    (string
     (progn
       (let ((winptr (.winptr window))
             (pos1 (.cursor-position window)))
         (if n
             (%waddnstr winptr string n)
             (%waddstr winptr string))
         (when (or attributes color-pair)
           (let ((pos2 (.cursor-position window))
                 (count (if n n (length string))))
             (move window (car pos1) (cadr pos1))
             (change-attributes window count attributes color-pair)
             (move window (car pos2) (cadr pos2)))))))
    (complex-string
     (if n
         (loop
            repeat (if (= n -1)
                       (- (.width window) (cadr (.cursor-position window)))
                       n)
            for ch across (.complex-char-array string)
            do (add-char window ch))
         (loop
            for ch across (.complex-char-array string)
            do (add-char window ch))))))

;;; TODOs

;; A common function to display both strings and chars.
;;(defun display (window object &key y x n)
;;  (if (typep object 'chtype)

;; rewrite all the addstr and print functions in a way that they use format internally and
;; can accept chars like ~% instead of C's \n.
;;(add-string scr (format nil " upper left corner~%~%~%"))

Refactor add-str to use add-char instead of change-attributes

(in-package :de.anvi.croatoan)

(defun add-string (window string &key attributes color-pair y x n)
  "Add the unrendered string to the window.

If n is given, write at most n chars from the string. If n is -1, as
many chars will be added that will fit on the line.

If the coordinates y and x are given, move to the destination first
and then add the string."
  (when (and y x) (move window y x))
  (let ((count (if n
                   (if (= n -1)
                       (- (.width window) (cadr (.cursor-position window)))
                       n)
                   (length string))))
    (typecase string
      (string
       (if (or attributes color-pair)
           ;; lisp string combined with attributes and colors
           (loop
              repeat count
              for ch across string
              do (add-char window ch :attributes attributes :color-pair color-pair))
           ;; simple lisp string, no attributes or colors
           (if n
               (%waddnstr (.winptr window) string n)
               (%waddstr  (.winptr window) string))))
      (complex-string
       (loop
          repeat count
          for ch across (.complex-char-array string)
          do (add-char window ch))))))


(in-package :clutter)

(def-suite environments :in clutter)

(in-suite environments)

(test stack-frame)
(test *stack*)
(test binding
  (let* ((ns (make-namespace))
         (symbol (make-clutter-symbol :name "test" :namespace ns))) ;TODO: clutter-gensym to ensure no collision
    (is (not (clutter-boundp symbol :lexical)))
    (is (bind symbol "value" :lexical))
    (is (clutter-boundp symbol :lexical))
    (is-true (unbind symbol :lexical) "Failed to unbind the symbol.")))
(test with-frame)
(test push-initial-binding)
(test push-initial-function-binding)
(test current-scope)
(test current-env)
(test lookup)
(test setf-lookup)

Expand binding test to cover all subenvs.

(in-package :clutter)

(def-suite environments :in clutter)

(in-suite environments)

(test stack-frame)
(test *stack*)
(test binding
  (mapc #'(lambda (env)
            (let* ((ns (make-namespace))
                   (symbol (make-clutter-symbol :name "test" :namespace ns))) ;TODO: clutter-gensym to ensure no collision
              (is (not (clutter-boundp symbol env)))
              (is (bind symbol "value" env))
              (is (clutter-boundp symbol env))
              (is-true (unbind symbol env) "Failed to unbind ~A from ~A." symbol env)))
        '(:function :lexical :dynamic :namespace)))
(test with-frame)
(test push-initial-binding)
(test push-initial-function-binding)
(test current-scope)
(test current-env)
(test lookup)
(test setf-lookup)


;;;; See the LICENSE file for licensing information.

(defsystem minion
  :name "minion"
  :author "Brian Mastenbrook"
  :version "0.1.0"
  :licence "MIT"
  :description "IRC bot for SBCL"
  :depends-on
  (:cl-irc :cl-ppcre :split-sequence
   :irc-bot drakma)
  :properties ((#:author-email . "cl-irc-devel@common-lisp.net")
               (#:date . "$Date: 2005/10/13 18:22:38 $")
               ((#:albert #:output-dir) . "doc/api-doc/")
               ((#:albert #:formats) . ("docbook"))
               ((#:albert #:docbook #:template) . "book")
               ((#:albert #:docbook #:bgcolor) . "white")
               ((#:albert #:docbook #:textcolor) . "black"))
  :components ((:module "minion"
                :serial t
                :components
                ((:file "packages")
                 (:file "mp2eliza")
                 (:file "eliza-rules")
                 (:file "steel-bazooka")
                 (:file "minion")))))

Use keywords for system names, and explicitly specify ASDF:DEFSYSTEM.

;;;; See the LICENSE file for licensing information.

(asdf:defsystem :minion
  :name "minion"
  :author "Brian Mastenbrook"
  :version "0.1.0"
  :licence "MIT"
  :description "IRC bot for SBCL"
  :depends-on
  (:cl-irc :cl-ppcre :split-sequence
   :irc-bot :drakma)
  :properties ((#:author-email . "cl-irc-devel@common-lisp.net")
               (#:date . "$Date: 2005/10/13 18:22:38 $")
               ((#:albert #:output-dir) . "doc/api-doc/")
               ((#:albert #:formats) . ("docbook"))
               ((#:albert #:docbook #:template) . "book")
               ((#:albert #:docbook #:bgcolor) . "white")
               ((#:albert #:docbook #:textcolor) . "black"))
  :components ((:module "minion"
                :serial t
                :components
                ((:file "packages")
                 (:file "mp2eliza")
                 (:file "eliza-rules")
                 (:file "steel-bazooka")
                 (:file "minion")))))


(cl:in-package #:clump-binary-tree)

;;; Make CHILD the left child of NODE.
(defgeneric link-left (parent child))

(defmethod link-left ((parent node) (child node))
  (setf (left parent) child))

(defmethod link-left ((parent node-with-parent) (child node-with-parent))
  (call-next-method)
  (setf (parent child) parent))

;;; Make CHILD the right child of PARENT.
(defgeneric link-right (parent child))

(defmethod link-right ((parent node) (child node))
  (setf (right parent) child))

(defmethod link-right ((parent node-with-parent) (child node-with-parent))
  (call-next-method)
  (setf (parent child) parent))

;;; Remove CHILD as the left child of PARENT.
(defgeneric unlink-left (parent child))

(defmethod unlink-left ((parent node) (child node))
  (setf (left parent) nil))

(defmethod unlink-left ((parent node-with-parent) (child node-with-parent))
  (call-next-method)
  (setf (parent child) nil))

;;; Remove CHILD as the right child of PARENT.
(defgeneric unlink-right (parent child))

(defmethod unlink-right ((parent node) (child node))
  (setf (right parent) nil))

(defmethod unlink-right ((parent node-with-parent) (child node-with-parent))
  (call-next-method)
  (setf (parent child) nil))

Allow for the child to be NIL.

(cl:in-package #:clump-binary-tree)

;;; Make CHILD the left child of NODE.
(defgeneric link-left (parent child))

(defmethod link-left ((parent node) child)
  (setf (left parent) child))

(defmethod link-left ((parent node-with-parent) (child node-with-parent))
  (call-next-method)
  (setf (parent child) parent))

;;; Make CHILD the right child of PARENT.
(defgeneric link-right (parent child))

(defmethod link-right ((parent node) child)
  (setf (right parent) child))

(defmethod link-right ((parent node-with-parent) (child node-with-parent))
  (call-next-method)
  (setf (parent child) parent))

;;; Remove CHILD as the left child of PARENT.
(defgeneric unlink-left (parent child))

(defmethod unlink-left ((parent node) child)
  (setf (left parent) nil))

(defmethod unlink-left ((parent node-with-parent) (child node-with-parent))
  (call-next-method)
  (setf (parent child) nil))

;;; Remove CHILD as the right child of PARENT.
(defgeneric unlink-right (parent child))

(defmethod unlink-right ((parent node) child)
  (setf (right parent) nil))

(defmethod unlink-right ((parent node-with-parent) (child node-with-parent))
  (call-next-method)
  (setf (parent child) nil))


;;;; bukvonesis.asd

(asdf:defsystem #:bukvonesis
  :serial t
  :description "Growing cyrillic characters for latin-only fonts."
  :author "Boian Tzonev <boiantz@gmail.com>"
  :license "Apache License, Version 2.0"
  :depends-on ("hunchentoot" "parenscript" "ponon" "lparallel" "closure-template" "clws") ;;todo remove ponon
  :components ((:file "package")
               (:file "bukvonesis")
	       (:file "hunchentoot")))

(in-package :bukvonesis)
(import-macros-from-lisp '$$ 'console.log)

Include clws server file in project.

;;;; bukvonesis.asd

(asdf:defsystem #:bukvonesis
  :serial t
  :description "Growing cyrillic characters for latin-only fonts."
  :author "Boian Tzonev <boiantz@gmail.com>"
  :license "Apache License, Version 2.0"
  :depends-on ("hunchentoot" "parenscript" "ponon" "lparallel" "closure-template" "clws") ;;todo remove ponon
  :components ((:file "package")
               (:file "bukvonesis")
	       (:file "hunchentoot")
	       (:file "clws")))

(in-package :bukvonesis)
(import-macros-from-lisp '$$ 'console.log)


(describe simple-let
          (== (let ())
              nil)
          (== (let ()
                42)
              42))

(describe let-with-multiple-expr-body
          (== (let ()
                1
                2)
              2))

(describe let-bindings
          (== (let* ((x 1)
                     (y 2))
                (+ x y))
              3)
          (let ((x 2))
            (== (let ((x 1)
                      (y (+ x 1)))
                  y)
                3)))

(describe let-binding-scope
          (== (begin (let ((zz 2)) zz)
                     zz)
              nil))

(describe named-let
          (== (let loop
                ((numbers ’(3 -2 1 6 -5))
                 (nonneg ’())
                 (neg ’()))
                (cond ((null? numbers)
                       (list nonneg neg))
                      ((>= (car numbers) 0)
                       (loop (cdr numbers)
                          (cons (car numbers) nonneg)
                          neg))
                      (else
                       (loop (cdr numbers)
                          nonneg
                          (cons (car numbers) neg)))))
              '((6 1 3) (-5 -2))))

Fix typo (copy-paste single quotes).

(describe simple-let
          (== (let ())
              nil)
          (== (let ()
                42)
              42))

(describe let-with-multiple-expr-body
          (== (let ()
                1
                2)
              2))

(describe let-bindings
          (== (let* ((x 1)
                     (y 2))
                (+ x y))
              3)
          (let ((x 2))
            (== (let ((x 1)
                      (y (+ x 1)))
                  y)
                3)))

(describe let-binding-scope
          (== (begin (let ((zz 2)) zz)
                     zz)
              nil))

(describe named-let
          (== (let loop
                ((numbers '(3 -2 1 6 -5))
                 (nonneg '())
                 (neg '()))
                (cond ((null? numbers)
                       (list nonneg neg))
                      ((>= (car numbers) 0)
                       (loop (cdr numbers)
                          (cons (car numbers) nonneg)
                          neg))
                      (else
                       (loop (cdr numbers)
                          nonneg
                          (cons (car numbers) neg)))))
              '((6 1 3) (-5 -2))))


(defsystem :map
  :serial t
  :description "Octave-like functionality for lisp!"
  :version "0.1.0"
  :author "Matt Novenstern <fisxoj@gmail.com>"
  :components ((:file "package")
	       (:file "conditions")
	       (:module utilities
			:components ((:file "printing")
				     (:file "missing-functions")))
	       (:module vectors
			:components ((:file "vector")
				     (:file "range")
				     (:file "vector-operations")))
	       (:module matrix
			:components ((:file "matrices")
				     (:file "matrix-predicates")
				     (:file "matrix-operations")
				     (:file "matrix-slices")
				     (:file "matrix-macros")
				     ))
	       (:module calculus
			:components ((:file "integration")
				     (:file "rkf45")))
	       (:module plotting
			:components ((:file "plot")))
	       (:module images
			:components ((:file "image"))))
  :depends-on (#:cl-jpeg #:external-program))

Load macros before the functions that use them

(defsystem :map
  :serial t
  :description "Octave-like functionality for lisp!"
  :version "0.1.0"
  :author "Matt Novenstern <fisxoj@gmail.com>"
  :components ((:file "package")
	       (:file "conditions")
	       (:module utilities
			:components ((:file "printing")
				     (:file "missing-functions")))
	       (:module vectors
			:components ((:file "vector")
				     (:file "range")
				     (:file "vector-operations")))
	       (:module matrix
			:components ((:file "matrices")
				     (:file "matrix-macros")
				     (:file "matrix-predicates")
				     (:file "matrix-operations")
				     (:file "matrix-slices")
				     ))
	       (:module calculus
			:components ((:file "integration")
				     (:file "rkf45")))
	       (:module plotting
			:components ((:file "plot")))
	       (:module images
			:components ((:file "image"))))
  :depends-on (#:cl-jpeg #:external-program))


(in-package #:asdf-user)

(defsystem :sicl-iteration
  :depends-on (:cleavir-code-utilities
	       :cleavir-internationalization
	       :sicl-iteration-support)
  :serial t
  :components
  ((:file "dotimes")
   (:file "dolist")
   (:file "iteration")))

Make component names match real file names.

(in-package #:asdf-user)

(defsystem :sicl-iteration
  :depends-on (:cleavir-code-utilities
	       :cleavir-internationalization
	       :sicl-iteration-support)
  :serial t
  :components
  ((:file "dotimes-defmacro")
   (:file "dolist-defmacro")
   (:file "do-dostar-defmacro")))


;;;; package.lisp

(defpackage #:spinneret
  (:use #:cl #:parenscript #:alexandria)
  (:export #:with-html #:with-html-string #:html
           #:*html* #:*html-fill-column* #:*html-min-room*
           #:*html-lang* #:*html-charset*
           #:*html-path*
           #:deftemplate #:do-elements
           #:deftag
           #:*unvalidated-attribute-prefixes*)
  (:shadowing-import-from :alexandria :switch))

Remove deftemplate from exported symbols

;;;; package.lisp

(defpackage #:spinneret
  (:use #:cl #:parenscript #:alexandria)
  (:export #:with-html #:with-html-string #:html
           #:*html* #:*html-fill-column* #:*html-min-room*
           #:*html-lang* #:*html-charset*
           #:*html-path*
           #:do-elements
           #:deftag
           #:*unvalidated-attribute-prefixes*)
  (:shadowing-import-from :alexandria :switch))


;;
;; Copyright (c) 2005-2010, Peter Seibel. All rights reserved.
;;

(defsystem com.gigamonkeys.utilities
  :description "Peter Seibel's collection of 'utilities'."
  :components
  ((:file "packages")
   (:file "heap" :depends-on ("packages"))
   (:file "clos" :depends-on ("packages"))
   (:file "date" :depends-on ("packages" "with-time"))
   (:file "files" :depends-on ("packages"))
   (:file "lists" :depends-on ("packages"))
   (:file "symbols" :depends-on ("packages"))
   (:file "numbers" :depends-on ("packages"))
   (:file "math" :depends-on ("packages"))
   (:file "randomization" :depends-on ("packages"))
   #+allegro(:file "timer" :depends-on ("packages"))
   (:file "with-time" :depends-on ("packages")))
  :depends-on (:alexandria :split-sequence))

Add newline to end of file.


(cl:in-package #:clump-2-3-tree)

(defclass tree ()
  ((%contents :initform nil :accessor contents)))

(defclass node ()
  ((%parent :initarg :parent :accessor parent)))

Define new class LEAF for the leaves of the 2-3 tree.

(cl:in-package #:clump-2-3-tree)

(defclass tree ()
  ((%contents :initform nil :accessor contents)))

(defclass node ()
  ((%parent :initarg :parent :accessor parent)))

(defclass leaf (node)
  ((%contents :initform nil :accessor contents)))


;;; -*- Lisp -*-

(defsystem :split-sequence
  :author "Arthur Lemmens <alemmens@xs4all.nl>"
  :maintainer "Sharp Lispers <sharplispers@googlegroups.com>"
  :description "Splits a sequence into a list of subsequences
  delimited by objects satisfying a test."
  :license "public domain"
  :version (:read-file-form "version.sexp")
  :components ((:file "split-sequence"))
  :in-order-to ((asdf:test-op (asdf:load-op :split-sequence-tests)))
  :perform (asdf:test-op :after (op c)
             (funcall (intern (symbol-name '#:run!) '#:5am) :split-sequence)))

(defsystem :split-sequence-tests
  :author "Arthur Lemmens <alemmens@xs4all.nl>"
  :maintainer "Sharp Lispers <sharplispers@googlegroups.com>"
  :description "Split-Sequence test suite"
  :license "public domain"
  :depends-on (:split-sequence :fiveam)
  :components ((:file "tests")))

Add version.sexp as static file

;;; -*- Lisp -*-

(defsystem :split-sequence
  :author "Arthur Lemmens <alemmens@xs4all.nl>"
  :maintainer "Sharp Lispers <sharplispers@googlegroups.com>"
  :description "Splits a sequence into a list of subsequences
  delimited by objects satisfying a test."
  :license "public domain"
  :version (:read-file-form "version.sexp")
  :components ((:static-file "version.sexp")
               (:file "split-sequence"))
  :in-order-to ((asdf:test-op (asdf:load-op :split-sequence-tests)))
  :perform (asdf:test-op :after (op c)
             (funcall (intern (symbol-name '#:run!) '#:5am) :split-sequence)))

(defsystem :split-sequence-tests
  :author "Arthur Lemmens <alemmens@xs4all.nl>"
  :maintainer "Sharp Lispers <sharplispers@googlegroups.com>"
  :description "Split-Sequence test suite"
  :license "public domain"
  :depends-on (:split-sequence :fiveam)
  :components ((:file "tests")))


;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
;;;
;;; --- ASDF component classes
;;;

(in-package :iolib.base)

(defclass :iolib-muffled-source-file (asdf:cl-source-file) ())

(macrolet ((with-muffled-output (&body body)
             `(let ((*load-print* nil)
                    (*load-verbose* t)
                    (*compile-print* nil)
                    (*compile-verbose* t)
                    #+cmu (ext:*gc-verbose* nil))
                ,@body)))
  (defmethod asdf:perform :around ((o asdf:compile-op)
                                   (c :iolib-muffled-source-file))
    (with-muffled-output
      (call-next-method)))

  (defmethod asdf:perform :around ((o asdf:load-source-op)
                                   (c :iolib-muffled-source-file))
    (with-muffled-output
      (call-next-method))))

(defclass :iolib-source-file (:iolib-muffled-source-file) ())

Set {COMPILE,LOAD}-VERBOSE to T when compiling IOLIB-SOURCE-FILEs

;;;; -*- Mode: Lisp; indent-tabs-mode: nil -*-
;;;
;;; --- ASDF component classes
;;;

(in-package :iolib.base)

(defclass :iolib-muffled-source-file (asdf:cl-source-file) ())

(macrolet ((with-muffled-output (&body body)
             `(let ((*load-print* nil)
                    (*load-verbose* nil)
                    (*compile-print* nil)
                    (*compile-verbose* nil)
                    #+cmu (ext:*gc-verbose* nil))
                ,@body)))
  (defmethod asdf:perform :around ((o asdf:compile-op)
                                   (c :iolib-muffled-source-file))
    (with-muffled-output
      (call-next-method)))

  (defmethod asdf:perform :around ((o asdf:load-source-op)
                                   (c :iolib-muffled-source-file))
    (with-muffled-output
      (call-next-method))))

(defclass :iolib-source-file (:iolib-muffled-source-file) ())


(cl:in-package #:sicl-boot-phase1)

(defun ld (filename environment)
  (format *trace-output* "Loading file ~a~%" filename)
  (finish-output *trace-output*)
  (sicl-extrinsic-environment:load-source-with-environments
   filename (compilation-environment environment) environment))

(defun fill-environment (environment)
  (setf (sicl-genv:find-class 'standard-class
			      (compilation-environment environment))
	(find-class 'temporary-standard-class))
  (sicl-genv:fmakunbound 'sicl-clos:ensure-generic-function-using-class
			 environment)
  (setf (sicl-genv:fdefinition 'make-instance environment)
	(let ((make-instance (sicl-genv:fdefinition
			      'make-instance
			      (compilation-environment environment))))
	  (lambda (&rest arguments)
	    (if (symbolp (first arguments))
		(apply make-instance
		       (sicl-genv:find-class
			(first arguments)
			(compilation-environment environment))
		       (rest arguments))
		(apply make-instance arguments)))))
  (ld "../../CLOS/ensure-class-using-class-support.lisp"
      environment)
  (ld "temporary-ensure-class.lisp" environment)
  (ld "../../Environment/standard-environment-functions.lisp" environment))

Load a file containing the definition of the class standard-object.

(cl:in-package #:sicl-boot-phase1)

(defun ld (filename environment)
  (format *trace-output* "Loading file ~a~%" filename)
  (finish-output *trace-output*)
  (sicl-extrinsic-environment:load-source-with-environments
   filename (compilation-environment environment) environment))

(defun fill-environment (environment)
  (setf (sicl-genv:find-class 'standard-class
			      (compilation-environment environment))
	(find-class 'temporary-standard-class))
  (sicl-genv:fmakunbound 'sicl-clos:ensure-generic-function-using-class
			 environment)
  (setf (sicl-genv:fdefinition 'make-instance environment)
	(let ((make-instance (sicl-genv:fdefinition
			      'make-instance
			      (compilation-environment environment))))
	  (lambda (&rest arguments)
	    (if (symbolp (first arguments))
		(apply make-instance
		       (sicl-genv:find-class
			(first arguments)
			(compilation-environment environment))
		       (rest arguments))
		(apply make-instance arguments)))))
  (ld "../../CLOS/ensure-class-using-class-support.lisp"
      environment)
  (ld "temporary-ensure-class.lisp" environment)
  (ld "../../CLOS/standard-object-defclass.lisp" environment)
  (ld "../../Environment/standard-environment-functions.lisp" environment))


;;;;; tré – Copyright (c) 2008–2010,2013 Sven Michael Klose <pixel@copei.de>

(dont-obfuscate apply call)
(declare-cps-exception apply %nconc last butlast)
(declare-native-cps-function apply)

(defun apply (fun &rest lst)
  (when-debug
    (| (function? fun)
	   (error "First argument ~A is not a function." fun))
	(| (list? (car (last lst)))
	   (error "Last argument is not a list.")))
  (alet (%nconc (butlast lst) (car (last lst)))
    ,(? (transpiler-cps-transformation? *transpiler*)
        '(?
           (defined? fun.tre-exp)            (fun.tre-exp.apply nil (%%native "[" ~%cont ", " ! "]"))
           (defined? fun._cps-transformed?)  (fun.apply nil (list-array (. ~%cont !)))
           (~%cont.apply nil (fun.apply nil (list-array !))))
        '(? (defined? fun.tre-exp)
            (fun.tre-exp.apply nil (%%native "[" ! "]"))
            (fun.apply nil (list-array !))))))

Fix call to non-CPS function from CPS function.

;;;;; tré – Copyright (c) 2008–2010,2013 Sven Michael Klose <pixel@copei.de>

(dont-obfuscate apply call)
(declare-cps-exception apply %nconc last butlast)
(declare-native-cps-function apply)

(defun apply (fun &rest lst)
  (when-debug
    (| (function? fun)
	   (error "First argument ~A is not a function." fun))
	(| (list? (car (last lst)))
	   (error "Last argument is not a list.")))
  (alet (%nconc (butlast lst) (car (last lst)))
    ,(? (transpiler-cps-transformation? *transpiler*)
        '(?
           (defined? fun.tre-exp)            (fun.tre-exp.apply nil (%%native "[" ~%cont ", " ! "]"))
           (defined? fun._cps-transformed?)  (fun.apply nil (list-array (. ~%cont !)))
           (~%cont.call nil (fun.apply nil (list-array !))))
        '(? (defined? fun.tre-exp)
            (fun.tre-exp.apply nil (%%native "[" ! "]"))
            (fun.apply nil (list-array !))))))


;;;;; tré – Copyright (c) 2008–2012 Sven Michael Klose <pixel@copei.de>

(defun transpiler-make-expex (tr)
  (let ex (make-expex)
    (= (transpiler-expex tr) ex

	   (expex-transpiler ex) tr

	   (expex-function-collector ex)
	       (lx (tr)
		     #'((fun args)
		          (transpiler-add-wanted-function ,tr fun)))

	   (expex-argument-filter ex)
	       (lx (tr)
	    	 #'((var)
		          (transpiler-add-wanted-variable ,tr var)))

	   (expex-functionp ex)
	       (lx (tr)
			 #'((fun)
		          (& (atom fun)
		             (| (transpiler-function-arguments ,tr fun)
			            (& (not (transpiler-unwanted-function? ,tr fun))
				           (function? (symbol-function fun)))))))

	   (expex-plain-arg-fun? ex)
	       (lx (tr)
			 #'((fun)
		          (transpiler-plain-arg-fun? ,tr fun))))
	ex))

(defun create-transpiler (&rest args)
  (aprog1 (apply #'make-transpiler args)
	(transpiler-reset !)
	(transpiler-make-std-macro-expander !)
	(transpiler-make-code-expander !)
	(funcall (transpiler-expex-initializer !) (transpiler-make-expex !))
    (make-global-funinfo !)))

Switch on assertions with *ASSERT*.

;;;;; tré – Copyright (c) 2008–2012 Sven Michael Klose <pixel@copei.de>

(defun transpiler-make-expex (tr)
  (let ex (make-expex)
    (= (transpiler-expex tr) ex

	   (expex-transpiler ex) tr

	   (expex-function-collector ex)
	       (lx (tr)
		     #'((fun args)
		          (transpiler-add-wanted-function ,tr fun)))

	   (expex-argument-filter ex)
	       (lx (tr)
	    	 #'((var)
		          (transpiler-add-wanted-variable ,tr var)))

	   (expex-functionp ex)
	       (lx (tr)
			 #'((fun)
		          (& (atom fun)
		             (| (transpiler-function-arguments ,tr fun)
			            (& (not (transpiler-unwanted-function? ,tr fun))
				           (function? (symbol-function fun)))))))

	   (expex-plain-arg-fun? ex)
	       (lx (tr)
			 #'((fun)
		          (transpiler-plain-arg-fun? ,tr fun))))
	ex))

(defun create-transpiler (&rest args)
  (aprog1 (apply #'make-transpiler args)
	(transpiler-reset !)
    (= (transpiler-assert? !) *assert*)
	(transpiler-make-std-macro-expander !)
	(transpiler-make-code-expander !)
	(funcall (transpiler-expex-initializer !) (transpiler-make-expex !))
    (make-global-funinfo !)))


(cl:in-package #:sicl-extrinsic-hir-compiler)

(defun rp (filename)
  (asdf:system-relative-pathname :sicl-extrinsic-hir-compiler filename))

(load (rp "../../Evaluation-and-compilation/lambda.lisp"))
(load (rp "../../Environment/multiple-value-bind.lisp"))
(load (rp "../../Data-and-control-flow/setf.lisp"))

Load file containing macro DEFUN.

(cl:in-package #:sicl-extrinsic-hir-compiler)

(defun rp (filename)
  (asdf:system-relative-pathname :sicl-extrinsic-hir-compiler filename))

(load (rp "../../Evaluation-and-compilation/lambda.lisp"))
(load (rp "../../Environment/multiple-value-bind.lisp"))
(load (rp "../../Data-and-control-flow/setf.lisp"))
(load (rp "../../Environment/defun.lisp"))


(in-package :stupid-chyat)

(defvar *acceptor*)

(define-easy-handler (root :uri "/") ()
  (generate-html-response))

(define-easy-handler (postmsg :uri "/postmsg") ((message :real-name "msg"))
  (let ((ua-stripped (strip-tags (user-agent)))
        (message-stripped (strip-tags message)))
    (cond
      ((and (string/= "" message-stripped)
            (message-allowed message-stripped))
       (post-message message-stripped ua-stripped)
       (generate-html-response))
      (t (generate-go-away!-response)))))

(defun start-chat ()
  "Start the chat"
  (flush-db)
  (reopen-db)
  (setq *acceptor* (make-instance 'easy-acceptor :ipv6 nil :port 8080 :address #(127 0 0 1)))
  (start *acceptor*))

(defun stop-chat ()
  "Stop the chat"
  (stop *acceptor*)
  (finalize-db))

(export '(start-chat stop-chat))

Handle post click more carefully (but still in ugly way)

(in-package :stupid-chyat)

(defvar *acceptor*)

(define-easy-handler (root :uri "/") ()
  (generate-html-response))

(define-easy-handler (postmsg :uri "/postmsg") ((message :real-name "msg"))
  (let ((ua-stripped (strip-tags (user-agent)))
        (message-stripped (strip-tags message)))
    (cond
      ((or (null message-stripped)
           (string= "" message-stripped))
       (generate-html-response))
      ((message-allowed message-stripped)
       (post-message message-stripped ua-stripped)
       (generate-html-response))
      (t (generate-go-away!-response)))))

(defun start-chat ()
  "Start the chat"
  (flush-db)
  (reopen-db)
  (setq *acceptor* (make-instance 'easy-acceptor :ipv6 nil :port 8080 :address #(127 0 0 1)))
  (start *acceptor*))

(defun stop-chat ()
  "Stop the chat"
  (stop *acceptor*)
  (finalize-db))

(export '(start-chat stop-chat))


(cl:in-package #:sicl-boot)

(defun define-validate-superclass (boot)
  (setf (sicl-genv:fdefinition 'sicl-clos:validate-superclass (r2 boot))
	(constantly t)))

(defun customize-r2 (boot)
  (let ((c (c1 boot))
	(r (r2 boot)))
    (define-make-instance boot)
    (define-direct-slot-definition-class boot)
    (define-find-class boot)
    (define-validate-superclass boot)
    (ld "default-superclasses-temporary-defun" c r)
    (ld "../CLOS/ensure-generic-function-using-class-support.lisp" c r)))

Use file suffix for loading.

(cl:in-package #:sicl-boot)

(defun define-validate-superclass (boot)
  (setf (sicl-genv:fdefinition 'sicl-clos:validate-superclass (r2 boot))
	(constantly t)))

(defun customize-r2 (boot)
  (let ((c (c1 boot))
	(r (r2 boot)))
    (define-make-instance boot)
    (define-direct-slot-definition-class boot)
    (define-find-class boot)
    (define-validate-superclass boot)
    (ld "default-superclasses-temporary-defun.lisp" c r)
    (ld "../CLOS/ensure-generic-function-using-class-support.lisp" c r)))


(cl:in-package #:clump-test)

;;; We know that the SPLAY operation preserves an in-order traversal
;;; of the tree.  Therefore, we test the SPLAY operation by the
;;; following steps:
;;;
;;;  1. Generate a random tree
;;;  2. Make an in-order traversal of that tree, saving the result
;;;  3. Select a random node of the random tree.
;;;  4. Splay the selected node.
;;;  5. Make an in-order traversal of the splayed node, saving the result.
;;;  6. Compare the two in-order traversals.

(defun in-order-traversal (tree)
  (let ((result '()))
    (clump-binary-tree:recursive-traversal
     tree
     ;; Function PRE.  Do nothing.
     (constantly t)
     ;; Function IN.
     (lambda (node)
       (push (data node) result)
       t)
     ;; Function POST.  Do nothing.
     #'identity)
    result))

Add function for testing the SPLAY operation on a single tree.

(cl:in-package #:clump-test)

;;; We know that the SPLAY operation preserves an in-order traversal
;;; of the tree.  Therefore, we test the SPLAY operation by the
;;; following steps:
;;;
;;;  1. Generate a random tree
;;;  2. Make an in-order traversal of that tree, saving the result
;;;  3. Select a random node of the random tree.
;;;  4. Splay the selected node.
;;;  5. Make an in-order traversal of the splayed node, saving the result.
;;;  6. Compare the two in-order traversals.

(defun in-order-traversal (tree)
  (let ((result '()))
    (clump-binary-tree:recursive-traversal
     tree
     ;; Function PRE.  Do nothing.
     (constantly t)
     ;; Function IN.
     (lambda (node)
       (push (data node) result)
       t)
     ;; Function POST.  Do nothing.
     #'identity)
    result))

(defun test-one-splay (tree)
  (let* ((traversal1 (in-order-traversal tree))
	 (random-node (select-random-node tree))
	 (ignore (clump-splay-tree:splay random-node))
	 (traversal2 (in-order-traversal random-node)))
    (declare (ignore ignore))
    (assert (equal traversal1 traversal2))))


(defpackage :glkit.asdf
  (:use #:cl #:asdf))

(in-package :glkit.asdf)

#+(or sbcl ccl cmucl ecl lispworks allegro)
(eval-when (:compile-toplevel :load-toplevel :execute)
  (pushnew :glkit-sv *features*))

(defsystem :glkit
  :description "Various utilities for OpenGL"
  :author ("rpav")
  :license "MIT"
  :version "0.0"

  :depends-on (:alexandria :defpackage-plus :sb-cga :mathkit
               :cl-opengl #+glkit-sv :static-vectors)
  :pathname "src"
  :serial t

  :components
  ((:file "package")
   (:file "protocol")

   (:module "shader-dict"
    :serial t
    :pathname "shader-dict"
    :components
    ((:file "shaders")
     (:file "uniforms")
     (:file "macros")))
   (:module "vao"
    :serial t
    :pathname "vao"
    :components
    ((:file "vao")))))

Exclude (and sbcl windows) from depending on static-vectors

(defpackage :glkit.asdf
  (:use #:cl #:asdf))

(in-package :glkit.asdf)

#+(or (and sbcl (not windows)) ccl cmucl ecl lispworks allegro)
(eval-when (:compile-toplevel :load-toplevel :execute)
  (pushnew :glkit-sv *features*))

(defsystem :glkit
  :description "Various utilities for OpenGL"
  :author ("rpav")
  :license "MIT"
  :version "0.0"

  :depends-on (:alexandria :defpackage-plus :sb-cga :mathkit
               :cl-opengl #+glkit-sv :static-vectors)
  :pathname "src"
  :serial t

  :components
  ((:file "package")
   (:file "protocol")

   (:module "shader-dict"
    :serial t
    :pathname "shader-dict"
    :components
    ((:file "shaders")
     (:file "uniforms")
     (:file "macros")))
   (:module "vao"
    :serial t
    :pathname "vao"
    :components
    ((:file "vao")))))


;;;; Generic conditions.

(in-package :erlangen.conditions)

(define-condition timeout (error) ()
  (:documentation
   "*Description:*

    Describes an error condition that can occur when using functions with
    a timeout. It denotes a that the operations was unable to
    successfully complete within a given duration."))

Fix typo in docstring of TIMEOUT.

;;;; Generic conditions.

(in-package :erlangen.conditions)

(define-condition timeout (error) ()
  (:documentation
   "*Description:*

    Describes an error condition that can occur when using functions with
    a timeout. It denotes a that the operation was unable to
    successfully complete within a given duration."))


(defpackage :fu-er-com
  (:use :cl :hunchentoot :cl-who :parenscript)
  (:export :start-server :stop-server))
(in-package :fu-er-com)

(defparameter *server* nil)

(defun stop-server ()
  (when *server*
    (stop *server*)
    (setq *server* nil)))

(defun start-server ()
  (stop-server)
  (start (make-instance 'easy-acceptor :address "localhost" :port 8080)))

; Allow cl-who and parenscript to work together
(setf *js-string-delimiter* #\")

(define-easy-handler (main-page :uri "/") ()
  (with-html-output-to-string (*standard-output* nil :prologue t)
    (:html
     (:head
      (:title "Fu-Er's Site"))
     (:body
       ))))

Add in the html foundation

(defpackage :fu-er-com
  (:use :cl :hunchentoot :cl-who :parenscript)
  (:export :start-server :stop-server))
(in-package :fu-er-com)

(defparameter *server* nil)

(defun stop-server ()
  (when *server*
    (stop *server*)
    (setq *server* nil)))

(defun start-server ()
  (stop-server)
  (start (make-instance 'easy-acceptor :address "localhost" :port 8080)))

; Allow cl-who and parenscript to work together
(setf *js-string-delimiter* #\")

(define-easy-handler (main-page :uri "/") ()
  (with-html-output-to-string (*standard-output* nil :prologue t)
    (:html
     (:head
      (:title "Fu-Er's Site")
      (:link :rel "stylesheet" :href "/main.css" :type "text/css"))
     (:body
      (:div :id "container"
            (:div :id "sidebar" "sidebar"
                  (:div :id "sidebar-bottom" "sidebar bottom"))
            (:div :id "main" "main"))))))


(defun cal (file)
   (handler-bind
     ;; automatically choose 'smash existing class' when loading
     ((t (lambda (c)
           (let ((restart (find-restart 'continue)))
             (when restart (invoke-restart restart))))))
    (sys.int::cal file)))

(cal "home/med/package.lisp")
(cal "home/med/line.lisp")
(cal "home/med/mark.lisp")
(cal "home/med/editor.lisp")
(cal "home/med/buffer.lisp")
(cal "home/med/point.lisp")
(cal "home/med/minibuffer.lisp")
(cal "home/med/redisplay.lisp")
(cal "home/med/commands.lisp")
(cal "home/med/keybindings.lisp")
(cal "home/med/main.lisp")

Update cal to directly invoke the continue restart.

(defun cal (file)
   (handler-bind
     ;; automatically choose 'smash existing class' when loading
     ((t (lambda (c)
           (invoke-restart 'continue))))
    (sys.int::cal file)))

(cal "home/med/package.lisp")
(cal "home/med/line.lisp")
(cal "home/med/mark.lisp")
(cal "home/med/editor.lisp")
(cal "home/med/buffer.lisp")
(cal "home/med/point.lisp")
(cal "home/med/minibuffer.lisp")
(cal "home/med/redisplay.lisp")
(cal "home/med/commands.lisp")
(cal "home/med/keybindings.lisp")
(cal "home/med/main.lisp")

(defun make ()
   (cal "home/med/all.lisp"))


(cl:in-package #:common-lisp-user)

(asdf:defsystem :cleavir-reaching-definitions
  :depends-on (:cleavir-utilities)
  :components
  ((:file "packages")
   (:file "reaching-definitions" :depends-on ("packages"))))

Define ASDF system in package ASDF-USER.

(cl:in-package #:asdf-user)

(defsystem :cleavir-reaching-definitions
  :depends-on (:cleavir-utilities)
  :components
  ((:file "packages")
   (:file "reaching-definitions" :depends-on ("packages"))))


(cl:in-package #:clump-binary-tree)

(defgeneric replace-child (node old-child new-child))

(defmethod replace-child ((node null) (old-child node) new-child)
  new-child)

Add method on REPLACE-CHILD specialized to NODE.

(cl:in-package #:clump-binary-tree)

(defgeneric replace-child (node old-child new-child))

(defmethod replace-child ((node null) (old-child node) new-child)
  new-child)

(defmethod replace-child ((node node) (old-child node) new-child)
  (cond ((eq old-child (left node))
	 (setf (left node) new-child))
	((eq old-child (right node))
	 (setf (right node) new-child))
	(t
	 (error 'must-be-child
		:tree node
		:child old-child))))


;;;; turtle-geometry.asd

(asdf:defsystem #:turtle-geometry
  :description "Describe turtle-geometry here"
  :author "Name <your@email.com>"
  :license "Licenceless Rider"
  :depends-on (#:err)
  :serial t
  :pathname "src/"
  :components ((:file "package")
               (:file "globals")
               (:file "utils")
               (:file "turtle")
               (:file "line-drawer")
               (:file "turtle-drawer")
               (:file "turtle-geometry")
               (:file "main")))

(asdf:defsystem #:turtle-geometry.tests
  :description "Describe turtle-geometry.tests here"
  :author "Name <your@email.com>"
  :license "Licenceless Rider"
  :depends-on (#:err
               #:turtle-geometry
               #:simple-testing)
  :serial t
  :pathname "t/"
  :components ((:file "package")
               (:file "tests")))

(defmethod asdf:perform ((op asdf:test-op)
                         (system (eql (asdf:find-system :turtle-geometry))))
  (format t "~2&*************~@
                ** Loading **~@
                *************~%")
  (asdf:oos 'asdf:load-op :turtle-geometry.tests)
  (asdf:oos 'asdf:test-op :turtle-geometry.tests))

Add new file to asdf description.

;;;; turtle-geometry.asd

(asdf:defsystem #:turtle-geometry
  :description "Describe turtle-geometry here"
  :author "Name <your@email.com>"
  :license "Licenceless Rider"
  :depends-on (#:err)
  :serial t
  :pathname "src/"
  :components ((:file "package")
               (:file "globals")
               (:file "utils")
               (:file "turtle")
               (:file "line-drawer")
               (:file "turtle-drawer")
               (:file "turtle-geometry")
               (:file "shapes")
               (:file "main")))

(asdf:defsystem #:turtle-geometry.tests
  :description "Describe turtle-geometry.tests here"
  :author "Name <your@email.com>"
  :license "Licenceless Rider"
  :depends-on (#:err
               #:turtle-geometry
               #:simple-testing)
  :serial t
  :pathname "t/"
  :components ((:file "package")
               (:file "tests")))

(defmethod asdf:perform ((op asdf:test-op)
                         (system (eql (asdf:find-system :turtle-geometry))))
  (format t "~2&*************~@
                ** Loading **~@
                *************~%")
  (asdf:oos 'asdf:load-op :turtle-geometry.tests)
  (asdf:oos 'asdf:test-op :turtle-geometry.tests))


;;;; $Id$
;;;; $URL$

;;;; See the LICENSE file for licensing information.

#+lispworks (cl:require "comm")

(cl:eval-when (:execute :load-toplevel :compile-toplevel)
  (cl:defpackage :usocket
      (:use :cl)
    (:export #:*wildcard-host*
             #:*auto-port*

             #:socket-connect ; socket constructors and methods
             #:socket-listen
             #:socket-accept
             #:socket-close
             #:wait-for-input
             #:get-local-address
             #:get-peer-address
             #:get-local-port
             #:get-peer-port
             #:get-local-name
             #:get-peer-name

             #:with-connected-socket ; convenience macros
             #:with-server-socket
             #:with-client-socket
             #:with-socket-listener

             #:usocket ; socket object and accessors
             #:stream-usocket
             #:stream-server-usocket
             #:socket
             #:socket-stream

             #:host-byte-order ; IP(v4) utility functions
             #:hbo-to-dotted-quad
             #:hbo-to-vector-quad
             #:vector-quad-to-dotted-quad
             #:dotted-quad-to-vector-quad
             #:ip=
             #:ip/=

             #:socket-condition ; conditions
             #:socket-error ; errors
             #:unknown-condition
             #:unknown-error)))

Add missing symbols to the export list.

;;;; $Id$
;;;; $URL$

;;;; See the LICENSE file for licensing information.

#+lispworks (cl:require "comm")

(cl:eval-when (:execute :load-toplevel :compile-toplevel)
  (cl:defpackage :usocket
      (:use :cl)
    (:export #:*wildcard-host*
             #:*auto-port*

             #:socket-connect ; socket constructors and methods
             #:socket-listen
             #:socket-accept
             #:socket-close
             #:wait-for-input
             #:get-local-address
             #:get-peer-address
             #:get-local-port
             #:get-peer-port
             #:get-local-name
             #:get-peer-name

             #:with-connected-socket ; convenience macros
             #:with-server-socket
             #:with-client-socket
             #:with-socket-listener

             #:usocket ; socket object and accessors
             #:stream-usocket
             #:stream-server-usocket
             #:socket
             #:socket-stream

             #:host-byte-order ; IP(v4) utility functions
             #:hbo-to-dotted-quad
             #:hbo-to-vector-quad
             #:vector-quad-to-dotted-quad
             #:dotted-quad-to-vector-quad
             #:ip=
             #:ip/=

             #:socket-condition ; conditions
             #:ns-condition
             #:socket-error ; errors
             #:ns-error
             #:unknown-condition
             #:ns-unknown-condition
             #:unknown-error
             #:ns-unknown-error)))


; tré – Copyright (c) 2010–2014,2016 Sven Michael Klose <pixel@copei.de>

(defun path-append (dir &rest path-components)
  (@ (x path-components dir)
    (= dir (+ (trim-tail dir "/") "/" (trim x "/")))))

Deal with NIL to add.

; tré – Copyright (c) 2010–2014,2016 Sven Michael Klose <pixel@copei.de>

(defun path-append (dir &rest path-components)
  (@ (x (remove-if #'not path-components) dir)
    (= dir (+ (trim-tail dir "/") "/" (trim x "/")))))