Skip to content

Instantly share code, notes, and snippets.

@kiwanami
Last active August 14, 2023 16:27
Show Gist options
  • Save kiwanami/1fd257fc1e8907d4d92e to your computer and use it in GitHub Desktop.
Save kiwanami/1fd257fc1e8907d4d92e to your computer and use it in GitHub Desktop.
;;; 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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment