#!/usr/local/bin/clisp -ansi -q   -Kfull
;; -*- mode: lisp -*-
;;******************************************************************************
;;FILE:              eurnews
;;LANGUAGE:          Common-Lisp
;;SYSTEM:            UNIX
;;USER-INTERFACE:    UNIX
;;DESCRIPTION
;;    Note: we compile on load only to check syntax errors faster.
;;USAGE
;;    euronews --help
;;AUTHORS
;;    <PJB> Pascal J. Bourguignon
;;MODIFICATIONS
;;    2004-03-24 <PJB> Added user selectable language.
;;    2002-09-30 <PJB> Created.
;;BUGS
;;LEGAL
;;    Copyright Pascal J. Bourguignon 2002 - 2004
;;
;;    This script 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 of the License, or (at your option) any later version.
;;
;;    This script 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 library; see the file COPYING.LIB.
;;    If not, write to the Free Software Foundation,
;;    59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
;;******************************************************************************

;; Clean the packages imported into COMMON-LISP-USER:
(MAPC (LAMBDA (USED) (UNUSE-PACKAGE USED "COMMON-LISP-USER"))
      (REMOVE (FIND-PACKAGE "COMMON-LISP")
              (COPY-SEQ (PACKAGE-USE-LIST "COMMON-LISP-USER"))))

;; From /usr/include/sysexists.h (Linux)
(defconstant _SYSEXITS_H      1)
(defconstant EX_OK            0)
(defconstant EX__BASE        64)
(defconstant EX_USAGE        64)
(defconstant EX_DATAERR      65)
(defconstant EX_NOINPUT      66)
(defconstant EX_NOUSER       67)
(defconstant EX_NOHOST       68)
(defconstant EX_UNAVAILABLE  69)
(defconstant EX_SOFTWARE     70)
(defconstant EX_OSERR        71)
(defconstant EX_OSFILE       72)
(defconstant EX_CANTCREAT    73)
(defconstant EX_IOERR        74)
(defconstant EX_TEMPFAIL     75)
(defconstant EX_PROTOCOL     76)
(defconstant EX_NOPERM       77)
(defconstant EX_CONFIG       78)
(defconstant EX__MAX         78)

(defvar do-clear    t "Whether clear screen actuall works.")
(defun clear () (when do-clear (ext:run-program "/usr/bin/clear")))

(defvar language    "ge" "The language selected for euronews.")
(defvar index       0)
(defvar last-index  0)
(defvar previous    nil)
(defvar urls        '())
(defvar length-urls 0)
(defvar played      nil)
(defvar played-last nil)
(defvar menu-items  '())

(defconstant +available-languages+ '(de fr en it es ru))

(defun language-to-euronews (lang)
  (cond
     ((member lang '("ge" "de") :test 'string-equal) "ge")
     ((member lang '("es" "sp") :test 'string-equal) "sp")
     ((member lang +available-languages+ :test 'string-equal) lang)
     (t nil)));;language-to-euronews

  
(dolist (arg (if (boundp 'ext:*args*) ext:*args* nil))
  (setq language (language-to-euronews arg))
  (unless language 
    (format t "~%usage:~%")
    (format t "   euronews  [de|fr|en|it|es|po|ru]~%")
    (ext:exit EX_USAGE)))


(defun stream-to-string-list (stream)
  (loop with line = (read-line stream nil nil)
        while line
        collect line into result
        do (setq line (read-line stream nil nil))
        finally return result)
  );;stream-to-string-list



(defun played-indicator      (index)  (if (aref played index) "*" " "))
(defun played-last-indicator (index)  (if (= index played-last) "#" " "))
(defun set-played (index  rest)
  (when rest (setq played-last index))
  (setf (aref played index) rest))


(defun get-urls ()
  (setq previous nil)
  (setq urls
        (loop for item in (sort
                           (loop for page in '( "accueil_info" "acceuil_eco" "euro" "lemag" "hitech" )
                                 for new-urls = (stream-to-string-list
                                                 (ext:run-shell-command 
                                                  (format nil "{ lynx -source 'http://www.euronews.net/create_html.php?page=~A&langue=~A'|tr '<' '\\012'|grep ramgen|sed -e 's/.*lien=\\(.*hostname\\).*/http:\\/\\/\\1/' ;}" page language)
                                                  :input     nil
                                                  :output    :stream))
                                 ;;do (format t "new-urls=~S~%" new-urls)
                                 append new-urls into all-urls
                                 finally return all-urls)
                           'string<=)
              ;;do (format t "item=~S~%" item)
              when (and previous (string/= previous item))
              collect item into all-urls
              do (setq previous item)
              finally return all-urls))
  (setq length-urls (length urls)) ;;get-urls
  (setq played (make-array (list length-urls) :initial-element nil))
  (setq played-last -1)
  (setq last-index 1));;get-urls


(defun get-file-name (url)
  (let ((question nil)
        (slash nil))
  (loop for index from (1- (length url)) downto 0
        until slash
        when (char= (char url index) (character '\?)) do (setq question index)
        when (char= (char url index) (character '\/)) do (setq slash index)
        finally return (subseq url (1+ slash) question)))
  );;get-file-name





;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; The main script:
;; ----------------

(get-urls)
(loop while (and (/= 0 last-index) (<= last-index length-urls))
      do
      ;; index is counted between 1 and (length urls)
      ;; index==0 means quit
      ;; urls list and played array are  0 indexed though.
      (clear)

      (setq menu-items
            (loop for index = 0 then (1+ index)
            for url in urls
            collect (format nil "~2D ~1A~1A ~34A" 
                       (1+ index)
                       (played-indicator        index)
                       (played-last-indicator   index)
                       (get-file-name (elt urls index)))
            into menu-items
            finally return menu-items))
      (loop for line from 0 to 21
            for menu = line
            do (loop for menu = line then (+ 22 menu)
                     while (< menu (length menu-items))
                     do (format t "~40A" (elt menu-items menu))
                     finally (format t "~%")))

      (format t "~%Number to play (0 to quit) or language ~S: "
              +available-languages+)
      (setq index (read))
      (cond
       ((member index +available-languages+)
         (setq language (language-to-euronews index))
         (get-urls))
       ((numberp index)
        (if (and (<= 0 index) (<= index length-urls))
            (setq last-index index)
          (progn
            (format t "Invalid option!")
            (setq last-index (- 0 last-index)))))
       ((eq 'n index)
        (setq last-index (1+ (mod last-index length-urls))))
       ((eq 'p index)
        (setq last-index (1+ (mod (- last-index 2) length-urls))))
       ((eq 'q index)
        (setq last-index 0))
       ((eq 'r index)
        ;; replay - no change
        )
       (t
        (format t "Invalid option!")
        (setq last-index (- 0 last-index))))
      
      (when (< 0 last-index)
        (ext::shell (format nil "/local/apps/RealPlayer8/realplay '~A' &"
                             (elt urls (1- last-index))))
        (set-played (1- last-index) t)
        (setq index (1+ (mod last-index length-urls))))
      (setq last-index (abs last-index))
      );;loop

(ext:exit EX_OK)

;;;; euronews                         --                     --          ;;;;