iplayer.el

   1 (defun get-iplayer-tree (&rest args)
   2   (with-temp-buffer
   3     (apply #'call-process "get-iplayer" nil t nil "--nocopyright" "--type" "radio,tv" "--tree" "--terse" args)
   4     (goto-char (point-min))
   5     (let (result program episodes)
   6       (while (< (point) (point-max))
   7         (cond
   8          ((looking-at "^\\w")
   9           (when (and program episodes)
  10             (push (cons program (reverse episodes)) result))
  11           (setf program (buffer-substring (point) (progn (end-of-line) (point))))
  12           (when (string-match "^\\(tv\\|radio\\), " program)
  13             (setq program (substring program (match-end 0))))
  14           (setf episodes nil)
  15           (unless (= (point) (point-max))
  16             (forward-char)))
  17          ((looking-at "^  \\([0-9]+\\):\\s-\\(.*\\)$")
  18           (let ((episode
  19                  (cons (buffer-substring (match-beginning 1) (match-end 1))
  20                        (buffer-substring (match-beginning 2) (match-end 2)))))
  21             (when (string-match "^\\(tv\\|radio\\), " (cdr  episode))
  22               (rplacd episode (substring (cdr episode) (match-end 0))))
  23             (push episode episodes))
  24           (forward-line))
  25          (t (forward-line))))
  26       (reverse result))))
  27
  28 (defun display-iplayer-tree (tree)
  29   (with-current-buffer (get-buffer-create "*iplayer*")
  30     (delete-region (point-min) (point-max))
  31     (iplayer-mode)
  32     (orgstruct-mode 1)
  33     (dolist (entry tree)
  34       (let ((program (car entry))
  35             (episodes (cdr entry)))
  36         (insert (propertize (format "* %s\n" program) 'face 'outline-1))
  37         (dolist (episode episodes)
  38           (insert (propertize (format "** %s\n" (cdr episode))
  39                               'face 'outline-2 'iplayer-id (car episode))))))
  40     (org-overview)
  41     (goto-char (point-min)))
  42   (switch-to-buffer (get-buffer-create "*iplayer*")))
  43
  44 (defvar iplayer-presets
  45   '(("1" . "BBC One")
  46     ("2" . "BBC Two")
  47     ("3" . "BBC Three")
  48     ("4" . "BBC Four")
  49
  50     ("!" . "BBC Radio 1")
  51     ("\"" . "BBC Radio 2")
  52     ("£" . "BBC Radio 3")
  53     ("$" . "BBC Radio 4")
  54     ("%" . "BBC Radio 5 live")
  55     ("^" . "BBC 6 Music")
  56     ("&" . "BBC 7")
  57     ("*" . "BBC Radio 4 Extra")))
  58
  59 (defun iplayer-preset (&optional prefix)
  60   (interactive "p")
  61   (let ((keys (this-command-keys))
  62         (presets (mapcar (lambda (x) (cons (read-kbd-macro (car x)) (cdr x))) iplayer-presets)))
  63     (cond
  64      ((= (length keys) 1)
  65       (let ((channel (cdr (assoc keys presets))))
  66         (if channel
  67             (progn
  68               (setq mode-line-process (format "[%s]" channel))
  69               (iplayer-channel (format "^%s$" channel)))
  70           (error "no preset for key %s" keys)))))))
  71
  72 (defun iplayer-channel (channel)
  73   (display-iplayer-tree (get-iplayer-tree "--channel" channel)))
  74
  75 (defun iplayer-download ()
  76   (interactive)
  77   (let ((id (get-text-property (point) 'iplayer-id)))
  78     (if id
  79         (let ((default-directory "~/iPlayer/"))
  80           ;; should probably use a process filter instead to give us a
  81           ;; progress bar
  82           (message "downloading id %s" id)
  83           (start-process "get-iplayer" " *get-iplayer*" "get-iplayer" "--get" (format "%s" id)))
  84       (message "no id at point"))))
  85
  86 (defconst iplayer-mode-map
  87   (let ((map (make-sparse-keymap)))
  88     (define-key map (kbd "0") 'iplayer)
  89     (let ((presets "123456789!\"£$%^&*()"))
  90       (dotimes (i (length presets))
  91         (define-key map (read-kbd-macro (substring presets i (1+ i)))
  92           'iplayer-preset)))
  93     (define-key map (kbd "RET") 'iplayer-download)
  94     map
  95     ))
  96
  97 (defun iplayer-mode ()
  98   "A major mode for the BBC's iPlayer.
  99 \\{iplayer-mode-map}"
 100   (interactive)
 101   (use-local-map iplayer-mode-map)
 102   (setq major-mode 'iplayer-mode mode-name "iPlayer"))
 103
 104 (defun iplayer ()
 105   (interactive)
 106   (setq mode-line-process nil)
 107   (display-iplayer-tree (get-iplayer-tree)))
 108
 109 (provide 'iplayer)