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

Diff of /slime/swank.lisp

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

revision 1.636 by trittweiler, Sun Feb 22 14:18:47 2009 UTC revision 1.637 by trittweiler, Thu Feb 26 20:53:07 2009 UTC
# Line 3476  Return NIL if LIST is circular." Line 3476  Return NIL if LIST is circular."
3476  ;;;;; Hashtables  ;;;;; Hashtables
3477    
3478    
3479    (defun hash-table-to-alist (ht)
3480      (let ((result '()))
3481        (maphash #'(lambda (key value)
3482                     (setq result (acons key value result)))
3483                 ht)
3484        result))
3485    
3486  (defmethod emacs-inspect ((ht hash-table))  (defmethod emacs-inspect ((ht hash-table))
3487    (append    (append
# Line 3492  Return NIL if LIST is circular." Line 3498  Return NIL if LIST is circular."
3498       `((:action "[clear hashtable]"       `((:action "[clear hashtable]"
3499                  ,(lambda () (clrhash ht))) (:newline)                  ,(lambda () (clrhash ht))) (:newline)
3500         "Contents: " (:newline)))         "Contents: " (:newline)))
3501     (loop for key being the hash-keys of ht     (let ((content (hash-table-to-alist ht)))
3502           for value being the hash-values of ht       (cond ((every (lambda (x) (typep (first x) '(or string symbol))) content)
3503           append `((:value ,key) " = " (:value ,value)              (setf content (sort content 'string< :key #'first)))
3504                    " " (:action "[remove entry]"             ((every (lambda (x) (typep (first x) 'number)) content)
3505                                 ,(let ((key key))              (setf content (sort content '< :key #'first))))
3506                                       (lambda () (remhash key ht))))       (loop for (key . value) in content appending
3507                    (:newline)))))             `((:value ,key) " = " (:value ,value)
3508                 " " (:action "[remove entry]"
3509                              ,(let ((key key))
3510                                    (lambda () (remhash key ht))))
3511                 (:newline))))))
3512    
3513  ;;;;; Arrays  ;;;;; Arrays
3514    

Legend:
Removed from v.1.636  
changed lines
  Added in v.1.637

  ViewVC Help
Powered by ViewVC 1.1.5