#!/bin/sh
: ; exec klone $0 "$@"
; The above line finds the klone executable in the $PATH
;;Skeleton of a typical klone script
;;(stack-dump-on-error t)
;;(kdb t)

(setq args (getopts "USAGE: gmail [options] patterns
Scans your MH mail via glimpse in a more user-friendly way, in that glimpse 
searches files containing ALL the patterns.

This script supposes that your mail + indexes are in ~/Mail, and stores
the results of searches in the folder ~/Mail/TMP as links to mails
To use it you must index (at night) your mails, for instance by
    glimpseindex -b -B -i -H ~/Mail ~/Mail
and do: 
    echo * > ~/Mail/.glimpse_exclude
    for i in 0 1 2 3 4 5 6 7 8 9; do echo \"*$i\";done>~/Mail/.glimpse_include
If a file ~/Mail/.glimpse_relative_path excists, it is used to prefix 
glimpse paths
"
    ("-F" file-pattern A-F 
      "limits  the search to those files whose name
       (including  the whole  path) matches file_pattern")
    ("-i" () A-i "case insensitive search")
    ("-k" () A-k "fgrep search")
    ("-w" () A-w "patterns must be a complete word")
    ("-x" () A-x "patterns must be a complete line")
    ("-1" () E-1 "agrep: 1 error permitted (0 default)")
    ("-2" () E-2 "2 errors tolerated")
    ("-3" () E-3 "2 errors tolerated")
    ("-4" () E-4 "2 errors tolerated")
    ("-5" () E-5 "2 errors tolerated")
    ("-6" () E-6 "2 errors tolerated")
    ("-7" () E-7 "2 errors tolerated")
    ("-8" () E-8 "2 errors tolerated")
    ("-d" destdir TMP "where to put results (default ~/Mail/TMP)")
    ("-v" () verbose "verbose operation")
    ("-ns" () nosort "dont sort messages")
))


(defun main (&aux
    glimpse
    file
    (count 0)
    (N 0)
    (ht (Hashtable ()))
    (search-string (copy ""))
    (re (regcomp "^([^:]*[/][0-9][0-9]*):"))
    (dir (expand-filename (if TMP TMP "~/Mail/TMP")))
    (old-dir (expand-filename "~/Mail/Old"))
    (path-prefix "")
  )
  (setq *current-directory* "~")
  (if (file-stats "~/Mail/.glimpse_relative_path") (progn
      (setq path-prefix (match "^([^\n]*)" 
	  (String (open "~/Mail/.glimpse_relative_path")) 1
      ))
      (if (not path-prefix) (setq path-prefix ""))
  ))
  (dolist (arg args)
    (if (/= "" search-string)
      (nconc search-string ";")
    )
    (nconc search-string arg)
  )
  (sh rm "-rf" ,dir)
  (if (/= 'directory (file-type dir)) (sh mkdir ,dir))
  (if (/= 'directory (file-type dir))
    (progn (PF "problem creating %0, aborting!\n" dir) (exit 1))
  )
  (setq command (+ (list "glimpse" "-H" "Mail" "-W" "-y" )
      (if A-F (list "-F" A-F))
      (if A-i '("-i"))
      (if A-w '("-w"))
      (if A-x '("-x"))
      (if A-k '("-k"))
      (if E-1 '("-1"))
      (if E-2 '("-2"))
      (if E-3 '("-3"))
      (if E-4 '("-4"))
      (if E-5 '("-5"))
      (if E-6 '("-6"))
      (if E-7 '("-7"))
      (if E-8 '("-8"))
      (list "-e" search-string))) 
  (if verbose (PF "issuing command: %0\n" command))
  (system command :output 'glimpse)
  (while (setq line (read-line glimpse ()))
    (if (and (regexec re line)
	(setq file (+ path-prefix (regsub re 1)))
	(incf count)
	(not (getn ht file))
      )
      (progn
	(if verbose (write-line line))
	(put ht file t)
	(incf N)
	(wait (system (list "ln" "-s" file (+ dir "/" (String N)))))
  )))
  (PF "%0 in %1 files found, put in %2\n" count N dir)
  (uniq-mess dir old-dir)
  (if (and (not nosort) (> N 0))
    (sh sortm "+TMP")
  )
)

(defun uniq-mess (dir old-dir &aux
    (ids (Hashtable ()))		;base of messages (list) per ID
    id
    files
    (*current-directory* dir)
  )
  (dolist (file (directory))
    (setq id (message-id file))
    (if (setq files (getn ids id))
      (lappend files file)
      (put ids id (vector file))
    )
  )
  (dohash (id files ids)
    (dolist (file (subseq files 1))	;keep only first one
      (sh rm ,file)
  ))
)

(setq message-id:re (regcomp "^Message-Id: *(.*)$"))
(defun message-id (file &aux
    (fd (open file))
    (res file)				;default id is unique: file name
  )
  (catch 'EOF (while t
      (if (regexec message-id:re (read-line fd))
	(throw 'EOF (setq res (regsub message-id:re 1)))
  )))
  res
)

(main)

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