g000001

(defn
  #^{:doc "P11 (*) Modified run-length encoding."
     :test (do (test= (encode-modified '(a a a a b c c a a d e e e e))
                       '((4 a) b (2 c) (2 a) d (4 e)))
               (test= (encode-modified []) [])
               (test= (encode-modified [1]) [1]))}
; ---------------
  encode-modified
; ---------------
  ([coll]

g000001

;;; 同じディレクトリ内で先頭3文字が一致するファイルを友達とみなし、順番に開いたりするもの
;;;

(require 'cl)

(defun get-friend-files ()
  "ファイル名の先頭3文字が合致しているファイルは友達"
  (let ((list (file-name-all-completions (substring (buffer-name) 0 3) "./"))
        (file-name-list '()))
    ;; 自分自身は必ずみつかるので、listの内容が2つ以上なら友達をソートして返す。

g000001

(progn
  (defun gcode-lookup ()
    "カーソル位置のシンボルをGoogle Codeで検索(lisp決め打ち)"
    (interactive)
    (browse-url
     (format "http://www.google.com/codesearch?q=%s+lang:%s+file:\\.%s$&hl=ja&num=20" 
             (thing-at-point 'symbol) "lisp" "lisp")))
  
  (define-key slime-mode-map [(control ?c) (control ?d) ?g] 'gcode-lookup))

g000001

;; 未完成
(define mapleave #f)
(define mapret #f)
(define mapstop #f)

(define (mapf finalf loopf . lists)
  (let/cc leave
    (set! mapleave leave)
    (let ((acc () )
          (stop? #t)

g000001

(defmacro message-to-poland (obj &optional (mesg nil mesg-sup?) &rest arg)
  (cond (arg `(,mesg ,obj (message-to-poland ,@arg)))
        (mesg-sup? `(,mesg ,obj))
        ('T `,obj)))


(set-macro-character #\[ (lambda (stream char)
                           (declare (ignore char))
                           `(message-to-poland ,@(read-delimited-list #\] stream 'T))))

g000001

(require :contextl)

(defpackage :8oclock (:use :cl :contextl))
(in-package :8oclock)

(defclass announce () 
  ((date :initarg :date :accessor date :type string)
   (mesg :initarg :mesg :accessor mesg)
   (footer :initarg :footer :accessor footer)
   (times :initarg :times :accessor times)

g000001

(require :sb-bsd-sockets)
(require :cl-ppcre)

(defpackage :dnsbl 
  (:use :cl)
  (:export :spam-champuru-p))

(in-package :dnsbl)

(defconstant +champuru-server+ "dnsbl.spam-champuru.livedoor.com")

g000001

;;  5:37am Tuesday,28 October 2008
(defpackage :goo (:use :cl :compat-utils))

(in-package :goo)

(defmacro op (fn &rest args)
  `(lambda (_) (,fn ,@args)))

(defalias d. cl:defconstant)
(defalias dv cl:defvar)

g000001

(defun urand-list (n &optional (byte 8))
  (with-open-file (in "/dev/urandom" :element-type `(unsigned-byte ,byte))
    (loop :repeat n :collect (read-byte in nil nil))))

(urand-list 3 256)

;=> (60911427192963316011544747287595784556349539712748006065011672149122741877820
;    75457469479310454168834878462254762462403698881818960517980139665538208344748
;    108658200307104181631682704758907704792362235556132495755053705541055592739152)

g000001

(progn
  (defun amop-lookup ()
    (interactive)
    (browse-url
     (format "http://www.lisp.org/mop/dictionary.html#%s"
             (let* ((name (thing-at-point 'symbol))
                    (pos (position ?: name)))
               (if pos
                   (subseq name (1+ pos))
                   name)))))