(defpackage clhs-lookup
  (:use :common-lisp)
  (:export :symbol-lookup
           :populate-table
           :spec-lookup))
(in-package :clhs-lookup)

(defparameter *hyperspec-pathname* (translate-logical-pathname "MOXIE:RES;"))

(defparameter *hyperspec-map-file* (merge-pathnames "Map_Sym.txt" *hyperspec-pathname*))

(defparameter *hyperspec-root* "http://www.lispworks.com/reference/HyperSpec/")

;;; AMOP.
(defparameter *mop-map-file* (merge-pathnames "Mop_Sym.txt" *hyperspec-pathname*))

(defparameter *mop-root* "http://www.alu.org/mop/")

(defvar *symbol-table* (make-hash-table :test 'equal))

(defvar *section-table* (make-hash-table :test 'equal))

(defvar *format-table* (make-hash-table :test 'equal))

(defvar *populated-p* nil)
                                                   
(defun add-clhs-section-to-table (&rest numbers)
  (let ((key (format nil "~{~d~^.~}" numbers))
        (target (concatenate 'string *hyperspec-root* (format nil "Body/~2,'0d_~(~{~36r~}~).htm" (car numbers) (mapcar #'(lambda (x) (+ x 9)) (cdr numbers))))))
    (setf (gethash key *section-table*) target)))

(defun valid-target (&rest numbers)
  (probe-file (format nil "Body/~2,'0d_~(~{~36r~}~).htm" (car numbers) (mapcar #'(lambda (x) (+ x 9)) (cdr numbers)))))

(defvar *last-warn-time* 0)

(defun populate-table ()
  (unless *populated-p*
    ;; Hyperspec
    (with-open-file (s *hyperspec-map-file* :if-does-not-exist nil)
      ;; populate the table with the symbols from the Map file
      ;; this bit is easy and portable.
      (unless s
        (when (> (- (get-universal-time) *last-warn-time*) 10)
          (format *trace-output* "Warning: could not find hyperspec map file. Adjust the path at the top of clhs-lookup.lisp to get links to the HyperSpec.~%")
          (setf *last-warn-time* (get-universal-time)))
        (return-from populate-table nil))
      (do ((symbol-name (read-line s nil s) (read-line s nil s))
           (url (read-line s nil s) (read-line s nil s)))
          ((eq url s) 'done)
        (setf (gethash symbol-name *symbol-table*) (concatenate 'string *hyperspec-root* (subseq url 3))))
      ;; add in section references.
      (let ((*default-pathname-defaults* *hyperspec-pathname*))
        ;; Yuk. I know. Fixes welcome.
        (loop for section from 0 to 27
              do (add-clhs-section-to-table section)
              do (loop named s for s1 from 1 to 26
                       unless (valid-target section s1)
                       do (return-from s nil)
                       do (add-clhs-section-to-table section s1)
                       do (loop named ss for s2 from 1 to 26
                                unless (valid-target section s1 s2)
                                do (return-from ss nil)
                                do (add-clhs-section-to-table section s1 s2)
                                do (loop named sss for s3 from 1 to 26
                                         unless (valid-target section s1 s2 s3)
                                         do (return-from sss nil)
                                         do (add-clhs-section-to-table section s1 s2 s3)
                                         do (loop named ssss for s4 from 1 to 26
                                                  unless (valid-target section s1 s2 s3 s4)
                                                  do (return-from ssss nil)
                                                  do (add-clhs-section-to-table section s1 s2 s3 s4)
                                                  do (loop named sssss for s5 from 1 to 26
                                                           unless (valid-target section s1 s2 s3 s4 s5)
                                                           do (return-from sssss nil)
                                                           do (add-clhs-section-to-table section s1 s2 s3 s4 s5))))))))
      ;; format directives
      (loop for code from 32 to 127
            do (setf (gethash (format nil "~~~A" (code-char code)) *format-table*)
                     (concatenate 'string
                                  *hyperspec-root*
                                  (case (code-char code)
                                    ((#\c #\C) "Body/22_caa.htm")
                                    ((#\%) "Body/22_cab.htm")
                                    ((#\&) "Body/22_cac.htm")
                                    ((#\|) "Body/22_cad.htm")
                                    ((#\~) "Body/22_cae.htm")
                                    ((#\r #\R) "Body/22_cba.htm")
                                    ((#\d #\D) "Body/22_cbb.htm")
                                    ((#\b #\B) "Body/22_cbc.htm")
                                    ((#\o #\O) "Body/22_cbd.htm")
                                    ((#\x #\X) "Body/22_cbe.htm")
                                    ((#\f #\F) "Body/22_cca.htm")
                                    ((#\e #\E) "Body/22_ccb.htm")
                                    ((#\g #\G) "Body/22_ccc.htm")
                                    ((#\$) "Body/22_ccd.htm")
                                    ((#\a #\A) "Body/22_cda.htm")
                                    ((#\s #\S) "Body/22_cdb.htm")
                                    ((#\w #\W) "Body/22_cdc.htm")
                                    ((#\_) "Body/22_cea.htm")
                                    ;((#\<) "Body/22_ceb.htm")
                                    ((#\i #\I) "Body/22_cec.htm")
                                    ((#\/) "Body/22_ced.htm")
                                    ((#\t #\T) "Body/22_cfa.htm")
                                    ;; FIXME
                                    ((#\<) "Body/22_cfb.htm")
                                    ((#\>) "Body/22_cfc.htm")
                                    ((#\*) "Body/22_cga.htm")
                                    ((#\[) "Body/22_cgb.htm")
                                    ((#\]) "Body/22_cgc.htm")
                                    ((#\{) "Body/22_cgd.htm")
                                    ((#\}) "Body/22_cge.htm")
                                    ((#\?) "Body/22_cgf.htm")
                                    ((#\() "Body/22_cha.htm")
                                    ((#\)) "Body/22_chb.htm")
                                    ((#\p #\P) "Body/22_chc.htm")
                                    ((#\;) "Body/22_cia.htm")
                                    ((#\^) "Body/22_cib.htm")
                                    ((#\Newline) "Body/22_cic.htm")
                                    (t "Body/22_c.htm")))))
      ;; glossary.
      )
    ;; MOP
    (with-open-file (s *mop-map-file* :if-does-not-exist nil)
      (when s
        (do ((symbol-name (read-line s nil s) (read-line s nil s))
             (url (read-line s nil s) (read-line s nil s)))
            ((eq url s) 'done)
          (setf (gethash (concatenate 'string "MOP:" symbol-name) *symbol-table*) (concatenate 'string *mop-root* url)))))
    (setf *populated-p* t)))

(defun spec-lookup (term &key (type :all))
  (unless *populated-p*
    (populate-table))
  (ecase type
    (:all
     (or (gethash term *symbol-table*)
         (gethash term *section-table*)
         (gethash term *format-table*)))
    (:symbol
     (gethash term *symbol-table*))
    (:section
     (gethash term *section-table*))
    (:format
     (gethash term *format-table*))))

(defun symbol-lookup (term)
  (spec-lookup term :type :symbol))