Mercurial > hg > xemacs-beta

comparison lisp/cl-extra.el @ 5162:41262f87eb39

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Handle (function ...) specially, cl-prettyprint. 2010-03-21 Aidan Kehoe <kehoea@parhasard.net> * cl-extra.el (cl-prettyprint): Handle (function ...) specially here, as we do (quote ...).
author Aidan Kehoe <kehoea@parhasard.net>
date Sun, 21 Mar 2010 13:20:35 +0000
parents 868a9ffcc37b
children 2d0937dc83cf
comparison
equal deleted inserted replaced
5161:125f4119e64d 5162:41262f87eb39
686 686
687 ;;; Some debugging aids. 687 ;;; Some debugging aids.
688 688
689 (defun cl-prettyprint (form) 689 (defun cl-prettyprint (form)
690 "Insert a pretty-printed rendition of a Lisp FORM in current buffer." 690 "Insert a pretty-printed rendition of a Lisp FORM in current buffer."
691 (let ((pt (point)) last) 691 (let ((pt (point)) last just)
692 (insert "\n" (prin1-to-string form) "\n") 692 (insert "\n" (prin1-to-string form) "\n")
693 (setq last (point)) 693 (setq last (point))
694 (goto-char (1+ pt)) 694 (goto-char (1+ pt))
695 (while (search-forward "(quote " last t) 695 (while (re-search-forward "(\\(?:\\(?:function\\|quote\\) \\)" last t)
696 (delete-backward-char 7) 696 (delete-region (match-beginning 0) (match-end 0))
697 (insert "'") 697 (if (= (length "(function ") (- (match-end 0) (match-beginning 0)))
698 (insert "#'")
699 (insert "'"))
700 (setq just (point))
698 (forward-sexp) 701 (forward-sexp)
699 (delete-char 1)) 702 (delete-char 1)
703 (goto-char just))
700 (goto-char (1+ pt)) 704 (goto-char (1+ pt))
701 (cl-do-prettyprint))) 705 (cl-do-prettyprint)))
702 706
703 (defun cl-do-prettyprint () 707 (defun cl-do-prettyprint ()
704 (skip-chars-forward " ") 708 (skip-chars-forward " ")