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

Diff of /slime/swank.lisp

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

revision 1.140 by heller, Tue Mar 9 20:41:45 2004 UTC revision 1.141 by heller, Wed Mar 10 08:23:19 2004 UTC
# Line 745  exists." Line 745  exists."
745    
746  (defun print-arglist (arglist)  (defun print-arglist (arglist)
747    (let ((*print-case* :downcase)    (let ((*print-case* :downcase)
748          (*print-pretty* t))          (*print-pretty* t)
749      (pprint-logical-block (*standard-output* arglist :prefix "(" :suffix ")")          (*print-circle* nil)
750            (*print-level* 10)
751            (*print-length* 20))
752        (pprint-logical-block (nil arglist :prefix "(" :suffix ")")
753        (loop        (loop
754         (let ((arg (pprint-pop)))         (let ((arg (pprint-pop)))
755           (etypecase arg           (etypecase arg
756             (symbol (princ arg))             (symbol (princ arg))
757             (cons (pprint-logical-block (*standard-output* arg :prefix "("             (cons (pprint-logical-block (nil nil :prefix "(" :suffix ")")
                                                           :suffix ")")  
758                     (princ (car arg))                     (princ (car arg))
759                     (write-char #\space)                     (write-char #\space)
760                     (pprint-fill *standard-output* (cdr arg) nil))))                     (pprint-fill *standard-output* (cdr arg) nil))))
# Line 763  exists." Line 765  exists."
765  (defun test-print-arglist (list string)  (defun test-print-arglist (list string)
766    (string= (print-arglist-to-string list) string))    (string= (print-arglist-to-string list) string))
767    
768  ;; (assert (test-print-arglist '(function cons) "(function cons)"))  ;; Should work:
769  ;; (assert (test-print-arglist '(quote cons) "(quote cons)"))  (assert (test-print-arglist '(function cons) "(function cons)"))
770  ;; (assert (test-print-arglist '(&key (function #'f)) "(&key (function #'f))"))  (assert (test-print-arglist '(quote cons) "(quote cons)"))
771    (assert (test-print-arglist '(&key (function #'f)) "(&key (function #'f))"))
772    ;; Expected failure:
773  ;; (assert (test-print-arglist '(&key ((function f))) "(&key ((function f)))"))  ;; (assert (test-print-arglist '(&key ((function f))) "(&key ((function f)))"))
774    
775    
# Line 1491  that symbols accessible in the current p Line 1495  that symbols accessible in the current p
1495    
1496  ;;;; Source Locations  ;;;; Source Locations
1497    
1498  (defslimefun find-function-locations (symbol-name)  (defslimefun find-definitions-for-emacs (symbol-name)
   "Return a list of source-locations for SYMBOL-NAME's functions."  
1499    (multiple-value-bind (symbol foundp) (find-symbol-designator symbol-name)    (multiple-value-bind (symbol foundp) (find-symbol-designator symbol-name)
1500      (cond ((not foundp)      (cond ((not foundp) '())
1501             (list (list :error (format nil "Unkown symbol: ~A" symbol-name))))            (t (loop for (dspec loc) in (find-definitions symbol)
1502            ((macro-function symbol)                     collect (list (to-string dspec) loc))))))
1503             (mapcar #'second (find-definitions symbol)))  
           ((special-operator-p symbol)  
            (list (list :error (format nil "~A is a special-operator" symbol))))  
           ((fboundp symbol)  
            (mapcar #'second (find-definitions symbol)))  
           (t (list (list :error  
                          (format nil "Symbol not fbound: ~A" symbol-name)))))))  
   
   
1504  (defun alistify (list key test)  (defun alistify (list key test)
1505    "Partition the elements of LIST into an alist.  KEY extracts the key    "Partition the elements of LIST into an alist.  KEY extracts the key
1506  from an element and TEST is used to compare keys."  from an element and TEST is used to compare keys."

Legend:
Removed from v.1.140  
changed lines
  Added in v.1.141

  ViewVC Help
Powered by ViewVC 1.1.5