;-*-LISP-*-

(eval-when (EVAL LOAD COMPILE)
  (or (get 'DEFVST 'VERSION)
      (load '((LISP) DEFVST)))
  (or (get 'LFSDEF 'VERSION)
      (load '((RWK) LFSDEF))))

(eval-when (eval compile)
  (or (get 'IOTA 'VERSION)
      (load '((LIBLSP) IOTA)))
  (or (get 'UMLMAC 'VERSION)
      (LOAD '((LISP) UMLMAC))))

(eval-when (eval load)
  (or (get 'ERMSGC 'VERSION)
      (load '((LIBMAX) ERMSGC))))

(defvst FILE-DIRECTORY
   MACHINE
   NAME
   FILES)

(defvst FILE-BLOCK
   FN1
   FN2
   RANDOM
   DATE
   RDATE)

(defmacro bp (bp)
  (and (symbolp bp) (boundp bp) (setq bp (symeval bp)))
  (if (fixnump bp)
      (lsh bp -24.)
      `(lsh ,bp -24.)))

(defmacro temp-array (idx)
   `(arraycall fixnum temp-array ,idx))


(defvar temp-array (*array () 'fixnum 1024.))

(defun get-directory (name &optional (machine (STATUS SITE)))
   (iota ((dir (mergef '((* *) |.FILE.| |(DIR)|)
		       `((,machine ,name) * *))
	       '(IN FIXNUM)))
     (let ((ldir))
       (dotimes (i 1024.)
	 (setf (temp-array i) (in dir)))
       (setq ldir (cons-a-file-directory
		     NAME (sixbit-to-ascii (temp-array FS-UDNAME))
		     MACHINE machine))
       (do ((i (temp-array FS-UDNAMP) (+ i FS-LUNBLK))
	    (files))
	   ((> i 1023.) (setf (file-directory-files ldir)
			      (nreverse files)))
	 (IF (zerop (logand (lsh (temp-array (+ i FS-UNRNDM)) -18.)
			    (lsh FS-UNIGFL -18.)))
	     (push (CONS-A-FILE-BLOCK
		      FN1    (sixbit-to-ascii (temp-array (+ i fs-unfn1)))
		      FN2    (sixbit-to-ascii (temp-array (+ i fs-unfn2)))
		      RANDOM (temp-array (+ i fs-unrndm))
		      DATE   (temp-array (+ i fs-undate))
		      RDATE  (temp-array (+ i fs-unref)))
		   files)))
       ldir)))


(defun date-to-ascii (date)
  (format ()  "~D//~D//~D"
	  (ldb #o2704 date)
	  (ldb #o2205 date)
	  (ldb #o3307 date)))

(defun date-time-to-ascii (date)
  (let* ((hours (// (logand #o777777 date) #.(* 60. 60. 2)))
	 (temp (\ (logand #o777777 date) #.(* 60. 60. 2)))
	 (minutes (// temp #.(* 60. 2)))
	 (temp (\ temp #.(* 60. 2)))
	 (seconds (// temp 2.)))
    (format ()
      "~A ~2D:~2,48D:~2,48D"
      (date-to-ascii date)
      hours minutes seconds)))

(defvar MFD-INDEX-ALIST () "ALIST of (mfd-index . dir-name)")

(defun get-mfd-indexes (&optional (machine (status site)))
  (iota ((mfd `((,machine foo) |M.F.D.| |(FILE)|) '(IN FIXNUM)))
    (dotimes (i 1024.)
       (setf (temp-array i) (in mfd)))
    (do ((i (temp-array fs-mdnamp) (+ i fs-lmnblk)))
	((> i 1023.))
	(declare (fixnum i))
      (if (not (zerop (temp-array i)))
	  (progn
	   (putprop (sixbit-to-ascii (temp-array i))
		    (// (- i 24.) 2)
		    'MFD-INDEX)
	   (push `(,(// (- i 24.) 2) . ,(sixbit-to-ascii (temp-array i)))
		 MFD-INDEX-ALIST))))))


(defmethod* (display file-block-class) (self)
  "Display a file"
  (format T "~&~6A ~6A ~A (~A) (~A)"
     (file-block-fn1 self)
     (file-block-fn2 self)
     (date-time-to-ascii (file-block-date self))
     (date-to-ascii (logand (lsh -1 18.) (file-block-rdate self)))
     (get-name-from-mfd-index (ldb (bp fs-unauth) (file-block-rdate self)))))

(defun get-name-from-mfd-index (idx)
  (if (= idx #o777) '|???|
      (cond ((cdr (assoc idx mfd-index-alist)))
	    (t '|???|))))

(defun display-files (files)
  (cursorpos 'c)
  (mapc #'(lambda (file) (send file 'display)) files)
  ())