g000001

;; quicklisp/dists/quicklisp/software/clsql-20140713-git/uffi/clsql-uffi.lisp


#-windows
(uffi:def-function ("strtoull" c-strtoull)
    ((str (* :unsigned-char))
     (endptr (* :unsigned-char))
     (radix :int))
  ;; :returning :unsigned-long-long
  :returning :unsigned-long)

g000001

;; Common Lispで挿入順序を保つgetがO(1)なデータ構造: :fill-pointer :adjustable なベクタ

(let ((v (make-array 0 :adjustable T :fill-pointer 0))
      (pos 0))
  (setq pos (vector-push-extend 'foo v))
  (setq pos (vector-push-extend 'foo v))
  (setq pos (vector-push-extend 'foo v))
  (setq pos (vector-push-extend 'top v))
  (list (elt v pos) v))
;=>  (TOP #(FOO FOO FOO TOP))

g000001

(defvar *freelist* '() "A List of free cons cells")


(defun allocate-list (n)
  (if (not (plusp n))
      nil
      (let* ((result (or *freelist* (cons nil nil)))
             (last-cons result))
        (dotimes (i (1- n))
          (if (null (cdr last-cons))

g000001

;;; Common  Lisp 
(multiple-value-bind (s m. h d m y) (get-decoded-time)
  (declare (ignore s m. h d))
  (labels ((ymd->ut (y m d) (encode-universal-time 0 0 0 d m y))
           (pad () (1+ (nth-value 6
                         (decode-universal-time (ymd->ut y m 1))))))
    (let ((nm (ymd->ut y (1+ m) 1)))
      (format t "~&~{~7@{~:[~3@T~;~:*~3D~]~}~%~}"
              `(,@(make-list (pad))
                ,@(loop :for d :from 1 :to 31

g000001

;;; teepeedee2-20140713-git/src/io/posix-socket.lisp
(defmethod socket-accept ((fd integer))
  (cffi:with-foreign-object (sa 'sockaddr_in)
    (cffi:with-foreign-object (len :int)
      (setf (cffi:mem-aref len :int) (cffi:foreign-type-size '(:pointer (:struct sockaddr_in))))
      (let ((s
             (socket-io-syscall
              #. (progn
                   (if (accept4-supported)
                    `(syscall-accept4 fd sa len

g000001

;;; 2.3.1.1 the entity database

(defvar *entity-table* (make-hash-table :test #'equalp))


(defun add-entity (name entity)
  (pushnew entity (gethash name *entity-table*) :test #'eq))

g000001

(defvar *iota-n* 0)


(define-key global-map [C-M-mouse-4]
  (defun iota-insert-reset ()
    (interactive)
    (setq *iota-n* 0)))


(define-key global-map [C-M-mouse-5]

g000001

(defun global-ignore-key (key)
  (define-key global-map key #'ignore))

(progn
  (and (featurep 'mwheel)
       (unload-feature 'mwheel))
  ;; (unload-feature 'x-win)
  ;; (unload-feature 'scroll-bar)
  ;; (unload-feature 'mouse)
  ;; (setq mouse-avoidance-mode 'banish)

g000001

(defclass molito ()
  ((x :initarg :x :initform 0 :accessor molito.x)
   (y :initarg :y :initform 0 :accessor molito.y)))


(make-instance 'molito :x 42 :y 84)
;=>  #<MOLITO {10194190A3}>


(defmethod print-object ((object molito) stream)

g000001

(defmethod print-object ((object event) stream)
  (with-slots (starting-time location duration) object
     (format stream "#<~:(~A~) at " (class-name (class-of object)))
     (write-date-and-time starting-time stream
                          :timezone (location-time-zone location))
     (when (> duration 0)
       (write-string " for " stream)
       (write-time-interval duration stream nil))
     (write-char #\> stream)))