[slime-cvs] CVS update: slime/slime.el slime/swank.lisp slime/swank-loader.lisp
Helmut Eller
heller at common-lisp.net
Wed Apr 21 18:56:43 UTC 2004
Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv11471
Modified Files:
slime.el swank.lisp swank-loader.lisp
Log Message:
Support for regexp based apropos. From Edi Weitz.
Date: Wed Apr 21 14:56:43 2004
Author: heller
Index: slime/slime.el
diff -u slime/slime.el:1.266 slime/slime.el:1.267
--- slime/slime.el:1.266 Tue Apr 20 18:38:39 2004
+++ slime/slime.el Wed Apr 21 14:56:42 2004
@@ -4031,24 +4031,33 @@
(error "No symbol given"))
(slime-eval-describe `(swank:describe-function ,symbol-name)))
-(defun slime-apropos (string &optional only-external-p package)
+(defun slime-apropos-summary (case-sensitive-p package only-external-p)
+ "Return a short description for the performed apropos search."
+ (concat (if case-sensitive-p "Case-sensitive " "")
+ "Apropos for "
+ (format "%S" string)
+ (if package (format " in package %S" package) "")
+ (if only-external-p " (external symbols only)" "")))
+
+(defun slime-apropos (string &optional only-external-p package
+ case-sensitive-p)
(interactive
(if current-prefix-arg
(list (read-string "SLIME Apropos: ")
(y-or-n-p "External symbols only? ")
(let ((pkg (slime-read-package-name "Package: ")))
- (if (string= pkg "") nil pkg)))
- (list (read-string "SLIME Apropos: ") t nil)))
+ (if (string= pkg "") nil pkg))
+ (y-or-n-p "Case-sensitive? "))
+ (list (read-string "SLIME Apropos: ") t nil nil)))
(let ((buffer-package (or package (slime-buffer-package t))))
(slime-eval-async
- `(swank:apropos-list-for-emacs ,string ,only-external-p ,package)
+ `(swank:apropos-list-for-emacs ,string ,only-external-p
+ ,case-sensitive-p ,package)
buffer-package
(lexical-let ((string string)
(package (or package buffer-package))
- (summary (concat "Apropos for "
- (format "%S" string)
- (if package (format " in package %S" package) "")
- (if only-external-p " (external symbols only)" ""))))
+ (summary (slime-apropos-summary case-sensitive-p package
+ only-external-p)))
(lambda (r) (slime-show-apropos r string package summary))))))
(defun slime-apropos-all ()
Index: slime/swank.lisp
diff -u slime/swank.lisp:1.168 slime/swank.lisp:1.169
--- slime/swank.lisp:1.168 Tue Apr 20 18:32:05 2004
+++ slime/swank.lisp Wed Apr 21 14:56:42 2004
@@ -1639,7 +1639,8 @@
;;;; Documentation
-(defslimefun apropos-list-for-emacs (name &optional external-only package)
+(defslimefun apropos-list-for-emacs (name &optional external-only
+ case-sensitive package)
"Make an apropos search for Emacs.
The result is a list of property lists."
(let ((package (if package
@@ -1647,7 +1648,7 @@
(error "No such package: ~S" package)))))
(mapcan (listify #'briefly-describe-symbol-for-emacs)
(sort (remove-duplicates
- (apropos-symbols name external-only package))
+ (apropos-symbols name external-only case-sensitive package))
#'present-symbol-before-p))))
(defun briefly-describe-symbol-for-emacs (symbol)
@@ -1693,12 +1694,33 @@
(string< (package-name (symbol-package a))
(package-name (symbol-package b)))))))
-(defun apropos-symbols (string external-only package)
- (remove-if (lambda (sym)
- (or (keywordp sym)
- (and external-only (not (symbol-external-p sym)))
- (and package (not (eq (symbol-package sym) package)))))
- (apropos-list string package)))
+(let ((regex-hash (make-hash-table :test #'equal)))
+ (defun compiled-regex (regex-string)
+ (or (gethash regex-string regex-hash)
+ (setf (gethash regex-string regex-hash)
+ (compile nil (nregex:regex-compile regex-string))))))
+
+(defun apropos-matcher (string case-sensitive package external-only)
+ (let* ((case-modifier (if case-sensitive #'string #'string-upcase))
+ (regex (compiled-regex (funcall case-modifier string))))
+ (lambda (symbol)
+ (and (not (keywordp symbol))
+ (if package (eq (symbol-package symbol) package) t)
+ (if external-only (symbol-external-p symbol) t)
+ (funcall regex (funcall case-modifier symbol))))))
+
+(defun apropos-symbols (string external-only case-sensitive package)
+ (let ((result '())
+ (matchp (apropos-matcher string case-sensitive package external-only)))
+ (with-package-iterator (next (or package (list-all-packages))
+ :external :internal)
+ (loop
+ (multiple-value-bind (morep symbol) (next)
+ (cond ((not morep)
+ (return))
+ ((funcall matchp symbol)
+ (push symbol result))))))
+ result))
(defun describe-to-string (object)
(with-output-to-string (*standard-output*)
Index: slime/swank-loader.lisp
diff -u slime/swank-loader.lisp:1.20 slime/swank-loader.lisp:1.21
--- slime/swank-loader.lisp:1.20 Fri Mar 19 16:07:35 2004
+++ slime/swank-loader.lisp Wed Apr 21 14:56:42 2004
@@ -29,13 +29,15 @@
(defparameter *sysdep-pathnames*
(mapcar #'make-swank-pathname
- #+cmu '("swank-source-path-parser" "swank-cmucl")
- #+sbcl '("swank-sbcl" "swank-source-path-parser" "swank-gray")
- #+openmcl '("swank-openmcl" "swank-gray")
- #+lispworks '("swank-lispworks" "swank-gray")
- #+allegro '("swank-allegro" "swank-gray")
- #+clisp '("xref" "metering" "swank-clisp" "swank-gray")
- ))
+ (append
+ '("nregex")
+ #+cmu '("swank-source-path-parser" "swank-cmucl")
+ #+sbcl '("swank-sbcl" "swank-source-path-parser" "swank-gray")
+ #+openmcl '("swank-openmcl" "swank-gray")
+ #+lispworks '("swank-lispworks" "swank-gray")
+ #+allegro '("swank-allegro" "swank-gray")
+ #+clisp '("xref" "metering" "swank-clisp" "swank-gray")
+ )))
(defparameter *lisp-name*
#+cmu "cmu"
@@ -43,7 +45,8 @@
#+openmcl "openmcl"
#+lispworks "lispworks"
#+allegro "allegro"
- #+clisp "clisp")
+ #+clisp "clisp"
+ )
(defparameter *swank-pathname* (make-swank-pathname "swank"))
More information about the slime-cvs
mailing list