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