Christophe Weblog Wiki Code Publications Music
first cut of iPlayer interface for Emacs
[iplayer-el.git] / iplayer.el
1 (defun get-iplayer-tree (&rest args)
2   (with-temp-buffer
3     (apply #'call-process "get-iplayer" nil t nil "--nocopyright" "--type" "radio,tv" "--tree" "--terse" args)
4     (goto-char (point-min))
5     (let (result program episodes)
6       (while (< (point) (point-max))
7         (cond
8          ((looking-at "^\\w")
9           (when (and program episodes)
10             (push (cons program (reverse episodes)) result))
11           (setf program (buffer-substring (point) (progn (end-of-line) (point))))
12           (when (string-match "^\\(tv\\|radio\\), " program)
13             (setq program (substring program (match-end 0))))
14           (setf episodes nil)
15           (unless (= (point) (point-max))
16             (forward-char)))
17          ((looking-at "^  \\([0-9]+\\):\\s-\\(.*\\)$")
18           (let ((episode
19                  (cons (buffer-substring (match-beginning 1) (match-end 1))
20                        (buffer-substring (match-beginning 2) (match-end 2)))))
21             (when (string-match "^\\(tv\\|radio\\), " (cdr  episode))
22               (rplacd episode (substring (cdr episode) (match-end 0))))
23             (push episode episodes))
24           (forward-line))
25          (t (forward-line))))
26       (reverse result))))
27
28 (defun display-iplayer-tree (tree)
29   (with-current-buffer (get-buffer-create "*iplayer*")
30     (delete-region (point-min) (point-max))
31     (iplayer-mode)
32     (orgstruct-mode 1)
33     (dolist (entry tree)
34       (let ((program (car entry))
35             (episodes (cdr entry)))
36         (insert (propertize (format "* %s\n" program) 'face 'outline-1))
37         (dolist (episode episodes)
38           (insert (propertize (format "** %s\n" (cdr episode))
39                               'face 'outline-2 'iplayer-id (car episode))))))
40     (org-overview)
41     (goto-char (point-min)))
42   (switch-to-buffer (get-buffer-create "*iplayer*")))
43
44 (defvar iplayer-presets
45   '(("1" . "BBC One")
46     ("2" . "BBC Two")
47     ("3" . "BBC Three")
48     ("4" . "BBC Four")
49
50     ("!" . "BBC Radio 1")
51     ("\"" . "BBC Radio 2")
52     ("£" . "BBC Radio 3")
53     ("$" . "BBC Radio 4")
54     ("%" . "BBC Radio 5 live")
55     ("^" . "BBC 6 Music")
56     ("&" . "BBC 7")
57     ("*" . "BBC Radio 4 Extra")))
58
59 (defun iplayer-preset (&optional prefix)
60   (interactive "p")
61   (let ((keys (this-command-keys))
62         (presets (mapcar (lambda (x) (cons (read-kbd-macro (car x)) (cdr x))) iplayer-presets)))
63     (message "%s" (this-command-keys))
64     (cond
65      ((= (length keys) 1)
66       (let ((channel (cdr (assoc keys presets))))
67         (if channel
68             (iplayer-channel (format "^%s$" channel))
69           (error "no preset for key %s" keys)))))))
70
71 (defun iplayer-channel (channel)
72   (display-iplayer-tree (get-iplayer-tree "--channel" channel)))
73
74 (defun iplayer-download ()
75   (interactive)
76   (let ((id (get-text-property (point) 'iplayer-id)))
77     (if id
78         (let ((default-directory "~/iPlayer/"))
79           ;; should probably use a process filter instead to give us a
80           ;; progress bar
81           (message "downloading id %s" id)
82           (start-process "get-iplayer" " *get-iplayer*" "get-iplayer" "--get" (format "%s" id)))
83       (message "no id at point"))))
84
85 (defconst iplayer-mode-map
86   (let ((map (make-sparse-keymap)))
87     (define-key map (kbd "0") 'iplayer)
88     (let ((presets "123456789!\"£$%^&*()"))
89       (dotimes (i (length presets))
90         (define-key map (read-kbd-macro (substring presets i (1+ i)))
91           'iplayer-preset)))
92     (define-key map (kbd "RET") 'iplayer-download)
93     map
94     ))
95
96 (defun iplayer-mode ()
97   "A major mode for the BBC's iPlayer.
98 \\{iplayer-mode-map}"
99   (interactive)
100   (use-local-map iplayer-mode-map)
101   (setq major-mode 'iplayer-mode mode-name "iPlayer"))
102
103 (defun iplayer ()
104   (interactive)
105   (display-iplayer-tree (get-iplayer-tree)))
106
107 (provide 'iplayer)