Instantly share code, notes, and snippets.

@youz /adcal.l
Created Dec 16, 2011

Embed
What would you like to do?
anything advent-calendar-2011 for #xyzzy
;;; -*- mode:lisp; package:adcal2011 -*-
;;; usage: M-x advent-calendar-2011
(eval-when (:compile-toplevel :load-toplevel :execute)
(require "cmu_loop")
(require "anything/anything")
(require "xml-http-request"))
(defpackage :advent-calendar-2011
(:nicknames :adcal2011)
(:use :lisp :editor :anything))
(in-package :adcal2011)
;; https://github.com/mattn/unite-advent_calendar から拝借
(defvar *calendars*
'((:type atnd :url "http://atnd.org/events/21936" :title "C++11 Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/20321" :title "bjam Advent Calendar jp 2011")
(:type atnd :url "http://atnd.org/events/23108" :title "Visual Basic Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/21988" :title "C# Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22001" :title "Silverlight Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22434" :title "Java Advent Calendar 2011 ")
(:type atnd :url "http://atnd.org/events/22247" :title "Play! framework Advent Calendar 2011 jp #play_ja")
(:type atnd :url "http://atnd.org/events/21977" :title "JavaScript Advent Calendar 2011 (フレームワークコース)")
(:type atnd :url "http://atnd.org/events/21979" :title "JavaScript Advent Calendar 2011 (Node.js/WebSocketsコース)")
(:type atnd :url "http://atnd.org/events/21980" :title "JavaScript Advent Calendar 2011 (オレ標準コース)")
(:type atnd :url "http://atnd.org/events/21978" :title "JavaScript Advent Calendar 2011 (WebGLコース)")
(:type atnd :url "http://atnd.org/events/22017" :title "Backbone.js Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22837" :title "jQuery Mobile Addenpa Calendar 2011")
(:type rss :url "http://perl-users.jp/articles/advent-calendar/2011/casual/rss" :title "Perl Advent Calendar Japan 2011 - Casual Track")
(:type rss :url "http://perl-users.jp/articles/advent-calendar/2011/hacker/rss" :title "Perl Advent Calendar Japan 2011 - Hacker Track")
(:type rss :url "http://perl-users.jp/articles/advent-calendar/2011/test/rss" :title "Perl Advent Calendar Japan 2011 - Test Track")
(:type rss :url "http://perl-users.jp/articles/advent-calendar/2011/acme/rss" :title "Perl Advent Calendar Japan 2011 - Acme Trap")
(:type rss :url "http://perl-users.jp/articles/advent-calendar/2011/english/rss" :title "Perl Advent Calendar Japan 2011 - English Track")
(:type rss :url "http://perl-users.jp/articles/advent-calendar/2011/anysan/rss" :title "Perl Advent Calendar Japan 2011 - AnySan Track")
(:type rss :url "http://perl-users.jp/articles/advent-calendar/2011/dbix/rss" :title "Perl Advent Calendar Japan 2011 - DBIx Track")
(:type rss :url "http://perl-users.jp/articles/advent-calendar/2011/amon2/rss" :title "Perl Advent Calendar Japan 2011 - Amon2 Track")
(:type atnd :url "http://atnd.org/events/22820" :title "Perl6 Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22781" :title "PHP Advent Calendar jp 2011")
(:type atnd :url "http://atnd.org/events/22473" :title "PHP5.4 Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22721" :title "CakePHP Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22380" :title "FuelPHP Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22378" :title "Symfony Advent Calendar JP 2011")
(:type atnd :url "http://atnd.org/events/22078" :title "PyPy Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22021" :title "Ruby Advent Calendar jp: 2011")
(:type atnd :url "http://atnd.org/events/10901" :title "Ruby逆引きレシピAdvent Calendar")
(:type atnd :url "http://atnd.org/events/22483" :title "G* Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22123" :title "Nimrod Advent Calendar jp: 2011")
(:type atnd :url "http://atnd.org/events/22463" :title "Esolang Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22563" :title "Processing Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22909" :title "Force.com Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22528" :title "MySQL Casual Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/21994" :title "PostgtreSQL Advent Calendar")
(:type atnd :url "http://atnd.org/events/21910" :title "カーネル/VM Advent Calendar")
(:type atnd :url "http://atnd.org/events/22792" :title "iOS Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22816" :title "cocos2d Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22351" :title "Windows Phone Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22723" :title "KINECT SDK Advent Calendar")
(:type atnd :url "http://atnd.org/events/22725" :title "OpenNI Advent Calendar")
(:type atnd :url "http://atnd.org/events/22935" :title "Fedora Advent Calendar ")
(:type atnd :url "http://atnd.org/events/22905" :title "Debian/Ubuntu JP Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/21987" :title "HTML5 Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/21919" :title "Less & Sass Advent calendar 2011")
(:type atnd :url "http://atnd.org/events/22823" :title "WordPress Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22672" :title "Reblog Advent Calend*e*r 3011")
(:type atnd :url "http://atnd.org/events/22760" :title "a-blog cms Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22596" :title "Cloud Foundry jp Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22821" :title "Windows Azure Advent Calendar jp: 2011")
(:type atnd :url "http://atnd.org/events/21925" :title "Vim Advent Calendar 2011 ")
(:type atnd :url "http://atnd.org/events/21982" :title "Emacs Advent Calendar jp: 2011")
(:type atnd :url "http://atnd.org/events/22048" :title "Jenkins Advent Calendar jp 2011")
(:type atnd :url "http://atnd.org/events/22899" :title "JIRA Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/21951" :title "Titanium Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22851" :title "Redmine Advent Calendar jp 2011")
(:type atnd :url "http://atnd.org/events/22819" :title "TFS Advent Calendar")
(:type atnd :url "http://atnd.org/events/22073" :title "PowerShell Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22039" :title "R Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22320" :title "ターミナルマルチプレクサ Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22027" :title "TDD Advent Calendar jp: 2011")
(:type atnd :url "http://atnd.org/events/22266" :title "コワーキング・アドベント・カレンダー 2011")
(:type atnd :url "http://atnd.org/events/22322" :title "日本App Inventorユーザー会 Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22833" :title "「Software Test & Quality Advent Calendar 2011」")
(:type atnd :url "http://atnd.org/events/22570" :title "Kosen Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22842" :title "Mac Dev JP advent calendar")
(:type atnd :url "http://atnd.org/events/22740" :title "Hatena::Staff Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22822" :title "元etolabo::Staff Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22852" :title "Ariel Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22939" :title "女帝 Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22020" :title "変態アドベントカレンダー 2011")
(:type atnd :url "http://atnd.org/events/22136" :title "まやふのほもっきんちゃん Advent Calendar")
(:type atnd :url "http://atnd.org/events/22829" :title ".。oO(さっちゃんAdvent Calendar)")
(:type atnd :url "http://atnd.org/events/22130" :title "Punishment Advent Calendar jp: 2011")
(:type atnd :url "http://atnd.org/events/22441" :title "PHP Advent Calendar 2011(全部俺)")
(:type atnd :url "http://atnd.org/events/22450" :title "Sphinx & blockdiag Advent Calendar(全部俺)")
(:type atnd :url "http://atnd.org/events/22557" :title "Python Advent Calendar 2011(全部俺)")
(:type atnd :url "http://atnd.org/events/22574" :title "Google Product Advent Calender 2011 (全部俺)")
(:type atnd :url "http://atnd.org/events/22631" :title "俺 AdventCalendar 2011")
(:type atnd :url "http://atnd.org/events/22669" :title "My AdventCalendar 2011")
(:type atnd :url "http://atnd.org/events/22826" :title "LispギャグAdvent Calendar")
(:type atnd :url "http://atnd.org/events/22834" :title "do_aki Advent Calendar 2011")
(:type atnd :url "http://atnd.org/events/22835" :title "JBoss Advent Calendar 2011(全部俺)")
(:type atnd :url "http://atnd.org/events/22862" :title "Windows Phone Advent Calendar ''ひとり'' 2011")
(:type atnd :url "http://atnd.org/events/22889" :title "xyttr Advent Calendar")
(:type partake.in :url "http://partake.in/events/07bb74d8-ba0d-4a3f-991c-b0547c78380c" :title "きつねさんAdvent Calendar 2012")
(:type partake.in :url "http://partake.in/events/33870915-f25b-40b6-9456-b898b898d48b" :title "Scala Advent Calendar jp 2011")
(:type partake.in :url "http://partake.in/events/b79f232d-5234-4ce3-9b10-b01629d492e7" :title "Functional Ikamusume Advent Calendar jp 2011")
(:type partake.in :url "http://partake.in/events/30381166-394a-4fab-a5ea-5984d051de01" :title "Theorem Proving Advent Calendar 2011")
(:type partake.in :url "http://partake.in/events/eaea52c2-61ef-46d5-a855-3a2dde459e3a" :title "Haskell Advent Calendar 2011")
(:type partake.in :url "http://partake.in/events/902cd6d9-0215-4ea3-b51f-b8ff32e56426" :title "Mercurial Advent Calendar 2011")
(:type partake.in :url "http://partake.in/events/ee35b200-e151-44c1-b123-482d0a7447b5" :title "Competitive Programming Advent Calendar")
))
;; util
(defun get-rss (rssurl)
;; xhrで使ってるXMLHTTP2.0(?)だとCDATAをパースしてくれない(?)ので6.0を使う
(let ((xhr (ole-create-object "Msxml2.XMLHTTP.6.0")))
(ole-method xhr :Open "GET" rssurl nil)
(ole-method xhr :Send)
(xhr::dom->sexp (ole-getprop xhr :responseXml))))
(defun rss-items (rssurl)
(flet ((find-node (tagname node)
(find-if #'(lambda (e) (string= tagname (car e))) (cddr node))))
(let ((rss (get-rss rssurl)))
(loop for elm in (cddr (find-node "channel" (car rss)))
when (string= "item" (car elm))
collect
(mapcan #'(lambda (k tag) (list k (caddr (find-node tag elm))))
'(:title :date :url :author :description)
'("title" "pubDate" "link" "author" "description"))))))
(defun to1line (text)
(substitute-string text "[\t\r\n]+" " "))
;; entries
(defun get-atnd-entries (url)
(let ((rssurl (concat (substitute-string url "events" "comments") ".rss")))
(loop for item in (rss-items rssurl)
for desc = (to1line (getf item :description))
when (string-match "https?://[^ \"]+" desc)
collect
(let ((url (match-string 0))
(text (substitute-string
(substitute-string desc "</?[^>]+>" "")
(regexp-quote url) " ")))
(cons (format nil "[~A] ~A~@[ by ~A~]" (getf item :date) text (getf item :author))
url)))))
(defun get-rss-entries (url)
(loop for item in (nreverse (rss-items url))
collect
(cons (format nil "[~A] ~A~@[ by ~A~]"
(getf item :date) (getf item :title) (getf item :author))
(getf item :url))))
(defvar *entries* nil)
(defun open-entry (title)
(let ((url (cdr (assoc title *entries* :test #'string=))))
(shell-execute url t)))
;; menu
(defun user::advent-calendar-2011 ()
(interactive)
(let ((anything::*anything-sources* #0=(make-hash-table :test 'equal))
(anything::*anything-type-attributes* #0#))
; エントリーをanythingで表示 (Partake.inは未対応)
(add-anything-attribute
:type calendar
:display "View entries"
:default t
:action
(lambda (title)
(let* #3=((p (find title *calendars*
:key #'(lambda (p) (getf p :title))
:test #'string=))
(type (getf p :type))
(url (getf p :url)))
(case type
(atnd
(let ((entries (get-atnd-entries url)))
#1=(if entries (view-entries title entries)
#2=(shell-execute url t))))
(rss (let ((entries (get-rss-entries url))) #1#))
(partake.in #2#)))))
; 集約ページを表示
(add-anything-attribute
:type calendar
:display "Open in browser"
:action
(lambda (title)
(let* #3#
(case type
((atnd partake.in) (shell-execute url t))
(rss (shell-execute (substitute-string url "/rss" "") t))))))
(add-anything-sources
:name "Advent Calendar 2011 jp"
:type calendar
:candidates (lambda () (mapcar #'(lambda (p) (getf p :title)) *calendars*)))
(anything)))
(defun view-entries (title entries)
(anything::anything-cleanup)
(let ((anything::*anything-sources* #0=(make-hash-table :test 'equal))
(anything::*anything-type-attributes* #0#)
(*entries* entries))
(setf (gethash title anything::*anything-sources*)
(anything::make-anything
:name title
:candidates (lambda () (mapcar #'car *entries*))
:action 'open-entry))
(anything)))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment