1 ;;; iplayer.el --- Browse and download BBC TV/radio shows
3 ;; Copyright (C) 2012-2015 Christophe Rhodes
5 ;; Author: Christophe Rhodes <csr21@cantab.net>
6 ;; URL: https://github.com/csrhodes/iplayer-el
8 ;; Keywords: multimedia, bbc
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
25 ;; Requires and uses the 'get-iplayer' script to provide a
26 ;; convenient interface to BBC iPlayer.
31 "Browse and download BBC TV/radio shows."
35 (defcustom iplayer-download-directory "~/iPlayer/"
36 "Directory into which shows will be downloaded."
40 (defvar iplayer-updating-cache-process nil)
41 (defvar iplayer-updating-cache-sentinel-info nil)
42 (defvar iplayer-updating-cache-sentinel-executing nil)
44 (defun iplayer-updating-cache-sentinel (process event)
45 ;; FIXME: assumes that all went well
46 (let* ((iplayer-updating-cache-sentinel-executing t)
47 (info (reverse iplayer-updating-cache-sentinel-info)))
48 (setq iplayer-updating-cache-process nil
49 iplayer-updating-cache-sentinel-info nil)
51 (let ((iplayer-command-frame (nth 0 info))
52 (iplayer-command-window (nth 1 info))
53 (iplayer-command-buffer (nth 2 info))
55 (function (nth 4 info)))
56 (when (and (frame-live-p iplayer-command-frame)
57 (window-live-p iplayer-command-window)
58 (buffer-live-p iplayer-command-buffer))
59 (let ((old-frame (selected-frame))
60 (old-window (selected-window))
61 (old-buffer (current-buffer)))
63 ((version< emacs-version "24")
64 (let ((pre-command-hook
66 (select-frame iplayer-command-frame)
67 (select-window iplayer-command-window)
68 (set-buffer iplayer-command-buffer)
69 (setq pre-command-hook nil))))
70 ;; KLUDGE: execute-kbd-macro executes a normal
71 ;; command-loop, whose first action is to select the
72 ;; current frame and window, which is why we contort
73 ;; things to select the frame/window/buffer we actually
74 ;; want in pre-command-hook. I'm actually surprised
75 ;; that it works, but mine is not too much to reason
76 ;; why; lots of other ways to try to achieve this didn't
78 (execute-kbd-macro keys)
79 ;; KLUDGE: and then we restore old state
80 (select-window old-window)
81 (select-frame old-frame)
82 (set-buffer old-buffer)))
84 ;; KLUDGE: we store the function name, which is fine,
85 ;; but some of our functions need to know which
86 ;; keystrokes were used to invoke them, so we need to
87 ;; pass those along, so we need to make sure that all
88 ;; iplayer-functions accept an optional argument, argh
90 (with-selected-frame iplayer-command-frame
91 (with-current-buffer iplayer-command-buffer
92 (with-selected-window iplayer-command-window
93 (funcall function keys)))))))))
94 (message "Done updating iPlayer cache"))))
96 (defmacro define-iplayer-command (name arglist &rest body)
97 (let (docstring interactive)
98 (when (stringp (car body))
99 (setq docstring (car body) body (cdr body)))
100 (when (and (consp (car body)) (eql (car (car body)) 'interactive))
101 (setq interactive (car body) body (cdr body)))
102 `(defun ,name ,arglist
103 ,@(when docstring (list docstring))
104 ,@(when interactive (list interactive))
105 (unless iplayer-updating-cache-process
106 (setq iplayer-updating-cache-process
107 (start-process "updating-iplayer" " *updating-iplayer*"
108 "get-iplayer" "--type" "radio,tv" "-q"))
109 (set-process-sentinel iplayer-updating-cache-process
110 'iplayer-updating-cache-sentinel)
111 (message "Updating iPlayer cache"))
112 (if iplayer-updating-cache-sentinel-executing
114 (push (list (selected-frame) (selected-window) (current-buffer) (this-command-keys-vector) ',name)
115 iplayer-updating-cache-sentinel-info)))))
117 (defun get-iplayer-tree (&rest args)
119 (apply #'call-process "get-iplayer" nil t nil "--nocopyright" "--type" "radio,tv" "--tree" "--terse" args)
120 (goto-char (point-min))
121 (let (result program episodes)
122 (while (< (point) (point-max))
125 (when (and program episodes)
126 (push (cons program (reverse episodes)) result))
127 (setf program (buffer-substring (point) (progn (end-of-line) (point))))
128 (when (string-match "^\\(tv\\|radio\\), " program)
129 (setq program (substring program (match-end 0))))
131 (unless (= (point) (point-max))
133 ((looking-at "^ \\([0-9]+\\):\\s-\\(.*\\)$")
135 (cons (buffer-substring (match-beginning 1) (match-end 1))
136 (buffer-substring (match-beginning 2) (match-end 2)))))
137 (when (string-match "^\\(tv\\|radio\\), " (cdr episode))
138 (rplacd episode (substring (cdr episode) (match-end 0))))
139 (push episode episodes))
144 (defun display-iplayer-tree (tree)
145 (with-current-buffer (get-buffer-create "*iplayer*")
146 (let ((buffer-read-only nil))
148 (delete-region (point-min) (point-max))
150 (let ((program (car entry))
151 (episodes (cdr entry)))
152 (insert (propertize (format "* %s\n" program) 'face 'outline-1))
153 (dolist (episode episodes)
154 (insert (propertize (format "** %s\n" (cdr episode))
155 'face 'outline-2 'iplayer-id (car episode)))))))
159 (goto-char (point-min))
160 (if iplayer-current-channel
161 (setq mode-line-process (format "[%s]" iplayer-current-channel))
162 (setq mode-line-process nil)))
163 (switch-to-buffer (get-buffer-create "*iplayer*")))
165 (defvar iplayer-presets
173 ("!" . "BBC Radio 1")
174 ("\"" . "BBC Radio 2")
175 ("£" . "BBC Radio 3")
176 ("$" . "BBC Radio 4")
177 ("%" . "BBC Radio 5 live")
178 ("^" . "BBC 6 Music")
180 ("*" . "BBC Radio 4 Extra"))
181 "Alist mapping keys to iPlayer channels.
183 Used in the `iplayer-preset' command.")
185 (defcustom iplayer-startup-channel "BBC One"
186 "The channel to display at startup"
188 ,@(mapcar (lambda (x) `(const ,(cdr x))) iplayer-presets)
189 (const :tag "Show all content" nil))
192 (defun iplayer-frob-presets (presets)
194 ((version< emacs-version "24")
195 (mapcar (lambda (x) (cons (read-kbd-macro (car x)) (cdr x))) presets))
198 (defvar iplayer-current-channel nil)
200 (define-iplayer-command iplayer-preset (&optional keys)
201 "Switch display to a preset channel.
203 The presets are defined in the variable `iplayer-presets'."
205 (let ((keys (or (and keys (concat keys)) (this-command-keys)))
206 (presets (iplayer-frob-presets iplayer-presets)))
209 (let ((channel (cdr (assoc keys presets))))
211 (iplayer-channel channel)
212 (error "no preset for key %s" keys)))))))
214 (defun iplayer-channel (channel)
215 (setq iplayer-current-channel channel)
216 (display-iplayer-tree (get-iplayer-tree "--channel" (format "^%s$" channel))))
218 (define-iplayer-command iplayer-refresh (&optional keys)
219 "Refresh the current iPlayer channel display."
221 (if iplayer-current-channel
222 (iplayer-channel iplayer-current-channel)
225 (defun iplayer-download-display-state (process)
226 (let ((id (process-get process 'iplayer-id))
227 (state (process-get process 'iplayer-state))
228 (progress (process-get process 'iplayer-progress)))
229 (with-current-buffer (get-buffer-create "*iplayer-progress*")
232 (goto-char (point-min))
233 (let ((found (re-search-forward (format "^%s:" id) nil 'end))
234 (inhibit-read-only t))
236 (unless (= (point) (progn (forward-line 0) (point)))
237 (goto-char (point-max))
242 (delete-region beg (point)))
243 (insert (format "%s: %s %s%%" id state progress)))))))
245 (defun iplayer-download-process-filter (process string)
248 ((string-match "^Starting download" string)
249 (process-put process 'iplayer-state 'downloading)
250 (process-put process 'iplayer-progress 0.0))
251 ((and (eql (process-get process 'iplayer-state) 'downloading)
252 (string-match "(\\([0-9]\\{1,3\\}.[0-9]\\)%)$" string))
253 (process-put process 'iplayer-progress (string-to-number (match-string 1 string))))
254 ((string-match "Started writing to temp file" string)
255 (process-put process 'iplayer-state 'transcoding)
256 (process-put process 'iplayer-progress 0.0))
257 ((string-match " Progress: =*>?\\([0-9]\\{1,3\\}\\)%-*|" string)
258 (let ((idx (match-beginning 0)) (data (match-data)))
259 (while (string-match " Progress: =*>?\\([0-9]\\{1,3\\}\\)%-*|" string (match-end 0))
260 (setq idx (match-beginning 0))
261 (setq data (match-data)))
262 (set-match-data data)
263 (process-put process 'iplayer-progress (string-to-number (match-string 1 string)))))
264 (t (with-current-buffer (process-buffer process)
266 (throw 'no-progress nil)))
267 (iplayer-download-display-state process)))
269 (defun iplayer-download-process-sentinel (process string)
271 ((string-match "^finished" string)
272 ;; KLUDGE: get-iplayer installs signal handlers and exit with a 0
273 ;; exit code from them. That means we can't use the sentinel to
274 ;; distinguish between being killed and exiting with success, so
275 ;; we hack around the problem.
276 (if (= (process-get process 'iplayer-progress) 100)
277 (process-put process 'iplayer-state 'finished)
278 (process-put process 'iplayer-state 'failed)))
279 ((string-match "^exited abnormally" string)
280 (process-put process 'iplayer-state 'failed)))
281 (iplayer-download-display-state process))
283 (defun iplayer-download ()
285 (let ((id (get-text-property (point) 'iplayer-id)))
287 (let ((default-directory iplayer-download-directory))
288 ;; should probably use a process filter instead to give us a
290 (message "downloading id %s" id)
292 (start-process "get-iplayer" " *get-iplayer*" "get-iplayer" "--modes=best" "--get" (format "%s" id))))
293 (process-put process 'iplayer-id id)
294 (process-put process 'iplayer-state 'connecting)
295 (process-put process 'iplayer-progress 0.0)
296 (set-process-filter process 'iplayer-download-process-filter)
297 (set-process-sentinel process 'iplayer-download-process-sentinel)
298 (display-buffer (get-buffer-create "*iplayer-progress*"))
299 (iplayer-download-display-state process)))
300 (message "no id at point"))))
302 (defun iplayer-previous ()
305 (outline-previous-heading)
306 (while (and (= (funcall outline-level) 1) (not (bobp)))
307 (outline-previous-heading)))
311 (outline-up-heading 1 t)
314 (defun iplayer-next ()
317 (outline-next-heading)
318 (while (and (= (funcall outline-level) 1) (not (eobp)))
319 (outline-next-heading)))
322 (outline-up-heading 1 t)
325 (defconst iplayer-mode-map
326 (let ((map (make-sparse-keymap)))
327 (define-key map (kbd "0") 'iplayer-show-all)
328 (let ((presets "123456789!\"£$%^&*()"))
329 (dotimes (i (length presets))
330 (define-key map (read-kbd-macro (substring presets i (1+ i)))
332 (define-key map (kbd "RET") 'iplayer-download)
333 (define-key map (kbd "g") 'iplayer-refresh)
334 (define-key map (kbd "j") 'iplayer-next)
335 (define-key map (kbd "k") 'iplayer-previous)
336 (define-key map (kbd "n") 'iplayer-next)
337 (define-key map (kbd "p") 'iplayer-previous)
341 (define-derived-mode iplayer-mode special-mode "iPlayer"
342 "A major mode for the BBC's iPlayer.
343 \\{iplayer-mode-map}")
345 (define-iplayer-command iplayer-show-all (&optional keys)
346 "Show all iPlayer entries."
348 (setq iplayer-current-channel nil)
349 (display-iplayer-tree (get-iplayer-tree)))
351 (define-iplayer-command iplayer (&optional keys)
352 "Start the emacs iPlayer interface."
354 (if iplayer-startup-channel
355 (iplayer-channel iplayer-startup-channel)
359 (autoload 'iplayer "iplayer" "Start the emacs iPlayer interface." t)
362 ;;; iplayer.el ends here