Mercurial > hg > xemacs-beta

comparison lisp/cl-extra.el @ 5172:be6e5ea38dda

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merge
author Ben Wing <ben@xemacs.org>
date Mon, 29 Mar 2010 00:11:03 -0500
parents 41262f87eb39
children 2d0937dc83cf
comparison
equal deleted inserted replaced
5171:8cd17b2131a1 5172:be6e5ea38dda
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 " ")