Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2
Modified Files: clhs-lookup.lisp Log Message: Add back MOP and format lookup
Date: Thu Jun 3 07:16:16 2004 Author: bmastenbrook
Index: lisppaste2/clhs-lookup.lisp diff -u lisppaste2/clhs-lookup.lisp:1.1 lisppaste2/clhs-lookup.lisp:1.2 --- lisppaste2/clhs-lookup.lisp:1.1 Tue Jun 1 06:41:27 2004 +++ lisppaste2/clhs-lookup.lisp Thu Jun 3 07:16:16 2004 @@ -1,9 +1,9 @@ (defpackage :clhs-lookup (:use :common-lisp) (:export :symbol-lookup - :populate-table)) + :populate-table + :spec-lookup)) (in-package :clhs-lookup)
-;;; CLHS. This will be the default lookup. -(defparameter *hyperspec-pathname* #p"/Users/chandler/HyperSpec/") +(defparameter *hyperspec-pathname* #p"/home/bmastenbrook/HyperSpec/")
(defparameter *hyperspec-map-file* (merge-pathnames "Data/Map_Sym.txt" *hyperspec-pathname*))
@@ -14,8 +14,20 @@
(defparameter *mop-root* "http://www.alu.org/mop/")
-(defvar *table* (make-hash-table :test 'equalp)) +(defvar *symbol-table* (make-hash-table :test 'equalp)) + +(defvar *section-table* (make-hash-table :test 'equalp)) + +(defvar *format-table* (make-hash-table :test 'equalp))
+(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))))) + (defun populate-table () ;; Hyperspec (with-open-file (s *hyperspec-map-file*) @@ -24,24 +36,97 @@ (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 *table*) (concatenate 'string *hyperspec-root* (subseq url 3)))) + (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) *table*) (concatenate 'string *mop-root* url)))))) - -(defmacro aif (test conseq &optional (else nil)) - `(let ((it ,test)) - (if it ,conseq - (symbol-macrolet ((it ,test)) - ,else)))) - -(defun symbol-lookup (str) - (aif (gethash str *table*) - it - nil)) + (with-open-file (s *mop-map-file*) + (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))))) + +(defun spec-lookup (term &key (type :all)) + (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))