;; Sample Lisp code, used as a test for clisp-indent.el
;; Contains at least one sample form for every special form or macro.
;; The list is sorted by exporting package.

(and (cond1) (cond2)
     (cond3)
     (cond4))

(and
  (cond1) (cond2)
  (cond3)
  (cond4))

(appease-cerrors
   (form1)
   (form2))

(assert (form1)
  "error")

(block nil
  (form1)
  (form2))

(block
    nil
  (form1)
  (form2))

(case foo
  ((T)
    (form1)
    (form2)))

(catch 'foo
  (form1)
  (form2))

(ccase foo
  ((T)
    (form1)
    (form2)))

(check-type x integer
  "error")

(compiler-let
    ((*load-pathname* nil))
  (form1))

(cond
  ((cond1)
    (form1)
    (form2)
    (form3)))

(cond ((cond1)
        (form1)
        (form2)
        (form3)))

(ctypecase x
  (integer
    (isqrt x)))

(decf
  (aref a i)
  (aref b i))

(declaim
  (optimize (safety 3)
            (speed 1)))

(declare
  (integer x))

(defclass fundamental-stream
          (stream clos:standard-object
           t)
  (($open :type boolean :initform t) ; whether the stream is open
   ($reval :type boolean :initform nil)) ; whether read-eval is allowed
  (:metaclass standard-class))

(defconstant pi
  3.14
  "Archimedes")

(defgeneric foobar (x y)
  "foo goes bar")

(define-condition arithmetic-error (error)
  (($operation :initarg :operation :reader arithmetic-error-operation)
   ($operands  :initarg :operands  :reader arithmetic-error-operands)))

(define-modify-macro decf (x)
  -
  "decrement")

(define-modify-macro incf (x) +
  "increment")

(define-setf-expander subseq (seq start end)
  (compute-expansion))

(define-setf-method subseq (seq start end)
  (compute-expansion))

(define-symbol-macro *ansi*
  (get-ansi))

(definternational date-format
  (t ENGLISH))

(deflanguage ENGLISH)

(deflocalized date-format ENGLISH
  "~1{~5@*~D-~4@*~2,'0D-~3@*~2,'0D ~2@*~2,'0D:~1@*~2,'0D:~0@*~2,'0D~:}")

(defmacro incf (place &optional (delta '1))
  `(setf ,place (+ ,place ,delta)))

(defmethod foo ((x integer)
                y
                (z t))
  (bar x y z))

(defpackage #:regexp
  (:nicknames #:re)
  (:documentation
   "POSIX Regular Expressions - matching, compiling, executing.")
  (:use #:lisp #:ffi)
  (:export #:match #:match-start #:match-end #:match-string #:regexp-quote
           #:regexp-compile #:regexp-exec #:regexp-split #:with-loop-split))

(defparameter pi
  3.14
  "Archimedes")

(defsetf nth SYSTEM::%SETNTH
  "set nth element")

(defsetf aref (array &rest indices) (value)
  `(SYSTEM::STORE ,array ,@indices ,value))

(defsetf aref (array &rest indices)
              (value)
  `(SYSTEM::STORE ,array ,@indices ,value))

(defstruct (control-string-directive
             (:copier nil)
             (:conc-name "CSD-")
             (:predicate nil)
             (:constructor make-csd ()))
  (type         0 :type fixnum)
  (cs-index     0 :type fixnum)
  (parm-list    nil :type list)
  (v-or-#-p     nil :type symbol)
  (colon-p      nil :type symbol)
  (atsign-p     nil :type symbol)
  (data         nil)
  (clause-chain nil))

(deftype designator (thing)
  (cond ((symbolp thing)
         ...)))

(defun foo
       (&optional x
        &key y)
  (list foo x y))

(defvar pi
  3.14
  "Archimedes")

(destructuring-bind (&optional x
                     &rest y)
    (foobar)
  (form1)
  (form2))

(deutsch
  "Beispiel"
 english
  "Sample")

(do ((x 1 (1+ x))
     (y (init-y)
        (inc y)))
    ((endp l))
  (form1))

(do* ((x 1 (1+ x))
      (y (init-y)
         (inc y)))
     ((endp l))
  (form1))

(do-all-symbols (s (find-package "NAME")
                 nil)
  (foobar))

(do-external-symbols (s (find-package "NAME")
                      nil)
  (foobar))

(do-symbols (s)
  (foobar))

(dohash (key val)
    (get-hash-table)
  (form1)
  (form2))

(dolist (x
         (list)
         nil)
  (form1))

(doseq (x
        (list)
        nil)
  (form1))

(dotimes (x
          (count)
          nil)
  (form1))

(do-something-interesting
    (iterating this object)
  (executing this code))

(ecase foo
  ((T)
    (form1)
    (form2)))

(english
  "Sample"
 deutsch
  "Beispiel")

(etypecase (form1)
  (integer
    (form2) (form3)
    (form3)))

(eval-when
    (compile)
  (do-something))

(exit-on-error
  (form1))

(flet ((mark-used
           (blockname
            &optional x
            &key y)
         (setf (get blockname 'used) t)
         (do ((L1 *format-uwps* (cdr L1))
              (L2 (get blockname 'uwps)))
             ((eq L1 L2))
           (setf (car L1) 'T))
         blockname))
  (mark-used nil))

(formatter
  "error: ~S")

(francais
  "exemple"
 english
  "Sample"
 deutsch
  "Beispiel")

(function
  random)

(function (lambda (x y)
            (+ x y)))

(function
  (lambda (x y)
    (+ x y)))

(function plus (lambda (x y)
                 (+ x y)))

(function plus
          (lambda (x y)
            (+ x y)))

(function
  plus
  (lambda (x y)
    (+ x y)))

(generic-flet
    ((dump (x)
       (:method ((x character))
         (format t "~C" x))
       (:method ((x integer))
         (format t "~D" x))))
  (dump obj))

(generic-function (x)
  (:method ((x character))
    (format t "~C" x))
  (:method ((x integer))
    (format t "~D" x)))

(generic-labels ((fib (x)
                   (:method ((x (eql 0)))
                     0)
                   (:method ((x (eql 1)))
                     1)
                   (:method ((x integer))
                     (if (minusp x)
                       (- (fib (+ x 2)) (fib (+ x 1)))
                       (+ (fib (- x 2)) (fib (- x 1)))))))
  (fib n))

(go
  nil)

(handler-bind
  ((simple-error
    #'(lambda (c) (throw 'exit (values nil c))))
   (error
    #'(lambda (c) (throw 'exit (values nil c)))))
  (form1))

(handler-case
  (push-object (part-ref object index) index)
  (part-ref-error ()
    (format t "~D does not refer to a selectable part." index))
  (:no-error (&optional x
              &key y)
    (f x y)))

(if (minusp x)
  (- (fib (+ x 2)) (fib (+ x 1)))
  (+ (fib (- x 2)) (fib (- x 1))))

(ignore-errors
  (/ x y))

(in-package "FOO"
            :use '("BAR"))

(in-package
  "FOO"
  :use '("BAR"))

(incf
  (aref a i)
  (aref b i))

(labels ((mark-used
             (blockname
              &optional x
              &key y)
           (setf (get blockname 'used) t)
           (do ((L1 *format-uwps* (cdr L1))
                (L2 (get blockname 'uwps)))
               ((eq L1 L2))
             (setf (car L1) 'T))
           blockname))
  (mark-used nil))

(lambda (x y)
  (+ x y))

(let ((x (i-x))
      (y
        (long-init-y)))
  (foobar))

(let* ((x (i-x))
       (y
         (long-init-y)))
  (foobar))


(load-time-value
  (foo)
  t)

(locally
  (declare (compile))
  (foo))

(loop
  (incf x)
  (return))

(loop-finish)

(macrolet ((Monat->Jahrtag (Monat) ; 0 <= Monat < 12, 0=März,...,11=Februar
             `(svref '#(0 31 61 92 122 153 184 214 245 275 306 337) ,Monat)))
  (form1))

(muffle-cerrors
  (form1))

(multiple-value-bind (x y)
    (floor a b)
  (values y x))

(multiple-value-call #'%expand-cons (rest form)
  (second form) nil
  (%expand-list (cddr form)))

(multiple-value-list
  (floor a b))

(multiple-value-prog1
    (floor a b)
  (foobar))

(multiple-value-setq
    (SM1 SM2 SM3 SM4 SM5)
  (get-setf-method (car form)))

(nth-value 1
  (floor a b))

(or (cond1) (cond2)
    (cond3)
    (cond4))

(or
  (cond1) (cond2)
  (cond3)
  (cond4))

(pop
  (form1))

(print-unreadable-object (class stream :type t)
  (write (class-classname class) :stream stream))

(prog (a b
       c d)
  retry
  (multiple-value-setq (c d)
    (floor a b))
  (if (zerop d)
    (return))
  (go retry))

(prog* (a b
        c d)
  retry
  (multiple-value-setq (c d)
    (floor a b))
  (if (zerop d)
    (return))
  (go retry))

(prog1
  (form1)
  (form2))

(prog2
  (form1)
  (form2)
  (form3))

(progn (form1)
       (form2))

(progn
  (form1)
  (form2))

(progv
    (vars)
    (vals)
  (form1)
  (form2))

(progv (vars) (vals)
  (form1)
  (form2))

(psetf a (get-a)
       b (get-b))

(psetf a
         (get-a)
       b
         (get-b))

(psetq a (get-a)
       b (get-b))

(psetq a
         (get-a)
       b
         (get-b))

(push (form1)
      (form2))

(push
  (form1)
  (form2))

(pushnew (form1)
         (form2))

(pushnew
  (form1)
  (form2))

(quote
  #(a b c))

(remf 'x
  'y)

(restart-bind ((nil *fun1*
                    :interactive-function *fun2*
                    :report-function *fun3*
                    :test-function *fun4*))
  (form1)
  (form2))

(restart-bind
    ((nil *fun1*
          :interactive-function *fun2*
          :report-function *fun3*
          :test-function *fun4*))
  (form1)
  (form2))

(restart-case
    (invoke-debugger condition)
  (continue (&optional x
             &aux y)
    (form1)
    (form2)))

(return
  (form1))

(return-from
  nil
  (form1))

(rotatef (aref x i)
         (aref y i))

(rotatef
  (aref x i)
  (aref y i))

(setf a (get-a)
      b (get-b))

(setf a
        (get-a)
      b
        (get-b))

(setq a (get-a)
      b (get-b))

(setq a
        (get-a)
      b
        (get-b))

(shiftf (aref x i)
        (aref y i)
        (aref z i))

(shiftf
  (aref x i)
  (aref y i)
  (aref z i))

(space
  (form1))

(step
  (form1))

(symbol-macrolet
    ((x (slot-value obj 'x))
     (y
       (slot-value obj 'y)))
  (form1))

(symbol-macrolet ((x (slot-value obj 'x))
                  (y
                    (slot-value obj 'y)))
  (form1))

(tagbody
  retry
  (multiple-value-setq (c d)
    (floor a b))
  (if (zerop d)
    (return))
  (go retry))

(the integer
  (form1))

(the-environment)

(throw
    'exit
  (form1))

(time
  (form1))

(trace foo
       bar)

(trace
  foo
  bar)

(typecase (form1)
  (integer
    (form2) (form3)
    (form3)))

(unless
    (cond1)
  (form1)
  (form2))

(untrace foo
         bar)

(untrace
  foo
  bar)

(unwind-protect
  (foo)
  (close s))

(when
    (cond1)
  (form1)
  (form2))

(with-accessors ((x1 thing-x) (y1 thing-y)
                 (z1 thing-z))
    thing1
  (form1))

(with-condition-restarts
    (conds)
    (restarts)
  (form1))

(with-hash-table-iterator
    (name table)
  (form1))

(with-hash-table-iterator (name table)
  (form1))

(with-input-from-string
    (x s :start 3)
  (form1))

(with-keyboard
  (form1))

(with-open-file (s "foobar"
                 :direction :input)
  (form1))

(with-open-stream (s stream)
  (form1))

(with-output-to-printer (s
                         :external-format charset:iso-8859-1)
  (form1))

(with-output-to-string (s str
                        :element-type 'character)
  (form1))

(with-package-iterator (name pack)
  (form1))

(with-restarts
    ((continue (&optional x
                &aux y)
       (form1)
       (form2)))
  (invoke-debugger condition))

(with-simple-restart
    (x error
     "error")
  (form1))

(with-slots ((x1 x) (y1 y)
             (z1 z))
    thing1
  (form1))

(with-standard-io-syntax
  (form1))

(without-floating-point-underflow
    (expt 10 x))

(with-some-new-context (binding
                        this variable)
  (execute)
  (this)
  (code))

;; Package SYSTEM
constant-eql
defformat-simple
ds-slot-default
ds-slot-initer
ds-slot-offset
ds-slot-readonly
ds-slot-type
formatter-bind-args
formatter-bind-terminator
formatter-bind-terminators
macro-expander
memq
multiple-value-setf
spd

;; Package FFI

bitsizeof
c-lines
cast

(def-c-enum perseverance
  persev_full
  persev_partial
  persev_immediate
  persev_bonus)

(def-c-struct flock
  (l_type short)
  (l_whence short)
  (l_start off_t)
  (l_len off_t)
  (l_pid pid_t))

(def-c-type FILE
  c-pointer)

(def-c-var signgam
  (:type int))

(def-c-const EPERM
  (:documentation "Operation not permitted"))

(def-call-in write-string-to-libsvm-output (:arguments (s c-string))
  (:name "libsvm_print_string")
  (:return-type nil))

(def-call-out fd-read
    (:arguments (fd int) (buf (c-ptr (c-array-max char 4096)) :out :alloca)
                (nbytes size_t) (persev perseverance))
  (:return-type ssize_t) (:name "fd_read"))

deref
element
sizeof
slot
typeof

;; Package SCREEN

with-window
