#!/bin/sh
: ; exec klone $0 "$@"
; The above line allows not to embed the exact path of the klone executable

;;Skeleton of a typical klone script

(setq args (getopts "USAGE: %0 [options] 
takes all files (whole dir if no argument) and if they lack the date
field, add one based on the file date itself."
    ("-v" () verbose "verbose operation")
;; --- Hidden Options ---
    ("-debug" () enter-debugger-on-error "enter klone debugger on error"
    :hidden t)
    ("-stackdump" () stackdump-on-error "verbose stack dump on error"
    :hidden t)
))

(if enter-debugger-on-error (kdb t))
(if stackdump-on-error (stack-dump-on-error t))

(setq re-numeric (regcomp "^[0-9]+$"))

(defun main (&aux (files (list))
  )
  ;; determines files we should process
  (if args (setq files args)
    (dolist (file (directory))
      (if (regexec re-numeric file) (lappend files file))
  ))
  (dolist (file files) (add-date file))
)

(defun add-date (file &aux
    mail
  )
  (setq mail (xmh-load file :error xmh-load::warning))
  (put mail "Treated" "Treated: Ok")
  (xmh-save mail)
)

;;AUTOLOAD: xmh-load
;;AUTODOC: xmh-load "parses a (X)MH mail file"
;;(xmh-load file [:error error-handler])
;;
;;Loads and returns a p-list describing the mail in the file argument
;;File can be a filename or an already open file descriptor
;;in the p-list, keys are strings of header names, and values are either 
;;strings or list of strings.
;;The mail body is indexed by the keyword :body
;;
;;If error-handler is set, it will be called with print-format -like arguments
;;you can throw to the 'xmh-load:error to exit without problems
;;
;;e.g: for the mail:
;;  From: foo@bar.com,
;;     gee@whiz.org
;;  Date: Fri, 28 Aug 1998 08:00:07 +0200 (MET DST)
;;  Received: from SCWM.MIT.EDU by sophia.inria.frn
;;  Received: (gjb@localhost) by elwha.cs.washington.edu
;;
;; the result will be:
;; ("From" "From: foo@bar.com,\n   gee@whiz.org"
;;  "Date" "Date: Fri, 28 Aug 1998 08:00:07 +0200 (MET DST)"
;;  "Received" ("Received: from SCWM.MIT.EDU by sophia.inria.frn"
;;              "Received: (gjb@localhost) by elwha.cs.washington.edu"))


(setq xmh-load:re-header (regcomp "^([^ \t\r\n:]+):(.*)$"))
(setq xmh-load:re-header-cont (regcomp "^[ \t\r\n]"))
(setq xmh-load:re-header-end  (regcomp "^$"))
(setq xmh-load:re-header-from  (regcomp "^From "))

(defun xmh-load (file &key ((error xmh-load:error) xmh-load::error) &aux 
    (fd (if (typep file Stream) file (open file)))
    (mail (vector))
    line current-header current-tag
  )
  (catch 'xmh-load:error
    (while (setq line (read-line fd ()))
      (if (regexec xmh-load:re-header line) (progn
	  (xmh-load:add-header mail current-tag current-header)
	  (setq current-header line)
	  (setq current-tag (regsub xmh-load:re-header 1))
	)
	(regexec xmh-load:re-header-cont line)
	(if current-header
	  (nconc current-header "\n" line)
	  (xmh-load:error "MH: continuation line without header: %0\n" line)
	)
	(regexec xmh-load:re-header-end line) (progn
	  (xmh-load:add-header mail current-tag current-header)
	  (put mail :body (String fd))
	  (if (not (typep file Stream)) (close fd))
	  (throw 'xmh-load:error mail)
	)
	(regexec xmh-load:re-header-from line)
	()				;ignore enveloppe From
	(= "--------" line) ()		;ignore MH headersep of drafts

	(xmh-load:error "MH: malformed header line: %0\n" line)
  )))
)

;;AUTOLOAD: xmh-save
;;AUTODOC: xmh-save "writes a (X)MH mail file"
;;(xmh-save mail [file])
;;
;;Loads and returns a p-list describing the mail in the file argument
;;File can be a filename or an already open file descriptor
;;in the p-list, keys are strings of header names, and values are either 
;;strings or list of strings.
;;The mail body is indexed by the keyword :body
;;
;;e.g: for the mail:
;;  From: foo@bar.com,
;;     gee@whiz.org
;;  Date: Fri, 28 Aug 1998 08:00:07 +0200 (MET DST)
;;  Received: from SCWM.MIT.EDU by sophia.inria.frn
;;  Received: (gjb@localhost) by elwha.cs.washington.edu
;;
;; the result will be:
;; ("From" "From: foo@bar.com,\n   gee@whiz.org"
;;  "Date" "Date: Fri, 28 Aug 1998 08:00:07 +0200 (MET DST)"
;;  "Received" ("Received: from SCWM.MIT.EDU by sophia.inria.frn"
;;              "Received: (gjb@localhost) by elwha.cs.washington.edu"))

(defun xmh-save (mail &optional file &aux
    must-move?
    (fd (if file (if (typep file Stream) file 
	  (progn (setq must-move? t)
	    (open "NEW-MAIL" :if-exists :supersede :direction :output)
	)) *standard-output*
    ))
    (body "")
  )
  (dohash (tag header mail)
    (if (= :body tag)
      (setq body header)
      (if (typep header List)
	(dolist (sub-header header) (write-line sub-header fd))
	(write-line header fd)
  )))
  (write-string body fd)
  (close fd)
  (if must-move? (wait (system (list "mv" "NEW-MAIL" file))))
)

(defun xmh-load:add-header (mail tag header &aux)
  (if (getn mail tag)
    ;; header already there, value is list of headers
    (with (value (getn mail tag))
      (if (typep value List)
	(lappend value header)
	(put mail tag (list value header))
    ))
    (put mail tag header)
))

(defun xmh-load::error (&rest args)
  (if (not (typep file Stream))
    (print-format *standard-error* "In file %0:\n" file)
  )
  (apply fatal-error (+ '(1) args))
)      

(defun xmh-load::warning (&rest args)
  (if (not (typep file Stream))
    (print-format *standard-error* "In file %0:\n" file)
  )
  (apply print-format (+ (list *standard-error*) args))
  (throw 'xmh-load:error mail)
)      

(main)

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

