Commits

Anonymous committed 37645db

Created

  • Participants
  • Tags xemacs

Comments (0)

Files changed (13)

+1998-01-11  SL Baur  <steve@altair.xemacs.org>
+
+	* Makefile: Update to newer package interface.
+
+1998-01-02  SL Baur  <steve@altair.xemacs.org>
+
+	* Makefile: Update to newer package interface.
+
+1997-12-23  SL Baur  <steve@altair.xemacs.org>
+
+	* Makefile: Created.
+# Makefile for edebug lisp code
+
+# This file is part of XEmacs.
+
+# XEmacs is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by the
+# Free Software Foundation; either version 2, or (at your option) any
+# later version.
+
+# XEmacs is distributed in the hope that it will be useful, but WITHOUT
+# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
+# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+# for more details.
+
+# You should have received a copy of the GNU General Public License
+# along with XEmacs; see the file COPYING.  If not, write to
+# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+# Boston, MA 02111-1307, USA.
+
+VERSION = 1.02
+PACKAGE = edebug
+PKG_TYPE = regular
+REQUIRES = xemacs-base
+CATEGORY = libs
+
+ELCS = advise-eval-region.elc cl-read.elc cl-specs.elc cust-print.elc \
+	edebug-cl-read.elc edebug.elc eval-reg.elc
+
+include ../../XEmacs.rules
+
+all:: $(ELCS) auto-autoloads.elc custom-load.elc
+
+srckit: srckit-std
+
+binkit: binkit-sourceonly
+Files included in this distribution:
+
+README		This file.
+Makefile	Just enough to make the manual and distribution.
+edebug.el	The reason for all this.
+cust-print.el	The custom print package.
+edebug-history	A history of older modifications.
+eval-reg.el     Elisp version of eval-region.
+cl-specs.el	Specifications for Common Lisp macros.
+cl-read.el	Customizable, CL-like reader from bosch@crpht.lu.
+edebug-cl-read.el Edebug reader macros for use with cl-read.
+edebug.tex	The manual source.
+edebug.texi     The core of the manual for Lisp Reference Manual.
+edebug-test.el  Some tests, not organized.
+
+--------------------------
+Installation
+
+To install, put the .el files in some directory in your load-path and
+byte-compile them.  Put the following forms in your .emacs file.
+
+(define-key emacs-lisp-mode-map "\C-xx" 'edebug-eval-top-level-form)
+(autoload 'edebug-eval-top-level-form "edebug")
+
+If you wish to change the default edebug global command prefix, change this:
+(setq edebug-global-prefix "\C-xX")
+
+Other options, are described in the manual.
+Also see cl-specs.el, and edebug-cl-read.el if they apply to you.
+
+In previous versions of edebug, users were directed to set
+`debugger' to `edebug-debug'.  This is no longer necessary
+since Edebug automatically sets it whenever Edebug is active.
+
+---------------------------
+
+Send me your enhancements, ideas, bugs, or fixes.
+There is an edebug mailing list if you want to keep up
+with the latest developments: edebug@cs.uiuc.edu
+(requests to: edebug-request@cs.uiuc.edu)
+
+You can use edebug-submit-bug-report to simplify bug reporting.
+
+Daniel LaLiberte   217-398-4114
+University of Illinois, Urbana-Champaign
+Department of Computer Science
+
+704 W Green
+Champaign IL, 61820

advise-eval-region.el

+;;; advise-eval-region.el --- Wrap advice around eval-region
+;; Copyright (C) 1996 Miranova Systems, Inc.
+
+;; Original-Author: Unknown
+;; Adapted-By: Steven L Baur <steve@miranova.com>
+;; Keywords: extensions lisp
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF.
+
+;;; Commentary:
+
+;; This file splits out advice to eval-region formerly done in cl-read.el.
+;; Due to the way cl-read.el reads itself in twice during bytecompilation,
+;; and the fact that functions shouldn't be advised twice, I split this out
+;; into its own file.
+
+;;; Code:
+
+(require 'advice)
+
+;; Advise the redefined eval-region
+(defadvice eval-region (around cl-read activate)
+  "Use the reader::read instead of the original read if cl-read-active."
+  (with-elisp-eval-region (not cl-read-active)
+    ad-do-it))
+
+(provide 'advise-eval-region)
+
+;;; advise-eval-region.el ends here
+;; Customizable, Common Lisp like reader for Emacs Lisp.
+;; 
+;; Copyright (C) 1993 by Guido Bosch <Guido.Bosch@loria.fr>
+
+;; This file is part of XEmacs
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;; Please send bugs and comments to the author.
+;;
+;; <DISCLAIMER>
+;; This program is still under development.  Neither the author nor
+;; his employer accepts responsibility to anyone for the consequences of
+;; using it or for whether it serves any particular purpose or works
+;; at all.
+
+
+;; Introduction
+;; ------------
+;;
+;; This package replaces the standard Emacs Lisp reader (implemented
+;; as a set of built-in Lisp function in C) by a flexible and
+;; customizable Common Lisp like one (implemented entirely in Emacs
+;; Lisp). During reading of Emacs Lisp source files, it is about 40%
+;; slower than the built-in reader, but there is no difference in
+;; loading byte compiled files - they dont contain any syntactic sugar
+;; and are loaded with the built in subroutine `load'.
+;;
+;; The user level functions for defining read tables, character and
+;; dispatch macros are implemented according to the Commom Lisp
+;; specification by Steel's (2nd edition), but the read macro functions
+;; themselves are implemented in a slightly different way, because the
+;; basic character reading is done in an Emacs buffer, and not by
+;; using the primitive functions `read-char' and `unread-char', as real
+;; CL does.  To get 100% compatibility with CL, the above functions
+;; (or their equivalents) must be implemented as subroutines.
+;;
+;; Another difference with real CL reading is that basic tokens (symbols
+;; numbers, strings, and a few more) are still read by the original
+;; built-in reader. This is necessary to get reasonable performance.
+;; As a consquence, the read syntax of basic tokens can't be
+;; customized.
+
+;; Most of the built-in reader syntax has been replaced by lisp
+;; character macros: parentheses and brackets, simple and double
+;; quotes, semicolon comments and the dot. In addition to that, the
+;; following new syntax features are provided:
+
+;; Backquote-Comma-Atsign Macro: `(,el ,@list) 
+;;
+;; (the clumsy Emacs Lisp syntax (` ((, el) (,@ list))) is also
+;; supported, but with one restriction: the blank behind the quote
+;; characters is mandatory when using the old syntax. The cl reader
+;; needs it as a landmark to distinguish between old and new syntax.
+;; An example:
+;;
+;; With blanks, both readers read the same:
+;; (` (, (head)) (,@ (tail))) -std-read->  (` (, (head)) (,@ (tail)))
+;; (` (, (head)) (,@ (tail))) -cl-read->   (` (, (head)) (,@ (tail)))
+;;
+;; Without blanks, the form is interpreted differently by the two readers:
+;; (`(,(head)) (,@(tail))) -std-read-> (` (, (head)) (,@ (tail)))
+;; (`(,(head)) (,@(tail))) -cl-read->  ((` ((, ((head)))) ((,@ ((tail)))))
+;;
+;; 
+;; Dispatch Character Macro" `#'
+;;
+;; #'<function>			function quoting
+;; #\<character>		character syntax
+;; #.<form>    			read time evaluation
+;; #p<path>, #P<path> 		paths
+;; #+<feature>, #-<feature> 	conditional reading
+;; #<n>=, #<n># 		tags for shared structure reading
+;;
+;; Other read macros can be added easily (see the definition of the
+;; above ones in this file, using the functions `set-macro-character'
+;; and `set-dispatch-macro-character')
+;;
+;; The Cl reader is mostly downward compatile, (exception: backquote
+;; comma macro, see above). E.g., this file, which is written entirely
+;; in the standard Emacs Lisp syntax, can be read and compiled with the
+;; cl-reader activated (see Examples below). 
+
+;; This also works with package.el for Common Lisp packages.
+
+
+;; Requirements
+;; ------------
+;; The package runs on Emacs 18 and Emacs 19 (FSF and Lucid) It is
+;; built on top of Dave Gillespie's cl.el package (version 2.02 or
+;; later).  The old one (from Ceazar Quiroz, still shiped with some
+;; Emacs 19 disributions) will not do.
+
+;; Usage
+;; -----
+;; The package is implemented as a kind of minor mode to the
+;; emacs-lisp-mode. As most of the Emacs Lisp files are still written
+;; in the standard Emacs Lisp syntax, the cl reader is only activated
+;; on elisp files whose property lines contain the following entry:
+;;
+;; -*- Read-Syntax: Common-Lisp -*-
+;;
+;; Note that both property name ("Read-Syntax") and value
+;; ("Common-Lisp") are not case sensitive. There can also be other
+;; properties in this line: 
+;;
+;; -*- Mode: Emacs-Lisp; Read-Syntax: Common-Lisp -*-
+
+;; Installation
+;; ------------
+;; Save this file in a directory where Emacs will find it, then
+;; byte compile it (M-x byte-compile-file).
+;;
+;; A permanent installation of the package can be done in two ways:
+;;
+;; 1.) If you want to have the package always loaded, put this in your
+;;     .emacs, or in just the files that require it:
+;;
+;; (require 'cl-read) 
+;;
+;; 2.) To load the cl-read package automatically when visiting an elisp
+;;     file that needs it, it has to be installed using the
+;;     emacs-lisp-mode-hook. In this case, put the following function
+;;     definition and add-hook form in your .emacs:
+;;
+;; (defun cl-reader-autoinstall-function () 
+;;   "Activates the Common Lisp style reader for emacs-lisp-mode buffers,
+;; if the property line has a local variable setting like this: 
+;; \;\; -*- Read-Syntax: Common-Lisp -*-"
+;;
+;;   (or (boundp 'local-variable-hack-done)
+;;       (let (local-variable-hack-done
+;;             (case-fold-search t))
+;;         (hack-local-variables-prop-line 't)
+;;         (cond 
+;;          ((and (boundp 'read-syntax)
+;;                read-syntax
+;;                (string-match "^common-lisp$" (symbol-name read-syntax)))
+;;           (require 'cl-read)
+;;           (make-local-variable 'cl-read-active)
+;;           (setq cl-read-active 't))))))
+;;
+;; (add-hook 'emacs-lisp-mode-hook 'cl-reader-autoinstall-function)
+;;
+;; The `cl-reader-autoinstall-function' function tests for the
+;; presence of the correct Read-Syntax property in the first line of
+;; the file and loads the cl-read package if necessary. cl-read
+;; replaces the following standard elisp functions:
+;;
+;; 	- read
+;; 	- read-from-string
+;; 	- eval-current-buffer
+;; 	- eval-buffer
+;; 	- eval-region
+;;	- eval-expression (to call reader explicitly)
+;;
+;; There may be other built-in functions that need to be replaced
+;; (e.g. load).  The behavior of the new reader function depends on
+;; the value of the buffer local variable `cl-read-active': if it is
+;; nil, they just call the original functions, otherwise they call the
+;; cl reader. If the cl reader is active in a buffer, this is
+;; indicated in the modeline by the string "CL" (minor mode like). 
+;;
+
+;; Examples:
+;; ---------
+;; After having installed the package as described above, the
+;; following forms can be evaluated (M-C-x) with the cl reader being
+;; active. (make sure that the mode line displays "(Emacs-Lisp CL)")
+;;
+;; (setq whitespaces '(#\space #\newline #\tab))
+;; (setq more-whitespaces `(#\page ,@whitespaces #\linefeed))
+;; (setq whitespace-strings (mapcar #'char-to-string more-whitespaces))
+;; 
+;; (setq shared-struct '(#1=[hello world] #1# #1#))
+;; (progn (setq cirlist '#1=(a b . #1#)) 't)
+;;
+;; This file, though written in standard Emacs Lisp syntax, can also be
+;; compiled with the cl reader active: Type M-x byte-compile-file
+
+;; TO DO List: 
+;; -----------
+;; - Provide a replacement for load so that uncompiled cl syntax
+;;   source file can be loaded, too.  For now prohibit loading un-bytecompiled.
+;; - Do we really need the (require 'cl) dependency?   Yes.
+;; - More read macros: #S for structs, #A for array, #X for hex, #nR for radix
+;; - Refine the error signaling mechanism.
+;;     - invalid-cl-read-syntax is now defined. what else?
+
+
+; Change History
+; 
+; $Log$
+; Revision 1.19  94/03/21  19:59:24  liberte
+; Add invalid-cl-read-syntax error symbol.
+; Add reader::read-sexp and reader::read-sexp-func to allow customization
+; based on the results of reading.
+; Remove more dependencies on cl-package.
+; Remove reader::eval-current-buffer, eval-buffer, and eval-region,
+; and use elisp-eval-region package instead.
+; 
+; Revision 1.18  94/03/04  23:42:24  liberte
+; Fix typos in comments.
+; 
+; Revision 1.17  93/11/24  12:04:09  bosch
+; cl-packages dependency removed. `reader::read-constituent' and
+; corresponding variables moved to cl-packages.el.
+; Multi-line comment #| ... |# dispatch character read macro added.
+; 
+; Revision 1.16  1993/11/23  10:21:02  bosch
+; Patches from Daniel LaLiberte integrated.
+;
+; Revision 1.15  1993/11/18  21:21:10  bosch
+; `reader::symbol-regexp1' modified.
+;
+; Revision 1.14  1993/11/17  19:06:32  bosch
+; More characters added to `reader::symbol-characters'.
+; `reader::read-constituent' modified.
+; defpackage form added.
+;
+; Revision 1.13  1993/11/16  13:06:41  bosch
+; - Symbol reading for CL package convention implemented.
+;   Variables `reader::symbol-characters', `reader::symbol-regexp1' and
+;   `reader::symbol-regexp2' and functions `reader::lookup-symbol' and
+;   `reader::read-constituent' added.
+; - Prefix for internal symbols is now "reader::" (Common Lisp
+;   compatible).
+; - Dispatch character macro #: for reading uninterned symbols added.
+;
+; Revision 1.12  1993/11/07  19:29:07  bosch
+; Minor bug fix.
+;
+; Revision 1.11  1993/11/07  19:23:59  bosch
+; Comment added. Character read macro #\<char> rewritten. Now reads 
+; e.g. #\meta-control-x. Needs to be checked. 
+; fix in `reader::restore-shared-structure'. `cl-reader-autoinstall-function' improved.
+;
+; Revision 1.10  1993/11/06  18:35:35  bosch
+; Included Daniel LaLiberte's Patches.
+; Efficiency of `reader::restore-shared-structure' improved.
+; Implementation notes for shared structure reading added.
+;
+; Revision 1.9  1993/09/08  07:44:54  bosch
+; Comment modified.
+;
+; Revision 1.8  1993/08/10  13:43:34  bosch
+; Hook function `cl-reader-autoinstall-function' for automatic installation added.
+; Buffer local variable `cl-read-active' added: together with the above
+; hook it allows the file specific activation of the cl reader.
+;
+; Revision 1.7  1993/08/10  10:35:21  bosch
+; Functions `read*' and `read-from-string*' renamed into `reader::read'
+; and `reader::read-from-string'. Whitespace character skipping after
+; recursive reader calls removed (Emacs 19 should not need this).
+; Functions `cl-reader-install'  and `cl-reader-uninstall' updated.
+; Introduction text and  function comments added.
+;
+; Revision 1.6 1993/08/09 15:36:05 bosch Function `read*' now nearly
+; elisp compatible (no functions as streams, yet -- I don't think I
+; will ever implement this, it would be far too slow).  Elisp
+; compatible function `read-from-string*' added.  Replacements for
+; `eval-current-buffer', `eval-buffer' and `eval-region' added.
+; Renamed feature `cl-dg' in `cl', as Dave Gillespie's cl.el package
+; is rather stable now.  Function `cl-reader-install' and
+; `cl-reader-uninstall' modified.
+;
+; Revision 1.5  1993/08/09  10:23:35  bosch
+; Functions `copy-readtable' and `set-syntax-from-character' added.
+; Variable `reader::internal-standard-readtable' added.  Standard
+; readtable initialization modified. Whitespace skipping placed back
+; inside the read loop.
+;
+; Revision 1.4  1993/05/14  13:00:48  bosch
+; Included patches from Daniel LaLiberte.
+;
+; Revision 1.3  1993/05/11  09:57:39  bosch
+; `read*' renamed in `reader::read-from-buffer'. `read*' now can read
+; from strings.
+;
+; Revision 1.2  1993/05/09  16:30:50  bosch
+; (require 'cl-read) added.
+; Calling of `{before,after}-read-hook' modified.
+;
+; Revision 1.1  1993/03/29  19:37:21  bosch
+; Initial revision
+;
+;
+
+;;; Code:
+
+(require 'cl)
+;; Thou shalt evaluate a defadvice only once, or thou shalt surely lose. -sb
+(require 'advise-eval-region)
+
+;; load before compiling
+;; This is ugly, but apparently the only way to do it :-(  -sb
+(provide 'cl-read)
+(require 'cl-read)
+
+;; bootstrapping with cl-packages
+;; defpackage and in-package are ignored until cl-read is installed.
+'(defpackage reader
+  (:nicknames "rd")
+  (:use el)
+  (:export
+   cl-read-active
+   copy-readtable
+   set-macro-character
+   get-macro-character
+   set-syntax-from-character
+   make-dispatch-macro-character
+   set-dispatch-macro-character
+   get-dispatch-macro-character
+   before-read-hook
+   after-read-hook
+   cl-reader-install
+   cl-reader-uninstall
+   read-syntax
+   cl-reader-autoinstall-function))
+
+'(in-package reader)
+
+
+(autoload 'compiled-function-p "bytecomp")
+
+;; This makes cl-read behave as a kind of minor mode: 
+
+(make-variable-buffer-local 'cl-read-active)
+(defvar cl-read-active nil
+  "Buffer local variable that enables Common Lisp style syntax reading.")
+(setq-default cl-read-active nil)
+
+(or (assq 'cl-read-active minor-mode-alist)
+    (setq minor-mode-alist
+	  (cons '(cl-read-active " CL") minor-mode-alist)))
+
+;; Define a new error symbol: invalid-cl-read-syntax
+;; XEmacs change
+(define-error 'invalid-cl-read-syntax "Invalid CL read syntax"
+  'invalid-read-syntax)
+
+(defun reader::error (msg &rest args)
+  (signal 'invalid-cl-read-syntax (list (apply 'format msg args))))
+
+
+;; The readtable
+
+(defvar reader::readtable-size 256
+  "The size of a readtable."
+  ;; Actually, the readtable is a vector of size (1+
+  ;; reader::readtable-size), because the last element contains the
+  ;; symbol `readtable', used for defining `readtablep.
+  )
+
+;; An entry of the readtable must have one of the following forms:
+;;
+;; 1. A symbol, one of {illegal, constituent, whitespace}.  It means 
+;;    the character's reader class.
+;;
+;; 2. A function (i.e., a symbol with a function definition, a byte
+;;    compiled function or an uncompiled lambda expression).  It means the
+;;    character is a macro character.
+;;
+;; 3. A vector of length `reader::readtable-size'. Elements of this vector
+;;    may be `nil' or a function (see 2.). It means the character is a
+;;    dispatch character, and the vector its dispatch function table.
+
+(defvar *readtable*)
+(defvar reader::internal-standard-readtable)
+
+(defun* copy-readtable 
+    (&optional (from-readtable *readtable*) 
+	       (to-readtable 
+		(make-vector (1+ reader::readtable-size) 'illegal)))
+  "Return a copy of FROM-READTABLE \(default: *readtable*\). If the
+FROM-READTABLE argument is provided as `nil', make a copy of a
+standard \(CL-like\) readtable. If TO-READTABLE is provided, modify and
+return it, otherwise create a new readtable object."
+
+  (if (null from-readtable)
+      (setq from-readtable reader::internal-standard-readtable))
+
+  (loop for i to reader::readtable-size
+	as from-syntax = (aref from-readtable i)
+	do (setf (aref to-readtable i)
+		 (if (vectorp from-syntax)
+		     (copy-sequence from-syntax)
+		   from-syntax))
+	finally return to-readtable))
+
+
+(defmacro reader::get-readtable-entry (char readtable)
+  (` (aref (, readtable) (, char))))
+   
+(defun set-macro-character 
+  (char function &optional readtable)
+    "Makes CHAR to be a macro character with FUNCTION as handler.
+When CHAR is seen by reader::read-from-buffer, it calls FUNCTION.
+Returns always t. Optional argument READTABLE is the readtable to set
+the macro character in (default: *readtable*)."
+  (or readtable (setq readtable *readtable*))
+  (or (reader::functionp function) 
+      (reader::error "Not valid character macro function: %s" function)) 
+  (setf (reader::get-readtable-entry char readtable) function)
+  t)
+
+
+(put 'set-macro-character 'edebug-form-spec 
+     '(&define sexp function-form &optional sexp))
+(put 'set-macro-character 'lisp-indent-function 1)
+
+(defun get-macro-character (char &optional readtable)
+   "Return the function associated with the character CHAR.
+Optional READTABLE defaults to *readtable*. If char isn't a macro
+character in READTABLE, return nil."
+   (or readtable (setq readtable *readtable*))
+   (let ((entry (reader::get-readtable-entry char readtable)))
+     (if (reader::functionp entry) 
+	 entry)))
+
+(defun set-syntax-from-character 
+  (to-char from-char &optional to-readtable from-readtable)   
+  "Make the syntax of TO-CHAR be the same as the syntax of FROM-CHAR.
+Optional TO-READTABLE and FROM-READTABLE are the corresponding tables
+to use. TO-READTABLE defaults to the current readtable
+\(*readtable*\), and FROM-READTABLE to nil, meaning to use the
+syntaxes from the standard Lisp Readtable."
+  (or to-readtable (setq to-readtable *readtable*))
+  (or from-readtable 
+      (setq from-readtable reader::internal-standard-readtable))
+  (let ((from-syntax
+	 (reader::get-readtable-entry from-char from-readtable)))
+    (if (vectorp from-syntax)
+	;; dispatch macro character table
+	(setq from-syntax (copy-sequence from-syntax)))
+    (setf (reader::get-readtable-entry to-char to-readtable)
+	  from-syntax))
+  t)
+
+
+;; Dispatch macro character
+(defun make-dispatch-macro-character (char &optional readtable)
+  "Let CHAR be a dispatch macro character in READTABLE (default: *readtable*)."
+  (or readtable (setq readtable *readtable*))
+  (setf (reader::get-readtable-entry char readtable)
+	;; create a dispatch character table 
+	(make-vector reader::readtable-size nil)))
+
+
+(defun set-dispatch-macro-character 
+  (disp-char sub-char function &optional readtable)
+  "Make reading CHAR1 followed by CHAR2 be handled by FUNCTION.
+Optional argument READTABLE (default: *readtable*).  CHAR1 must first be 
+made a dispatch char with `make-dispatch-macro-character'."
+  (or readtable (setq readtable *readtable*))
+  (let ((disp-table (reader::get-readtable-entry disp-char readtable)))
+    ;; check whether disp-char is a valid dispatch character
+    (or (vectorp disp-table)
+	(reader::error "`%c' not a dispatch macro character." disp-char))
+    ;; check whether function is a valid function 
+    (or (reader::functionp function) 
+	(reader::error "Not valid dispatch character macro function: %s" 
+		       function))
+    (setf (aref disp-table sub-char) function)))
+
+(put 'set-dispatch-macro-character 'edebug-form-spec
+     '(&define sexp sexp function-form &optional sexp))
+(put 'set-dispatch-macro-character 'lisp-indent-function 2)
+
+
+(defun get-dispatch-macro-character 
+  (disp-char sub-char &optional readtable)
+  "Return the macro character function for SUB-CHAR unser DISP-CHAR.
+Optional READTABLE defaults to *readtable*.
+Returns nil if there is no such function."
+  (or readtable (setq readtable *readtable*))
+  (let ((disp-table (reader::get-readtable-entry disp-char readtable)))
+    (and (vectorp disp-table)
+	 (reader::functionp (aref disp-table sub-char))
+	 (aref disp-table sub-char))))
+
+
+(defun reader::functionp (function)
+  ;; Check whether FUNCTION is a valid function object to be used 
+  ;; as (dispatch) macro character function.
+  (or (and (symbolp function) (fboundp function))
+      (compiled-function-p function)
+      (and (consp function) (eq (first function) 'lambda))))
+	   
+
+;; The basic reader loop 
+
+;; shared and circular structure reading
+(defvar reader::shared-structure-references nil)
+(defvar reader::shared-structure-labels nil)
+
+(defun reader::read-sexp-func (point func)
+  ;; This function is called to read a sexp at POINT by calling FUNC.
+  ;; reader::read-sexp-func is here to be advised, e.g. by Edebug,
+  ;; to do something before or after reading.
+  (funcall func))
+
+(defmacro reader::read-sexp (point &rest body)
+  ;; Called to return a sexp starting at POINT.  BODY creates the sexp result
+  ;; and should leave point after the sexp.  The body is wrapped in
+  ;; a lambda expression and passed to reader::read-sexp-func.
+  (` (reader::read-sexp-func (, point) (function (lambda () (,@ body))))))
+
+(put 'reader::read-sexp 'edebug-form-spec '(form body))
+(put 'reader::read-sexp 'lisp-indent-function 2)
+(put 'reader::read-sexp 'lisp-indent-hook 1)  ;; Emacs 18
+
+
+(defconst before-read-hook nil)
+(defconst after-read-hook nil)
+
+;; Set the hooks to `read-char' in order to step through the reader. e.g.
+;; (add-hook 'before-read-hook '(lambda () (message "before") (read-char)))
+;; (add-hook 'after-read-hook '(lambda () (message "after") (read-char)))
+
+(defmacro reader::encapsulate-recursive-call (reader-call)
+  ;; Encapsulate READER-CALL, a form that contains a recursive call to
+  ;; the reader, for usage inside the main reader loop.  The macro
+  ;; wraps two hooks around READER-CALL: `before-read-hook' and
+  ;; `after-read-hook'.
+  ;;
+  ;; If READER-CALL returns normally, the macro exits immediately from
+  ;; the surrounding loop with the value of READER-CALL as result.  If
+  ;; it exits non-locally (with tag `reader-ignore'), it just returns
+  ;; the value of READER-CALL, in which case the surrounding reader
+  ;; loop continues its execution.
+  ;;
+  ;; In both cases, `before-read-hook' and `after-read-hook' are
+  ;; called before and after executing READER-CALL.
+  ;; Are there any other uses for these hooks?  Edebug doesn't need them.
+  (` (prog2
+	 (run-hooks 'before-read-hook)
+	 ;; this catch allows to ignore the return, in the case that
+	 ;; reader::read-from-buffer should continue looping (e.g.
+	 ;; skipping over comments)
+	 (catch 'reader-ignore
+	   ;; this only works inside a block (e.g., in a loop): 
+	   ;; go outside 
+	   (return 
+	    (prog1 
+		(, reader-call)
+	      ;; this occurrence of the after hook fires if the 
+	      ;; reader-call returns normally ...
+	      (run-hooks 'after-read-hook))))
+       ;; ... and that one if  it was thrown to the tag 'reader-ignore
+       (run-hooks 'after-read-hook))))
+
+(put 'reader::encapsulate-recursive-call 'edebug-form-spec '(form))
+(put 'reader::encapsulate-recursive-call 'lisp-indent-function 0)
+
+(defun reader::read-from-buffer (&optional stream reader::recursive-p)
+  (or (bufferp stream)
+      (reader::error "Sorry, can only read on buffers"))
+  (if (not reader::recursive-p)
+      ;; set up environment for shared structure reading
+      (let (reader::shared-structure-references
+	    reader::shared-structure-labels
+	    tmp-sexp)
+	;; the reader returns an unshared sexpr, possibly containing
+	;; symbolic references
+	(setq tmp-sexp (reader::read-from-buffer stream 't))
+	(if ;; sexpr actually contained shared structures
+	    reader::shared-structure-references
+	    (reader::restore-shared-structure tmp-sexp)
+	  ;; it did not, so don't bother about restoring
+	  tmp-sexp))
+
+    (loop for char = (following-char)
+	  for entry = (reader::get-readtable-entry  char *readtable*)
+	  if (eobp) do (reader::error "End of file during reading")
+	  do 
+	  (cond 
+
+	   ((eq entry 'illegal)
+	    (reader::error "`%c' has illegal character syntax" char))
+
+	   ;; skipping whitespace characters must be done inside this
+	   ;; loop as character macro subroutines may return without
+	   ;; leaving the loop using (throw 'reader-ignore ...)
+	   ((eq entry 'whitespace)
+	    (forward-char 1)  
+	    ;; skip all whitespace
+	    (while (eq 'whitespace 
+		       (reader::get-readtable-entry  
+			(following-char) *readtable*))
+	      (forward-char 1)))
+
+	   ;; for every token starting with a constituent character
+	   ;; call the built-in reader (symbols, numbers, strings,
+	   ;; characters with ?<char> syntax)
+	   ((eq entry 'constituent)    
+	    (reader::encapsulate-recursive-call
+	     (reader::read-constituent stream)))
+
+	   ((vectorp entry)
+	    ;; Dispatch macro character. The dispatch macro character
+	    ;; function is contained in the vector `entry', at the
+	    ;; place indicated by <sub-char>, the first non-digit
+	    ;; character following the <disp-char>:
+	    ;; 	<disp-char><digit>*<sub-char>
+	    (reader::encapsulate-recursive-call
+	      (loop initially do (forward-char 1)
+		    for sub-char = (prog1 (following-char) 
+				     (forward-char 1))
+		    while (memq sub-char 
+				'(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9))
+		    collect sub-char into digit-args
+		    finally 
+		    (return 
+		     (funcall 
+		      ;; no test is done here whether a non-nil
+		      ;; contents is a correct dispatch character
+		      ;; function to apply.
+		      (or (aref entry sub-char)
+			  (reader::error
+			   "Undefined subsequent dispatch character `%c'" 
+			   sub-char))
+		      stream
+		      sub-char 
+		      (string-to-int
+		       (apply 'concat 
+			      (mapcar 
+			       'char-to-string digit-args))))))))
+	    
+	   (t
+	    ;; must be a macro character. In this case, `entry' is
+	    ;; the function to be called
+	    (reader::encapsulate-recursive-call
+	      (progn 
+		(forward-char 1)
+		(funcall entry stream char))))))))
+
+
+;; Constituent reader fix for Emacs 18
+(if (string-match "^19" emacs-version)
+    (defun reader::read-constituent (stream)
+      (reader::read-sexp (point)
+	(reader::original-read stream)))
+
+  (defun reader::read-constituent (stream)
+    (reader::read-sexp (point)
+      (prog1 (reader::original-read stream)
+	;; For Emacs 18, backing up is necessary because the `read' function 
+	;; reads one character too far after reading a symbol or number.
+	;; This doesnt apply to reading chars (e.g. ?n).
+	;; This still loses for escaped chars.
+	(if (not (eq (reader::get-readtable-entry
+		      (preceding-char) *readtable*) 'constituent))
+	    (forward-char -1))))))
+
+
+;; Make the default current CL readtable
+
+(defconst *readtable*
+  (loop with raw-readtable = 
+	(make-vector (1+ reader::readtable-size) 'illegal)
+	initially do (setf (aref raw-readtable reader::readtable-size)
+			   'readtable)
+	for entry in 
+	'((constituent ?! ?@ ?$ ?% ?& ?* ?_ ?- ?+ ?= ?/ ?\\ ?0 ?1 ?2
+		       ?3 ?4 ?5 ?6 ?7 ?8 ?9 ?: ?~ ?> ?< ?a ?b
+		       ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p
+		       ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z ?A ?B ?C ?D
+		       ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R
+		       ?S ?T ?U ?V ?W ?X ?Y ?Z)
+	  (whitespace ?  ?\t ?\n ?\r ?\f)
+
+	  ;; The following CL character classes are only useful for
+	  ;; token parsing.  We don't need them, as token parsing is
+	  ;; left to the built-in reader.
+	  ;; (single-escape ?\\)
+	  ;; (multiple-escape ?|)
+	  )
+	do 
+	(loop for char in (rest entry)
+	      do (setf (reader::get-readtable-entry  char raw-readtable)
+		       (first entry)))
+	finally return raw-readtable)
+  "The current readtable.")
+
+
+;; Variables used non-locally in the standard readmacros
+(defvar reader::context)
+(defvar reader::stack)
+(defvar reader::recursive-p)
+
+
+;;;; Read macro character definitions
+
+;;; Hint for modifying, testing and debugging new read macros: All the
+;;; read macros and dispatch character macros below are defined in
+;;; the `*readtable*'.  Modifications or
+;;; instrumenting with edebug are effective immediately without having to
+;;; copy the internal readtable to the standard *readtable*.  However,
+;;; if you wish to modify reader::internal-standard-readtable, then
+;;; you must recopy *readtable*.
+
+;; Chars and strings
+
+;; This is defined to distinguish chars from constituents 
+;; since chars are read by the standard reader without reading too far.
+(set-macro-character ?\?
+  (function
+   (lambda (stream char)
+     (forward-char -1)
+     (reader::read-sexp (point)
+       (reader::original-read stream)))))
+
+;; ?\M-\C-a
+
+;; This is defined to distinguish strings from constituents
+;; since backing up after reading a string is simpler.
+(set-macro-character ?\"
+  (function
+   (lambda (stream char)
+     (forward-char -1)
+     (reader::read-sexp (point)
+       (prog1 (reader::original-read stream)
+	 ;; This is not needed with Emacs 19, but it is OK.  See above.
+	 (if (/= (preceding-char) ?\")
+	     (forward-char -1)))))))
+
+;; Lists and dotted pairs
+(set-macro-character ?\( 
+  (function 
+   (lambda (stream char)
+     (reader::read-sexp (1- (point))
+       (catch 'read-list
+	 (let ((reader::context 'list) reader::stack )
+	   ;; read list elements up to a `.'
+	   (catch 'dotted-pair
+	     (while t
+	       (setq reader::stack (cons (reader::read-from-buffer stream 't) 
+					 reader::stack))))
+	   ;; In dotted pair. Read one more element
+	   (setq reader::stack (cons (reader::read-from-buffer stream 't) 
+				     reader::stack)
+		 ;; signal it to the closing paren
+		 reader::context 'dotted-pair)
+	   ;; Next char *must* be the closing paren that throws read-list
+	   (reader::read-from-buffer stream 't)
+	   ;; otherwise an error is signalled
+	   (reader::error "Illegal dotted pair read syntax")))))))
+
+(set-macro-character ?\) 
+  (function 
+   (lambda (stream char)
+     (cond ((eq reader::context 'list)
+	    (throw 'read-list (nreverse reader::stack)))
+	   ((eq reader::context 'dotted-pair)
+	    (throw 'read-list (nconc (nreverse (cdr reader::stack)) 
+				     (car reader::stack))))
+	   (t 
+	    (reader::error "`)' doesn't end a list"))))))
+	
+(set-macro-character ?\.
+  (function 
+   (lambda (stream char)
+     (and (eq reader::context 'dotted-pair) 
+	  (reader::error "No more than one `.' allowed in list"))
+     (throw 'dotted-pair nil))))
+
+;; '(#\a . #\b)
+;; '(a . (b . c))
+
+;; Vectors: [a b]
+(set-macro-character ?\[
+  (function
+   (lambda (stream char)
+     (reader::read-sexp (1- (point))
+       (let ((reader::context 'vector))
+	 (catch 'read-vector
+	   (let ((reader::context 'vector)
+		 reader::stack)
+	     (while t (push (reader::read-from-buffer stream 't)
+			    reader::stack)))))))))
+
+(set-macro-character ?\] 
+  (function 
+   (lambda (stream char)
+     (if (eq reader::context 'vector)
+	 (throw 'read-vector (apply 'vector (nreverse reader::stack)))
+       (reader::error "`]' doesn't end a vector"))))) 
+
+;; Quote and backquote/comma macro
+(set-macro-character ?\'
+  (function
+   (lambda (stream char)
+     (reader::read-sexp (1- (point))
+       (list (reader::read-sexp (point) 'quote)
+	     (reader::read-from-buffer stream 't))))))
+
+(set-macro-character ?\`
+  (function
+   (lambda (stream char)
+     (if (= (following-char) ?\ )
+	 ;; old backquote syntax. This is ambigous, because 
+	 ;; (`(sexp)) is a valid form in both syntaxes, but 
+	 ;; unfortunately not the same. 
+	 ;; old syntax: read -> (` (sexp))
+	 ;; new syntax: read -> ((` (sexp)))
+	 (reader::read-sexp (1- (point)) '\`)
+       (reader::read-sexp (1- (point))
+	 (list (reader::read-sexp (point) '\`)
+	       (reader::read-from-buffer stream 't)))))))
+
+(set-macro-character ?\,
+  (function
+   (lambda (stream char)
+     (cond ((eq (following-char) ?\ )
+	    ;; old syntax
+	    (reader::read-sexp (point) '\,))
+	   ((eq (following-char) ?\@)
+	    (forward-char 1)
+	    (cond ((eq (following-char) ?\ )
+		   (reader::read-sexp (point) '\,\@))
+		  (t
+		   (reader::read-sexp (- (point) 2)
+		     (list 
+		      (reader::read-sexp (point) '\,\@)
+		      (reader::read-from-buffer stream 't))))))
+	   (t
+	    (reader::read-sexp (1- (point))
+	      (list
+	       (reader::read-sexp (1- (point)) '\,)
+	       (reader::read-from-buffer stream 't))))))))
+
+;; 'a
+;; '(a b c)
+;; (let ((a 10) (b '(20 30))) `(,a ,@b c))
+;; the old syntax is also supported:
+;; (let ((a 10) (b '(20 30))) (` ((, a) (,@ b) c)))
+
+;; Single line character comment:  ; 
+(set-macro-character ?\;
+  (function
+   (lambda (stream char)
+     (skip-chars-forward "^\n\r")
+     (throw 'reader-ignore nil))))
+
+
+
+;; Dispatch character character #
+(make-dispatch-macro-character ?\#)
+
+(defsubst reader::check-0-infix (n)
+  (or (= n 0) 
+      (reader::error "Numeric infix argument not allowed: %d" n)))
+
+
+(defalias 'search-forward-regexp 're-search-forward)
+
+;; nested multi-line comments #| ... |#
+(set-dispatch-macro-character ?\# ?\|
+  (function 
+   (lambda (stream char n)
+     (reader::check-0-infix n)
+     (let ((counter 0))
+       (while (search-forward-regexp "#|\\||#" nil t)
+	 (if (string-equal
+	      (buffer-substring
+	       (match-beginning 0) (match-end 0))
+	      "|#")
+	     (cond ((> counter 0)
+		    (decf counter))
+		   ((= counter 0)
+		    ;; stop here
+		    (goto-char (match-end 0))
+		    (throw 'reader-ignore nil))
+		   ('t
+		    (reader::error "Unmatching closing multicomment")))
+	   (incf counter)))
+       (reader::error "Unmatching opening multicomment")))))
+
+;; From cl-packages.el
+(defconst reader::symbol-characters "[A-Za-z0-9-_!@$%^&*+=|~{}<>/]")
+(defconst reader::symbol-regexp2
+  (format "\\(%s+\\)" reader::symbol-characters))
+
+(set-dispatch-macro-character ?\# ?\:
+  (function
+   (lambda (stream char n)
+     (reader::check-0-infix n)
+     (or (looking-at reader::symbol-regexp2)
+	 (reader::error "Invalid symbol read syntax"))
+     (goto-char (match-end 0))
+     (make-symbol 
+      (buffer-substring (match-beginning 0) (match-end 0))))))
+
+;; Function quoting: #'<function>
+(set-dispatch-macro-character ?\# ?\'
+  (function
+   (lambda (stream char n)
+     (reader::check-0-infix n)
+     ;; Probably should test if cl is required by current buffer.
+     ;; Currently, cl will always be a feature because cl-read requires it.
+     (reader::read-sexp (- (point) 2)
+       (list 
+	(reader::read-sexp (point) (if (featurep 'cl)  'function* 'function))
+	(reader::read-from-buffer stream 't))))))
+
+;; Character syntax: #\<char> 
+;; Not yet implemented: #\Control-a #\M-C-a etc. 
+;; This definition is not used - the next one is more general.
+'(set-dispatch-macro-character ?# ?\\
+  (function 
+   (lambda (stream char n)
+     (reader::check-0-infix n)
+     (let ((next (following-char))
+           name)
+       (if (not (and (<= ?a next) (<= next ?z)))
+           (progn (forward-char 1) next)
+         (setq next (reader::read-from-buffer stream t))
+         (cond ((symbolp next) (setq name (symbol-name next)))
+               ((integerp next) (setq name (int-to-string next))))
+         (if (= 1 (length name))
+             (string-to-char name)
+           (case next
+             (linefeed  ?\n)
+             (newline   ?\r)
+             (space     ?\ )
+             (rubout    ?\b)
+             (page      ?\f)
+             (tab       ?\t)
+             (return    ?\C-m)
+             (t
+              (reader::error "Unknown character specification `%s'"
+			     next))))))))
+  )
+
+(defvar reader::special-character-name-table
+  '(("linefeed"	. ?\n)
+    ("newline"	. ?\r)
+    ("space"	. ?\ )
+    ("rubout"	. ?\b)
+    ("page"	. ?\f)
+    ("tab"        . ?\t)
+    ("return"	. ?\C-m)))
+
+(set-dispatch-macro-character ?# ?\\
+  (function 
+   (lambda (stream char n)
+     (reader::check-0-infix n)
+     (forward-char -1)
+     ;; We should read in a special package to avoid creating symbols.
+     (let ((symbol (reader::read-from-buffer stream t))
+	   (case-fold-search t)
+	   name modifier character char-base)
+       (setq name (symbol-name symbol))
+       (if (string-match "^\\(meta-\\|m-\\|control-\\|c-\\)+" name)
+	   (setq modifier (substring name
+				     (match-beginning 1)
+				     (match-end 1))
+		 character (substring name (match-end 1)))
+	 (setq character name))
+       (setq char-base 
+	     (cond ((= (length character) 1)
+		    (string-to-char character))
+		   ('t 
+		    (cdr (assoc character 
+				reader::special-character-name-table)))))
+       (or char-base 
+	   (reader::error
+	    "Unknown character specification `%s'" character))
+	
+       (and modifier
+	    (progn 
+	      (and (string-match "control-\\|c-" modifier)
+		   (decf char-base 32))
+	      (and (string-match "meta-\\|m-" modifier)
+		   (incf char-base 128))))
+       char-base))))
+
+;; '(#\meta-space #\tab #\# #\> #\< #\a #\A  #\return #\space)
+;; (eq #\m-tab ?\M-\t)
+;; (eq #\c-m-x #\m-c-x)
+;; (eq #\Meta-Control-return #\M-C-return)
+;; (eq #\m-m-c-c-x #\m-c-x)
+;; #\C-space #\C-@ ?\C-@
+
+
+
+;; Read and load time evaluation:  #.<form>
+;; Not yet implemented: #,<form>
+(set-dispatch-macro-character ?\# ?\.
+  (function 
+   (lambda (reader::stream reader::char reader::n)
+     (reader::check-0-infix reader::n)
+     ;; This eval will see all internal vars of reader, 
+     ;; e.g. stream, reader::recursive-p.  Anything that might be bound.
+     ;; We must use `read' here rather than read-from-buffer with 'recursive-p
+     ;; because the expression must not have unresolved #n#s in it anyway.
+     ;; Otherwise the top-level expression must be completely read before
+     ;; any embedded evaluation(s) occur(s).  CLtL2 does not specify this.
+     ;; Also, call `read' so that it may be customized, by e.g. Edebug
+     (eval (read reader::stream)))))
+;; '(#.(current-buffer) #.(get-buffer "*scratch*"))
+
+;; Path names (kind of):  #p<string>, #P<string>,
+(set-dispatch-macro-character ?\# ?\P
+  (function 
+   (lambda (stream char n)
+     (reader::check-0-infix n)
+     (let ((string (reader::read-from-buffer stream 't)))
+       (or (stringp string) 
+	   (reader::error "Pathname must be a string: %s" string))
+       (expand-file-name string)))))
+
+(set-dispatch-macro-character ?\# ?\p
+  (get-dispatch-macro-character ?\# ?\P))
+
+;; #P"~/.emacs"
+;; #p"~root/home" 
+
+;; Feature reading:  #+<feature>,  #-<feature>
+;; Not yet implemented: #+<boolean expression>, #-<boolean expression>
+
+
+(defsubst reader::read-feature (stream char n flag)
+  (reader::check-0-infix n)
+  (let (;; Use the original reader to only read the feature.
+	;; This is not exactly correct without *read-suppress*.
+	;; Also Emacs 18 read goes one too far,
+	;; so we assume there is a space after the feature.
+	(feature (reader::original-read stream))
+	(object (reader::read-from-buffer stream 't)))
+    (if (eq (featurep feature) flag)
+	object
+      ;; Ignore it.
+      (throw 'reader-ignore nil))))
+
+(set-dispatch-macro-character ?\# ?\+
+  (function 
+   (lambda (stream char n)
+     (reader::read-feature stream char n t))))
+
+(set-dispatch-macro-character ?\# ?\-
+  (function 
+   (lambda (stream char n)
+     (reader::read-feature stream char n nil))))
+
+;; (#+cl loop #+cl do #-cl while #-cl t (body))
+
+
+
+
+;; Shared structure reading: #<n>=, #<n>#
+
+;; Reading of sexpression with shared and circular structure read
+;; syntax  is done in two steps:
+;; 
+;; 1. Create an sexpr with unshared structures, just as the ordinary
+;;    read macros do, with two exceptions: 
+;;    - each label (#<n>=) creates, as a side effect, a symbolic
+;;      reference for the sexpr that follows it
+;;    - each reference (#<n>#) is replaced by the corresponding
+;;      symbolic reference. 
+;;
+;; 2. This non-cyclic and unshared lisp structure is given to the
+;;    function `reader::restore-shared-structure' (see
+;;    `reader::read-from-buffer'), which simply replaces
+;;    destructively all symbolic references by the lisp structures the
+;;    references point at. 
+;;
+;; A symbolic reference is an uninterned symbol whose name is obtained
+;; from the label/reference number using the function `int-to-string': 
+;;
+;; There are two non-locally used variables (bound in
+;; `reader::read-from-buffer') which control shared structure reading: 
+;; `reader::shared-structure-labels': 
+;;	A list of integers that correspond to the label numbers <n> in
+;;      the string currently read. This is used to avoid multiple
+;;      definitions of the same label.
+;; `reader::shared-structure-references': 
+;;      The list of symbolic references that will be used as temporary
+;;      placeholders for the shared objects introduced by a reference
+;;      with the same number identification.
+
+(set-dispatch-macro-character ?\# ?\=
+  (function 
+   (lambda (stream char n)
+     (and (= n 0) (reader::error "0 not allowed as label"))
+     ;; check for multiple definition of the same label
+     (if (memq n reader::shared-structure-labels)
+	 (reader::error "Label defined twice")
+       (push n reader::shared-structure-labels))
+     ;; create an uninterned symbol as symbolic reference for the label
+     (let* ((string (int-to-string n))
+	    (ref (or (find string reader::shared-structure-references
+			   :test 'string=)
+		     (first 
+		      (push (make-symbol string) 
+			    reader::shared-structure-references)))))
+       ;; the link between the symbolic reference and the lisp
+       ;; structure it points at is done using the symbol value cell
+       ;; of the reference symbol.
+       (setf (symbol-value ref) 
+	     ;; this is also the return value 
+	     (reader::read-from-buffer stream 't))))))
+
+
+(set-dispatch-macro-character ?\# ?\#
+  (function
+   (lambda (stream char n)
+     (and (= n 0) (reader::error "0 not allowed as label"))
+     ;; use the non-local variable `reader::recursive-p' (from the reader
+     ;; main loop) to detect labels at the top level of an sexpr.
+     (if (not reader::recursive-p)
+	 (reader::error "References at top level not allowed"))
+     (let* ((string (int-to-string n))
+	    (ref (or (find string reader::shared-structure-references
+			   :test 'string=)
+		     (first
+		      (push (make-symbol string) 
+			    reader::shared-structure-references)))))
+       ;; the value of reading a #n# form is a reference symbol
+       ;; whose symbol value is or will be the shared structure. 
+       ;; `reader::restore-shared-structure' then replaces the symbol by
+       ;; its value.
+       ref))))
+
+(defun reader::restore-shared-structure (obj)
+  ;; traverses recursively OBJ and replaces all symbolic references by
+  ;; the objects they point at. Remember that a symbolic reference is
+  ;; an uninterned symbol whose value is the object it points at. 
+  (cond 
+   ((consp obj)
+    (loop for rest on obj
+	  as lastcdr = rest
+	  do
+	  (if;; substructure is a symbolic reference
+	      (memq (car rest) reader::shared-structure-references)
+	      ;; replace it by its symbol value, i.e. the associated object
+	      (setf (car rest) (symbol-value (car rest)))
+	    (reader::restore-shared-structure (car rest)))
+	  finally 
+	  (if (memq (cdr lastcdr) reader::shared-structure-references)
+	      (setf (cdr lastcdr) (symbol-value (cdr lastcdr)))
+	    (reader::restore-shared-structure (cdr lastcdr)))))
+   ((vectorp obj)
+    (loop for i below (length obj)
+	  do
+	  (if;; substructure  is a symbolic reference
+	      (memq (aref obj i) reader::shared-structure-references)
+	      ;; replace it by its symbol value, i.e. the associated object
+	      (setf (aref obj i) (symbol-value (aref obj i)))
+	    (reader::restore-shared-structure (aref obj i))))))
+  obj)
+
+
+;; #1=(a b #3=[#2=c])
+;; (#1=[#\return #\a] #1# #1#)
+;; (#1=[a b c] #1# #1#)
+;; #1=(a b . #1#)
+
+;; Creation and initialization of an internal standard readtable. 
+;; Do this after all the macros and dispatch chars above have been defined.
+
+(defconst reader::internal-standard-readtable (copy-readtable)
+  "The original (CL-like) standard readtable. If you ever modify this
+readtable, you won't be able to recover a standard readtable using
+\(copy-readtable nil\)")
+
+
+;; Replace built-in functions that call the built-in reader
+;; 
+;; The following functions are replaced here: 
+;;
+;; read			by	reader::read
+;; read-from-string	by	reader::read-from-string
+;;
+;; eval-expression	by	reader::eval-expression
+;; Why replace eval-expression? Not needed for Lucid Emacs since the
+;; reader for arguments is also written in Lisp, and so may be overridden.
+;;
+;; eval-current-buffer  by	reader::eval-current-buffer
+;; eval-buffer		by	reader::eval-buffer
+;; original-eval-region by	reader::original-eval-region
+
+
+;; Temporary read buffer used for reading from strings
+(defconst reader::tmp-buffer
+  (get-buffer-create " *CL Read*"))
+
+;; Save a pointer to the original read function
+(or (fboundp 'reader::original-read)
+    (fset 'reader::original-read  (symbol-function 'read)))
+
+(defun reader::read (&optional stream reader::recursive-p)
+  "Read one Lisp expression as text from STREAM, return as Lisp object.
+If STREAM is nil, use the value of `standard-input' \(which see\).
+STREAM or the value of `standard-input' may be:
+ a buffer \(read from point and advance it\)
+ a marker \(read from where it points and advance it\)
+ a string \(takes text from string, starting at the beginning\)
+ t \(read text line using minibuffer and use it\).
+
+This is the cl-read replacement of the standard elisp function
+`read'. The only incompatibility is that functions as stream arguments
+are not supported."
+  (if (not cl-read-active)
+      (reader::original-read stream)
+    (if (null stream)			; read from standard-input
+	(setq stream standard-input))
+
+    (if (eq stream 't)			; read from minibuffer
+	(setq stream (read-from-minibuffer "Common Lisp Expression: ")))
+
+    (cond 
+
+     ((bufferp stream)			; read from buffer
+      (reader::read-from-buffer stream reader::recursive-p))
+
+     ((markerp stream)			; read from marker
+      (save-excursion 
+	(set-buffer (marker-buffer stream))
+	(goto-char (marker-position stream))
+	(reader::read-from-buffer (current-buffer) reader::recursive-p)))
+
+     ((stringp stream)			; read from string
+      (save-excursion
+	(set-buffer reader::tmp-buffer)
+	(auto-save-mode -1)
+	(erase-buffer)
+	(insert stream)
+	(goto-char (point-min))
+	(reader::read-from-buffer reader::tmp-buffer reader::recursive-p)))
+     (t 
+      (reader::error "Not a valid stream: %s" stream)))))
+
+;; read-from-string
+;; save a pointer to the original `read-from-string' function
+(or (fboundp 'reader::original-read-from-string)
+    (fset 'reader::original-read-from-string
+	  (symbol-function 'read-from-string)))
+
+(defun reader::read-from-string (string &optional start end)
+  "Read one Lisp expression which is represented as text by STRING.
+Returns a cons: (OBJECT-READ . FINAL-STRING-INDEX).
+START and END optionally delimit a substring of STRING from which to read;
+they default to 0 and (length STRING) respectively.
+
+This is the cl-read replacement of the standard elisp function
+`read-from-string'.  It uses the reader macros in *readtable* if
+`cl-read-active' is non-nil in the current buffer."
+
+  ;; Does it really make sense to have read-from-string depend on
+  ;; what the current buffer happens to be?   Yes, so code that
+  ;; has nothing to do with cl-read uses original reader.
+  (if (not cl-read-active)
+      (reader::original-read-from-string string start end)
+    (or start (setq start 0))
+    (or end (setq end (length string)))
+    (save-excursion
+      (set-buffer reader::tmp-buffer)
+      (auto-save-mode -1)
+      (erase-buffer)
+      (insert (substring string 0 end))
+      (goto-char (1+ start))
+      (cons 
+       (reader::read-from-buffer reader::tmp-buffer nil)
+       (1- (point))))))
+
+;; (read-from-string "abc (car 'a) bc" 4)
+;; (reader::read-from-string "abc (car 'a) bc" 4)
+;; (read-from-string "abc (car 'a) bc" 2 11)
+;; (reader::read-from-string "abc (car 'a) bc" 2 11)
+;; (reader::read-from-string "`(car ,first ,@rest)")
+;; (read-from-string ";`(car ,first ,@rest)")
+;; (reader::read-from-string ";`(car ,first ,@rest)")
+
+;; We should replace eval-expression, too, so that it reads (and
+;; evals) in the current buffer.  Alternatively, this could be fixed
+;; in C.  In Lemacs 19.6 and later, this function is already written
+;; in lisp, and based on more primitive read functions we already
+;; replaced. The reading happens during the interactive parameter
+;; retrieval, which is written in lisp, too.  So this replacement of
+;; eval-expression is only required for (FSF) Emacs 18 (and 19?).
+
+(or (fboundp 'reader::original-eval-expression)
+    (fset 'reader::original-eval-expression 
+          (symbol-function 'eval-expression)))
+
+(defun reader::eval-expression (reader::expression)
+  "Evaluate EXPRESSION and print value in minibuffer.
+Value is also consed on to front of variable `values'."
+  (interactive 
+   (list
+    (car (read-from-string
+          (read-from-minibuffer 
+           "Eval: " nil 
+           ;;read-expression-map ;; not for emacs 18
+           nil ;; use default map
+           nil ;; don't do read with minibuffer current.
+           ;; 'edebug-expression-history ;; not for emacs 18
+           )))))
+  (setq values (cons (eval reader::expression) values))
+  (prin1 (car values) t))
+
+(require 'eval-reg "eval-reg")
+; (require 'advice)
+
+
+;; installing/uninstalling the cl reader
+;; These two should always be used in pairs, or just install once and
+;; never uninstall. 
+(defun cl-reader-install ()
+  (interactive)
+  (fset 'read 			'reader::read)
+  (fset 'read-from-string 	'reader::read-from-string)
+  (fset 'eval-expression 	'reader::eval-expression)
+  (elisp-eval-region-install))
+
+(defun cl-reader-uninstall ()
+  (interactive)
+  (fset 'read 		       
+	(symbol-function 'reader::original-read))
+  (fset 'read-from-string	
+	(symbol-function 'reader::original-read-from-string))
+  (fset 'eval-expression
+	(symbol-function 'reader::original-eval-expression))
+  (elisp-eval-region-uninstall))
+
+;; Globally installing the cl-read replacement functions is safe, even
+;; for buffers without cl read syntax. The buffer local variable
+;; `cl-read-active' controls whether the replacement funtions of this
+;; package or the original ones are actually called.
+(cl-reader-install)
+(cl-reader-uninstall)
+
+(add-hook 'emacs-lisp-mode-hook 'cl-reader-autoinstall-function)
+
+'(defvar read-syntax)
+
+'(defun cl-reader-autoinstall-function () 
+  "Activates the Common Lisp style reader for emacs-lisp-mode buffers,
+if the property line has a local variable setting like this: 
+\;\; -*- Read-Syntax: Common-Lisp -*-"
+  ;; this is a hack to avoid recursion in the case that the prop line 
+  ;; containes "Mode: emacs-lisp" entry
+  (or (boundp 'local-variable-hack-done)
+      (let (local-variable-hack-done
+	    (case-fold-search t))
+	;; Usually `hack-local-variables-prop-line' is called only after
+	;; installation of the major mode. But we need to know about the
+	;; local variables before that, so we call the local variable hack
+	;; explicitly here:
+	(hack-local-variables-prop-line 't)
+	;; But hack-local-variables-prop-line not defined in emacs 18.
+	(cond 
+	 ((and (boundp 'read-syntax)
+	       read-syntax
+	       (string-match "^common-lisp$" (symbol-name read-syntax)))
+	  (require 'cl-read)
+	  (make-local-variable 'cl-read-active)
+	  (setq cl-read-active 't))))))
+
+;; Emacs 18 doesnt have hack-local-variables-prop-line.  So use this instead.
+(defun cl-reader-autoinstall-function ()
+  (save-excursion
+    (goto-char (point-min))
+    (let ((case-fold-search t))
+      (cond ((re-search-forward 
+	      "read-syntax: *common-lisp" 
+	      (save-excursion 
+		(end-of-line)
+		(point))
+	      t)
+	     (require 'cl-read)
+	     (make-local-variable 'cl-read-active)
+	     (setq cl-read-active t))))))
+
+
+(run-hooks 'cl-read-load-hooks)
+
+;; cl-read.el ends here
+;; cl-specs.el - Edebug specs for cl.el
+
+;; Copyright (C) 1993 Free Software Foundation, Inc.
+;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu>
+;; Keywords: lisp, tools, maint
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;;; Commentary:
+
+;; LCD Archive Entry:
+;; cl-specs.el|Daniel LaLiberte|liberte@cs.uiuc.edu
+;; |Edebug specs for cl.el
+;; |$Date$|$Revision$|~/modes/cl-specs.el|
+
+;; These specs are to be used with edebug.el version 3.3 or later and
+;; cl.el version 2.03 or later, by Dave Gillespie <daveg@synaptics.com>.
+
+;; This file need not be byte-compiled, but it shouldn't hurt.
+
+;;; Code:
+
+(provide 'cl-specs)
+;; Do the above provide before the following require.
+;; Otherwise if you load this before edebug if cl is already loaded
+;; an infinite loading loop would occur.
+(require 'edebug)
+
+;; Blocks
+
+(def-edebug-spec block (symbolp body))
+(def-edebug-spec return (&optional form))
+(def-edebug-spec return-from (symbolp &optional form))
+
+;; Loops
+
+(def-edebug-spec when t)
+(def-edebug-spec unless t)
+(def-edebug-spec case (form &rest (sexp body)))
+(def-edebug-spec ecase case)
+(def-edebug-spec do
+  ((&rest &or symbolp (symbolp &optional form form))
+   (form body) 
+   cl-declarations body))
+(def-edebug-spec do* do)
+(def-edebug-spec dolist 
+  ((symbolp form &optional form) cl-declarations body))
+(def-edebug-spec dotimes dolist)
+(def-edebug-spec do-symbols
+  ((symbolp &optional form form) cl-declarations body))
+(def-edebug-spec do-all-symbols 
+  ((symbolp &optional form) cl-declarations body))
+
+;; Multiple values
+
+(def-edebug-spec multiple-value-list (form))
+(def-edebug-spec multiple-value-call (function-form body))
+(def-edebug-spec multiple-value-bind 
+  ((&rest symbolp) form cl-declarations body))
+(def-edebug-spec multiple-value-setq ((&rest symbolp) form))
+(def-edebug-spec multiple-value-prog1 (form body))
+
+;; Bindings
+
+(def-edebug-spec lexical-let let)
+(def-edebug-spec lexical-let* let)
+
+(def-edebug-spec psetq setq)
+(def-edebug-spec progv (form form body))
+
+(def-edebug-spec flet ((&rest (defun*)) cl-declarations body))
+(def-edebug-spec labels flet)
+
+(def-edebug-spec macrolet 
+  ((&rest (&define name (&rest arg) cl-declarations-or-string def-body)) 
+   cl-declarations body))
+
+(def-edebug-spec symbol-macrolet 
+  ((&rest (symbol sexp)) cl-declarations body))
+
+(def-edebug-spec destructuring-bind
+  (&define cl-macro-list form cl-declarations def-body))
+
+;; Setf
+
+(def-edebug-spec setf (&rest [place form])) ;; sexp is not specific enough
+(def-edebug-spec psetf setf)
+
+(def-edebug-spec letf  ;; *not* available in Common Lisp
+  ((&rest (gate place &optional form))
+   body))
+(def-edebug-spec letf* letf)
+
+
+(def-edebug-spec defsetf 
+  (&define name 
+	   [&or [symbolp &optional stringp]
+		[cl-lambda-list (symbolp)]]
+	   cl-declarations-or-string def-body))
+
+(def-edebug-spec define-setf-method 
+  (&define name cl-lambda-list cl-declarations-or-string def-body))
+
+(def-edebug-spec define-modify-macro
+  (&define name cl-lambda-list ;; should exclude &key
+	   symbolp &optional stringp))
+
+(def-edebug-spec callf (function* place &rest form))
+(def-edebug-spec callf2 (function* form place &rest form))
+
+;; Other operations on places
+
+(def-edebug-spec remf (place form))
+
+(def-edebug-spec incf (place &optional form))
+(def-edebug-spec decf incf)
+(def-edebug-spec push (form place))
+(def-edebug-spec pushnew 
+  (form place &rest 
+	&or [[&or ":test" ":test-not" ":key"] function-form]
+	[keywordp form]))
+(def-edebug-spec pop (place))
+
+(def-edebug-spec shiftf (&rest place))  ;; really [&rest place] form
+(def-edebug-spec rotatef (&rest place))
+
+
+;; Functions with function args.  These are only useful if the
+;; function arg is quoted with ' instead of function.
+
+(def-edebug-spec some (function-form form &rest form))
+(def-edebug-spec every some)
+(def-edebug-spec notany some)
+(def-edebug-spec notevery some)
+
+;; Mapping
+
+(def-edebug-spec map (form function-form form &rest form))
+(def-edebug-spec maplist (function-form form &rest form))
+(def-edebug-spec mapc maplist)
+(def-edebug-spec mapl maplist)
+(def-edebug-spec mapcan maplist)
+(def-edebug-spec mapcon maplist)
+
+;; Sequences
+
+(def-edebug-spec reduce (function-form form &rest form))
+
+;; Types and assertions
+
+(def-edebug-spec cl-type-spec (sexp)) ;; not worth the trouble to specify, yet.
+
+(def-edebug-spec deftype defmacro*)
+(def-edebug-spec check-type (place cl-type-spec &optional stringp))
+;; (def-edebug-spec assert (form &optional form stringp &rest form))
+(def-edebug-spec assert (form &rest form))
+(def-edebug-spec typecase (form &rest ([&or cl-type-spec "otherwise"] body)))
+(def-edebug-spec etypecase typecase)
+
+(def-edebug-spec ignore-errors t)
+
+;; Time of Evaluation
+
+(def-edebug-spec eval-when
+  ((&rest &or "compile" "load" "eval") body))
+(def-edebug-spec load-time-value (form &optional &or "t" "nil"))
+
+;; Declarations
+
+(def-edebug-spec cl-decl-spec 
+  ((symbolp &rest sexp)))
+
+(def-edebug-spec cl-declarations
+  (&rest ("declare" &rest cl-decl-spec)))
+
+(def-edebug-spec cl-declarations-or-string
+  (&or stringp cl-declarations))
+
+(def-edebug-spec declaim (&rest cl-decl-spec))
+(def-edebug-spec declare (&rest cl-decl-spec))  ;; probably not needed.
+(def-edebug-spec locally (cl-declarations &rest form))
+(def-edebug-spec the (cl-type-spec form))
+
+;;======================================================
+;; Lambda things
+
+(def-edebug-spec cl-lambda-list
+  (([&rest arg]
+    [&optional ["&optional" cl-&optional-arg &rest cl-&optional-arg]]
+    [&optional ["&rest" arg]]
+    [&optional ["&key" [cl-&key-arg &rest cl-&key-arg]
+		&optional "&allow-other-keywords"]]
+    [&optional ["&aux" &rest
+		&or (symbolp &optional def-form) symbolp]]
+    )))
+
+(def-edebug-spec cl-&optional-arg
+  (&or (arg &optional def-form arg) arg))
+
+(def-edebug-spec cl-&key-arg
+  (&or ([&or (symbolp arg) arg] &optional def-form arg) arg))
+
+;; The lambda list for macros is different from that of normal lambdas.
+;; Note that &environment is only allowed as first or last items in the 
+;; top level list.
+
+(def-edebug-spec cl-macro-list
+  (([&optional "&environment" arg]
+    [&rest cl-macro-arg]
+    [&optional ["&optional" &rest 
+		&or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
+    [&optional [[&or "&rest" "&body"] cl-macro-arg]]
+    [&optional ["&key" [&rest 
+			[&or ([&or (symbolp cl-macro-arg) arg] 
+			      &optional def-form cl-macro-arg)
+			     arg]]
+		&optional "&allow-other-keywords"]]
+    [&optional ["&aux" &rest
+		&or (symbolp &optional def-form) symbolp]]
+    [&optional "&environment" arg]
+    )))
+
+(def-edebug-spec cl-macro-arg
+  (&or arg cl-macro-list1))
+
+(def-edebug-spec cl-macro-list1
+  (([&optional "&whole" arg]  ;; only allowed at lower levels
+    [&rest cl-macro-arg]
+    [&optional ["&optional" &rest 
+		&or (cl-macro-arg &optional def-form cl-macro-arg) arg]]
+    [&optional [[&or "&rest" "&body"] cl-macro-arg]]
+    [&optional ["&key" [&rest 
+			[&or ([&or (symbolp cl-macro-arg) arg] 
+			      &optional def-form cl-macro-arg)
+			     arg]]
+		&optional "&allow-other-keywords"]]
+    [&optional ["&aux" &rest
+		&or (symbolp &optional def-form) symbolp]]
+    . [&or arg nil])))
+
+
+(def-edebug-spec defun*
+  ;; Same as defun but use cl-lambda-list.
+  (&define [&or name
+		("setf" :name setf name)]
+	   cl-lambda-list
+	   cl-declarations-or-string
+	   [&optional ("interactive" interactive)]
+	   def-body))
+(def-edebug-spec defsubst* defun*)
+
+(def-edebug-spec defmacro* 
+  (&define name cl-macro-list cl-declarations-or-string def-body))
+(def-edebug-spec define-compiler-macro defmacro*)
+
+
+(def-edebug-spec function*
+  (&or symbolp cl-lambda-expr))
+
+(def-edebug-spec cl-lambda-expr
+  (&define ("lambda" cl-lambda-list
+	    ;;cl-declarations-or-string
+	    ;;[&optional ("interactive" interactive)]
+	    def-body)))
+
+;; Redefine function-form to also match function*
+(def-edebug-spec function-form
+  ;; form at the end could also handle "function",
+  ;; but recognize it specially to avoid wrapping function forms.
+  (&or ([&or "quote" "function"] &or symbolp lambda-expr) 
+       ("function*" cl-lambda-expr)
+       form))
+
+;;======================================================
+;; Structures
+;; (def-edebug-spec defstruct (&rest sexp)) would be sufficient, but...
+
+;; defstruct may contain forms that are evaluated when a structure is created.
+(def-edebug-spec defstruct
+  (&define  ; makes top-level form not be wrapped
+   [&or symbolp
+	(gate
+	 symbolp &rest 
+		 (&or [":conc-name" &or stringp "nil"]
+		      [":constructor" symbolp &optional cl-lambda-list]
+		      [":copier" symbolp]
+		      [":predicate" symbolp]
+		      [":include" symbolp &rest sexp];; not finished
+		      ;; The following are not supported.
+		      ;; [":print-function" ...]
+		      ;; [":type" ...]
+		      ;; [":initial-offset" ...]
+		      ))]
+   [&optional stringp]
+   ;; All the above is for the following def-form.
+   &rest &or symbolp (symbolp def-form &optional ":read-only" sexp)))
+
+;;======================================================
+;; Loop
+
+;; The loop macro is very complex, and a full spec is found below.
+;; The following spec only minimally specifies that
+;; parenthesized forms are executable, but single variables used as
+;; expressions will be missed.  You may want to use this if the full
+;; spec causes problems for you.
+
+(def-edebug-spec loop
+  (&rest &or symbolp form))
+
+;; Below is a complete spec for loop, in several parts that correspond
+;; to the syntax given in CLtL2.  The specs do more than specify where
+;; the forms are; it also specifies, as much as Edebug allows, all the
+;; syntactically legal loop clauses.  The disadvantage of this
+;; completeness is rigidity, but the "for ... being" clause allows
+;; arbitrary extensions of the form: [symbolp &rest &or symbolp form].
+
+(def-edebug-spec loop
+  ([&optional ["named" symbolp]]
+   [&rest 
+    &or
+    ["repeat" form]
+    loop-for-as
+    loop-with
+    loop-initial-final]
+   [&rest loop-clause]
+   ))
+
+(def-edebug-spec loop-with
+  ("with" loop-var
+   loop-type-spec
+   [&optional ["=" form]]
+   &rest ["and" loop-var
+	  loop-type-spec
+	  [&optional ["=" form]]]))
+
+(def-edebug-spec loop-for-as
+  ([&or "for" "as"] loop-for-as-subclause
+   &rest ["and" loop-for-as-subclause]))
+
+(def-edebug-spec loop-for-as-subclause
+  (loop-var 
+   loop-type-spec
+   &or 
+   [[&or "in" "on" "in-ref" "across-ref"]
+    form &optional ["by" function-form]]
+
+   ["=" form &optional ["then" form]]
+   ["across" form]
+   ["being" 
+    [&or "the" "each"]
+    &or 
+    [[&or "element" "elements"] 
+     [&or "of" "in" "of-ref"] form
+     &optional "using" ["index" symbolp]];; is this right?
+    [[&or "hash-key" "hash-keys"
+	  "hash-value" "hash-values"]
+     [&or "of" "in"]
+     hash-table-p &optional ["using" ([&or "hash-value" "hash-values" 
+					   "hash-key" "hash-keys"] sexp)]]
+					
+    [[&or "symbol" "present-symbol" "external-symbol"
+	  "symbols" "present-symbols" "external-symbols"]
+     [&or "in" "of"] package-p]
+     
+    ;; Extensions for Emacs Lisp, including Lucid Emacs.
+    [[&or "frame" "frames"
+	  "screen" "screens"
+	  "buffer" "buffers"]]
+
+    [[&or "window" "windows"] 
+     [&or "of" "in"] form]
+
+    [[&or "overlay" "overlays"
+	  "extent" "extents"]
+     [&or "of" "in"] form
+     &optional [[&or "from" "to"] form]]
+
+    [[&or "interval" "intervals"] 
+     [&or "in" "of"] form
+     &optional [[&or "from" "to"] form]
+     ["property" form]]
+     
+    [[&or "key-code" "key-codes"
+	  "key-seq" "key-seqs"
+	  "key-binding" "key-bindings"] 
+     [&or "in" "of"] form
+     &optional ["using" ([&or "key-code" "key-codes"
+			      "key-seq" "key-seqs"
+			      "key-binding" "key-bindings"] 
+			 sexp)]]
+    ;; For arbitrary extensions, recognize anything else.
+    [symbolp &rest &or symbolp form]
+    ]
+   
+   ;; arithmetic - must be last since all parts are optional.
+   [[&optional [[&or "from" "downfrom" "upfrom"] form]]
+    [&optional [[&or "to" "downto" "upto" "below" "above"] form]]
+    [&optional ["by" form]]
+    ]))
+
+(def-edebug-spec loop-initial-final
+  (&or ["initially" 
+	;; [&optional &or "do" "doing"]  ;; CLtL2 doesnt allow this.
+	&rest loop-non-atomic-expr]
+       ["finally" &or 
+	[[&optional &or "do" "doing"] &rest loop-non-atomic-expr]
+	["return" form]]))
+
+(def-edebug-spec loop-and-clause
+  (loop-clause &rest ["and" loop-clause]))
+
+(def-edebug-spec loop-clause
+  (&or
+   [[&or "while" "until" "always" "never" "thereis"] form]
+     
+   [[&or "collect" "collecting"
+	 "append" "appending"
+	 "nconc" "nconcing"
+	 "concat" "vconcat"] form 
+	 [&optional ["into" loop-var]]]
+
+   [[&or "count" "counting"
+	 "sum" "summing"
+	 "maximize" "maximizing"
+	 "minimize" "minimizing"] form
+	 [&optional ["into" loop-var]]
+	 loop-type-spec]
+
+   [[&or "if" "when" "unless"]
+    form loop-and-clause
+    [&optional ["else" loop-and-clause]]
+    [&optional "end"]]
+
+   [[&or "do" "doing"] &rest loop-non-atomic-expr]
+
+   ["return" form]
+   loop-initial-final
+   ))
+
+(def-edebug-spec loop-non-atomic-expr
+  ([&not atom] form))
+
+(def-edebug-spec loop-var
+  ;; The symbolp must be last alternative to recognize e.g. (a b . c)
+  ;; loop-var => 
+  ;; (loop-var . [&or nil loop-var])
+  ;; (symbolp . [&or nil loop-var])
+  ;; (symbolp . loop-var)
+  ;; (symbolp . (symbolp . [&or nil loop-var]))
+  ;; (symbolp . (symbolp . loop-var))
+  ;; (symbolp . (symbolp . symbolp)) == (symbolp symbolp . symbolp)
+  (&or (loop-var . [&or nil loop-var]) [gate symbolp]))
+
+(def-edebug-spec loop-type-spec
+  (&optional ["of-type" loop-d-type-spec]))
+
+(def-edebug-spec loop-d-type-spec
+  (&or (loop-d-type-spec . [&or nil loop-d-type-spec]) cl-type-spec))
+
+;; cl-specs.el ends here
+;;; cust-print.el --- handles print-level and print-circle.
+
+;; Copyright (C) 1992 Free Software Foundation, Inc.
+
+;; Author: Daniel LaLiberte <liberte@cs.uiuc.edu>
+;; Adapted-By: ESR
+;; Keywords: extensions
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF
+
+;; LCD Archive Entry:
+;; cust-print|Daniel LaLiberte|liberte@cs.uiuc.edu
+;; |Handle print-level, print-circle and more.
+;; |$Date$|$Revision$|
+
+;; ===============================
+;; $Header$
+;; $Log$
+;; Revision 1.4  1994/03/23  20:34:29  liberte
+;; * Change "emacs" to "original" - I just can't decide. 
+;;
+;; Revision 1.3  1994/02/21  21:25:36  liberte
+;; * Make custom-prin1-to-string more robust when errors occur.
+;; * Change "internal" to "emacs".
+;;
+;; Revision 1.2  1993/11/22  22:36:36  liberte
+;; * Simplified and generalized printer customization.
+;;     custom-printers is an alist of (PREDICATE . PRINTER) pairs
+;;     for any data types.  The PRINTER function should print to
+;;     `standard-output'  add-custom-printer and delete-custom-printer
+;;     change custom-printers.
+;;
+;; * Installation function now called install-custom-print.  The
+;;     old name is still around for now.
+;;
+;; * New macro with-custom-print (added earlier) - executes like
+;;     progn but with custom-print activated temporarily.
+;;
+;; * Cleaned up comments for replacements of standardard printers.
+;;
+;; * Changed custom-prin1-to-string to use a temporary buffer.
+;;
+;; * Internal symbols are prefixed with CP::.
+;;
+;; * Option custom-print-vectors (added earlier) - controls whether
+;;     vectors should be printed according to print-length and
+;;     print-length.  Emacs doesnt do this, but cust-print would
+;;     otherwise do it only if custom printing is required.
+;;
+;; * Uninterned symbols are treated as non-read-equivalent.
+;;
+
+
+;;; Commentary:
+
+;; This package provides a general print handler for prin1 and princ
+;; that supports print-level and print-circle, and by the way,
+;; print-length since the standard routines are being replaced.  Also,
+;; to print custom types constructed from lists and vectors, use
+;; custom-print-list and custom-print-vector.  See the documentation
+;; strings of these variables for more details.  
+
+;; If the results of your expressions contain circular references to
+;; other parts of the same structure, the standard Emacs print
+;; subroutines may fail to print with an untrappable error,
+;; "Apparently circular structure being printed".  If you only use cdr
+;; circular lists (where cdrs of lists point back; what is the right
+;; term here?), you can limit the length of printing with
+;; print-length.  But car circular lists and circular vectors generate
+;; the above mentioned error in Emacs version 18.  Version
+;; 19 supports print-level, but it is often useful to get a better
+;; print representation of circular and shared structures; the print-circle
+;; option may be used to print more concise representations.
+
+;; There are three main ways to use this package.  First, you may
+;; replace prin1, princ, and some subroutines that use them by calling
+;; install-custom-print so that any use of these functions in
+;; Lisp code will be affected; you can later reset with
+;; uninstall-custom-print.  Second, you may temporarily install
+;; these functions with the macro with-custom-print.  Third, you
+;; could call the custom routines directly, thus only affecting the
+;; printing that requires them.
+
+;; Note that subroutines which call print subroutines directly will
+;; not use the custom print functions.  In particular, the evaluation
+;; functions like eval-region call the print subroutines directly.
+;; Therefore, if you evaluate (aref circ-list 0), where circ-list is a
+;; circular list rather than an array, aref calls error directly which
+;; will jump to the top level instead of printing the circular list.
+
+;; Uninterned symbols are recognized when print-circle is non-nil,
+;; but they are not printed specially here.  Use the cl-packages package
+;; to print according to print-gensym.
+
+;; Obviously the right way to implement this custom-print facility is
+;; in C or with hooks into the standard printer.  Please volunteer
+;; since I don't have the time or need.  More CL-like printing
+;; capabilities could be added in the future.
+
+;; Implementation design: we want to use the same list and vector
+;; processing algorithm for all versions of prin1 and princ, since how
+;; the processing is done depends on print-length, print-level, and
+;; print-circle.  For circle printing, a preprocessing step is
+;; required before the final printing.  Thanks to Jamie Zawinski
+;; for motivation and algorithms.
+
+
+;;; Code:
+;;=========================================================
+
+;; If using cl-packages:
+
+'(defpackage "cust-print"
+   (:nicknames "CP" "custom-print")
+   (:use "el")
+   (:export
+    print-level
+    print-circle
+
+    install-custom-print
+    uninstall-custom-print
+    custom-print-installed-p
+    with-custom-print
+
+    custom-prin1
+    custom-princ
+    custom-prin1-to-string
+    custom-print
+    custom-format
+    custom-message
+    custom-error
+
+    custom-printers
+    add-custom-printer
+    ))
+
+'(in-package cust-print)
+
+(require 'backquote)
+
+;; Emacs 18 doesnt have defalias.
+;; Provide def for byte compiler.
+(defun defalias (symbol func) (fset symbol func))
+;; Better def when loaded.
+(or (fboundp 'defalias) (fset 'defalias 'fset))
+
+
+;; Variables:
+;;=========================================================
+
+;;(defvar print-length nil
+;;  "*Controls how many elements of a list, at each level, are printed.
+;;This is defined by emacs.")
+
+(defvar print-level nil
+  "*Controls how many levels deep a nested data object will print.  
+
+If nil, printing proceeds recursively and may lead to
+max-lisp-eval-depth being exceeded or an error may occur:
+`Apparently circular structure being printed.'
+Also see `print-length' and `print-circle'.
+
+If non-nil, components at levels equal to or greater than `print-level'
+are printed simply as `#'.  The object to be printed is at level 0,
+and if the object is a list or vector, its top-level components are at
+level 1.")
+
+
+(defvar print-circle nil
+  "*Controls the printing of recursive structures.  
+
+If nil, printing proceeds recursively and may lead to
+`max-lisp-eval-depth' being exceeded or an error may occur:
+\"Apparently circular structure being printed.\"  Also see
+`print-length' and `print-level'.
+
+If non-nil, shared substructures anywhere in the structure are printed
+with `#N=' before the first occurrence (in the order of the print
+representation) and `#N#' in place of each subsequent occurrence,
+where N is a positive decimal integer.
+
+There is no way to read this representation in standard Emacs,
+but if you need to do so, try the cl-read.el package.")