;;; potatoe.el --- major mode for displaying tv programs

;; Copyright (C) 1999 Mark Probst

;; Author: Mark Probst <schani@unix.cslab.tuwien.ac.at>
;; Maintainer: Mark Probst <schani@unix.cslab.tuwien.ac.at>
;; Version: 0.1

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program; if not, you can either send email to this
;; program's maintainer or write to: The Free Software Foundation,
;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.

;;; Commentary:

;; the easiest way to use potatoe is this:
;; * byte-compile potatoe.el (M-x byte-compile)
;; * insert this into your ~/.emacs file:
;;   (autoload 'potatoe "/path/to/potatoe/potatoe"
;;             "Major mode for displaying TV programs" t)
;; * customize potatoe-data-dir and potatoe-favourites-regexp

;;; Code:

(defgroup potatoe nil
  "Potatoe TV Program"
  :group 'applications)

(defcustom potatoe-data-dir "/nethome/hansolo/schani/Work/unix/potatoe/data"
  "Directory containing the TV program listing files."
  :group 'potatoe
  :type 'directory)

(defcustom potatoe-favourites-regexp "Simpsons\\|South Park\\|Chicken\\|Enterprise\\|Star Trek\\|Babylon 5\\|Boxen\\|Formel 1"
  "Regexp which matches titles of favourites."
  :group 'potatoe
  :type 'regexp)

(require 'cl)

(defvar potatoe-data nil)

(defvar potatoe-day-data nil)

(defvar potatoe-current-day nil)

(defmacro let-vector (vars vector &rest body)
  `(let* ((**vector** ,vector)
	  ,@(let ((index -1))
	      (mapcar #'(lambda (var)
			  (incf index)
			  `(,var (aref **vector** ,index)))
		      vars)))
     ,@body))

(defmacro with-broadcast-bindings (data &rest body)
  `(let ((**broadcast** ,data))
     (let-vector (year month day category hour minute title url station showview vps aux) ,data
       ,@body)))

(defun list-less-p (al bl)
  (do ((a al (cdr a))
       (b bl (cdr b)))
      ((or (null a)
	   (/= (car a) (car b)))
       (cond ((null a) nil)
	     ((< (car a) (car b)) t)
	     (t nil)))))

(defun potatoe-broadcast-sort-predicate (a b)
  (list-less-p (list (aref a 0) (aref a 1) (aref a 2) (aref a 4) (aref a 5))
	       (list (aref b 0) (aref b 1) (aref b 2) (aref b 4) (aref b 5))))

(defun potatoe-day-sort-predicate (a b)
  (list-less-p (list (first a) (second a) (third a))
	       (list (first b) (second b) (third b))))

(defun potatoe-read-data ()
  (let ((new-potatoe-data nil)
	(new-potatoe-day-data nil))
    (dolist (filename (directory-files potatoe-data-dir t "^tv-[0-9][0-9][0-9][0-9]-[0-9][0-9]-[0-9][0-9]$"))
      (string-match "\\([0-9]+\\)-\\([0-9]+\\)-\\([0-9]+\\)" filename)
      (let ((year (string-to-number (match-string 1 filename)))
	    (month (string-to-number (match-string 2 filename)))
	    (day (string-to-number (match-string 3 filename)))
	    (broadcasts (sort (with-temp-buffer
				(insert-file-contents filename)
				(car (read-from-string (buffer-string))))
			      'potatoe-broadcast-sort-predicate)))
	(setq new-potatoe-data (append broadcasts new-potatoe-data))
	(push (list year month day broadcasts) new-potatoe-day-data)))
    (setq potatoe-data (sort new-potatoe-data 'potatoe-broadcast-sort-predicate))
    (setq potatoe-day-data (sort new-potatoe-day-data 'potatoe-day-sort-predicate))
    (setq potatoe-current-day (car potatoe-day-data)))
  nil)

(defun potatoe-summarize-data (broadcast)
  (with-broadcast-bindings broadcast
    (format "%02d-%02d %02d:%02d %-12s %s"
	    month day hour minute station title)))

(defun potatoe-favourite-p (broadcast)
  (let ((title (aref broadcast 6)))
    (string-match potatoe-favourites-regexp title)))

(defvar potatoe-summary-vector nil)

(defun potatoe-generate-summary-vector ()
  (let ((summary-list nil))
    (dolist (broadcast (if potatoe-display-all-days
			   potatoe-data
			 (fourth potatoe-current-day)))
      (let ((is-favourite (potatoe-favourite-p broadcast)))
	(if (or is-favourite potatoe-display-unfavourites)
	    (push (list broadcast is-favourite) summary-list))))
    (setq potatoe-summary-vector (apply 'vector (reverse summary-list)))))

(defun potatoe-display-summary ()
  (interactive)
  (set-buffer (get-buffer-create "*potatoe*"))
  (erase-buffer)
  (dotimes (i (length potatoe-summary-vector))
    (let* ((lst (aref potatoe-summary-vector i))
	   (broadcast (first lst))
	   (is-favourite (second lst)))
      (let ((begin-pos (point)))
	(insert (potatoe-summarize-data broadcast))
	(when is-favourite
	  (add-text-properties begin-pos (point) '(face highlight)))
	(newline))))
  (beginning-of-buffer))

(defun potatoe-set-day-data-and-redisplay (new-day-data)
  (setq potatoe-current-day new-day-data)
  (potatoe-generate-summary-vector)
  (potatoe-display-summary))

(defun potatoe-goto-now ()
  "Move to the earliest broadcast which has not yet begun."
  (interactive)
  (let* ((time-list (decode-time (current-time)))
	 (minute (second time-list))
	 (hour (third time-list))
	 (day (fourth time-list))
	 (month (fifth time-list))
	 (year (sixth time-list))
	 (day-data (find nil potatoe-day-data :test #'(lambda (a b)
							(and (= (first b) year)
							     (= (second b) month)
							     (= (third b) day))))))
    (if day-data
	(progn
	  (unless (eq potatoe-current-day day-data)
	    (potatoe-set-day-data-and-redisplay day-data))
	  (potatoe-goto-time hour minute))
      (progn
	(message "No information for today")
	(beep)))))

(defun potatoe-goto-time (the-hour the-minute)
  (let ((index (position nil potatoe-summary-vector :test #'(lambda (a b)
							      (with-broadcast-bindings (first b)
								(not (list-less-p (list hour minute)
										  (list the-hour the-minute))))))))
    (goto-line (1+ index))))

(defun potatoe-goto-hour (hour)
  "Goto the first broadcast starting after the hour HOUR has started."
  (interactive "NHour: ")
  (potatoe-goto-time hour 0))

(defvar potatoe-display-unfavourites t)

(defun potatoe-toggle-unfavourites ()
  "Toggles the display of broadcasts which are not favourites."
  (interactive)
  (setq potatoe-display-unfavourites (not potatoe-display-unfavourites))
  (potatoe-generate-summary-vector)
  (potatoe-display-summary))

(defvar potatoe-display-all-days nil)

(defun potatoe-toggle-day ()
  "Switches between displaying only one day and all days for which
broadcast information is available."
  (interactive)
  (setq potatoe-display-all-days (not potatoe-display-all-days))
  (potatoe-generate-summary-vector)
  (potatoe-display-summary))

(defun potatoe-jump-day (offset)
  (let* ((pos (position potatoe-current-day potatoe-day-data))
	 (new-pos (+ pos offset)))
    (if (or (< new-pos 0) (>= new-pos (length potatoe-day-data)))
	(progn
	  (message "No such day")
	  (beep))
      (potatoe-set-day-data-and-redisplay (nth new-pos potatoe-day-data)))))

(defun potatoe-next-day ()
  "Goto the next day for which broadcast information is available."
  (interactive)
  (potatoe-jump-day 1))

(defun potatoe-previous-day ()
  "Goto the previous day for which broadcast information is
available."
  (interactive)
  (potatoe-jump-day -1))

(defun potatoe-index-at-point ()
  (let ((index (1- (count-lines 1 (if (eobp) (point) (1+ (point)))))))
    (when (eobp)
      (incf index))
    (if (>= index (length potatoe-summary-vector))
	nil
      index)))

(defun potatoe-broadcast-at-point ()
  (let ((index (potatoe-index-at-point)))
    (if index
	(car (aref potatoe-summary-vector index))
      nil)))

(defun potatoe-generate-detail (broadcast)
  (with-broadcast-bindings broadcast
    (set-buffer (get-buffer-create "*potatoe-detail*"))
    (erase-buffer)
    (insert (format "%04d-%02d-%02d %02d:%02d %-21s %s\n" year month day hour minute station category))
    (insert (format "%s\n" title))
    (when showview
      (insert (format "ShowView %-20s" showview)))
    (when vps
      (insert (format "VPS %-20s" vps)))
    (when (or showview vps)
      (insert "\n"))
    (when aux
      (insert (format "\n%s\n" aux)))
    (beginning-of-buffer)))

(defun potatoe-show-detail ()
  "Shows the detail information of the broadcast at point in the
`*potatoe-detail*' buffer."
  (interactive)
  (let ((broadcast (potatoe-broadcast-at-point)))
    (if broadcast
	(progn
	  (potatoe-generate-detail broadcast)
	  (display-buffer "*potatoe-detail*"))
      (beep))))

(defvar potatoe-mode-hook nil
  "Normal hook run when entering potatoe mode.")

(defvar potatoe-mode-map nil
  "Keymap for potatoe mode.")

(unless potatoe-mode-map
  (setq potatoe-mode-map (make-sparse-keymap))
  (define-key potatoe-mode-map "\r" 'potatoe-show-detail)
  (define-key potatoe-mode-map "F" 'potatoe-toggle-unfavourites)
  (define-key potatoe-mode-map "D" 'potatoe-toggle-day)
  (define-key potatoe-mode-map "+" 'potatoe-next-day)
  (define-key potatoe-mode-map "-" 'potatoe-previous-day)
  (define-key potatoe-mode-map "h" 'potatoe-goto-hour)
  (define-key potatoe-mode-map "n" 'potatoe-goto-now)
  (define-key potatoe-mode-map "R" 'potatoe-display-summary))

(defun potatoe-mode ()
  "Major mode for viewing TV program listings.

Key bindings:
\\{potatoe-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (use-local-map potatoe-mode-map)
  (setq mode-name "potatoe")
  (setq major-mode 'potatoe-mode)
  (run-hooks 'potatoe-mode-hook))

(defun potatoe ()
  (interactive)
  (if potatoe-data
      (switch-to-buffer "*potatoe*")
    (progn
      (potatoe-read-data)
      (potatoe-generate-summary-vector)
      (potatoe-display-summary)
      (potatoe-mode)
      (switch-to-buffer (current-buffer)))))
