kurohuku

(defmacro yielding (&body body)
  (let ((gtail (gensym))
	(ghead (gensym))
	(garg (gensym))
	(gtmp (gensym)))
    `(let* ((,ghead (cons nil nil))
	    (,gtail ,ghead))
       (macrolet
	   ((yield (,garg) `(setf (cdr ,',gtail) (cons ,,garg nil)
				  ,',gtail (cdr ,',gtail)))

kurohuku

(require 'cl)

(defvar mode-specified-try-functions-table (make-hash-table))

(defun set-mode-specified-try-functions (mode functions)
  (setf (gethash mode mode-specified-try-functions-table)
	functions))
(defun set-default-try-functions (functions)
  (setf (gethash :default mode-specified-try-functions-table)

kurohuku

(eval-when (:load-toplevel :execute)
  (require :asdf)
  (require :asdf-install)
  (require :sb-md5)
  (require :sb-rotate-byte)
  (require :sb-posix)
  ;; (require :sb-cover)
  (require :sb-rt)
  (require :sb-simple-streams)
  (require :sb-bsd-sockets)

kurohuku

;;; CommonQtの関数を再定義する。
;;; CommonQtはquicklisp経由で入れた commonqt-20110110-git
;;; Qtのバージョンは4.7.1
;;; (#_property obj prop-name) 時、prop-nameに大文字が入っていると
;;; 何故か""が返るので、string-downcaseを追加した。
;;; #_property で返る値がqobjectクラスでない場合があるので、
;;; typecaseを追加して、#_propertyの戻り値がqobjectの時だけ
;;; #_toStringや#_toIntを呼び出すようにした。

(in-package :qt)

kurohuku

(defmacro case+ (form test &body clauses)
  (let ((gtest (gensym))
	(gform (gensym)))
    (labels
	((clause->or (clause)
	   (if (listp (car clause))
	       `((or
		  ,@(mapcar
		     #'(lambda (x)
			 `(funcall ,gtest ,gform ,x))

kurohuku

;;;; SRFI-42 Eager Comprehensions ( 先行評価的内包表記 ) in Common Lisp
(defpackage srfi-42
  (:use :cl)
  (:export ))

(in-package :srfi-42)


;;; Qualifiers

kurohuku

(in-package :asdf-install)
(defun make-ssl-stream (sock-stream)
  (let ((pkg (find-package 'CL+SSL)))
    (when pkg
      (funcall (find-symbol "MAKE-SSL-CLIENT-STREAM" pkg)
               sock-stream))))

(defun ssl-library-loaded? ()
  (find-package 'CL+SSL))

kurohuku

(require 'cl)

;;; syntax-table
(defvar shorthand-syntax-table
  (make-syntax-table))

(defmacro with-shorthand-syntax (&rest body)
  `(with-syntax-table shorthand-syntax-table
     ,@body))
(defmacro sh:syntax (&rest body)

kurohuku

(defmacro define-insertion-template (name template)
  (destructuring-bind (vars fmt)
      (parse-template template)
    (let* ((syms (mapcar 
		  (lambda (v)
		    `(,v ,(gensym)))
		  (remove-duplicates vars))))
      `(defun ,name ()
	 (interactive)
	 (let ,(mapcar 'second syms) 

kurohuku

(defclass template ()
  ((template :initarg :template :initform (error "template string is required"))
   (template-format-string)
   (dollar-symbols)))

(defun parse-template-string (str)
  (let (strs syms)
    (with-input-from-string (s str)
      (loop :named loop
	 :for ch = (read-char s nil nil)