[Emacs-diffs] /srv/bzr/emacs/trunk r107575: Define -print-nonl client command

[Andreas Schwab]

------------------------------------------------------------
revno: 107575
committer: Andreas Schwab <address@hidden>
branch nick: emacs
timestamp: Sun 2012-03-11 18:53:07 +0100
message:
  Define -print-nonl client command
  
  * lib-src/emacsclient.c (main): Handle -print-nonl command.
  
  * lisp/server.el (server-msg-size): New constant.
  (server-reply-print): New function.
  (server-eval-and-print): Use it.
  (server-eval-at): Use server-quote-arg and server-unquote-arg.
  Handle -print-nonl.
modified:
  lib-src/ChangeLog
  lib-src/emacsclient.c
  lisp/ChangeLog
  lisp/server.el

=== modified file 'lib-src/ChangeLog'
--- a/lib-src/ChangeLog 2012-03-11 11:49:59 +0000
+++ b/lib-src/ChangeLog 2012-03-11 17:53:07 +0000
@@ -1,5 +1,7 @@
 2012-03-11  Andreas Schwab  <address@hidden>
 
+       * emacsclient.c (main): Handle -print-nonl command.
+
        * emacsclient.c (main): Handle multiple messages in a single
        datagram.
 

=== modified file 'lib-src/emacsclient.c'
--- a/lib-src/emacsclient.c     2012-03-11 11:49:59 +0000
+++ b/lib-src/emacsclient.c     2012-03-11 17:53:07 +0000
@@ -1812,6 +1812,14 @@
              printf ("%s", str);
              needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n';
            }
+         else if (strprefix ("-print-nonl ", p))
+           {
+             /* -print-nonl STRING: Print STRING on the terminal.
+                Used to continue a preceding -print command.  */
+             str = unquote_argument (p + strlen ("-print-nonl "));
+             printf ("%s", str);
+             needlf = str[0] == '\0' ? needlf : str[strlen (str) - 1] != '\n';
+           }
          else if (strprefix ("-error ", p))
            {
              /* -error DESCRIPTION: Signal an error on the terminal. */

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2012-03-11 17:31:44 +0000
+++ b/lisp/ChangeLog    2012-03-11 17:53:07 +0000
@@ -1,3 +1,11 @@
+2012-03-11  Andreas Schwab  <address@hidden>
+
+       * server.el (server-msg-size): New constant.
+       (server-reply-print): New function.
+       (server-eval-and-print): Use it.
+       (server-eval-at): Use server-quote-arg and server-unquote-arg.
+       Handle -print-nonl.
+
 2012-03-11  Christopher Schmidt  <address@hidden>
 
        * ibuffer.el (ibuffer-redisplay): Remove gratuitous error

=== modified file 'lisp/server.el'
--- a/lisp/server.el    2012-02-08 16:48:25 +0000
+++ b/lisp/server.el    2012-03-11 17:53:07 +0000
@@ -706,9 +706,29 @@
           (pp v)
           (let ((text (buffer-substring-no-properties
                        (point-min) (point-max))))
-            (server-send-string
-             proc (format "-print %s\n"
-                          (server-quote-arg text)))))))))
+            (server-reply-print (server-quote-arg text) proc)))))))
+
+(defconst server-msg-size 1024
+  "Maximum size of a message sent to a client.")
+
+(defun server-reply-print (qtext proc)
+  "Send a `-print QTEXT' command to client PROC.
+QTEXT must be already quoted.
+This handles splitting the command if it would be bigger than
+`server-msg-size'."
+  (let ((prefix "-print ")
+       part)
+    (while (> (+ (length qtext) (length prefix) 1) server-msg-size)
+      ;; We have to split the string
+      (setq part (substring qtext 0 (- server-msg-size (length prefix) 1)))
+      ;; Don't split in the middle of a quote sequence
+      (if (string-match "\\(^\\|[^&]\\)\\(&&\\)+$" part)
+         ;; There is an uneven number of & at the end
+         (setq part (substring part 0 -1)))
+      (setq qtext (substring qtext (length part)))
+      (server-send-string proc (concat prefix part "\n"))
+      (setq prefix "-print-nonl "))
+    (server-send-string proc (concat prefix qtext "\n"))))
 
 (defun server-create-tty-frame (tty type proc)
   (unless tty
@@ -911,6 +931,11 @@
   Print STRING on stdout.  Used to send values
   returned by -eval.
 
+`-print-nonl STRING'
+  Print STRING on stdout.  Used to continue a
+  preceding -print command that would be too big to send
+  in a single message.
+
 `-error DESCRIPTION'
   Signal an error and delete process PROC.
 
@@ -1560,20 +1585,22 @@
       (process-send-string
        process
        (concat "-auth " secret " -eval "
-              (replace-regexp-in-string
-               " " "&_" (format "%S" form))
+              (server-quote-arg (format "%S" form))
               "\n"))
       (while (memq (process-status process) '(open run))
        (accept-process-output process 0 10))
       (goto-char (point-min))
       ;; If the result is nil, there's nothing in the buffer.  If the
       ;; result is non-nil, it's after "-print ".
-      (when (search-forward "\n-print" nil t)
-       (let ((start (point)))
-         (while (search-forward "&_" nil t)
-           (replace-match " " t t))
-         (goto-char start)
-         (read (current-buffer)))))))
+      (let ((answer ""))
+       (while (re-search-forward "\n-print\\(-nonl\\)? " nil t)
+         (setq answer
+               (concat answer
+                       (buffer-substring (point)
+                                         (progn (skip-chars-forward "^\n")
+                                                (point))))))
+       (if (not (equal answer ""))
+           (read (server-unquote-arg answer)))))))
 
 
 (provide 'server)