/[slime]/slime/swank.lisp
ViewVC logotype

Diff of /slime/swank.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.524 by mbaringer, Mon Feb 4 16:25:08 2008 UTC revision 1.525 by heller, Mon Feb 4 16:35:39 2008 UTC
# Line 415  Useful for low level debugging." Line 415  Useful for low level debugging."
415    (<= (char-code c) 127))    (<= (char-code c) 127))
416    
417    
 ;;;;; Misc  
   
 (defun length= (seq n)  
   "Test for whether SEQ contains N number of elements. I.e. it's equivalent  
  to (= (LENGTH SEQ) N), but besides being more concise, it may also be more  
  efficiently implemented."  
   (etypecase seq  
     (list (do ((i n (1- i))  
                (list seq (cdr list)))  
               ((or (<= i 0) (null list))  
                (and (zerop i) (null list)))))  
     (sequence (= (length seq) n))))  
   
 (defun ensure-list (thing)  
   (if (listp thing) thing (list thing)))  
   
 (defun recursively-empty-p (list)  
   "Returns whether LIST consists only of arbitrarily nested empty lists."  
   (cond ((not (listp list)) nil)  
         ((null list) t)  
         (t (every #'recursively-empty-p list))))  
   
 (defun maybecall (bool fn &rest args)  
   "Call FN with ARGS if BOOL is T. Otherwise return ARGS as multiple values."  
   (if bool (apply fn args) (values-list args)))  
   
 (defun exactly-one-p (&rest values)  
   "If exactly one value in VALUES is non-NIL, this value is returned.  
 Otherwise NIL is returned."  
   (let ((found nil))  
     (dolist (v values)  
       (when v (if found  
                   (return-from exactly-one-p nil)  
                   (setq found v))))  
     found))  
   
   
418  ;;;;; Symbols  ;;;;; Symbols
419    
420  (defun symbol-status (symbol &optional (package (symbol-package symbol)))  (defun symbol-status (symbol &optional (package (symbol-package symbol)))
# Line 1569  gracefully." Line 1532  gracefully."
1532      (let ((*read-suppress* nil))      (let ((*read-suppress* nil))
1533        (read-from-string string))))        (read-from-string string))))
1534    
 (defun read-softly-from-string (string)  
   "Returns three values:  
   
      1. the object resulting from READing STRING.  
   
      2. The index of the first character in STRING that was not read.  
   
      3. T if the object is a symbol that had to be newly interned  
         in some package. (This does not work for symbols in  
         compound forms like lists or vectors.)"  
   (multiple-value-bind (symbol found? symbol-name package) (parse-symbol string)  
     (if found?  
         (values symbol (length string) nil)  
         (multiple-value-bind (sexp pos) (read-from-string string)  
           (values sexp pos  
                   (when (symbolp sexp)  
                     (prog1 t  
                       ;; assert that PARSE-SYMBOL didn't parse incorrectly.  
                       (assert (and (equal symbol-name (symbol-name sexp))  
                                    (eq package (symbol-package sexp)))))))))))  
   
 (defun unintern-in-home-package (symbol)  
   (unintern symbol (symbol-package symbol)))  
   
1535  ;; FIXME: deal with #\| etc.  hard to do portably.  ;; FIXME: deal with #\| etc.  hard to do portably.
1536  (defun tokenize-symbol (string)  (defun tokenize-symbol (string)
1537    "STRING is interpreted as the string representation of a symbol    "STRING is interpreted as the string representation of a symbol
# Line 1755  Errors are trapped and invoke our debugg Line 1694  Errors are trapped and invoke our debugg
1694    (with-buffer-syntax ()    (with-buffer-syntax ()
1695      (let ((*print-readably* nil))      (let ((*print-readably* nil))
1696        (cond ((null values) "; No value")        (cond ((null values) "; No value")
1697              ((and (length= values 1)  (integerp (car values)))              ((and (integerp (car values)) (null (cdr values)))
1698               (let ((i (car values)))               (let ((i (car values)))
1699                 (format nil "~A~D (#x~X, #o~O, #b~B)"                 (format nil "~A~D (#x~X, #o~O, #b~B)"
1700                         *echo-area-prefix* i i i i)))                         *echo-area-prefix* i i i i)))
# Line 2915  NIL is returned if the list is circular. Line 2854  NIL is returned if the list is circular.
2854          *inspectee-actions* (make-array 10 :adjustable t :fill-pointer 0)          *inspectee-actions* (make-array 10 :adjustable t :fill-pointer 0)
2855          *inspector-history* (make-array 10 :adjustable t :fill-pointer 0)))          *inspector-history* (make-array 10 :adjustable t :fill-pointer 0)))
2856    
 (defun valid-function-name-p (form)  
   (or (symbolp form)  
       (and (consp form)  
            (second form)  
            (not (third form))  
            (eq (first form) 'setf)  
            (symbolp (second form)))))  
   
2857  (defslimefun init-inspector (string)  (defslimefun init-inspector (string)
2858    (with-buffer-syntax ()    (with-buffer-syntax ()
2859      (reset-inspector)      (reset-inspector)

Legend:
Removed from v.1.524  
changed lines
  Added in v.1.525

  ViewVC Help
Powered by ViewVC 1.1.5