iplayer.el

   1 ;;; iplayer.el --- Browse and download BBC TV/radio shows
   2
   3 ;; Copyright (C) 2012-2015  Christophe Rhodes
   4
   5 ;; Author: Christophe Rhodes <csr21@cantab.net>
   6 ;; URL: https://github.com/csrhodes/iplayer-el
   7 ;; Version: 0.1
   8 ;; Keywords: multimedia, bbc
   9
  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.
  14
  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.
  19
  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/>.
  22
  23 ;;; Commentary:
  24
  25 ;; Requires and uses the 'get-iplayer' script to provide a
  26 ;; convenient interface to BBC iPlayer.
  27
  28 ;;; Code:
  29
  30 (defgroup iplayer nil
  31   "Browse and download BBC TV/radio shows."
  32   :prefix "iplayer-"
  33   :group 'applications)
  34
  35 (defcustom iplayer-download-directory "~/iPlayer/"
  36   "Directory into which shows will be downloaded."
  37   :group 'iplayer
  38   :type 'directory)
  39
  40 (defvar iplayer-updating-cache-process nil)
  41 (defvar iplayer-updating-cache-sentinel-info nil)
  42 (defvar iplayer-updating-cache-sentinel-executing nil)
  43
  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)
  50     (dolist (info info)
  51       (let ((iplayer-command-frame (nth 0 info))
  52             (iplayer-command-window (nth 1 info))
  53             (iplayer-command-buffer (nth 2 info))
  54             (keys (nth 3 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)))
  62             (cond
  63              ((version< emacs-version "24")
  64               (let ((pre-command-hook
  65                      (lambda ()
  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
  77                 ;; in fact work.
  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)))
  83              (t
  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
  89               ;; argh 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"))))
  95
  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
 113            (progn ,@body)
 114          (push (list (selected-frame) (selected-window) (current-buffer) (this-command-keys-vector) ',name)
 115                iplayer-updating-cache-sentinel-info)))))
 116
 117 (defun get-iplayer-tree (&rest args)
 118   (with-temp-buffer
 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))
 123         (cond
 124          ((looking-at "^\\w")
 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))))
 130           (setf episodes nil)
 131           (unless (= (point) (point-max))
 132             (forward-char)))
 133          ((looking-at "^  \\([0-9]+\\):\\s-\\(.*\\)$")
 134           (let ((episode
 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))
 140           (forward-line))
 141          (t (forward-line))))
 142       (reverse result))))
 143
 144 (defun display-iplayer-tree (tree)
 145   (with-current-buffer (get-buffer-create "*iplayer*")
 146     (let ((buffer-read-only nil))
 147       (fundamental-mode)
 148       (delete-region (point-min) (point-max))
 149       (dolist (entry tree)
 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)))))))
 156     (iplayer-mode)
 157     (orgstruct-mode 1)
 158     (org-overview)
 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*")))
 164
 165 (defvar iplayer-presets
 166   '(("1" . "BBC One")
 167     ("2" . "BBC Two")
 168     ("3" . "BBC Three")
 169     ("4" . "BBC Four")
 170     ("8" . "CBBC")
 171     ("9" . "CBeebies")
 172
 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")
 179     ("&" . "BBC 7")
 180     ("*" . "BBC Radio 4 Extra"))
 181   "Alist mapping keys to iPlayer channels.
 182
 183 Used in the `iplayer-preset' command.")
 184
 185 (defcustom iplayer-startup-channel "BBC One"
 186   "The channel to display at startup"
 187   :type `(choice
 188           ,@(mapcar (lambda (x) `(const ,(cdr x))) iplayer-presets)
 189           (const :tag "Show all content" nil))
 190   :group 'iplayer)
 191
 192 (defun iplayer-frob-presets (presets)
 193   (cond
 194    ((version< emacs-version "24")
 195     (mapcar (lambda (x) (cons (read-kbd-macro (car x)) (cdr x))) presets))
 196    (t presets)))
 197
 198 (defvar iplayer-current-channel nil)
 199
 200 (define-iplayer-command iplayer-preset (&optional keys)
 201   "Switch display to a preset channel.
 202
 203 The presets are defined in the variable `iplayer-presets'."
 204   (interactive)
 205   (let ((keys (or (and keys (concat keys)) (this-command-keys)))
 206         (presets (iplayer-frob-presets iplayer-presets)))
 207     (cond
 208      ((= (length keys) 1)
 209       (let ((channel (cdr (assoc keys presets))))
 210         (if channel
 211             (iplayer-channel channel)
 212           (error "no preset for key %s" keys)))))))
 213
 214 (defun iplayer-channel (channel)
 215   (setq iplayer-current-channel channel)
 216   (display-iplayer-tree (get-iplayer-tree "--channel" (format "^%s$" channel))))
 217
 218 (define-iplayer-command iplayer-refresh (&optional keys)
 219   "Refresh the current iPlayer channel display."
 220   (interactive)
 221   (if iplayer-current-channel
 222       (iplayer-channel iplayer-current-channel)
 223     (iplayer-show-all)))
 224
 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*")
 230       (special-mode)
 231       (save-excursion
 232         (goto-char (point-min))
 233         (let ((found (re-search-forward (format "^%s:" id) nil 'end))
 234               (inhibit-read-only t))
 235           (unless found
 236             (unless (= (point) (progn (forward-line 0) (point)))
 237               (goto-char (point-max))
 238               (newline)))
 239           (forward-line 0)
 240           (let ((beg (point)))
 241             (end-of-line)
 242             (delete-region beg (point)))
 243           (insert (format "%s: %s %s%%" id state progress)))))))
 244
 245 (defun iplayer-download-process-filter (process string)
 246   (catch 'no-progress
 247     (cond
 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)
 265           (insert string))
 266         (throw 'no-progress nil)))
 267     (iplayer-download-display-state process)))
 268
 269 (defun iplayer-download-process-sentinel (process string)
 270   (cond
 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))
 282
 283 (defun iplayer-download ()
 284   (interactive)
 285   (let ((id (get-text-property (point) 'iplayer-id)))
 286     (if id
 287         (let ((default-directory iplayer-download-directory))
 288           ;; should probably use a process filter instead to give us a
 289           ;; progress bar
 290           (message "downloading id %s" id)
 291           (let ((process
 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"))))
 301
 302 (defun iplayer-previous ()
 303   (interactive)
 304   (save-match-data
 305     (outline-previous-heading)
 306     (while (and (= (funcall outline-level) 1) (not (bobp)))
 307       (outline-previous-heading)))
 308   (hide-other)
 309   (unless (bobp)
 310     (save-excursion
 311       (outline-up-heading 1 t)
 312       (show-children))))
 313
 314 (defun iplayer-next ()
 315   (interactive)
 316   (save-match-data
 317     (outline-next-heading)
 318     (while (and (= (funcall outline-level) 1) (not (eobp)))
 319       (outline-next-heading)))
 320   (hide-other)
 321   (save-excursion
 322     (outline-up-heading 1 t)
 323     (show-children)))
 324
 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)))
 331           'iplayer-preset)))
 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)
 338     map
 339     ))
 340
 341 (define-derived-mode iplayer-mode special-mode "iPlayer"
 342   "A major mode for the BBC's iPlayer.
 343 \\{iplayer-mode-map}")
 344
 345 (define-iplayer-command iplayer-show-all (&optional keys)
 346   "Show all iPlayer entries."
 347   (interactive)
 348   (setq iplayer-current-channel nil)
 349   (display-iplayer-tree (get-iplayer-tree)))
 350
 351 (define-iplayer-command iplayer (&optional keys)
 352   "Start the emacs iPlayer interface."
 353   (interactive)
 354   (if iplayer-startup-channel
 355       (iplayer-channel iplayer-startup-channel)
 356     (iplayer-show-all)))
 357
 358 ;;;###autoload
 359 (autoload 'iplayer "iplayer" "Start the emacs iPlayer interface." t)
 360
 361 (provide 'iplayer)
 362 ;;; iplayer.el ends here