[Lisppaste-cvs] CVS update: lisppaste2/abbrev.lisp lisppaste2/lisppaste.asd lisppaste2/clhs-lookup.lisp

[Brian Mastenbrook]

Update of /project/lisppaste/cvsroot/lisppaste2
In directory common-lisp.net:/home/bmastenbrook/lisppaste2

Modified Files:
	lisppaste.asd clhs-lookup.lisp 
Added Files:
	abbrev.lisp 
Log Message:
Abbreviations for CLHS lookup

Date: Thu Jul  8 10:42:27 2004
Author: bmastenbrook



Index: lisppaste2/lisppaste.asd
diff -u lisppaste2/lisppaste.asd:1.13 lisppaste2/lisppaste.asd:1.14
--- lisppaste2/lisppaste.asd:1.13	Thu Jun 17 06:10:04 2004
+++ lisppaste2/lisppaste.asd	Thu Jul  8 10:42:26 2004
@@ -1,5 +1,5 @@
 ;;;; Silly emacs, this is -*- Lisp -*-
-;;;; $Id: lisppaste.asd,v 1.13 2004/06/17 13:10:04 bmastenbrook Exp $
+;;;; $Id: lisppaste.asd,v 1.14 2004/07/08 17:42:26 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.asd,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -29,7 +29,8 @@
                  (:file "colorize-package")
                  (:file "coloring-css" :depends-on ("colorize-package"))
                  (:file "colorize" :depends-on ("colorize-package" "coloring-css"))
-                 (:file "clhs-lookup" :depends-on ("encode-for-pre"))
+                 (:file "abbrev")
+                 (:file "clhs-lookup" :depends-on ("encode-for-pre" "abbrev"))
                  (:file "r5rs-lookup" :depends-on ("encode-for-pre"))
                  (:file "elisp-lookup" :depends-on ("encode-for-pre"))
                  (:file "lisppaste"


Index: lisppaste2/clhs-lookup.lisp
diff -u lisppaste2/clhs-lookup.lisp:1.6 lisppaste2/clhs-lookup.lisp:1.7
--- lisppaste2/clhs-lookup.lisp:1.6	Thu Jun 17 05:59:17 2004
+++ lisppaste2/clhs-lookup.lisp	Thu Jul  8 10:42:26 2004
@@ -3,7 +3,7 @@
                                                       :spec-lookup))
 (in-package :clhs-lookup)
 
-(defparameter *hyperspec-pathname* #p"/home/chandler/public_html/HyperSpec/")
+(defparameter *hyperspec-pathname* #p"/home/bmastenbrook/HyperSpec/")
 
 (defparameter *hyperspec-map-file* (merge-pathnames "Data/Map_Sym.txt" *hyperspec-pathname*))
 
@@ -16,6 +16,8 @@
 
 (defvar *symbol-table* (make-hash-table :test 'equalp))
 
+(defvar *abbrev-table* (make-hash-table :test 'equalp))
+
 (defvar *section-table* (make-hash-table :test 'equalp))
 
 (defvar *format-table* (make-hash-table :test 'equalp))
@@ -43,10 +45,16 @@
           (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))))
+      (flet ((set-symbol (sym url)
+               (setf (gethash sym *symbol-table*) url)
+               (let ((abbrev (abbrev:abbrev sym)))
+                 (and abbrev
+                      (pushnew sym (gethash abbrev *abbrev-table* nil)
+                               :test #'string-equal)))))
+        (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)
+          (set-symbol symbol-name (concatenate 'string *hyperspec-root* (subseq url 3)))))
       ;; add in section references.
       (let ((*default-pathname-defaults* *hyperspec-pathname*))
         ;; Yuk. I know. Fixes welcome.
@@ -126,6 +134,17 @@
         (setf (gethash (concatenate 'string "MOP:" symbol-name) *symbol-table*) (concatenate 'string *mop-root* url))))
     (setf *populated-p* t)))
 
+(defun abbrev-lookup (term)
+  (let ((abbrevs (gethash term *abbrev-table* nil)))
+    (if (eql (length abbrevs) 0)
+        nil
+        (if (eql (length abbrevs) 1)
+            (format nil "~A: ~A"
+                    (car abbrevs)
+                    (gethash (car abbrevs) *symbol-table*))
+            (format nil "Matches: ~{~A~^ ~}"
+                    abbrevs)))))
+
 (defun spec-lookup (term &key (type :all))
   (unless *populated-p*
     (populate-table))
@@ -133,7 +152,10 @@
     (:all
      (or (gethash term *symbol-table*)
          (gethash term *section-table*)
-         (gethash term *format-table*)))
+         (gethash term *format-table*)
+         (abbrev-lookup term)))
+    (:abbrev
+     (abbrev-lookup term))
     (:symbol
      (gethash term *symbol-table*))
     (:section