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