Christophe Weblog Wiki Code Publications Music
33af51289fea7f6f96e2096a70bdaa5d865c5d23
[iplayer-el.git] / iplayer.el
1 ;;; iplayer.el --- Browse and download BBC TV/radio shows
2
3 ;; Copyright (C) 2012-2013  Christophe Rhodes
4
5 ;; Author: Christophe Rhodes <csr21@cantab.net>
6 ;; Version: 0.1
7 ;; Keywords: multimedia
8
9 ;; This program is free software; you can redistribute it and/or modify
10 ;; it under the terms of the GNU General Public License as published by
11 ;; the Free Software Foundation, either version 3 of the License, or
12 ;; (at your option) any later version.
13
14 ;; This program is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17 ;; GNU General Public License for more details.
18
19 ;; You should have received a copy of the GNU General Public License
20 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
21
22 ;;; Commentary:
23
24 ;; Requires and uses the 'get-iplayer' script to provide a
25 ;; convenient interface to BBC iPlayer.
26
27 ;;; Code:
28 (defvar iplayer-updating-cache-process nil)
29 (defvar iplayer-updating-cache-sentinel-info nil)
30 (defvar iplayer-updating-cache-sentinel-executing nil)
31
32 (defun iplayer-updating-cache-sentinel (process event)
33   ;; FIXME: assumes that all went well
34   (let* ((iplayer-updating-cache-sentinel-executing t)
35          (info (reverse iplayer-updating-cache-sentinel-info)))
36     (setq iplayer-updating-cache-process nil
37           iplayer-updating-cache-sentinel-info nil)
38     (dolist (info info)
39       (let ((iplayer-command-frame (car info))
40             (iplayer-command-window (cadr info))
41             (iplayer-command-buffer (caddr info))
42             (keys (car (cdddr info))))
43         (when (and (frame-live-p iplayer-command-frame)
44                    (window-live-p iplayer-command-window)
45                    (buffer-live-p iplayer-command-buffer))
46           (let ((old-frame (selected-frame))
47                 (old-window (selected-window))
48                 (old-buffer (current-buffer)))
49             (let ((pre-command-hook
50                    (lambda ()
51                      (select-frame iplayer-command-frame)
52                      (select-window iplayer-command-window)
53                      (set-buffer iplayer-command-buffer)
54                      (setq pre-command-hook nil))))
55               ;; KLUDGE: execute-kbd-macro executes a normal
56               ;; command-loop, whose first action is to select the
57               ;; current frame and window, which is why we contort
58               ;; things to select the frame/window/buffer we actually
59               ;; want in pre-command-hook.  I'm actually surprised
60               ;; that it works, but mine is not too much to reason
61               ;; why; lots of other ways to try to achieve this didn't
62               ;; in fact work.
63               (execute-kbd-macro keys)
64               ;; KLUDGE: and then we restore old state
65               (select-window old-window)
66               (select-frame old-frame)
67               (set-buffer old-buffer))))))
68     (message "Done updating iPlayer cache")))
69
70 (defmacro define-iplayer-command (name arglist &rest body)
71   (let (docstring interactive)
72     (when (stringp (car body))
73       (setq docstring (car body) body (cdr body)))
74     (when (and (consp (car body)) (eql (caar body) 'interactive))
75       (setq interactive (car body) body (cdr body)))
76     `(defun ,name ,arglist
77        ,@(when docstring (list docstring))
78        ,@(when interactive (list interactive))
79        (unless iplayer-updating-cache-process
80          (setq iplayer-updating-cache-process
81                (start-process "updating-iplayer" " *updating-iplayer*"
82                               "get-iplayer" "--type" "radio,tv" "-q"))
83          (set-process-sentinel iplayer-updating-cache-process
84                                'iplayer-updating-cache-sentinel)
85          (message "Updating iPlayer cache"))
86        (if iplayer-updating-cache-sentinel-executing
87            (progn ,@body)
88          (push (list (selected-frame) (selected-window) (current-buffer) (this-command-keys-vector))
89                iplayer-updating-cache-sentinel-info)))))
90
91 (defun get-iplayer-tree (&rest args)
92   (with-temp-buffer
93     (apply #'call-process "get-iplayer" nil t nil "--nocopyright" "--type" "radio,tv" "--tree" "--terse" args)
94     (goto-char (point-min))
95     (let (result program episodes)
96       (while (< (point) (point-max))
97         (cond
98          ((looking-at "^\\w")
99           (when (and program episodes)
100             (push (cons program (reverse episodes)) result))
101           (setf program (buffer-substring (point) (progn (end-of-line) (point))))
102           (when (string-match "^\\(tv\\|radio\\), " program)
103             (setq program (substring program (match-end 0))))
104           (setf episodes nil)
105           (unless (= (point) (point-max))
106             (forward-char)))
107          ((looking-at "^  \\([0-9]+\\):\\s-\\(.*\\)$")
108           (let ((episode
109                  (cons (buffer-substring (match-beginning 1) (match-end 1))
110                        (buffer-substring (match-beginning 2) (match-end 2)))))
111             (when (string-match "^\\(tv\\|radio\\), " (cdr  episode))
112               (rplacd episode (substring (cdr episode) (match-end 0))))
113             (push episode episodes))
114           (forward-line))
115          (t (forward-line))))
116       (reverse result))))
117
118 (defun display-iplayer-tree (tree)
119   (with-current-buffer (get-buffer-create "*iplayer*")
120     (delete-region (point-min) (point-max))
121     (iplayer-mode)
122     (orgstruct-mode 1)
123     (dolist (entry tree)
124       (let ((program (car entry))
125             (episodes (cdr entry)))
126         (insert (propertize (format "* %s\n" program) 'face 'outline-1))
127         (dolist (episode episodes)
128           (insert (propertize (format "** %s\n" (cdr episode))
129                               'face 'outline-2 'iplayer-id (car episode))))))
130     (org-overview)
131     (goto-char (point-min)))
132   (switch-to-buffer (get-buffer-create "*iplayer*")))
133
134 (defvar iplayer-presets
135   '(("1" . "BBC One")
136     ("2" . "BBC Two")
137     ("3" . "BBC Three")
138     ("4" . "BBC Four")
139
140     ("!" . "BBC Radio 1")
141     ("\"" . "BBC Radio 2")
142     ("£" . "BBC Radio 3")
143     ("$" . "BBC Radio 4")
144     ("%" . "BBC Radio 5 live")
145     ("^" . "BBC 6 Music")
146     ("&" . "BBC 7")
147     ("*" . "BBC Radio 4 Extra"))
148   "Alist mapping keys to iPlayer channels.
149
150 Used in the `iplayer-preset' command.")
151
152 (define-iplayer-command iplayer-preset (&optional prefix)
153   "Switch display to a preset channel.
154
155 The presets are defined in the variable `iplayer-presets'."
156   (interactive "p")
157   (let ((keys (this-command-keys))
158         (presets (mapcar (lambda (x) (cons (read-kbd-macro (car x)) (cdr x))) iplayer-presets)))
159     (cond
160      ((= (length keys) 1)
161       (let ((channel (cdr (assoc keys presets))))
162         (if channel
163             (progn
164               (setq mode-line-process (format "[%s]" channel))
165               (iplayer-channel (format "^%s$" channel)))
166           (error "no preset for key %s" keys)))))))
167
168 (defun iplayer-channel (channel)
169   (display-iplayer-tree (get-iplayer-tree "--channel" channel)))
170
171 (defun iplayer-download ()
172   (interactive)
173   (let ((id (get-text-property (point) 'iplayer-id)))
174     (if id
175         (let ((default-directory "~/iPlayer/"))
176           ;; should probably use a process filter instead to give us a
177           ;; progress bar
178           (message "downloading id %s" id)
179           (start-process "get-iplayer" " *get-iplayer*" "get-iplayer" "--get" (format "%s" id)))
180       (message "no id at point"))))
181
182 (defun iplayer-previous ()
183   (interactive)
184   (save-match-data
185     (outline-previous-heading)
186     (while (and (= (funcall outline-level) 1) (not (bobp)))
187       (outline-previous-heading)))
188   (hide-other)
189   (unless (bobp)
190     (save-excursion
191       (outline-up-heading 1 t)
192       (show-children))))
193
194 (defun iplayer-next ()
195   (interactive)
196   (save-match-data
197     (outline-next-heading)
198     (while (and (= (funcall outline-level) 1) (not (eobp)))
199       (outline-next-heading)))
200   (hide-other)
201   (save-excursion
202     (outline-up-heading 1 t)
203     (show-children)))
204
205 (defconst iplayer-mode-map
206   (let ((map (make-sparse-keymap)))
207     (define-key map (kbd "0") 'iplayer)
208     (let ((presets "123456789!\"£$%^&*()"))
209       (dotimes (i (length presets))
210         (define-key map (read-kbd-macro (substring presets i (1+ i)))
211           'iplayer-preset)))
212     (define-key map (kbd "RET") 'iplayer-download)
213     (define-key map (kbd "j") 'iplayer-next)
214     (define-key map (kbd "k") 'iplayer-previous)
215     map
216     ))
217
218 (defun iplayer-mode ()
219   "A major mode for the BBC's iPlayer.
220 \\{iplayer-mode-map}"
221   (interactive)
222   (use-local-map iplayer-mode-map)
223   (setq major-mode 'iplayer-mode mode-name "iPlayer"))
224
225 (define-iplayer-command iplayer ()
226   "Start the emacs iPlayer interface."
227   (interactive)
228   (setq mode-line-process nil)
229   (display-iplayer-tree (get-iplayer-tree)))
230
231 ;;;###autoload
232 (autoload 'iplayer "iplayer" "Start the emacs iPlayer interface." t)
233
234
235 (provide 'iplayer)
236 ;;; iplayer.el ends here