1 (defvar iplayer-updating-cache-process nil)
2 (defvar iplayer-updating-cache-sentinel-info nil)
3 (defvar iplayer-updating-cache-sentinel-executing nil)
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)
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
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
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")))
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
61 (push (list (selected-frame) (selected-window) (current-buffer) (this-command-keys-vector))
62 iplayer-updating-cache-sentinel-info)))))
64 (defun get-iplayer-tree (&rest args)
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))
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))))
78 (unless (= (point) (point-max))
80 ((looking-at "^ \\([0-9]+\\):\\s-\\(.*\\)$")
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))
91 (defun display-iplayer-tree (tree)
92 (with-current-buffer (get-buffer-create "*iplayer*")
93 (delete-region (point-min) (point-max))
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))))))
104 (goto-char (point-min)))
105 (switch-to-buffer (get-buffer-create "*iplayer*")))
107 (defvar iplayer-presets
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")
120 ("*" . "BBC Radio 4 Extra"))
121 "Alist mapping keys to iPlayer channels.
123 Used in the `iplayer-preset' command.")
125 (define-iplayer-command iplayer-preset (&optional prefix)
126 "Switch display to a preset channel.
128 The presets are defined in the variable `iplayer-presets'."
130 (let ((keys (this-command-keys))
131 (presets (mapcar (lambda (x) (cons (read-kbd-macro (car x)) (cdr x))) iplayer-presets)))
134 (let ((channel (cdr (assoc keys presets))))
137 (setq mode-line-process (format "[%s]" channel))
138 (iplayer-channel (format "^%s$" channel)))
139 (error "no preset for key %s" keys)))))))
141 (defun iplayer-channel (channel)
142 (display-iplayer-tree (get-iplayer-tree "--channel" channel)))
144 (defun iplayer-download ()
146 (let ((id (get-text-property (point) 'iplayer-id)))
148 (let ((default-directory "~/iPlayer/"))
149 ;; should probably use a process filter instead to give us a
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"))))
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)))
162 (define-key map (kbd "RET") 'iplayer-download)
166 (defun iplayer-mode ()
167 "A major mode for the BBC's iPlayer.
168 \\{iplayer-mode-map}"
170 (use-local-map iplayer-mode-map)
171 (setq major-mode 'iplayer-mode mode-name "iPlayer"))
173 (define-iplayer-command iplayer ()
174 "Start the emacs iPlayer interface."
176 (setq mode-line-process nil)
177 (display-iplayer-tree (get-iplayer-tree)))