;; emacscoincoin.el un coincoin pour emacs

;; Copyright (C) 2005 Lo�ïc Le Guyader <loic.leguyader@laposte.net>

;; 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.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.

;;; Commentary:

;; after having edited the cookies variable to a correct value
;; byte-compile the file and load it, then start the coincoin with 
;; M-x startcc
;; Poste a message with
;; M-x post
;; Stop the coincoin with
;; M-x stopcc


(defvar cookies "Cookie:md5=;unique_id=")
(defvar ua "User-Agent: emacscoincoin 24.9")
(defvar tribunebuffer nil)
(defvar lastid 0)
(defvar remotexmlbuffer nil) 
(defvar refresh nil) ;;timer to refresh the board
(defvar causeavectribune nil)

(defun startcc ()
  "start le coincoin"
  (interactive)
  (save-excursion  
   (setq tribunebuffer (get-buffer-create "*linuxfr*"))
   (set-buffer tribunebuffer)
   (erase-buffer)
   (setq buffer-read-only t)
   (goto-char 0)
   (updatetribune)
   (switch-to-buffer "*linuxfr*")
   (setq refresh (run-at-time t 30 'updatetribune))
   )
  )

(defun stopcc ()
  "stop le coincoin"
  (interactive)
  (cancel-timer refresh)
  (setq lastid 0)
  (kill-buffer tribunebuffer)
  )

;; recupere les nouveaux messages
(defun updatetribune ()
  "mets a jour la tribune"
  (if (not causeavectribune)
      (let (
	    (temps)
	    (sid)
	    (id)
	    (info)
	    (message)
	    (login)
	    )
	(setq causeavectribune t)
	(get-remotexml)
	(save-excursion
	  (set-buffer remotexmlbuffer)
	  (goto-char (point-max))
	  (while (re-search-backward "<post time=\"\\([0-9]*\\)\" id=\"\\([0-9]*\\)\">\n\\s-*<info>\\(.*\\)</info>\n\\s-*<message>\\(.*\\)</message>\n\\s-*<login>\\(.*\\)</login>\n</post>" nil t)
	    
	    
	    (setq temps (match-string 1))
	    (setq sid (match-string 2))
	    (setq id (string-to-number sid))
	    (setq info (match-string 3))
	    (setq message (match-string 4))
	    (setq login (match-string 5))
	    
	    (if (> id lastid)
		(save-excursion
		  (set-buffer tribunebuffer)
		  (goto-char (point-max))
		  (setq inhibit-read-only t)
		  (insert (fabrique-ligne  temps sid info login message))
		  (newline)
		  (setq inhibit-read-only nil)
		  (setq lastid id)
		  )
	      )
	    
	    (set-buffer remotexmlbuffer)
	    
	    )
	  )
	(kill-buffer remotexmlbuffer)
	(setq causeavectribune nil)
	)
    )
  )

;; fabrique une ligne a afficher
(defun fabrique-ligne (temps id info login msg)
  "fabrique une ligne"
  (let (
	(ntemps)
	(nmsg)
	(nlogin)
	(timemap (make-sparse-keymap))
	)
    (define-key timemap [mouse-1] 'click-on-horloge)
    (setq ntemps (propertize (concat (substring temps 8 10) ":"
				     (substring temps 10 12) ":"
				     (substring temps 12 14) )
			     'mouse-face 'highlight
			     'keymap timemap))
    (setq nmsg (desalopage msg))
    (setq nlogin  (propertize login 'face '(:foreground "red")
			      'help-echo (concat id " " info)))
    (concat ntemps " " nlogin " : " nmsg )
    )
  )

;; convertit le html en truc lisible
(defun desalopage (msg)
  "d�ésalope le bordel"
  (let (
	(nmessage)
	(res)
	(nbuffer)
	)
    (save-excursion
      (setq nbuffer (get-buffer-create "*eccc*"))
      (set-buffer nbuffer)
      (erase-buffer)
      (goto-char 0)
      (insert msg)
      
      (goto-char 0)
      (perform-replace "&amp;" "&" nil nil nil) 
      (goto-char 0) ;; mystere et boule de crassse, mais faut le faire 2 fois !
      (perform-replace "&amp;" "&" nil nil nil) 
      (goto-char 0)
      (perform-replace "&gt;" ">" nil nil nil) 
      (goto-char 0)
      (perform-replace "&lt;" "<" nil nil nil) 
      (goto-char 0)
      (perform-replace "&eacute;" "�é" nil nil nil) 
      (goto-char 0)
      (perform-replace "&egrave;" "�è" nil nil nil) 
      (goto-char 0)
      (perform-replace "&ecirc;" "�ê" nil nil nil) 
      (goto-char 0)
      (perform-replace "&ccedil;" "�ç" nil nil nil) 
      (goto-char 0)
      (perform-replace "&agrave;" "�à" nil nil nil) 
      (goto-char 0)
      (perform-replace "&acirc;" "�â" nil nil nil) 
      (goto-char 0)
      (perform-replace "&ocirc;" "�ô" nil nil nil) 
      (goto-char 0)
      (perform-replace "&ugrave;" "�ù" nil nil nil) 
      (goto-char 0)
      (perform-replace "&ucirc;" "�û" nil nil nil) 
      (goto-char 0)
      (perform-replace "&icirc;" "�î" nil nil nil) 
      (goto-char 0)
      (perform-replace "&iuml;" "�ï" nil nil nil) 
      (goto-char 0)
      (perform-replace "&quot;" "\"" nil nil nil) 

      (horloge-dans-message)
      (totoz-dans-message)
      (setq nmessage (buffer-string))
      (kill-buffer nbuffer)
      (setq res nmessage)
      )
    )
  )
;; pour mettre en evidence les horloges dans les messages
(defun horloge-dans-message ()
  "mets les propri�ét�és comme il faut pour les horloges dans les messages"
  (let (
	(timemap (make-sparse-keymap))
	)
    (define-key timemap [down-mouse-1] 'press-on-horloge)
    (define-key timemap [mouse-1] 'release-on-horloge)
    (save-excursion
      (goto-char 0)
      (while (re-search-forward "[0-2][0-9]:[0-5][0-9]:[0-5][0-9]" nil t)
	(add-text-properties (match-beginning 0) (match-end 0) 
			     (list 'face '(:foreground "blue")
				    'mouse-face 'highlight
				    'help-echo 'show-message
				    'keymap timemap ) )
	)
      )
    )
  )
      
;; affiche les messages correspondant �à horloge
(defun show-message (window object position)
  "affiche les messages"
  (let (
	(avant-horloge)
	(apres-horloge)
	(horloge)
	(message nil)
	)
    (save-excursion
      (set-buffer object)
      (save-excursion
	(goto-char position)
	(save-excursion
	  (setq avant-horloge (skip-chars-backward "0-9:")))
	(save-excursion
	  (setq apres-horloge (skip-chars-forward "0-9:")))
	
	(setq horloge (buffer-substring (+ (point) avant-horloge)
					(+ (point) apres-horloge)))
	(goto-char 0)
	(while (re-search-forward (concat "^" horloge ".*") nil t)
	  (setq message (concat message 
				(buffer-substring (match-beginning 0) (match-end 0))
				"\n"))
	  )
	(setq message message)
	)
      )
    )
  )

;; pour mettre en evidence les totoz dans les messages
(defun totoz-dans-message ()
  "mets les propri�ét�és comme il faut pour les totoz dans les messages"
  (let (
	(totoz)
	)
    (save-excursion
      (goto-char 0)
      (while (re-search-forward "\\[:\\([^]%]*\\)\\]" nil t)
	(setq totoz (buffer-substring (match-beginning 1) (match-end 1)))
	(add-text-properties (match-beginning 1) (match-end 1) 
			     (list 
			      'face '(:foreground "blue")
			      'mouse-face 'highlight
			      'display (get-totoz totoz)))
	)
      )
    )
  )

;;
(defun get-totoz (nom)
  ""
  (create-image (concat "~/.wmcoincoin/totoz/" nom ".gif"))
  )

;; press on horloge
(defun press-on-horloge (event)
  "quand on appuie sur une horloge"
  (interactive "e")
  (let (
	(avant-horloge)
	(apres-horloge)
	(horloge)
	)
    (save-excursion
      (set-buffer (window-buffer (posn-window (event-end event))))
      (save-excursion
	(goto-char (posn-point (event-end event)))
	(save-excursion
	  (setq avant-horloge (skip-chars-backward "0-9:")))
	(save-excursion
	  (setq apres-horloge (skip-chars-forward "0-9:")))
	
	(setq horloge (buffer-substring (+ (point) avant-horloge)
					(+ (point) apres-horloge)))
	(goto-char 0)
	(while (re-search-forward (concat "^" horloge ".*") nil t)
	  (setq inhibit-read-only t)
	  (add-text-properties (match-beginning 0) (match-end 0) 
			       (list 'face '(:background "lightblue")))
	  (setq inhibit-read-only nil)
	  )

	)
      )
    )
  )

;; press on horloge
(defun release-on-horloge (event)
  "quand on d�é-appuie sur une horloge"
  (interactive "e")
  (let (
	(avant-horloge)
	(apres-horloge)
	(horloge)
	)
    (save-excursion
      (set-buffer (window-buffer (posn-window (event-end event))))
      (save-excursion
	(goto-char (posn-point (event-end event)))
	(save-excursion
	  (setq avant-horloge (skip-chars-backward "0-9:")))
	(save-excursion
	  (setq apres-horloge (skip-chars-forward "0-9:")))
	
	(setq horloge (buffer-substring (+ (point) avant-horloge)
					(+ (point) apres-horloge)))
	(goto-char 0)
	(while (re-search-forward (concat "^" horloge ".*") nil t)
	  (setq inhibit-read-only t)
	  (add-text-properties (match-beginning 0) (match-end 0) 
			       (list 'face '(:background nil)))
	  (setq inhibit-read-only nil)
	  )

	)
      )
    )
  )

;; quand on click sur une horloge pour r�épondre
(defun click-on-horloge (event)
  "lorsque l'on clique sur une horloge pour r�épondre"
  (interactive "e")
  (save-excursion
    (set-buffer (window-buffer (posn-window (event-end event))))
    (save-excursion
      (goto-char (posn-point (event-end event)))
      (beginning-of-line)
      (post-with-horloge (buffer-substring (point) (+ (point) 8)))
      )
    )
  )

;; post avec un horloge
(defun post-with-horloge (horloge)
 "poste un message avec un horloge"
 (let (
       (message)
       (prompt  (concat horloge " : "))
       )
   (setq message (concat prompt (read-from-minibuffer prompt)))
   (post message)
   )
 )

 
;;get the remotxml in a buffer called *remotexml*
(defun get-remotexml ()
  "get a page"
  (let (
	(host "linuxfr.org")
	(port 80)
	(file "/board/remote.xml")
	(tcp-connection)
	(request) )
    (save-excursion
      (setq remotexmlbuffer (get-buffer-create "*remotexml*"))
      (setq tcp-connection
	    (open-network-stream
	     "GET"
	     remotexmlbuffer
	     host
	     port
	     ))
      
      (setq request (concat "GET " file " HTTP/1.0\nhost:" host "\n\n"))
      (process-send-string tcp-connection request)
      
      (while (eq (process-status tcp-connection) 'open)
	(sit-for 0 200) )

      (delete-process tcp-connection)
      )
    )
  )

;;post le message
(defun post (message)
  "poste un truc"
  (interactive "M")
  (let (
	(host "linuxfr.org")
	(port 80)
	(file "/board/add.html")
	(postdata "url=../board/&section=1&message=")
	(tcp-connection)
	(request)
	(temp)
	)
    (save-excursion
      (setq causeavectribune t)
      (setq tcp-connection
	    (open-network-stream
	     "POST"
	     nil
	     host
	     port
	     ))
      
      (setq temp (concat postdata message))
      (setq request (concat "POST " file " HTTP/1.0\n" 
			    "Host:" host "\n"
			    cookies "\n"
			    ua "\n" 
			    "Content-Type: application/x-www-form-urlencoded\n"
			    "Content-Length:" (number-to-string (length temp)) "\n\n"
			    temp))
      (process-send-string tcp-connection request)
      
      (while (eq (process-status tcp-connection) 'open)
	(sit-for 0 200) )
      
      (delete-process tcp-connection)
      (setq causeavectribune nil)
      )
    (updatetribune)
    
    )
  )