gistfile1.el

(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)
   (theme :initarg :theme :accessor theme)))

;; layers
;; +---------------+
;; | root          |
;; +--------+------+
;; | hatena | mail |
;; +--------|------|
;; |        | mixi |
;; +---------------+

(deflayer hatena)
(deflayer mail)
(deflayer mixi (mail))

(defun fill-line (string fill)
  (with-input-from-string (in string)
    (with-output-to-string (out)
      (loop :for line := (read-line in nil nil) :while line
            :do (loop :with cnt := 0
                      :for c :across line 
                      :do (princ c out) 
                          (incf cnt (if (standard-char-p c) 1 2))
                      :when (> cnt fill) 
                        :do (princ #\Newline out) (setq cnt 0))
                (princ #\Newline out)))))

(define-layered-function make-announcement (data stream)
  (:documentation "ブログ、mixi、ML用メールでの告知を作成する"))

(define-layered-method make-announcement (data stream)
  (format stream
          "~A~%~
~A~%~
~A~%~%~
~A~%"
          (make-title data)
          (make-mesg data)
          (make-table data)
          (make-footer data)))

;; 基本
(define-layered-function make-title (data)
  (:documentation "タイトルの作成"))

(define-layered-method make-title (data)
  (format nil
          "[勉強会]~A 第~A回 慢性的CL勉強会@Lingr8時だョ!全員集合告知"
          (date data) (times data)))

(define-layered-function make-table (data)
  (:documentation "時間割等の表を作成"))
(define-layered-method make-table (data))

(define-layered-function make-mesg (data))
(define-layered-method make-mesg (data)
  (mesg data))

(define-layered-function make-footer (data))
(define-layered-method make-footer (data)
  (footer data))

;; hatena
(define-layered-method make-table :in hatena (data)
  (format nil
          "|場所:|[http://www.lingr.com/room/common-lisp-jp:title=Lingr: Common Lisp部屋]|
|日時|~A (土) 20:00から適当(途中参加/離脱/ROM歓迎)|
|勉強会の目標|CLに関して一つ位賢くなった気になること|

|時刻|お題|対象者|参考リンク|
|20:00-21:00位まで|~A|CLで色々書く(書きたい)方|-|"
          (date data)
          (theme data)))

(define-layered-method make-footer :in  hatena (data)
  "勉強会のネタがあれば、このブログにコメント頂くか、Lingr等に書き置きしてみて下さい。好きなテーマを持ち込んでみて頂くというのも大歓迎です!
-[http://www.lingr.com/room/common-lisp-jp:title=Lingr: Common Lisp部屋]
■")

;; mail
(define-layered-method make-table :in mail (data)
  (format nil
          "~
場所: Common Lisp部屋(http://www.lingr.com/room/common-lisp-jp)
日時: ~A (土) 20:00から適当(途中参加/離脱/ROM歓迎)
勉強会の目標: CLに関して一つ位賢くなった気になること
お題: ~A"
          (date data)
          (theme data)))

(define-layered-method make-mesg :in mail (data)
  (FILL-LINE 
   (format nil "こんにちは、g000001です。
~A日にLingrを使ってのオンライン勉強会第~A回目を開催しますので、お気軽にご参加頂けたらと思います。

~A" 
           (date data) 
           (times data)
           (mesg data))
   60))

(define-layered-method make-footer :in mail :around (data)
  (fill-line (call-next-method) 60))

;; mixi
(define-layered-method make-title :in mixi (data) 
  (format nil "~A 20:00 CLオンライン勉強会" (date data)))

;; 具現化
(progn
  (defparameter *22th* 
    (make-instance 'announce
                   :date "11/1"
                   :times 22
                   :mesg "今回は、趣向を変えまして、井戸端会議的な感じで開催してみたいと思います。
内容は、2部構成で、
 (1) CL家族会議
名前からすると何だか良く分かりませんが、毎週CLの活動を報告しあうことによってなんらかしらCL的行動が活性化しないかというものです。
 ひとりずつ順番に
[1]今週のCL的活動を報告(書いたコード/勉強してる内容とか) 
[2]疑問に思ったことを報告 
[3]やってみたいことを相談
みたいな感じで報告しあったら何か面白いんじゃないのかしら、という企画です。
 (2) どう書くorgを眺める
どう書くorgにも100を越えるCLのコードが蓄積されています。これらのコードを先頭からレビューしたりして眺めつつ勉強というのはどうかなという企画です。
解答されていない問題に挑戦してみるのもありかなと思いますが、簡単でないので解答されてないことが多いので時間的にちょっと厳しいんじゃないかなと思います。"
                   :theme "(1)CL家族会議 (2)どう書くorg/CL部門を眺める"
                   :footer "勉強会のネタがあれば、Lingr等に書き置きしてみて下さい。好きなテーマを持ち込んでみて頂くというのも大歓迎です!
■"))
  
  (with-open-file (out "/tmp/hatena.txt" :direction :output :if-exists :supersede)
    (with-active-layers (hatena) 
      (make-announcement *22th* out))
    (with-active-layers (mail) 
      (make-announcement *22th* out))
    (with-active-layers (mixi)
      (make-announcement *22th* out))
    ))