iplayer.el

   1 (defvar iplayer-updating-cache-process nil)
   2 (defvar iplayer-updating-cache-sentinel-info nil)
   3 (defvar iplayer-updating-cache-sentinel-executing nil)
   4
   5 (defun iplayer-updating-cache-sentinel (process event)
   6   ;; FIXME: assumes that all went well
   7   (let* ((iplayer-updating-cache-sentinel-executing t)
   8          (info (reverse iplayer-updating-cache-sentinel-info)))
   9     (setq iplayer-updating-cache-process nil
  10           iplayer-updating-cache-sentinel-info nil)
  11     (dolist (info info)
  12       (let ((iplayer-command-frame (car info))
  13             (iplayer-command-window (cadr info))
  14             (iplayer-command-buffer (caddr info))
  15             (keys (car (cdddr info))))
  16         (when (and (frame-live-p iplayer-command-frame)
  17                    (window-live-p iplayer-command-window)
  18                    (buffer-live-p iplayer-command-buffer))
  19           (let ((old-frame (selected-frame))
  20                 (old-window (selected-window))
  21                 (old-buffer (current-buffer)))
  22             (let ((pre-command-hook
  23                    (lambda ()
  24                      (select-frame iplayer-command-frame)
  25                      (select-window iplayer-command-window)
  26                      (set-buffer iplayer-command-buffer)
  27                      (setq pre-command-hook nil))))
  28               ;; KLUDGE: execute-kbd-macro executes a normal
  29               ;; command-loop, whose first action is to select the
  30               ;; current frame and window, which is why we contort
  31               ;; things to select the frame/window/buffer we actually
  32               ;; want in pre-command-hook.  I'm actually surprised
  33               ;; that it works, but mine is not too much to reason
  34               ;; why; lots of other ways to try to achieve this didn't
  35               ;; in fact work.
  36               (execute-kbd-macro keys)
  37               ;; KLUDGE: and then we restore old state
  38               (select-window old-window)
  39               (select-frame old-frame)
  40               (set-buffer old-buffer))))))
  41     (message "Done updating iPlayer cache")))
  42
  43 (defmacro define-iplayer-command (name arglist &rest body)
  44   (let (docstring interactive)
  45     (when (stringp (car body))
  46       (setq docstring (car body) body (cdr body)))
  47     (when (and (consp (car body)) (eql (caar body) 'interactive))
  48       (setq interactive (car body) body (cdr body)))
  49     `(defun ,name ,arglist
  50        ,@(when docstring (list docstring))
  51        ,@(when interactive (list interactive))
  52        (unless iplayer-updating-cache-process
  53          (setq iplayer-updating-cache-process
  54                (start-process "updating-iplayer" " *updating-iplayer*"
  55                               "get-iplayer" "--type" "radio,tv" "-q"))
  56          (set-process-sentinel iplayer-updating-cache-process
  57                                'iplayer-updating-cache-sentinel)
  58          (message "Updating iPlayer cache"))
  59        (if iplayer-updating-cache-sentinel-executing
  60            (progn ,@body)
  61          (push (list (selected-frame) (selected-window) (current-buffer) (this-command-keys-vector))
  62                iplayer-updating-cache-sentinel-info)))))
  63
  64 (defun get-iplayer-tree (&rest args)
  65   (with-temp-buffer
  66     (apply #'call-process "get-iplayer" nil t nil "--nocopyright" "--type" "radio,tv" "--tree" "--terse" args)
  67     (goto-char (point-min))
  68     (let (result program episodes)
  69       (while (< (point) (point-max))
  70         (cond
  71          ((looking-at "^\\w")
  72           (when (and program episodes)
  73             (push (cons program (reverse episodes)) result))
  74           (setf program (buffer-substring (point) (progn (end-of-line) (point))))
  75           (when (string-match "^\\(tv\\|radio\\), " program)
  76             (setq program (substring program (match-end 0))))
  77           (setf episodes nil)
  78           (unless (= (point) (point-max))
  79             (forward-char)))
  80          ((looking-at "^  \\([0-9]+\\):\\s-\\(.*\\)$")
  81           (let ((episode
  82                  (cons (buffer-substring (match-beginning 1) (match-end 1))
  83                        (buffer-substring (match-beginning 2) (match-end 2)))))
  84             (when (string-match "^\\(tv\\|radio\\), " (cdr  episode))
  85               (rplacd episode (substring (cdr episode) (match-end 0))))
  86             (push episode episodes))
  87           (forward-line))
  88          (t (forward-line))))
  89       (reverse result))))
  90
  91 (defun display-iplayer-tree (tree)
  92   (with-current-buffer (get-buffer-create "*iplayer*")
  93     (delete-region (point-min) (point-max))
  94     (iplayer-mode)
  95     (orgstruct-mode 1)
  96     (dolist (entry tree)
  97       (let ((program (car entry))
  98             (episodes (cdr entry)))
  99         (insert (propertize (format "* %s\n" program) 'face 'outline-1))
 100         (dolist (episode episodes)
 101           (insert (propertize (format "** %s\n" (cdr episode))
 102                               'face 'outline-2 'iplayer-id (car episode))))))
 103     (org-overview)
 104     (goto-char (point-min)))
 105   (switch-to-buffer (get-buffer-create "*iplayer*")))
 106
 107 (defvar iplayer-presets
 108   '(("1" . "BBC One")
 109     ("2" . "BBC Two")
 110     ("3" . "BBC Three")
 111     ("4" . "BBC Four")
 112
 113     ("!" . "BBC Radio 1")
 114     ("\"" . "BBC Radio 2")
 115     ("£" . "BBC Radio 3")
 116     ("$" . "BBC Radio 4")
 117     ("%" . "BBC Radio 5 live")
 118     ("^" . "BBC 6 Music")
 119     ("&" . "BBC 7")
 120     ("*" . "BBC Radio 4 Extra"))
 121   "Alist mapping keys to iPlayer channels.
 122
 123 Used in the `iplayer-preset' command.")
 124
 125 (define-iplayer-command iplayer-preset (&optional prefix)
 126   "Switch display to a preset channel.
 127
 128 The presets are defined in the variable `iplayer-presets'."
 129   (interactive "p")
 130   (let ((keys (this-command-keys))
 131         (presets (mapcar (lambda (x) (cons (read-kbd-macro (car x)) (cdr x))) iplayer-presets)))
 132     (cond
 133      ((= (length keys) 1)
 134       (let ((channel (cdr (assoc keys presets))))
 135         (if channel
 136             (progn
 137               (setq mode-line-process (format "[%s]" channel))
 138               (iplayer-channel (format "^%s$" channel)))
 139           (error "no preset for key %s" keys)))))))
 140
 141 (defun iplayer-channel (channel)
 142   (display-iplayer-tree (get-iplayer-tree "--channel" channel)))
 143
 144 (defun iplayer-download ()
 145   (interactive)
 146   (let ((id (get-text-property (point) 'iplayer-id)))
 147     (if id
 148         (let ((default-directory "~/iPlayer/"))
 149           ;; should probably use a process filter instead to give us a
 150           ;; progress bar
 151           (message "downloading id %s" id)
 152           (start-process "get-iplayer" " *get-iplayer*" "get-iplayer" "--get" (format "%s" id)))
 153       (message "no id at point"))))
 154
 155 (defconst iplayer-mode-map
 156   (let ((map (make-sparse-keymap)))
 157     (define-key map (kbd "0") 'iplayer)
 158     (let ((presets "123456789!\"£$%^&*()"))
 159       (dotimes (i (length presets))
 160         (define-key map (read-kbd-macro (substring presets i (1+ i)))
 161           'iplayer-preset)))
 162     (define-key map (kbd "RET") 'iplayer-download)
 163     map
 164     ))
 165
 166 (defun iplayer-mode ()
 167   "A major mode for the BBC's iPlayer.
 168 \\{iplayer-mode-map}"
 169   (interactive)
 170   (use-local-map iplayer-mode-map)
 171   (setq major-mode 'iplayer-mode mode-name "iPlayer"))
 172
 173 (define-iplayer-command iplayer ()
 174   "Start the emacs iPlayer interface."
 175   (interactive)
 176   (setq mode-line-process nil)
 177   (display-iplayer-tree (get-iplayer-tree)))
 178
 179 (provide 'iplayer)