aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorAndreas Schwab2012-03-11 18:54:16 +0100
committerAndreas Schwab2012-03-11 18:54:16 +0100
commitad0bf5b6db5b1d8ea654f62675b2484111594ffc (patch)
tree70850bfe243cb6484d25e074de2368ee94f98654
parente29ab36b489e14bda49a2c0e61dac3a7e13e75f1 (diff)
downloademacs-ad0bf5b6db5b1d8ea654f62675b2484111594ffc.tar.gz
emacs-ad0bf5b6db5b1d8ea654f62675b2484111594ffc.zip
* server.el (server-eval-at): Handle non-tcp connections. Decode
result string.
-rw-r--r--lisp/ChangeLog3
-rw-r--r--lisp/server.el62
2 files changed, 37 insertions, 28 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index abb3872d1ac..0e2a791f0e9 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,8 @@
12012-03-11 Andreas Schwab <schwab@linux-m68k.org> 12012-03-11 Andreas Schwab <schwab@linux-m68k.org>
2 2
3 * server.el (server-eval-at): Handle non-tcp connections. Decode
4 result string.
5
3 * server.el (server-msg-size): New constant. 6 * server.el (server-msg-size): New constant.
4 (server-reply-print): New function. 7 (server-reply-print): New function.
5 (server-eval-and-print): Use it. 8 (server-eval-and-print): Use it.
diff --git a/lisp/server.el b/lisp/server.el
index 78b81e0b05b..ed83225eccd 100644
--- a/lisp/server.el
+++ b/lisp/server.el
@@ -1559,34 +1559,39 @@ only these files will be asked to be saved."
1559Returns the result of the evaluation, or signals an error if it 1559Returns the result of the evaluation, or signals an error if it
1560cannot contact the specified server. For example: 1560cannot contact the specified server. For example:
1561 \(server-eval-at \"server\" '(emacs-pid)) 1561 \(server-eval-at \"server\" '(emacs-pid))
1562returns the process ID of the Emacs instance running \"server\". 1562returns the process ID of the Emacs instance running \"server\"."
1563This function requires the use of TCP sockets. " 1563 (let* ((server-dir (if server-use-tcp server-auth-dir server-socket-dir))
1564 (or server-use-tcp 1564 (server-file (expand-file-name server server-dir))
1565 (error "This function requires TCP sockets")) 1565 (coding-system-for-read 'binary)
1566 (let ((auth-file (expand-file-name server server-auth-dir)) 1566 (coding-system-for-write 'binary)
1567 (coding-system-for-read 'binary) 1567 address port secret process)
1568 (coding-system-for-write 'binary) 1568 (unless (file-exists-p server-file)
1569 address port secret process) 1569 (error "No such server: %s" server))
1570 (unless (file-exists-p auth-file)
1571 (error "No such server definition: %s" auth-file))
1572 (with-temp-buffer 1570 (with-temp-buffer
1573 (insert-file-contents auth-file) 1571 (when server-use-tcp
1574 (unless (looking-at "\\([0-9.]+\\):\\([0-9]+\\)") 1572 (let ((coding-system-for-read 'no-conversion))
1575 (error "Invalid auth file")) 1573 (insert-file-contents server-file)
1576 (setq address (match-string 1) 1574 (unless (looking-at "\\([0-9.]+\\):\\([0-9]+\\)")
1577 port (string-to-number (match-string 2))) 1575 (error "Invalid auth file"))
1578 (forward-line 1) 1576 (setq address (match-string 1)
1579 (setq secret (buffer-substring (point) (line-end-position))) 1577 port (string-to-number (match-string 2)))
1580 (erase-buffer) 1578 (forward-line 1)
1581 (unless (setq process (open-network-stream "eval-at" (current-buffer) 1579 (setq secret (buffer-substring (point) (line-end-position)))
1582 address port)) 1580 (erase-buffer)))
1583 (error "Unable to contact the server")) 1581 (unless (setq process (make-network-process
1584 (set-process-query-on-exit-flag process nil) 1582 :name "eval-at"
1585 (process-send-string 1583 :buffer (current-buffer)
1586 process 1584 :host address
1587 (concat "-auth " secret " -eval " 1585 :service (if server-use-tcp port server-file)
1588 (server-quote-arg (format "%S" form)) 1586 :family (if server-use-tcp 'ipv4 'local)
1589 "\n")) 1587 :noquery t))
1588 (error "Unable to contact the server"))
1589 (if server-use-tcp
1590 (process-send-string process (concat "-auth " secret "\n")))
1591 (process-send-string process
1592 (concat "-eval "
1593 (server-quote-arg (format "%S" form))
1594 "\n"))
1590 (while (memq (process-status process) '(open run)) 1595 (while (memq (process-status process) '(open run))
1591 (accept-process-output process 0 10)) 1596 (accept-process-output process 0 10))
1592 (goto-char (point-min)) 1597 (goto-char (point-min))
@@ -1600,7 +1605,8 @@ This function requires the use of TCP sockets. "
1600 (progn (skip-chars-forward "^\n") 1605 (progn (skip-chars-forward "^\n")
1601 (point)))))) 1606 (point))))))
1602 (if (not (equal answer "")) 1607 (if (not (equal answer ""))
1603 (read (server-unquote-arg answer))))))) 1608 (read (decode-coding-string (server-unquote-arg answer)
1609 'emacs-internal)))))))
1604 1610
1605 1611
1606(provide 'server) 1612(provide 'server)