--- /dev/null
+(defun get-iplayer-tree (&rest args)
+ (with-temp-buffer
+ (apply #'call-process "get-iplayer" nil t nil "--nocopyright" "--type" "radio,tv" "--tree" "--terse" args)
+ (goto-char (point-min))
+ (let (result program episodes)
+ (while (< (point) (point-max))
+ (cond
+ ((looking-at "^\\w")
+ (when (and program episodes)
+ (push (cons program (reverse episodes)) result))
+ (setf program (buffer-substring (point) (progn (end-of-line) (point))))
+ (when (string-match "^\\(tv\\|radio\\), " program)
+ (setq program (substring program (match-end 0))))
+ (setf episodes nil)
+ (unless (= (point) (point-max))
+ (forward-char)))
+ ((looking-at "^ \\([0-9]+\\):\\s-\\(.*\\)$")
+ (let ((episode
+ (cons (buffer-substring (match-beginning 1) (match-end 1))
+ (buffer-substring (match-beginning 2) (match-end 2)))))
+ (when (string-match "^\\(tv\\|radio\\), " (cdr episode))
+ (rplacd episode (substring (cdr episode) (match-end 0))))
+ (push episode episodes))
+ (forward-line))
+ (t (forward-line))))
+ (reverse result))))
+
+(defun display-iplayer-tree (tree)
+ (with-current-buffer (get-buffer-create "*iplayer*")
+ (delete-region (point-min) (point-max))
+ (iplayer-mode)
+ (orgstruct-mode 1)
+ (dolist (entry tree)
+ (let ((program (car entry))
+ (episodes (cdr entry)))
+ (insert (propertize (format "* %s\n" program) 'face 'outline-1))
+ (dolist (episode episodes)
+ (insert (propertize (format "** %s\n" (cdr episode))
+ 'face 'outline-2 'iplayer-id (car episode))))))
+ (org-overview)
+ (goto-char (point-min)))
+ (switch-to-buffer (get-buffer-create "*iplayer*")))
+
+(defvar iplayer-presets
+ '(("1" . "BBC One")
+ ("2" . "BBC Two")
+ ("3" . "BBC Three")
+ ("4" . "BBC Four")
+
+ ("!" . "BBC Radio 1")
+ ("\"" . "BBC Radio 2")
+ ("£" . "BBC Radio 3")
+ ("$" . "BBC Radio 4")
+ ("%" . "BBC Radio 5 live")
+ ("^" . "BBC 6 Music")
+ ("&" . "BBC 7")
+ ("*" . "BBC Radio 4 Extra")))
+
+(defun iplayer-preset (&optional prefix)
+ (interactive "p")
+ (let ((keys (this-command-keys))
+ (presets (mapcar (lambda (x) (cons (read-kbd-macro (car x)) (cdr x))) iplayer-presets)))
+ (message "%s" (this-command-keys))
+ (cond
+ ((= (length keys) 1)
+ (let ((channel (cdr (assoc keys presets))))
+ (if channel
+ (iplayer-channel (format "^%s$" channel))
+ (error "no preset for key %s" keys)))))))
+
+(defun iplayer-channel (channel)
+ (display-iplayer-tree (get-iplayer-tree "--channel" channel)))
+
+(defun iplayer-download ()
+ (interactive)
+ (let ((id (get-text-property (point) 'iplayer-id)))
+ (if id
+ (let ((default-directory "~/iPlayer/"))
+ ;; should probably use a process filter instead to give us a
+ ;; progress bar
+ (message "downloading id %s" id)
+ (start-process "get-iplayer" " *get-iplayer*" "get-iplayer" "--get" (format "%s" id)))
+ (message "no id at point"))))
+
+(defconst iplayer-mode-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "0") 'iplayer)
+ (let ((presets "123456789!\"£$%^&*()"))
+ (dotimes (i (length presets))
+ (define-key map (read-kbd-macro (substring presets i (1+ i)))
+ 'iplayer-preset)))
+ (define-key map (kbd "RET") 'iplayer-download)
+ map
+ ))
+
+(defun iplayer-mode ()
+ "A major mode for the BBC's iPlayer.
+\\{iplayer-mode-map}"
+ (interactive)
+ (use-local-map iplayer-mode-map)
+ (setq major-mode 'iplayer-mode mode-name "iPlayer"))
+
+(defun iplayer ()
+ (interactive)
+ (display-iplayer-tree (get-iplayer-tree)))
+
+(provide 'iplayer)