#!/bin/sh
: ; exec klone $0 "$@"
; The above line finds the klone executable in the $PATH

;;; ************************************************************************
;;; 
;;;		Hot list processing script
;;; 
;;; ************************************************************************

;;; Reads hotlist (file ~/.mosaic-hotlist-default)
;;; and hot list HTML format (standard input)
;;; Generates new item from hot list with HTML format (standard output)

;;; ========================================================================
;;;	Treats arguments
;;; ========================================================================

(setq usage "mosaic-new [options]
Incorporates items of a hotlist or hyperlink from HTML into a HTML document.
-? for help
")

(with
  (
    args (getopts usage
      ("-input" "hotlist-path" (hotlist-path "~/.mosaic-hotlist-default")
	"default is ~/.mosaic-hotlist-default"
      )
      ("-html" () input-is-html
	"indicates that input is a HTML document (default is hot list)"
      )
      ("-output" "html-path" (html-path "~/public_html/hotlist.html")
	"default is ~/public_html/hotlist.htm"
      )
      ("-c" () must-create
	"asks to create a complete document (default is to insert)"
      )
      ("-v" () verbose
	"prints some comments"
      )
      ("-debug" () debug
	"prints detailled comments"
      )
  ))
  (if args
    (progn
      (print usage)
      (exit)
)))

;; (print-format *standard-output* "-hotlist %0 -html %1 -c %2" hotlist-path html-path must-create)
;; (exit)

;;; ========================================================================
;;;	Format description
;;; ========================================================================

;;; --------------------------------
;;; format of html file (one line)
;;; --------------------------------
;; <A HREF="url">name</A>

(setq anchor-re (regcomp ".*<[a|A] [h|H][r|R][e|E][f|F]=\"(.*)\">(.*)<.*/[a|A]>.*")) 
;; 1 - url
;; 2 - name
(setq anchor-format "<LI><A HREF=\"%0\">%1</A>")

;;; --------------------------------
;;; format of hot list file (two lines) 
;;; --------------------------------
;; url
;; name

(setq url-re (regcomp "^([^ \t]+:[/][/][^ \t]+)"))
;; 1 - url

(setq hotlist-format "%0\n%1")

;;; --------------------------------
;;; format indicating place to insert
;;; --------------------------------

(setq insert-format "<comment Place to insert new items> </comment>")
(setq insert-re (regcomp insert-format))

;;; ========================================================================
;;;	Processing
;;; ========================================================================

;;; --------------------------------
;;;  Reads URL in HTML 
;;; --------------------------------

(setq  url-list (coerce () Hashtable)) 

(if (not must-create)
  (with (*standard-input* (open html-path))
    (if verbose (print-format "Reads HTML document %0\n" html-path))
    (while (setq line (read-line *standard-input* ()))
      (if (regexec anchor-re line)
	(put url-list (regsub anchor-re 1) (regsub anchor-re 2))
))))

;; (if debug (dohash (k v url-list) (print-format "\nURL: %0\nNAME: %1\m" k v)))

;;; --------------------------------
;;;  Read Hot List and memorizes the new ones
;;; --------------------------------

(setq new-entries (list))

(if input-is-html
  (with (
      *standard-input* (open hotlist-path)
    )
    (if verbose (print-format "Reads URL in %0\n" hotlist-path))
    (while (setq line (read-line *standard-input* ()))
      ;; (if debug (? line "\n" (regexec anchor-re line) "\n"))
      (if (regexec anchor-re line)
	(with (
	    url (regsub anchor-re 1)
	    name (regsub anchor-re 2)
	  )
  ;; (if debug (print-format *standard-output* "url: %0\nname: %1\n" url name))
	  (if (not (get url-list url ()))
	    (put new-entries -1 (print-format String anchor-format url name))
  )))))
  (with (
      *standard-input* (open hotlist-path)
    )
    (if verbose (print-format "Reads Hot list %0\n" hotlist-path))
    (while (setq line (read-line *standard-input* ()))
      (if (regexec url-re line)
	(with (
	    url (regsub url-re 1)
	    name (read-line *standard-input* "???")
	  )
	  (if (not (get url-list url ()))
	    (put new-entries -1 (print-format String anchor-format url name))
))))))

;;(if debug (? new-entries))

;;; --------------------------------
;;;  Sorts new entries according name 
;;; --------------------------------

;; normalize-phrase
;; extract the phrase in lowercase, without the first "a " or "the "
;; and lower-cased

(setq re-norm (regcomp "^<li><[^>]*>((a|the)[ ]+)?(.*)$"))
(defun normalize-phrase (p &aux p-norm)
  (setq p-norm (tolower p))
  (if (regexec re-norm p-norm)
    (setq p-norm (regsub re-norm 3))
  )
  p-norm
)
  
(if verbose (print-format "Sorts URLs\n"))
(sort new-entries
  (lambda (p1 p2) (compare (normalize-phrase p1) (normalize-phrase p2)))
)

;; (if debug (? new-entries))

;;; --------------------------------
;;;  Add new entries in the given file
;;; --------------------------------
;;;  At insertion point if exists or at the end

(if must-create
  ;; Creation from scratch
  (with (
      dummy (if verbose (print-format "Creates %0 with %1 item(s)\n" html-path (length new-entries)))
      *standard-output* (open html-path :direction :io :if-exists :supersede)
    )
    (print-format "<TITLE>Mosaic Hotlist</TITLE>\n")
    (print-format "<ul>\n<h2>Mosaic Hotlist</h2>")
    (dolist (s new-entries) (write-line s))
    (write-line insert-format)
    (print-format "</ul>")
  )
  ;; Insertion at the given point (default is end)
  (with (
      dummy (if verbose (print-format "Insert %0 item(s) in %1\n" (length new-entries) html-path))
      *standard-output* (open html-path :direction :io :if-exists :overwrite)
      *standard-input* *standard-output*
      insertion-position 0
      pending-strings (copy ())
    )
    (while (setq line (read-line *standard-input* ()))
      (if (regexec insert-re line)
	(while (setq line (read-line *standard-input* ()))
	  (setq pending-strings (put pending-strings -1 line))
	)	
	(setq insertion-position (file-position *standard-input*))
	(put url-list (regsub anchor-re 1) (regsub anchor-re 2))
    ))
    (file-position *standard-output* insertion-position)
    (dolist (s new-entries) (write-line s))
    (write-line insert-format)
    (dolist (s pending-strings) (write-line s))
  )
)

;;; ************************************************************************

;;; EMACS MODES
;;; Local Variables: ***
;;; mode:lisp ***
;;; End: ***