home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / windows / winlisp.zip / LISPLIB.LZH / ABBREV.WL next >
Text File  |  1989-09-22  |  1KB  |  43 lines
  1. ;============================================================================
  2. ; WinLisp:
  3. ;
  4. ;               A B B R E V I A T I O N    P A C K A G E
  5. ;
  6. ; Copyright (c) Stephan POPOVITCH 1988-1989
  7. ; Author: Stephan POPOVITCH
  8. ;============================================================================
  9.  
  10. (defvar errnotasym    "not a symbol")
  11. (defvar errsxt         "bad {} abreviation")
  12. (defvar errbracesxt    "} without matching {")
  13. (defvar errnotanabbrev     "not an abbreviation")
  14.  
  15. (dmd defabbrev (symbol long-name)
  16.     `(put-abbrev ',symbol ',long-name))
  17.  
  18. (de put-abbrev (symbol long-name)
  19.     (unless (symbolp symbol) (error 'put-abbrev 'errnotasym symbol))
  20.     (unless (symbolp long-name) (error 'put-abbrev 'errnotasym long-name))
  21.     (putprop symbol long-name 'abbrev))
  22.  
  23. (de get-abbrev (symbol)
  24.     (unless (and (symbolp symbol) (abbrevp symbol))
  25.             (error 'get-abbrev errnotanabbrev symbol))
  26.     (getprop symbol 'abbrev))
  27.  
  28. (de abbrevp (symbol)
  29.     (when (memq 'abbrev (plist symbol)) t))
  30.  
  31. (dmc |}| ()
  32.      (error '|}| errbracesxt ()))
  33.  
  34. (dmc |{| ()
  35.     (let ((l (read-delimited-list #/})))
  36.          (unless (and (consp l) (symbolp (car l)) (null (cdr l)))
  37.                  (error '|{| errsxt l))
  38.          (if (<> (peekcn) #/:)
  39.          (get-abbrev (car l))
  40.          (let ((#:winlisp:colon (get-abbrev (car l))))
  41.           (read)))))
  42.  
  43.