Commit 97ba2ce7 authored by Tobias C. Rittweiler's avatar Tobias C. Rittweiler

Wrap PRINT-OBJECT method in cruft.lisp around WITH-PACKAGE-LOCK on clisp.

darcs-hash:20090905182408-f5546-ae09df09afb0a5d97990ae5644411db198ef4a8d.gz
parent 8dc02af1
...@@ -253,12 +253,11 @@ ...@@ -253,12 +253,11 @@
;;; We don't need this on Allegro CL's as we hook into their ;;; We don't need this on Allegro CL's as we hook into their
;;; named-readtable facility, and they provide such a method already. ;;; named-readtable facility, and they provide such a method already.
;; FIXME: This may violate package locks.
#-allegro #-allegro
(defmethod print-object :around ((rt readtable) stream) (without-package-lock (:common-lisp)
(let ((name (readtable-name rt))) (defmethod print-object :around ((rt readtable) stream)
(if name (let ((name (readtable-name rt)))
(print-unreadable-object (rt stream :type nil :identity t) (if name
(format stream "~A ~S" (string :named-readtable) name)) (print-unreadable-object (rt stream :type nil :identity t)
(call-next-method)))) (format stream "~A ~S" (string :named-readtable) name))
\ No newline at end of file (call-next-method)))))
\ No newline at end of file
...@@ -7,6 +7,7 @@ ...@@ -7,6 +7,7 @@
:serial t :serial t
:components :components
((:file "package") ((:file "package")
(:file "utils" :depends-on ("package")) (:file "without-package-locks" :depends-on ("package"))
(:file "cruft" :depends-on ("package" "utils")) (:file "utils" :depends-on ("package" "without-package-locks"))
(:file "named-readtables" :depends-on ("package" "utils" "cruft")))) (:file "cruft" :depends-on ("package" "utils"))
\ No newline at end of file (:file "named-readtables" :depends-on ("package" "utils" "cruft"))))
\ No newline at end of file
;;;;
;;;; Copyright (c) 2008 - 2009 Tobias C. Rittweiler <tcr@freebits.de>
;;;;
;;;; All rights reserved.
;;;;
;;;; See LICENSE for details.
;;;;
(in-package :editor-hints.named-readtables)
(defmacro without-package-lock ((&rest package-names) &body body)
(declare (ignorable package-names))
#+clisp (return-from without-package-lock
`(ext:without-package-lock (,@package-names) ,@body))
`(progn ,@body))
\ No newline at end of file
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment