calfw-syobocal.el

;;; syobo.el --- calfw for syoboi calendar

;; Copyright (C) 2014 @kiwanami

;; Author: @kiwanami
;; Keywords: calendar

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; Customize `syb:channels' and
;; M-x syb:open-calendar-syobocal

;;; Code:

(require 'calfw)
(require 'json)
(require 'request-deferred)


;; customize channel (see the web site)
;; https://sites.google.com/site/syobocal/spec/chid-list
(defvar syb:channels "1,2,16,17,128")


(defstruct syb:title
  tid first-year first-month title link)

(defstruct syb:program
  pid tid chid chname sttime edtime count title-ref)

(defun syb:k (key alist)
  (cdr (assq key alist)))

(defun syb:sk (key alist)
  (cdr (assoc key alist)))

(defun syb:to-emacs-time (timestr)
  (seconds-to-time (string-to-int timestr)))

(defun syb:to-time (timestr)
  (let ((dt (decode-time (syb:to-emacs-time timestr))))
    (list
     (list (nth 4 dt) (nth 3 dt) (nth 5 dt))
     (list (nth 2 dt) (nth 1 dt)))))

(defvar syb:source-last-begin-date nil "[internal] ")
(defvar syb:source-last-end-date nil "[internal] ")
(defvar syb:source-entries nil "[internal] ")

(defun syb:source-data (b e)
  (unless
      (and
       (equal syb:source-last-begin-date b)
       (equal syb:source-last-end-date e))
    (setq syb:source-last-begin-date b)
    (setq syb:source-last-end-date e)
    (deferred:$
      (syb:retrieve-data b e)
      (deferred:nextc it
        (lambda (x) 
          (let ((cp (cfw:cp-get-component)))
            (when cp
              (cfw:cp-update cp)))))))
  syb:source-entries)

(defun syb:open-calendar-syobocal ()
  (interactive)
  (setq syb:source-last-begin-date nil)
  (setq syb:source-last-end-date nil)
  (cfw:open-calendar-buffer
   :date (cfw:emacs-to-calendar (current-time))
   :contents-sources
   (list (make-cfw:source :name "Syoboi Calendar"
                          :data 'syb:source-data))))

(defun syb:retrieve-data (begin-date end-date)
  (lexical-let*
      ((begin-date-str
        (format-time-string
         "%Y-%m-%d" (cfw:calendar-to-emacs begin-date)))
       (end-date-str
        (format-time-string
         "%Y-%m-%d" (cfw:calendar-to-emacs end-date)))
       (days (format "%d" (cfw:days-diff begin-date end-date))))
    (deferred:$
      (request-deferred
       "http://cal.syoboi.jp/json"
       :params `(("Req" . "ProgramByDate,TitleMedium") ("start" . ,begin-date-str) ("days" . ,days) ("ChID" . ,syb:channels))
       :parser 'json-read)
      (deferred:nextc it
        (lambda (response) 
          (let* ((data (request-response-data response))
                 (titles-src (cdr (assq 'Titles data)))
                 (programs-src (cdr (assq 'Programs data)))
                 (titles
                  (loop for (id . lst) in titles-src
                        for ti = (make-syb:title 
                                  :tid (syb:k 'TID lst)
                                  :title (syb:k 'Title lst)
                                  :first-year (syb:k 'FirstYear lst)
                                  :first-month (syb:k 'FirstMonth lst)
                                  :link (syb:k 'Links lst))
                        collect (cons (syb:title-tid ti) ti)))
                 (programs
                  (loop for (id . lst) in programs-src
                        for tid = (syb:k 'TID lst)
                        for ti = (syb:sk tid titles)
                        for pg = (make-syb:program
                                  :pid (syb:k 'PID lst)
                                  :tid tid
                                  :chid (syb:k 'ChID lst)
                                  :chname (syb:k 'ChName lst)
                                  :sttime (syb:to-time (syb:k 'StTime lst))
                                  :edtime (syb:to-time (syb:k 'EdTime lst))
                                  :count (syb:k 'Count lst)
                                  :title-ref ti)
                        collect pg)))
            (setq syb:source-entries
                  (loop for pg in programs
                        for sttime = (syb:program-sttime pg)
                        for edtime = (syb:program-edtime pg)
                        collect
                        (make-cfw:event
                         :title (format "%s %s (%s)" 
                                        (syb:title-title (syb:program-title-ref pg))
                                        (syb:program-count pg)
                                        (syb:program-chname pg))
                         :start-date (car sttime) :start-time (cadr sttime)
                         :end-date (car edtime) :end-time (cadr edtime)
                         )))))))))

;; (progn (eval-current-buffer) (syb:open-calendar-syobocal))

(provide 'syobo)
;;; syobo.el ends here

calfw-syoboi.png