#!/u/annis/local/bin/csi -script
;;; $Id: most-recently-changed.scm,v 1.8 2005-01-27 15:01:14-06 annis Exp $
;;; $Source: /u/annis/code/chicken/RCS/most-recently-changed.scm,v $
;;;
;;; Copyright (c) 2005 William S. Annis.  All rights reserved.
;;; This is free software; you can redistribute it and/or modify it
;;; under the same terms as Perl (the Artistic Licence).  Developed at
;;; the Department of Biostatistics and Medical Informatics, University
;;; of Wisconsin, Madison.
;;;
;;; Find N number of the most recently touched files from a given
;;; directory down.
;;;   $0 [ -n N ] dir0 dir1 ... dirM
;;;      show N most recent (default 7) in all directories given

(require-extension posix)
(require-extension format)
(require-extension vector-lib)          ; for the sorted pail
;(require-extension debug)

;(define (regular-file? fn)   ;;; correct version will be in next release
;  (not (directory? fn)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Sorted Pails - a fixed size window of values; on adding a new
;;;   value it is checked against the current contents; if it is between
;;;   the top and bottom value, it is inserted and the bottom value
;;;   is tossed away.  This is used for collecting the N most something.

;;; spail: (vector . comparator-function)
(define spail-data car)
(define spail-gte cdr)

;;; make-spail int comparator (optional default fill value)
;;;   the comparator is for sorting 
(define (make-spail size gte . default)
  (cons (make-vector size (:optional default #f))
        gte))

;;; Binary search: much faster once you start getting above about 150 items.
(define (binary-vec-gte-index gte v item)
  (define (insert-here? idx)
    (and (gte (vector-ref v (- idx 1))
              item)
         (gte item (vector-ref v idx))))
  (let search ((start 1) (end (vector-length v)) (previous-i #f))
    (let ((i (quotient (+ start end) 2)))
      (if (and previous-i (= i previous-i))
          #f
          (cond ((insert-here? i) i)
                ((gte item (vector-ref v i))
                 (search start i i))
                ((gte (vector-ref v i) item)
                 (search i end i)))))))

(define (spail-set! spail item)
  (let* ((v (spail-data spail))
         (gte (spail-gte spail))
         (idx (binary-vec-gte-index gte v item)))
    (cond (idx (vector-insert! v idx item))
          ((gte item (vector-ref v 0))
           (vector-insert! v 0 item))
          (else #f))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; file information - don't stat files already seen
;;;   (string:filename . float:mtime)
(define file-info cons)
(define finfo-fname car)
(define finfo-modtime cdr)

;;; have to chop off the annoying trailing newline
(define (fixed-timestring t)
  (let ((mtz (time->string (seconds->local-time t))))
    (substring mtz 0 (- (string-length mtz) 1))))

(define (finfo-print f)
  (match-let (((name . mtime) f))
    ;; the empty string is the filename for the default non-file fill
    (unless (string=? name "")
      (print (format "~a ~a" (fixed-timestring mtime) name)))))

;;; for sorting
(define (finfo-modtime>=? f1 f2)
  (>= (finfo-modtime f1)
      (finfo-modtime f2)))

(define file-modtime file-modification-time)   ; RSI-prevention


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; grovel over a dictionary, shoving regular files into the spail
(define (find-most-recent dir spail)
  (find-files dir
              regular-file?
              (lambda (fn slist)
                (spail-set! spail (file-info fn (file-modtime fn))))
              spail))

(define (main *ign*)
  (let ((argv (command-line-arguments))
        (spail (make-spail 7 finfo-modtime>=? (file-info "" 0))))
    (if (string=? (car argv) "-n")
        (begin
          (set! spail (make-spail 
                       (string->number (cadr argv))
                       finfo-modtime>=?
                       (file-info "" 0)))
          (set! argv (cddr argv))))
    (map (lambda (dir) (find-most-recent dir spail)) argv)
    ;; now spail is full of our most recent files
    (vector-map finfo-print (spail-data spail))))

(main #f)

;;; Local Variables: ***
;;; mode: hen ***
;;; End: ***