Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv6729

Modified Files: elisp-lookup.lisp clhs-lookup.lisp r5rs-lookup.lisp Log Message: Conditional populating

Date: Wed Jun 9 12:47:13 2004 Author: bmastenbrook

Index: lisppaste2/elisp-lookup.lisp diff -u lisppaste2/elisp-lookup.lisp:1.1 lisppaste2/elisp-lookup.lisp:1.2 --- lisppaste2/elisp-lookup.lisp:1.1 Thu Jun 3 13:20:19 2004 +++ lisppaste2/elisp-lookup.lisp Wed Jun 9 12:47:13 2004 @@ -1,21 +1,27 @@ (defpackage :elisp-lookup (:use :cl) - (:export :symbol-lookup :populate-table)) + (:export :populate-table :symbol-lookup)) (in-package :elisp-lookup)

(defparameter *elisp-root* "http://www.gnu.org/software/emacs/elisp-manual/html_node/")

(defparameter *elisp-file* "elisp-symbols.lisp-expr")

-(defparameter *table* nil) +(defvar *table* nil) + +(defvar *populated-p* nil)

(defun populate-table () - (with-open-file (r *elisp-file* :direction :input) - (setf *table* (make-hash-table :test #'equalp)) - (let ((s (read r))) - (loop for i in s do (setf (gethash (car i) *table*) (cdr i)))) - 'done)) + (unless *populated-p* + (with-open-file (r *elisp-file* :direction :input) + (setf *table* (make-hash-table :test #'equalp)) + (let ((s (read r))) + (loop for i in s do (setf (gethash (car i) *table*) (cdr i)))) + 'done) + (setf *populated-p* t)))

(defun symbol-lookup (symbol) + (unless *populated-p* + (populate-table)) (multiple-value-bind (val found) (gethash symbol *table*) (if found

Index: lisppaste2/clhs-lookup.lisp diff -u lisppaste2/clhs-lookup.lisp:1.3 lisppaste2/clhs-lookup.lisp:1.4 --- lisppaste2/clhs-lookup.lisp:1.3 Fri Jun 4 17:14:31 2004 +++ lisppaste2/clhs-lookup.lisp Wed Jun 9 12:47:13 2004 @@ -19,6 +19,8 @@ (defvar *section-table* (make-hash-table :test 'equalp))

(defvar *format-table* (make-hash-table :test 'equalp)) + +(defvar *populated-p* nil)

(defun add-clhs-section-to-table (&rest numbers) (let ((key (format nil "~{~d~^.~}" numbers)) @@ -29,93 +31,97 @@ (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*) - ;; populate the table with the symbols from the Map file - ;; this bit is easy and portable. - (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) + (unless *populated-p* + ;; Hyperspec + (with-open-file (s *hyperspec-map-file*) + ;; populate the table with the symbols from the Map file + ;; this bit is easy and portable. + (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 (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 (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 (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 (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 (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*) - (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))))) + ;; 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*) + (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*)

Index: lisppaste2/r5rs-lookup.lisp diff -u lisppaste2/r5rs-lookup.lisp:1.1 lisppaste2/r5rs-lookup.lisp:1.2 --- lisppaste2/r5rs-lookup.lisp:1.1 Thu Jun 3 07:14:45 2004 +++ lisppaste2/r5rs-lookup.lisp Wed Jun 9 12:47:13 2004 @@ -6,16 +6,22 @@

(defparameter *r5rs-file* "r5rs-symbols.lisp-expr")

-(defparameter *table* nil) +(defvar *table* nil) + +(defvar *populated-p* nil)

(defun populate-table () - (with-open-file (r *r5rs-file* :direction :input) - (setf *table* (make-hash-table :test #'equalp)) - (let ((s (read r))) - (loop for i in s do (setf (gethash (car i) *table*) (cdr i)))) - 'done)) + (unless *populated-p* + (with-open-file (r *r5rs-file* :direction :input) + (setf *table* (make-hash-table :test #'equalp)) + (let ((s (read r))) + (loop for i in s do (setf (gethash (car i) *table*) (cdr i)))) + 'done) + (setf *populated-p* t)))

(defun symbol-lookup (symbol) + (unless *populated-p* + (populate-table)) (multiple-value-bind (val found) (gethash symbol *table*) (if found