Re: Insert character pairs

[Juri Linkov <juri@jurta.org>]

Richard Stallman <rms@gnu.org> writes:
>     > +      (let* (p (str (pp-to-string (save-excursion
>     > +                                    (prog1 (read (current-buffer))
> 						    ^
>     But this would also lead to all comments being removed , right?
>
> Yes, it would.  So people would only want to use this in
> special situations.

I think it should be harmless in all situations.  Luckily, it is possible
to achieve this easily with minimal modifications in `pp-to-string':

Index: emacs/lisp/emacs-lisp/pp.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/emacs-lisp/pp.el,v
retrieving revision 1.21
diff -u -r1.21 pp.el
--- emacs/lisp/emacs-lisp/pp.el	22 Mar 2004 15:32:24 -0000	1.21
+++ emacs/lisp/emacs-lisp/pp.el	6 May 2004 12:07:31 -0000
@@ -37,10 +37,13 @@
   :group 'pp)
 
 ;;;###autoload
-(defun pp-to-string (object)
+(defun pp-to-string (object &optional as-string)
   "Return a string containing the pretty-printed representation of OBJECT.
 OBJECT can be any Lisp object.  Quoting characters are used as needed
-to make output that `read' can handle, whenever this is possible."
+to make output that `read' can handle, whenever this is possible.
+Optional argument AS-STRING means that OBJECT is treated as
+a string containing the printed representation of Lisp data.
+The function modifies this string and returns it pretty-printed."
   (save-excursion
     (set-buffer (generate-new-buffer " pp-to-string"))
     (unwind-protect
@@ -49,7 +52,9 @@
 	  (set-syntax-table emacs-lisp-mode-syntax-table)
 	  (let ((print-escape-newlines pp-escape-newlines)
 		(print-quoted t))
-	    (prin1 object (current-buffer)))
+	    (if (not (and as-string (stringp object)))
+                (prin1 object (current-buffer))
+              (princ object (current-buffer))))
 	  (goto-char (point-min))
 	  (while (not (eobp))
 	    ;; (message "%06d" (- (point-max) (point)))
@@ -60,8 +65,10 @@
 	      (save-excursion
 		(backward-char 1)
 		(skip-chars-backward "'`#^")
-		(when (and (not (bobp)) (= ?\ (char-before)))
-		  (delete-char -1)
+		(when (and (not (bobp)) (memq (char-before) '(?\ ?\t ?\n)))
+		  (delete-region
+		   (point)
+		   (progn (skip-chars-backward " \t\n") (point)))
 		  (insert "\n"))))
 	     ((condition-case err-var
 		  (prog1 t (up-list 1))
@@ -70,7 +77,7 @@
 		(forward-char 1))
 	      (delete-region
 	       (point)
-	       (progn (skip-chars-forward " \t") (point)))
+	       (progn (skip-chars-forward " \t\n") (point)))
 	      (insert ?\n))
 	     (t (goto-char (point-max)))))
 	  (goto-char (point-min))
Index: emacs/lisp/emacs-lisp/lisp-mode.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/emacs-lisp/lisp-mode.el,v
retrieving revision 1.155
diff -u -r1.155 lisp-mode.el
--- emacs/lisp/emacs-lisp/lisp-mode.el	22 Mar 2004 15:31:46 -0000	1.155
+++ emacs/lisp/emacs-lisp/lisp-mode.el	6 May 2004 13:07:32 -0000
@@ -239,6 +239,7 @@
     (set-keymap-parent emacs-lisp-mode-map lisp-mode-shared-map)
     (define-key emacs-lisp-mode-map "\e\t" 'lisp-complete-symbol)
     (define-key emacs-lisp-mode-map "\e\C-x" 'eval-defun)
+    (define-key emacs-lisp-mode-map "\e\C-q" 'indent-or-pp-sexp)
     (define-key emacs-lisp-mode-map [menu-bar] (make-sparse-keymap))
     (define-key emacs-lisp-mode-map [menu-bar emacs-lisp]
       (cons "Emacs-Lisp" map))
@@ -369,6 +370,7 @@
   (let ((map (make-sparse-keymap)))
     (set-keymap-parent map lisp-mode-shared-map)
     (define-key map "\e\C-x" 'eval-defun)
+    (define-key map "\e\C-q" 'indent-or-pp-sexp)
     (define-key map "\e\t" 'lisp-complete-symbol)
     (define-key map "\n" 'eval-print-last-sexp)
     map)
@@ -1083,6 +1085,27 @@
 	   (lisp-indent-line))
       (indent-sexp endmark)
       (set-marker endmark nil))))
+
+(defun indent-or-pp-sexp (&optional arg)
+  "Indent each line of the list or, with argument, pretty-printify the list."
+  (interactive "P")
+  (if arg
+      (let* (p
+             (s (pp-to-string
+                 (buffer-substring
+                  (point)
+                  (save-excursion
+                    (forward-sexp 1)
+                    (setq p (point))))
+                 t)))
+        (delete-region (point) p)
+        (save-excursion
+          (insert s)
+          (if (eq (char-before) ?\n)
+              (delete-char -1)))
+        (indent-sexp))
+    (indent-sexp)))
 
 ;;;; Lisp paragraph filling commands.

-- 
Juri Linkov
http://www.jurta.org/emacs/