Christophe Weblog Wiki Code Publications Music
make sure to select window/buffer/frame in emacs24
[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 (nth 0 info))
40             (iplayer-command-window (nth 1 info))
41             (iplayer-command-buffer (nth 2 info))
42             (keys (nth 3 info))
43             (function (nth 4 info)))
44         (when (and (frame-live-p iplayer-command-frame)
45                    (window-live-p iplayer-command-window)
46                    (buffer-live-p iplayer-command-buffer))
47           (let ((old-frame (selected-frame))
48                 (old-window (selected-window))
49                 (old-buffer (current-buffer)))
50             (cond
51              ((version< emacs-version "24")
52               (let ((pre-command-hook
53                      (lambda ()
54                        (select-frame iplayer-command-frame)
55                        (select-window iplayer-command-window)
56                        (set-buffer iplayer-command-buffer)
57                        (setq pre-command-hook nil))))
58                 ;; KLUDGE: execute-kbd-macro executes a normal
59                 ;; command-loop, whose first action is to select the
60                 ;; current frame and window, which is why we contort
61                 ;; things to select the frame/window/buffer we actually
62                 ;; want in pre-command-hook.  I'm actually surprised
63                 ;; that it works, but mine is not too much to reason
64                 ;; why; lots of other ways to try to achieve this didn't
65                 ;; in fact work.
66                 (execute-kbd-macro keys)
67                 ;; KLUDGE: and then we restore old state
68                 (select-window old-window)
69                 (select-frame old-frame)
70                 (set-buffer old-buffer)))
71              (t
72               ;; KLUDGE: we store the function name, which is fine,
73               ;; but some of our functions need to know which
74               ;; keystrokes were used to invoke them, so we need to
75               ;; pass those along, so we need to make sure that all
76               ;; iplayer-functions accept an optional argument, argh
77               ;; argh argh.
78               (with-selected-frame iplayer-command-frame
79                 (with-current-buffer iplayer-command-buffer
80                   (with-selected-window iplayer-command-window
81                     (funcall function keys)))))))))
82       (message "Done updating iPlayer cache"))))
83
84 (defmacro define-iplayer-command (name arglist &rest body)
85   (let (docstring interactive)
86     (when (stringp (car body))
87       (setq docstring (car body) body (cdr body)))
88     (when (and (consp (car body)) (eql (car (car body)) 'interactive))
89       (setq interactive (car body) body (cdr body)))
90     `(defun ,name ,arglist
91        ,@(when docstring (list docstring))
92        ,@(when interactive (list interactive))
93        (unless iplayer-updating-cache-process
94          (setq iplayer-updating-cache-process
95                (start-process "updating-iplayer" " *updating-iplayer*"
96                               "get-iplayer" "--type" "radio,tv" "-q"))
97          (set-process-sentinel iplayer-updating-cache-process
98                                'iplayer-updating-cache-sentinel)
99          (message "Updating iPlayer cache"))
100        (if iplayer-updating-cache-sentinel-executing
101            (progn ,@body)
102          (push (list (selected-frame) (selected-window) (current-buffer) (this-command-keys-vector) ',name)
103                iplayer-updating-cache-sentinel-info)))))
104
105 (defun get-iplayer-tree (&rest args)
106   (with-temp-buffer
107     (apply #'call-process "get-iplayer" nil t nil "--nocopyright" "--type" "radio,tv" "--tree" "--terse" args)
108     (goto-char (point-min))
109     (let (result program episodes)
110       (while (< (point) (point-max))
111         (cond
112          ((looking-at "^\\w")
113           (when (and program episodes)
114             (push (cons program (reverse episodes)) result))
115           (setf program (buffer-substring (point) (progn (end-of-line) (point))))
116           (when (string-match "^\\(tv\\|radio\\), " program)
117             (setq program (substring program (match-end 0))))
118           (setf episodes nil)
119           (unless (= (point) (point-max))
120             (forward-char)))
121          ((looking-at "^  \\([0-9]+\\):\\s-\\(.*\\)$")
122           (let ((episode
123                  (cons (buffer-substring (match-beginning 1) (match-end 1))
124                        (buffer-substring (match-beginning 2) (match-end 2)))))
125             (when (string-match "^\\(tv\\|radio\\), " (cdr  episode))
126               (rplacd episode (substring (cdr episode) (match-end 0))))
127             (push episode episodes))
128           (forward-line))
129          (t (forward-line))))
130       (reverse result))))
131
132 (defun display-iplayer-tree (tree)
133   (with-current-buffer (get-buffer-create "*iplayer*")
134     (delete-region (point-min) (point-max))
135     (iplayer-mode)
136     (orgstruct-mode 1)
137     (dolist (entry tree)
138       (let ((program (car entry))
139             (episodes (cdr entry)))
140         (insert (propertize (format "* %s\n" program) 'face 'outline-1))
141         (dolist (episode episodes)
142           (insert (propertize (format "** %s\n" (cdr episode))
143                               'face 'outline-2 'iplayer-id (car episode))))))
144     (org-overview)
145     (goto-char (point-min)))
146   (switch-to-buffer (get-buffer-create "*iplayer*")))
147
148 (defvar iplayer-presets
149   '(("1" . "BBC One")
150     ("2" . "BBC Two")
151     ("3" . "BBC Three")
152     ("4" . "BBC Four")
153
154     ("!" . "BBC Radio 1")
155     ("\"" . "BBC Radio 2")
156     ("£" . "BBC Radio 3")
157     ("$" . "BBC Radio 4")
158     ("%" . "BBC Radio 5 live")
159     ("^" . "BBC 6 Music")
160     ("&" . "BBC 7")
161     ("*" . "BBC Radio 4 Extra"))
162   "Alist mapping keys to iPlayer channels.
163
164 Used in the `iplayer-preset' command.")
165
166 (define-iplayer-command iplayer-preset (&optional keys)
167   "Switch display to a preset channel.
168
169 The presets are defined in the variable `iplayer-presets'."
170   (interactive)
171   (let ((keys (or (and keys (concat keys)) (this-command-keys)))
172         (presets (mapcar (lambda (x) (cons (read-kbd-macro (car x)) (cdr x))) iplayer-presets)))
173     (cond
174      ((= (length keys) 1)
175       (let ((channel (cdr (assoc keys presets))))
176         (if channel
177             (progn
178               (setq mode-line-process (format "[%s]" channel))
179               (iplayer-channel (format "^%s$" channel)))
180           (error "no preset for key %s" keys)))))))
181
182 (defun iplayer-channel (channel)
183   (display-iplayer-tree (get-iplayer-tree "--channel" channel)))
184
185 (defun iplayer-download ()
186   (interactive)
187   (let ((id (get-text-property (point) 'iplayer-id)))
188     (if id
189         (let ((default-directory "~/iPlayer/"))
190           ;; should probably use a process filter instead to give us a
191           ;; progress bar
192           (message "downloading id %s" id)
193           (start-process "get-iplayer" " *get-iplayer*" "get-iplayer" "--modes=best" "--get" (format "%s" id)))
194       (message "no id at point"))))
195
196 (defun iplayer-previous ()
197   (interactive)
198   (save-match-data
199     (outline-previous-heading)
200     (while (and (= (funcall outline-level) 1) (not (bobp)))
201       (outline-previous-heading)))
202   (hide-other)
203   (unless (bobp)
204     (save-excursion
205       (outline-up-heading 1 t)
206       (show-children))))
207
208 (defun iplayer-next ()
209   (interactive)
210   (save-match-data
211     (outline-next-heading)
212     (while (and (= (funcall outline-level) 1) (not (eobp)))
213       (outline-next-heading)))
214   (hide-other)
215   (save-excursion
216     (outline-up-heading 1 t)
217     (show-children)))
218
219 (defconst iplayer-mode-map
220   (let ((map (make-sparse-keymap)))
221     (define-key map (kbd "0") 'iplayer)
222     (let ((presets "123456789!\"£$%^&*()"))
223       (dotimes (i (length presets))
224         (define-key map (read-kbd-macro (substring presets i (1+ i)))
225           'iplayer-preset)))
226     (define-key map (kbd "RET") 'iplayer-download)
227     (define-key map (kbd "j") 'iplayer-next)
228     (define-key map (kbd "k") 'iplayer-previous)
229     map
230     ))
231
232 (defun iplayer-mode ()
233   "A major mode for the BBC's iPlayer.
234 \\{iplayer-mode-map}"
235   (interactive)
236   (use-local-map iplayer-mode-map)
237   (setq major-mode 'iplayer-mode mode-name "iPlayer"))
238
239 (define-iplayer-command iplayer (&optional keys)
240   "Start the emacs iPlayer interface."
241   (interactive)
242   (setq mode-line-process nil)
243   (display-iplayer-tree (get-iplayer-tree)))
244
245 ;;;###autoload
246 (autoload 'iplayer "iplayer" "Start the emacs iPlayer interface." t)
247
248 (provide 'iplayer)
249 ;;; iplayer.el ends here