vince-gnus-composition.el

;; Introduction d'une citation
(defun vince-sc-header-fr ()
  "En ce beau matin/soir/après-midi/nuit/etc. du <date>, <from> nous disait... ;
1. Si <from> n'est pas trouvé, on le remplace par un inconnu
2. Si <date> n'est pas trouvé, seule la deuxième partie de la phrase est insérée"
  (let ((sc-mumble ""))			; Je ne sais pas à quoi ça
					; sert, mais c'est dans tous
					; les autres. Je crois que ça
					; indique que renvoyer pour
					; les sc-mail-field quand le
					; champ en question n'est pas
					; trouvé.
    (insert "OoO "
	    (sc-hdr (vince-sc-date-prefixe-fr (sc-mail-field "date"))
		    (if (vince-is-idiot (downcase (sc-mail-field "from"))) ; Si c'est un idiot...
			(let ()
			  (concat 
			   (int-to-string
			    (-
			     (time-to-days (date-to-time (sc-mail-field "date")))
			     (time-to-days (encode-time 0 0 0 01 09 1993))))
			   " septembre 1993")) ; Septembre 1993...
		      (vince-traduire-date-fr (sc-mail-field "date"))) ", ")
	    (sc-hdr "vers " (format-time-string "%H:%M" (date-to-time (sc-mail-field "date"))) ", ")
; le "t" à la fin, c'est pour renvoyer nil s'il n'y a pas d'auteur.
	    (if (string-match user-full-name (sc-mail-field "sc-author"))
		"je disais:"
	      (concat (or
		       (sc-hdr "" (sc-mail-field "from") " " t)
		       "un inconnu ")
;	    (or (sc-hdr "" (sc-mail-field "sc-author") " " t)
;		"un inconnu ")
;	    (or (sc-hdr "<" (sc-mail-field "sc-from-address") "> " t)
;		(sc-hdr "<" (sc-mail-field "sc-reply-address") "> " t)
;		"")
		      "disait :")))
	    (fill-paragraph nil)	; Ca évite de mettre des
					; retours à la ligne
					; arbitraires
	    (insert "\n")))

;; Définit un préfixe adapté à l'heure du message.
;; Exemple :(vince-sc-date-prefixe-fr "Wed, 18 Jul 2001 07:03:01 +0200 (EST)")
(defun vince-sc-date-prefixe-fr (date)
  "Renvoie un préfixe approprié (en Français) pour la date donnée en paramètre ;
Par exemple, pour la matin : En ce beau matin du ;
Renvoie la chaîne vide si la date est vide"
  (if (or (equal date nil)
	  (equal date ""))
      ""				; Je ne sais pas si c'est propre
    (let ((heure (parse-integer (format-time-string "%H" (date-to-time date)))))
      (concat
       (cond
	((< heure 2) "En cette nuit nuageuse")
	((< heure 3) "En cette nuit striée d'éclairs")
	((< heure 5) "En ce milieu de nuit étoilée")
	((< heure 7) "En cette fin de nuit blanche")
	((< heure 8) "En cette aube naissante")
	((< heure 9) "En ce doux début de matinée")
	((< heure 10) "En cette matinée ensoleillée")
	((< heure 11) "En cette matinée pluvieuse")
	((< heure 12) "En cette fin de matinée radieuse")
	((< heure 13) "Pendant le temps de midi")
	((< heure 14) "Peu avant le début de l'après-midi")
	((< heure 15) "En ce début d'après-midi nuageux")
	((< heure 16) "En ce début d'après-midi ensoleillé")
	((< heure 17) "Vers la fin de l'après-midi")
	((< heure 19) "Lors de la soirée naissante")
	((< heure 20) "Pendant le repas")
	((< heure 21) "Pendant le journal télévisé")
	((< heure 22) "En ce début de soirée")
	((< heure 23) "En cette soirée bien amorcée")
	(t "La nuit ayant déjà recouvert d'encre ce jour"))
       " du "))))


;; Traduction d'une date
;; Exemple : (vince-traduire-date-fr "Wed, 18 Jul 2001 16:03:01 +0200 (EST)")
(defun vince-traduire-date-fr (date)
  "Renvoie la date donnée en Français ;
Thu, Jun 5 2000 14:05:18 +200 ET devient jeudi 5 juin 2000
Renvoie la chaîne vide si la date est vide"
  (if (or (equal date nil)
	  (equal date ""))
      ""				; Je ne sais pas si c'est propre
    (let ((time (date-to-time date)))
; %w est le numéro du jour de la semaine ; 0 = dimanche
      (concat
       (nth (parse-integer (format-time-string "%w" time))
	    '("dimanche" "lundi" "mardi" "mercredi" "jeudi" "vendredi" "samedi"))
; Le jour du mois
       (format-time-string " %d " time)
; Le nom du mois
; %m est le numéro du mois
       (nth (1- (parse-integer (format-time-string "%m" time)))
	    '("janvier" "février" "mars" "avril" "mai" "juin" "juillet"
	      "août" "septembre" "octobre" "novembre" "décembre"))
; L'année
       (format-time-string " %Y" time)))))
   
(setq sc-rewrite-header-list
      '(
	(vince-sc-header-fr)
	(vince-sc-header-fr)
	(vince-sc-header-fr)
	(vince-sc-header-fr)
	(vince-sc-header-fr)
	(vince-sc-header-fr)
	(vince-sc-header-fr)
	(vince-sc-header-fr)
	(vince-sc-header-fr)
	(vince-sc-header-fr)
	))