Re: Insert character pairs

[Juri Linkov]

Richard Stallman <address@hidden> 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/