iplayer.el

   1 ;;; iplayer.el --- Browse and download BBC TV/radio shows
   2
   3 ;; Copyright (C) 2012-2014  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
  29 (defgroup iplayer nil
  30   "Browse and download BBC TV/radio shows."
  31   :prefix "iplayer-"
  32   :group 'applications)
  33
  34 (defcustom iplayer-download-directory "~/iPlayer/"
  35   "Directory into which shows will be downloaded."
  36   :group 'iplayer
  37   :type 'directory)
  38
  39 (defvar iplayer-updating-cache-process nil)
  40 (defvar iplayer-updating-cache-sentinel-info nil)
  41 (defvar iplayer-updating-cache-sentinel-executing nil)
  42
  43 (defun iplayer-updating-cache-sentinel (process event)
  44   ;; FIXME: assumes that all went well
  45   (let* ((iplayer-updating-cache-sentinel-executing t)
  46          (info (reverse iplayer-updating-cache-sentinel-info)))
  47     (setq iplayer-updating-cache-process nil
  48           iplayer-updating-cache-sentinel-info nil)
  49     (dolist (info info)
  50       (let ((iplayer-command-frame (nth 0 info))
  51             (iplayer-command-window (nth 1 info))
  52             (iplayer-command-buffer (nth 2 info))
  53             (keys (nth 3 info))
  54             (function (nth 4 info)))
  55         (when (and (frame-live-p iplayer-command-frame)
  56                    (window-live-p iplayer-command-window)
  57                    (buffer-live-p iplayer-command-buffer))
  58           (let ((old-frame (selected-frame))
  59                 (old-window (selected-window))
  60                 (old-buffer (current-buffer)))
  61             (cond
  62              ((version< emacs-version "24")
  63               (let ((pre-command-hook
  64                      (lambda ()
  65                        (select-frame iplayer-command-frame)
  66                        (select-window iplayer-command-window)
  67                        (set-buffer iplayer-command-buffer)
  68                        (setq pre-command-hook nil))))
  69                 ;; KLUDGE: execute-kbd-macro executes a normal
  70                 ;; command-loop, whose first action is to select the
  71                 ;; current frame and window, which is why we contort
  72                 ;; things to select the frame/window/buffer we actually
  73                 ;; want in pre-command-hook.  I'm actually surprised
  74                 ;; that it works, but mine is not too much to reason
  75                 ;; why; lots of other ways to try to achieve this didn't
  76                 ;; in fact work.
  77                 (execute-kbd-macro keys)
  78                 ;; KLUDGE: and then we restore old state
  79                 (select-window old-window)
  80                 (select-frame old-frame)
  81                 (set-buffer old-buffer)))
  82              (t
  83               ;; KLUDGE: we store the function name, which is fine,
  84               ;; but some of our functions need to know which
  85               ;; keystrokes were used to invoke them, so we need to
  86               ;; pass those along, so we need to make sure that all
  87               ;; iplayer-functions accept an optional argument, argh
  88               ;; argh argh.
  89               (with-selected-frame iplayer-command-frame
  90                 (with-current-buffer iplayer-command-buffer
  91                   (with-selected-window iplayer-command-window
  92                     (funcall function keys)))))))))
  93       (message "Done updating iPlayer cache"))))
  94
  95 (defmacro define-iplayer-command (name arglist &rest body)
  96   (let (docstring interactive)
  97     (when (stringp (car body))
  98       (setq docstring (car body) body (cdr body)))
  99     (when (and (consp (car body)) (eql (car (car body)) 'interactive))
 100       (setq interactive (car body) body (cdr body)))
 101     `(defun ,name ,arglist
 102        ,@(when docstring (list docstring))
 103        ,@(when interactive (list interactive))
 104        (unless iplayer-updating-cache-process
 105          (setq iplayer-updating-cache-process
 106                (start-process "updating-iplayer" " *updating-iplayer*"
 107                               "get-iplayer" "--type" "radio,tv" "-q"))
 108          (set-process-sentinel iplayer-updating-cache-process
 109                                'iplayer-updating-cache-sentinel)
 110          (message "Updating iPlayer cache"))
 111        (if iplayer-updating-cache-sentinel-executing
 112            (progn ,@body)
 113          (push (list (selected-frame) (selected-window) (current-buffer) (this-command-keys-vector) ',name)
 114                iplayer-updating-cache-sentinel-info)))))
 115
 116 (defun get-iplayer-tree (&rest args)
 117   (with-temp-buffer
 118     (apply #'call-process "get-iplayer" nil t nil "--nocopyright" "--type" "radio,tv" "--tree" "--terse" args)
 119     (goto-char (point-min))
 120     (let (result program episodes)
 121       (while (< (point) (point-max))
 122         (cond
 123          ((looking-at "^\\w")
 124           (when (and program episodes)
 125             (push (cons program (reverse episodes)) result))
 126           (setf program (buffer-substring (point) (progn (end-of-line) (point))))
 127           (when (string-match "^\\(tv\\|radio\\), " program)
 128             (setq program (substring program (match-end 0))))
 129           (setf episodes nil)
 130           (unless (= (point) (point-max))
 131             (forward-char)))
 132          ((looking-at "^  \\([0-9]+\\):\\s-\\(.*\\)$")
 133           (let ((episode
 134                  (cons (buffer-substring (match-beginning 1) (match-end 1))
 135                        (buffer-substring (match-beginning 2) (match-end 2)))))
 136             (when (string-match "^\\(tv\\|radio\\), " (cdr  episode))
 137               (rplacd episode (substring (cdr episode) (match-end 0))))
 138             (push episode episodes))
 139           (forward-line))
 140          (t (forward-line))))
 141       (reverse result))))
 142
 143 (defun display-iplayer-tree (tree)
 144   (with-current-buffer (get-buffer-create "*iplayer*")
 145     (let ((buffer-read-only nil))
 146       (fundamental-mode)
 147       (delete-region (point-min) (point-max))
 148       (dolist (entry tree)
 149         (let ((program (car entry))
 150               (episodes (cdr entry)))
 151           (insert (propertize (format "* %s\n" program) 'face 'outline-1))
 152           (dolist (episode episodes)
 153             (insert (propertize (format "** %s\n" (cdr episode))
 154                                 'face 'outline-2 'iplayer-id (car episode)))))))
 155     (iplayer-mode)
 156     (orgstruct-mode 1)
 157     (org-overview)
 158     (goto-char (point-min))
 159     (if iplayer-current-channel
 160         (setq mode-line-process (format "[%s]" iplayer-current-channel))
 161       (setq mode-line-process nil)))
 162   (switch-to-buffer (get-buffer-create "*iplayer*")))
 163
 164 (defvar iplayer-presets
 165   '(("1" . "BBC One")
 166     ("2" . "BBC Two")
 167     ("3" . "BBC Three")
 168     ("4" . "BBC Four")
 169     ("8" . "CBBC")
 170     ("9" . "CBeebies")
 171
 172     ("!" . "BBC Radio 1")
 173     ("\"" . "BBC Radio 2")
 174     ("£" . "BBC Radio 3")
 175     ("$" . "BBC Radio 4")
 176     ("%" . "BBC Radio 5 live")
 177     ("^" . "BBC 6 Music")
 178     ("&" . "BBC 7")
 179     ("*" . "BBC Radio 4 Extra"))
 180   "Alist mapping keys to iPlayer channels.
 181
 182 Used in the `iplayer-preset' command.")
 183
 184 (defcustom iplayer-startup-channel "BBC One"
 185   "The channel to display at startup"
 186   :type `(choice
 187           ,@(mapcar (lambda (x) `(const ,(cdr x))) iplayer-presets)
 188           (const :tag "Show all content" nil))
 189   :group 'iplayer)
 190
 191 (defun iplayer-frob-presets (presets)
 192   (cond
 193    ((version< emacs-version "24")
 194     (mapcar (lambda (x) (cons (read-kbd-macro (car x)) (cdr x))) presets))
 195    (t presets)))
 196
 197 (defvar iplayer-current-channel nil)
 198
 199 (define-iplayer-command iplayer-preset (&optional keys)
 200   "Switch display to a preset channel.
 201
 202 The presets are defined in the variable `iplayer-presets'."
 203   (interactive)
 204   (let ((keys (or (and keys (concat keys)) (this-command-keys)))
 205         (presets (iplayer-frob-presets iplayer-presets)))
 206     (cond
 207      ((= (length keys) 1)
 208       (let ((channel (cdr (assoc keys presets))))
 209         (if channel
 210             (iplayer-channel channel)
 211           (error "no preset for key %s" keys)))))))
 212
 213 (defun iplayer-channel (channel)
 214   (setq iplayer-current-channel channel)
 215   (display-iplayer-tree (get-iplayer-tree "--channel" (format "^%s$" channel))))
 216
 217 (define-iplayer-command iplayer-refresh (&optional keys)
 218   "Refresh the current iPlayer channel display."
 219   (interactive)
 220   (if iplayer-current-channel
 221       (iplayer-channel iplayer-current-channel)
 222     (iplayer-show-all)))
 223
 224 (defun iplayer-download-display-state (process)
 225   (let ((id (process-get process 'iplayer-id))
 226         (state (process-get process 'iplayer-state))
 227         (progress (process-get process 'iplayer-progress)))
 228     (with-current-buffer (get-buffer-create "*iplayer-progress*")
 229       (special-mode)
 230       (save-excursion
 231         (goto-char (point-min))
 232         (let ((found (re-search-forward (format "^%s:" id) nil 'end))
 233               (inhibit-read-only t))
 234           (unless found
 235             (unless (= (point) (progn (forward-line 0) (point)))
 236               (goto-char (point-max))
 237               (newline)))
 238           (forward-line 0)
 239           (let ((beg (point)))
 240             (end-of-line)
 241             (delete-region beg (point)))
 242           (insert (format "%s: %s %s%%" id state progress)))))))
 243
 244 (defun iplayer-download-process-filter (process string)
 245   (catch 'no-progress
 246     (cond
 247      ((string-match "^Starting download" string)
 248       (process-put process 'iplayer-state 'downloading)
 249       (process-put process 'iplayer-progress 0.0))
 250      ((and (eql (process-get process 'iplayer-state) 'downloading)
 251            (string-match "(\\([0-9]\\{1,3\\}.[0-9]\\)%)$" string))
 252       (process-put process 'iplayer-progress (string-to-number (match-string 1 string))))
 253      ((string-match "Started writing to temp file" string)
 254       (process-put process 'iplayer-state 'transcoding)
 255       (process-put process 'iplayer-progress 0.0))
 256      ((string-match " Progress: =*>?\\([0-9]\\{1,3\\}\\)%-*|" string)
 257       (let ((idx (match-beginning 0)) (data (match-data)))
 258         (while (string-match " Progress: =*>?\\([0-9]\\{1,3\\}\\)%-*|" string (match-end 0))
 259           (setq idx (match-beginning 0))
 260           (setq data (match-data)))
 261         (set-match-data data)
 262         (process-put process 'iplayer-progress (string-to-number (match-string 1 string)))))
 263      (t (with-current-buffer (process-buffer process)
 264           (insert string))
 265         (throw 'no-progress nil)))
 266     (iplayer-download-display-state process)))
 267
 268 (defun iplayer-download-process-sentinel (process string)
 269   (cond
 270    ((string-match "^finished" string)
 271     ;; KLUDGE: get-iplayer installs signal handlers and exit with a 0
 272     ;; exit code from them.  That means we can't use the sentinel to
 273     ;; distinguish between being killed and exiting with success, so
 274     ;; we hack around the problem.
 275     (if (= (process-get process 'iplayer-progress) 100)
 276         (process-put process 'iplayer-state 'finished)
 277       (process-put process 'iplayer-state 'failed)))
 278    ((string-match "^exited abnormally" string)
 279     (process-put process 'iplayer-state 'failed)))
 280   (iplayer-download-display-state process))
 281
 282 (defun iplayer-download ()
 283   (interactive)
 284   (let ((id (get-text-property (point) 'iplayer-id)))
 285     (if id
 286         (let ((default-directory iplayer-download-directory))
 287           ;; should probably use a process filter instead to give us a
 288           ;; progress bar
 289           (message "downloading id %s" id)
 290           (let ((process
 291                  (start-process "get-iplayer" " *get-iplayer*" "get-iplayer" "--modes=best" "--get" (format "%s" id))))
 292             (process-put process 'iplayer-id id)
 293             (process-put process 'iplayer-state 'connecting)
 294             (process-put process 'iplayer-progress 0.0)
 295             (set-process-filter process 'iplayer-download-process-filter)
 296             (set-process-sentinel process 'iplayer-download-process-sentinel)
 297             (display-buffer (get-buffer-create "*iplayer-progress*"))
 298             (iplayer-download-display-state process)))
 299       (message "no id at point"))))
 300
 301 (defun iplayer-previous ()
 302   (interactive)
 303   (save-match-data
 304     (outline-previous-heading)
 305     (while (and (= (funcall outline-level) 1) (not (bobp)))
 306       (outline-previous-heading)))
 307   (hide-other)
 308   (unless (bobp)
 309     (save-excursion
 310       (outline-up-heading 1 t)
 311       (show-children))))
 312
 313 (defun iplayer-next ()
 314   (interactive)
 315   (save-match-data
 316     (outline-next-heading)
 317     (while (and (= (funcall outline-level) 1) (not (eobp)))
 318       (outline-next-heading)))
 319   (hide-other)
 320   (save-excursion
 321     (outline-up-heading 1 t)
 322     (show-children)))
 323
 324 (defconst iplayer-mode-map
 325   (let ((map (make-sparse-keymap)))
 326     (define-key map (kbd "0") 'iplayer-show-all)
 327     (let ((presets "123456789!\"£$%^&*()"))
 328       (dotimes (i (length presets))
 329         (define-key map (read-kbd-macro (substring presets i (1+ i)))
 330           'iplayer-preset)))
 331     (define-key map (kbd "RET") 'iplayer-download)
 332     (define-key map (kbd "g") 'iplayer-refresh)
 333     (define-key map (kbd "j") 'iplayer-next)
 334     (define-key map (kbd "k") 'iplayer-previous)
 335     (define-key map (kbd "n") 'iplayer-next)
 336     (define-key map (kbd "p") 'iplayer-previous)
 337     map
 338     ))
 339
 340 (define-derived-mode iplayer-mode special-mode "iPlayer"
 341   "A major mode for the BBC's iPlayer.
 342 \\{iplayer-mode-map}")
 343
 344 (define-iplayer-command iplayer-show-all (&optional keys)
 345   "Show all iPlayer entries."
 346   (interactive)
 347   (setq iplayer-current-channel nil)
 348   (display-iplayer-tree (get-iplayer-tree)))
 349
 350 (define-iplayer-command iplayer (&optional keys)
 351   "Start the emacs iPlayer interface."
 352   (interactive)
 353   (if iplayer-startup-channel
 354       (iplayer-channel iplayer-startup-channel)
 355     (iplayer-show-all)))
 356
 357 ;;;###autoload
 358 (autoload 'iplayer "iplayer" "Start the emacs iPlayer interface." t)
 359
 360 (provide 'iplayer)
 361 ;;; iplayer.el ends here