Timeline view of some directories of the hard drive (Common Lisp)

Un article de Caverne des 1001 nuits.


Having a timeline view of several folders in the hard drive.

This is my first Common Lisp program, so don't be too harsh :-)


; champ.lisp "Timeline explorer" v 1.1
; Copyleft 1001nuits (http://www.1001nuits.org - August 2010

;=====================General constants =====================
(defparameter *symbols* (list 'get-file-info 'test-get-file-info
                      'remove-singletons 'test-remove-singletons) "General symbols of the file")
(defparameter *DIR-WC* "*/" "Wild card default for directories. Could be implementation specific")
(defparameter *DIR* "/")
(defparameter *FILE-WC* "*" "Wild card default for files.")
(defparameter *months* (vector "January" "February" "March" "April" "May" "June" 
                        "July" "August" "September" "October" "November" "December"))

(defparameter *dict* nil)

(defun doc ()
    (dolist (elt *symbols*)
        (format t "Documentation for '~A': ~A~%" elt (documentation elt 'function))))

;=====================Get file info=====================

(defclass fi-info ()
    ((fi-univ :accessor univ
              :initarg :univ)
     (fi-dire :accessor dire
              :initarg :dire) 
     (fi-name :accessor name
              :initarg :name)
     (fi-year :accessor year
              :initarg :year)
     (fi-month :accessor month
               :initarg :month) 
     (fi-day :accessor day
             :initarg :day)
     (fi-seconds :accessor seconds
                 :initarg :seconds)))

(defun get-file-info (f)
    "Gets file information and put them in a list"
    (let* ((n (with-open-file (s f) (file-write-date s)))
           (l (multiple-value-list (decode-universal-time n)))
           (seconds (+ (first l) (* 60 (second l)) (* 3600 (third l))))
           (day (fourth l))
           (month (fifth l))
           (year (sixth l))
           (dire (namestring (car (directory f)))))
        (make-instance 'fi-info :univ n :dire dire :name f :seconds seconds :day day :month month :year year)))

(defun fi-more-recent-efficient? (a b)
    (if (> (univ a) (univ b)) t nil)) 

(defmethod format-link ((a fi-info))
    (let* ((fname (concatenate 'string (pathname-name (pathname (name a))) "." (pathname-type (pathname (name a)))))
           (fdir (subseq (name a) 0 (- (length (name a)) (length fname)))))
        (format nil "<a href=\"file://~A\" target=\"new\">~A</a> - <a href=\"file://~A\" target=\"new\">Folder</a>"
            (name a) fname fdir)))
(defmethod get-time ((a fi-info))
    (let ((timeobj (multiple-value-list (decode-universal-time (univ a)))))
        (format nil "~2,'0d:~2,'0d:~2,'0d" (third timeobj) (second timeobj) (first timeobj))))

(defun runfrom (dir)
    "The dir parameter is supposed to end with '/' because it is a folder"
    (let ((files (directory (concatenate 'string dir *FILE-WC*))))
        (dolist (file files 'done-files)
            (push (get-file-info (namestring file)) *dict*)))
    (let ((subdirs (directory (concatenate 'string dir *DIR-WC*))))
        (dolist (subdir subdirs 'done-dirs)
            (runfrom (concatenate 'string (namestring subdir) *DIR*))))) ;recurse

(defun html-format-dict (outputfile dict)
    (with-open-file (strea outputfile :direction :output
                                    :if-exists :supersede)
        (format strea "<html><head><title>Timeline Explorer</title></head>~%")
        (let ((tyear 0) (tmonth 0) (tday 0))
            (dolist (obj dict 'end)
                (let ( (tempyear (year obj))
                       (tempmonth (month obj))
                       (tempday (day obj))
                       (changeofyear nil)
                       (changeofmonth nil)
                       (changeofday nil))
                    (if (equal tyear 0)
                            (setf tyear tempyear) ;init loop
                            (setf changeofyear t))
                        (if (not (equal tyear tempyear))
                            (progn (setf changeofyear t) (setf tyear tempyear))))
                    (if (equal tmonth 0)
                            (setf tmonth tempmonth) ;init loop
                            (setf changeofmonth t))
                        (if (not (equal tmonth tempmonth))
                            (progn (setf changeofmonth t) (setf tmonth tempmonth))))
                    (if (equal tday 0)
                            (setf tday tempday) ;init loop
                            (setf changeofday t))
                        (if (not (equal tday tempday))
                                (setf changeofday t) (setf tday tempday))))
                    (if changeofyear (format strea "<hr>== Comments ==

Tested on [http://clisp.cons.org CLISP]. This is important because wild cards for directories are implementation specific.

[1]> (load "champ.lisp")
;; Loading file champ.lisp ...
;; Loaded file champ.lisp
[2]> (timeline-explorer:main "/home/foo/temp/output.html" "/home/foo/Documents" "/home/bar/Things")
7637 records treated in 4 seconds
Sorting done. Writing output to file...
Output written
Total time: 8 seconds

The program generates a very basic html page that you can bookmark in order to get it when you refresh it.