/[lisppaste]/lisppaste2/abbrev.lisp
ViewVC logotype

Contents of /lisppaste2/abbrev.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (show annotations)
Thu Jul 8 17:42:26 2004 UTC (9 years, 9 months ago) by bmastenbrook
Branch: MAIN
CVS Tags: HEAD
Abbreviations for CLHS lookup
1 (defpackage :abbrev (:use :cl :split-sequence)
2 (:export :abbrev))
3 (in-package :abbrev)
4
5 (defun could-be-wrap (term char-set)
6 (loop for char in char-set
7 if (and (> (length term) 1)
8 (char= (elt term 0) char)
9 (char= (elt term (1- (length term))) char))
10 return char))
11
12 (defun abbrev (term &key wrap)
13 (if (> (length term) 0)
14 (if (char= (elt term 0) #\:)
15 (abbrev (subseq term 1))
16 (let ((char (could-be-wrap term '(#\* #\+))))
17 (if char
18 (abbrev (subseq term 1 (1- (length term))) :wrap char)
19 (let ((split (split-sequence #\- term)))
20 (if (and (> (length split) 1)
21 (every #'(lambda (e) (> (length e) 0)) split))
22 (let ((abbrev (format nil "~{~C~^-~}"
23 (mapcar #'(lambda (e)
24 (elt e 0)) split))))
25 (when wrap
26 (setf abbrev (format nil "~C~A~C"
27 wrap abbrev wrap))
28 (setf term (format nil "~C~A~C"
29 wrap term wrap)))
30 abbrev))))))))

  ViewVC Help
Powered by ViewVC 1.1.5