/[gcl]/gcl/ansi-tests/cl-symbols-aux.lsp
ViewVC logotype

Diff of /gcl/ansi-tests/cl-symbols-aux.lsp

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

revision 1.3 by pfdietz, Sat Mar 1 03:35:48 2003 UTC revision 1.4 by pfdietz, Fri Apr 4 03:02:57 2003 UTC
# Line 17  Line 17 
17    (multiple-value-bind (sym status)    (multiple-value-bind (sym status)
18        (find-symbol #+lower-case str #-lower-case (string-upcase str) 'common-lisp)        (find-symbol #+lower-case str #-lower-case (string-upcase str) 'common-lisp)
19        (or        (or
20         ;; Symbol not present in the common lisp package         ;; Symbol not present in the common lisp package as an external symbol
21         (not status)         (not (eqt status :external))
22         ;; Check if it has any properties whose indicators are         ;; Check if it has any properties whose indicators are
23         ;; external in any of the standard packages or are accessible         ;; external in any of the standard packages or are accessible
24         ;; in CL-USER         ;; in CL-USER
25         (and (eqt status :external)         (let ((plist (symbol-plist sym)))
26              (let ((plist (symbol-plist sym)))           (loop for e = plist then (cddr e)
27                (loop for e = plist then (cddr e)                 while e
28                      while e                 for indicator = (car e)
29                      for indicator = (car e)                 when (and (symbolp indicator)
30                      when (and (symbolp indicator)                           (or (is-external-symbol-of indicator
31                                (or (is-external-symbol-of indicator                                                      "COMMON-LISP")
32                                                           "COMMON-LISP")                               (is-external-symbol-of indicator "KEYWORD")
33                                    (is-external-symbol-of indicator "KEYWORD")                               (eqt indicator (find-symbol
34                                    (eqt indicator (find-symbol                                               (symbol-name indicator)
35                                                    (symbol-name indicator)                                               "COMMON-LISP-USER"))))
36                                                    "COMMON-LISP-USER"))))                 collect indicator)))))
                     collect indicator))))))  
37    
38  (defun safe-symbol-name (sym)  (defun safe-symbol-name (sym)
39    (catch-type-error (symbol-name sym)))    (catch-type-error (symbol-name sym)))

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26