X-Git-Url: http://christophe.rhodes.io/gitweb/?p=iplayer-el.git;a=blobdiff_plain;f=iplayer.el;h=6c4352021471045b4a493591bd23ed3d17f01a08;hp=a27450b6da1250ab823320641887dceb5dcd15ab;hb=9ada771e3df04aa49f295d46e75ba8d2e8012444;hpb=95b13c36c85b1276b4d2eb198497f2249e6de8f4 diff --git a/iplayer.el b/iplayer.el index a27450b..6c43520 100644 --- a/iplayer.el +++ b/iplayer.el @@ -1,6 +1,6 @@ ;;; iplayer.el --- Browse and download BBC TV/radio shows -;; Copyright (C) 2012-2013 Christophe Rhodes +;; Copyright (C) 2012-2014 Christophe Rhodes ;; Author: Christophe Rhodes ;; Version: 0.1 @@ -25,6 +25,17 @@ ;; convenient interface to BBC iPlayer. ;;; Code: + +(defgroup iplayer nil + "Browse and download BBC TV/radio shows." + :prefix "iplayer-" + :group 'applications) + +(defcustom iplayer-download-directory "~/iPlayer/" + "Directory into which shows will be downloaded." + :group 'iplayer + :type 'directory) + (defvar iplayer-updating-cache-process nil) (defvar iplayer-updating-cache-sentinel-info nil) (defvar iplayer-updating-cache-sentinel-executing nil) @@ -131,18 +142,23 @@ (defun display-iplayer-tree (tree) (with-current-buffer (get-buffer-create "*iplayer*") - (delete-region (point-min) (point-max)) + (let ((buffer-read-only nil)) + (fundamental-mode) + (delete-region (point-min) (point-max)) + (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))))))) (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))) + (goto-char (point-min)) + (if iplayer-current-channel + (setq mode-line-process (format "[%s]" iplayer-current-channel)) + (setq mode-line-process nil))) (switch-to-buffer (get-buffer-create "*iplayer*"))) (defvar iplayer-presets @@ -150,6 +166,8 @@ ("2" . "BBC Two") ("3" . "BBC Three") ("4" . "BBC Four") + ("8" . "CBBC") + ("9" . "CBeebies") ("!" . "BBC Radio 1") ("\"" . "BBC Radio 2") @@ -163,34 +181,121 @@ Used in the `iplayer-preset' command.") +(defcustom iplayer-startup-channel "BBC One" + "The channel to display at startup" + :type `(choice + ,@(mapcar (lambda (x) `(const ,(cdr x))) iplayer-presets) + (const :tag "Show all content" nil)) + :group 'iplayer) + +(defun iplayer-frob-presets (presets) + (cond + ((version< emacs-version "24") + (mapcar (lambda (x) (cons (read-kbd-macro (car x)) (cdr x))) presets)) + (t presets))) + +(defvar iplayer-current-channel nil) + (define-iplayer-command iplayer-preset (&optional keys) "Switch display to a preset channel. The presets are defined in the variable `iplayer-presets'." (interactive) (let ((keys (or (and keys (concat keys)) (this-command-keys))) - (presets (mapcar (lambda (x) (cons (read-kbd-macro (car x)) (cdr x))) iplayer-presets))) + (presets (iplayer-frob-presets iplayer-presets))) (cond ((= (length keys) 1) (let ((channel (cdr (assoc keys presets)))) (if channel - (progn - (setq mode-line-process (format "[%s]" channel)) - (iplayer-channel (format "^%s$" channel))) + (iplayer-channel channel) (error "no preset for key %s" keys))))))) (defun iplayer-channel (channel) - (display-iplayer-tree (get-iplayer-tree "--channel" channel))) + (setq iplayer-current-channel channel) + (display-iplayer-tree (get-iplayer-tree "--channel" (format "^%s$" channel)))) + +(define-iplayer-command iplayer-refresh (&optional keys) + "Refresh the current iPlayer channel display." + (interactive) + (if iplayer-current-channel + (iplayer-channel iplayer-current-channel) + (iplayer-show-all))) + +(defun iplayer-download-display-state (process) + (let ((id (process-get process 'iplayer-id)) + (state (process-get process 'iplayer-state)) + (progress (process-get process 'iplayer-progress))) + (with-current-buffer (get-buffer-create "*iplayer-progress*") + (special-mode) + (save-excursion + (goto-char (point-min)) + (let ((found (re-search-forward (format "^%s:" id) nil 'end)) + (inhibit-read-only t)) + (unless found + (unless (= (point) (progn (forward-line 0) (point))) + (goto-char (point-max)) + (newline))) + (forward-line 0) + (let ((beg (point))) + (end-of-line) + (delete-region beg (point))) + (insert (format "%s: %s %s%%" id state progress))))))) + +(defun iplayer-download-process-filter (process string) + (catch 'no-progress + (cond + ((string-match "^Starting download" string) + (process-put process 'iplayer-state 'downloading) + (process-put process 'iplayer-progress 0.0)) + ((and (eql (process-get process 'iplayer-state) 'downloading) + (string-match "(\\([0-9]\\{1,3\\}.[0-9]\\)%)$" string)) + (process-put process 'iplayer-progress (string-to-number (match-string 1 string)))) + ((string-match "Started writing to temp file" string) + (process-put process 'iplayer-state 'transcoding) + (process-put process 'iplayer-progress 0.0)) + ((string-match " Progress: =*>?\\([0-9]\\{1,3\\}\\)%-*|" string) + (let ((idx (match-beginning 0)) (data (match-data))) + (while (string-match " Progress: =*>?\\([0-9]\\{1,3\\}\\)%-*|" string (match-end 0)) + (setq idx (match-beginning 0)) + (setq data (match-data))) + (set-match-data data) + (process-put process 'iplayer-progress (string-to-number (match-string 1 string))))) + (t (with-current-buffer (process-buffer process) + (insert string)) + (throw 'no-progress nil))) + (iplayer-download-display-state process))) + +(defun iplayer-download-process-sentinel (process string) + (cond + ((string-match "^finished" string) + ;; KLUDGE: get-iplayer installs signal handlers and exit with a 0 + ;; exit code from them. That means we can't use the sentinel to + ;; distinguish between being killed and exiting with success, so + ;; we hack around the problem. + (if (= (process-get process 'iplayer-progress) 100) + (process-put process 'iplayer-state 'finished) + (process-put process 'iplayer-state 'failed))) + ((string-match "^exited abnormally" string) + (process-put process 'iplayer-state 'failed))) + (iplayer-download-display-state process)) (defun iplayer-download () (interactive) (let ((id (get-text-property (point) 'iplayer-id))) (if id - (let ((default-directory "~/iPlayer/")) + (let ((default-directory iplayer-download-directory)) ;; 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" "--modes=best" "--get" (format "%s" id))) + (let ((process + (start-process "get-iplayer" " *get-iplayer*" "get-iplayer" "--modes=best" "--get" (format "%s" id)))) + (process-put process 'iplayer-id id) + (process-put process 'iplayer-state 'connecting) + (process-put process 'iplayer-progress 0.0) + (set-process-filter process 'iplayer-download-process-filter) + (set-process-sentinel process 'iplayer-download-process-sentinel) + (display-buffer (get-buffer-create "*iplayer-progress*")) + (iplayer-download-display-state process))) (message "no id at point")))) (defun iplayer-previous () @@ -218,29 +323,36 @@ The presets are defined in the variable `iplayer-presets'." (defconst iplayer-mode-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "0") 'iplayer) + (define-key map (kbd "0") 'iplayer-show-all) (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) + (define-key map (kbd "g") 'iplayer-refresh) (define-key map (kbd "j") 'iplayer-next) (define-key map (kbd "k") 'iplayer-previous) + (define-key map (kbd "n") 'iplayer-next) + (define-key map (kbd "p") 'iplayer-previous) map )) -(defun iplayer-mode () +(define-derived-mode iplayer-mode special-mode "iPlayer" "A major mode for the BBC's iPlayer. -\\{iplayer-mode-map}" +\\{iplayer-mode-map}") + +(define-iplayer-command iplayer-show-all (&optional keys) + "Show all iPlayer entries." (interactive) - (use-local-map iplayer-mode-map) - (setq major-mode 'iplayer-mode mode-name "iPlayer")) + (setq iplayer-current-channel nil) + (display-iplayer-tree (get-iplayer-tree))) (define-iplayer-command iplayer (&optional keys) "Start the emacs iPlayer interface." (interactive) - (setq mode-line-process nil) - (display-iplayer-tree (get-iplayer-tree))) + (if iplayer-startup-channel + (iplayer-channel iplayer-startup-channel) + (iplayer-show-all))) ;;;###autoload (autoload 'iplayer "iplayer" "Start the emacs iPlayer interface." t)