;; edebug-cl-read.el - Edebug reader macros for use with cl-read. ;; If you use cl-read.el and want to use edebug with any code ;; in a file written with CL syntax, then you need to use this ;; package. ;; To install, add the following to your .emacs file: ;; (add-hook ;; 'cl-load-hook ;; (function ;; (lambda () ;; (add-hook 'edebug-setup-hook ;; (function (lambda () (load-library "edebug-cl-read"))))))) ;; To Do: ;; Handle shared structures, but this is not normally used in executable code. ;; Read-time evaluation shouldn't be used in a form argument since ;; there is no way to instrument the result of the evaluation. ;; Need to mangle all local variable names that might be visible to ;; eval, e.g. stream, char (require 'cl) ;; dg version (require 'cl-read) (provide 'edebug-cl-read) (defconst edebug-readtable (copy-readtable) "The modified readtable in use while reading and instrumenting code.") ;; We need to call offset routines before and after processing several ;; macro chars. So the next two utilities do that given macro char args. ;; Only wrap those macro char handlers that dont need to be replaced. (defun edebug-wrap-macro-handler (char) ;; Assumes char already handled by function. (let ((func (get-macro-character char))) (set-macro-character char (byte-compile (` (lambda (stream char) (edebug-storing-offsets (1- (point)) (funcall (function (, func)) stream char))))) edebug-readtable))) ;; Not used, but it could be. '(defun edebug-wrap-dispatch-macro-handler (disp-char sub-char) ;; Assumes chars already handled by function (let ((func (get-dispatch-macro-character disp-char sub-char))) (set-dispatch-macro-character disp-char sub-char (byte-compile (` (lambda (stream char n) (edebug-storing-offsets ;; good up to 999 (- (point) 2 (if (> n 9) (if (> n 99) 2 1) 0)) (funcall (function (, func)) stream char n))))) edebug-readtable))) ;; Install the changes to the edebug-readtable now. (progn (edebug-wrap-macro-handler ?\?) (edebug-wrap-macro-handler ?\") (edebug-wrap-macro-handler ?\[) ) ;;To recopy from *readtable* ;;(set-syntax-from-character ?\' ?\' edebug-readtable *readtable*) ;;============================================================ ;; The rest are replacements for the handlers in cl-read. ;; To read symbols and numbers (constituents), save the internal ;; constituent reader function, define a new one which will be used only ;; while reading for instrumenting. (if (not (fboundp 'edebug-reader:read-constituent)) (fset 'edebug-reader:read-constituent (symbol-function 'reader:read-constituent))) (defun edebug-read-constituent (stream) ;; Store point before and after reading constituent. (edebug-storing-offsets (point) (edebug-reader:read-constituent stream))) (defvar edebug-read-context) (defvar edebug-read-stack) ;; Lists and dotted pairs ;; For \(, we must replace the handler because the behavior is ;; changed in the middle. (set-macro-character ?\( (function (lambda (stream char) (let (edebug-read-dotted-list) (edebug-storing-offsets (1- (point)) (catch 'read-list (let ((edebug-read-context 'list) edebug-read-stack) ;; read list elements up to a `.' (catch 'dotted-pair (while t (push (reader:read-from-buffer stream 't) edebug-read-stack))) ;; In dotted pair. Read one more element (push (reader:read-from-buffer stream 't) edebug-read-stack) ;; signal it to the closing paren (setq edebug-read-context 'dotted-pair) ;; If the dotted form is a list, signal to offset routines. (setq edebug-read-dotted-list (listp (car edebug-read-stack))) ;; Next char *must* be closing paren that throws read-list (reader:read-from-buffer stream 't) ;; otherwise an error is signalled (error "CL read error: illegal dotted pair read syntax"))))))) edebug-readtable) ;; ?\) and ?\. are almost identical but included for completeness. (set-macro-character ?\) (function (lambda (stream char) (cond ((eq edebug-read-context 'list) (throw 'read-list (nreverse edebug-read-stack))) ((eq edebug-read-context 'dotted-pair) (throw 'read-list (nconc (nreverse (cdr edebug-read-stack)) (car edebug-read-stack)))) (t (error "CL read error: `)' doesn't end a list"))))) edebug-readtable) (set-macro-character ?\. (function (lambda (stream char) (and (eq edebug-read-context 'dotted-pair) (error "CL read error: no more than one `.' allowed in list")) (throw 'dotted-pair nil))) edebug-readtable) ;;----------------------------- ;; Quoting and backquoting (set-macro-character ?\' (function (lambda (stream char) (edebug-storing-offsets (1- (point)) (list (edebug-storing-offsets (point) 'quote) (reader:read-from-buffer stream 't))))) edebug-readtable) (set-macro-character ?\` (function (lambda (stream char) (if (= (following-char) ?\ ) (edebug-storing-offsets (point) '\`) (edebug-storing-offsets (1- (point)) (list (edebug-storing-offsets (point) '\`) (reader:read-from-buffer stream 't)))))) edebug-readtable) (set-macro-character ?\, (function (lambda (stream char) (cond ((eq (following-char) ?\ ) ;; old syntax (edebug-storing-offsets (point) '\,)) ((eq (following-char) ?\@) (forward-char 1) (cond ((eq (following-char) ?\ ) (edebug-storing-offsets (point) '\,\@)) (t (edebug-storing-offsets (- (point) 2) (list (edebug-storing-offsets (point) '\,\@) (reader:read-from-buffer stream 't)))))) (t (edebug-storing-offsets (1- (point)) (list (edebug-storing-offsets (point) '\,) (reader:read-from-buffer stream 't))))))) edebug-readtable) (defun edebug-ensure-n=0 (n) (or (= n 0) (error "Cl reader error: numeric infix argument not allowed %d" n))) (set-dispatch-macro-character ?\# ?\' (function (lambda (stream char n) (edebug-ensure-n=0 n) (edebug-storing-offsets (- (point) 2) (list (edebug-storing-offsets (point) (if (featurep 'cl) 'function* 'function)) (reader:read-from-buffer stream 't))))) edebug-readtable) ;; Read time evaluation: #.