[slime-cvs] CVS slime
heller
heller at common-lisp.net
Mon Sep 15 21:11:19 UTC 2008
Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv28587
Modified Files:
ChangeLog swank-lispworks.lisp
Log Message:
* swank-lispworks.lisp (describe-symbol-for-emacs): Revert last
change.
--- /project/slime/cvsroot/slime/ChangeLog 2008/09/15 10:41:02 1.1507
+++ /project/slime/cvsroot/slime/ChangeLog 2008/09/15 21:11:19 1.1508
@@ -1,7 +1,12 @@
2008-09-15 Helmut Eller <heller at common-lisp.net>
+ * swank-lispworks.lisp (describe-symbol-for-emacs): Revert last
+ change.
+
+2008-09-15 Helmut Eller <heller at common-lisp.net>
+
* swank.lisp (sldb-loop): Send a :sldb-return event to ourselfes
- when returning to inform the debug session at the lower level.
+ to inform the debug session at the lower level.
(wait-for-event): Drop the report-interrupt argument. No longer
needed.
(event-match-p): Add an OR pattern operator. Used to wait for
--- /project/slime/cvsroot/slime/swank-lispworks.lisp 2008/09/12 18:55:42 1.115
+++ /project/slime/cvsroot/slime/swank-lispworks.lisp 2008/09/15 21:11:19 1.116
@@ -154,12 +154,7 @@
(let ((pos (position #\newline string)))
(if (null pos) string (subseq string 0 pos))))
(doc (kind &optional (sym symbol))
- (let ((string (or
- (documentation sym kind)
- (lwdoc (symbol-name sym)
- (package-name (symbol-package sym))
- kind))))
-
+ (let ((string (or (documentation sym kind))))
(if string
(first-line string)
:not-documented)))
@@ -213,66 +208,6 @@
(when (fboundp sym)
(describe-function sym)))
-(defvar *lwdoc-types*
- '(("%FUN-DOCUMENTATION" . function)
- ("%VAR-DOCUMENTATION" . variable)
- ("%SETF-DOCUMENTATION" . setf)
- ("%STRUCT-DOCUMENTATION" . structure)))
-
-;; (lwdoc 'cons 'common-lisp 't)
-(defun lwdoc (name package type)
- "Search in $LWHOME/lwdoc for entries matching NAME and PACKAGE."
- (lw:when-let (doc (lookup-lwdoc name package))
- (destructuring-bind (kind description) doc
- (when (or (eq type t)
- (eq (cdr (assoc kind *lwdoc-types* :test #'string-equal))
- type))
- description))))
-
-(defun lookup-lwdoc (name package)
- (when (probe-file (sys:lispworks-file "lwdoc"))
- (with-open-file (file (sys:lispworks-file "lwdoc"))
- (lwdoc-search file 0 (file-length file) package name))))
-
-;; Use binary search, assuming that the entries are ordered alphabetically
-(defun lwdoc-search (file min max package name)
- (declare (optimize (sys:interruptable 3)))
- (let ((pos (+ min (floor (- max min) 2))))
- (and (< min (1- max))
- (let ((record (parse-lwdoc-record file pos)))
- (and record
- (destructuring-bind (rpackage rname kind doc) record
- ;;(format t "~d ~d ~a ~a~%" min max rpackage rname)
- (ecase (cond ((string-equal package rpackage)
- (cond ((string-equal name rname) '=)
- ((string-lessp name rname) '<)
- (t '>)))
- ((string-lessp package rpackage) '<)
- (t '>))
- (= (list kind doc))
- (< (lwdoc-search file min pos package name))
- (> (lwdoc-search file pos max package name)))))))))
-
-(defun parse-lwdoc-record (file position)
- (declare (optimize (sys:interruptable 3)))
- (file-position file position)
- (when (peek-char #\null file nil nil)
- ;; Search previous #\null or beginning of file
- (do* ((end (file-position file))
- (start end (max (- start 10) 0)))
- (nil)
- (file-position file start)
- (when (= start 0) (return))
- (peek-char #\null file)
- (when (< (file-position file) end) (return)))
- (peek-char #\" file)
- (let ((key (read file))
- (doc (read file)))
- (peek-char #\null file)
- (read-char file)
- (append (lw:split-sequence ":" key :coalesce-separators t)
- (list doc)))))
-
;;; Debugging
(defclass slime-env (env:environment)
More information about the slime-cvs
mailing list