/[advanced-readtable]/src.lisp
ViewVC logotype

Diff of /src.lisp

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

revision 11 by rklochkov, Sun Dec 30 14:35:37 2012 UTC revision 12 by rklochkov, Mon Dec 31 13:39:29 2012 UTC
# Line 15  Line 15 
15    "List of handlers. Each handler is a cons (key . function)    "List of handlers. Each handler is a cons (key . function)
16  function = (lambda (name package) ...) -> package")  function = (lambda (name package) ...) -> package")
17    
   
   
   
18  ;;;  ;;;
19  ;;; Prepare readtables  ;;; Prepare readtables
20  ;;;  ;;;
21    
   
   
22  (defvar *advanced-readtable* (copy-readtable nil))  (defvar *advanced-readtable* (copy-readtable nil))
23  (defvar *colon-readtable* (copy-readtable nil)  (defvar *colon-readtable* (copy-readtable nil)
24    "Support readtable with colon as whitespace")    "Support readtable with colon as whitespace")
# Line 34  function = (lambda (name package) ...) - Line 29  function = (lambda (name package) ...) -
29    
30  (defpackage #:advanced-readtable.junk)  (defpackage #:advanced-readtable.junk)
31    
   
   
32  (defun try-funcall (handlers-list name package)  (defun try-funcall (handlers-list name package)
33    (declare (type list handlers-list)    (declare (type list handlers-list)
34             (type string name)             (type string name)
# Line 55  function = (lambda (name package) ...) - Line 48  function = (lambda (name package) ...) -
48          (or          (or
49           (cl:find-package name)           (cl:find-package name)
50           (when current-package           (when current-package
51             (try-funcall (package-finders current-package) sname current-package))             (try-funcall (package-finders current-package)
52                            sname current-package))
53           (try-funcall *package-finders* sname current-package)))))           (try-funcall *package-finders* sname current-package)))))
54    
55  (defvar *package-symbol-finders* (make-hash-table :test 'eq)  (defvar *package-symbol-finders* (make-hash-table :test 'eq)
# Line 161  RETURN: number of the colons" Line 155  RETURN: number of the colons"
155  (defun read-after-colon (stream maybe-package colons)  (defun read-after-colon (stream maybe-package colons)
156    "Read symbol package:sym or list package:(...)"    "Read symbol package:sym or list package:(...)"
157    (declare (type stream stream)    (declare (type stream stream)
158             (type fixnum colons))             (type (integer 0 2) colons))
159      (check-type colons (integer 0 2))
160    (when (= colons 0) ; no colon: this is a symbol or an atom    (when (= colons 0) ; no colon: this is a symbol or an atom
161      (return-from read-after-colon      (return-from read-after-colon
162        (if (symbolp maybe-package)        (if (symbolp maybe-package)
# Line 188  RETURN: number of the colons" Line 183  RETURN: number of the colons"
183        (check-type token symbol)        (check-type token symbol)
184        (multiple-value-bind (symbol status)        (multiple-value-bind (symbol status)
185            (find-symbol (symbol-name token) package)            (find-symbol (symbol-name token) package)
186            (unless status
187              (if (= colons 1) (error "No external symbol ~S in ~S"
188                                      (symbol-name token) package)
189                  (cerror "Intern ~S in ~S" "No such symbol ~S in package ~S"
190                          (symbol-name token) package)))
191          (unintern token)          (unintern token)
192          (when (and (= colons 1) (not (eq status :external)))          (when (and (= colons 1) (not (eq status :external)))
193            (cerror "Use anyway"            (cerror "Use anyway"

Legend:
Removed from v.11  
changed lines
  Added in v.12

  ViewVC Help
Powered by ViewVC 1.1.5