[Lisppaste-cvs] CVS update: lisppaste2/elisp-lookup.lisp lisppaste2/clhs-lookup.lisp lisppaste2/r5rs-lookup.lisp
Brian Mastenbrook
bmastenbrook at common-lisp.net
Wed Jun 9 19:47:13 UTC 2004
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
More information about the Lisppaste-cvs
mailing list