;;;; -*- mode:emacs-lisp;coding:utf-8 -*-
;;;;******************************************************************************
;;;;FILE: pjb-server.el
;;;;LANGUAGE: emacs lisp
;;;;SYSTEM: emacs
;;;;USER-INTERFACE: emacs
;;;;DESCRIPTION
;;;;
;;;; This module exports functions to manage a TCP server process in emacs
;;;; (using netcat to listen).
;;;;
;;;;AUTHORS
;;;; <PJB> Pascal J. Bourguignon
;;;;MODIFICATIONS
;;;; 2002-04-10 <PJB> Created.
;;;;BUGS
;;;;LEGAL
;;;; LGPL
;;;;
;;;; Copyright Pascal J. Bourguignon 2002 - 2011
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 2 of the License, or (at your option) any later version.
;;;;
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
;;;;
;;;;******************************************************************************
(require 'pjb-cl)
(require 'pjb-queue)
(require 'pjb-utilities)
(provide 'pjb-server)
(defvar netcat-process)
(defun pjb-server$open (remote-ip remote-port read-call-back)
"
RETURN: An open pjb-server or nil.
"
(let ( (stream-process (open-network-stream "pjb-server$$network-stream"
nil remote-ip remote-port)) )
(set-process-filter stream-process read-call-back)
stream-process)
);;pjb-server$open
(defun pjb-server$listen (local-ip local-port read-call-back)
"
NOTE: READ-CALL-BACK must be a function (lambda (SERVER STRING)) that
will be called when STRING data is available from SERVER.
RETURN: A listening pjb-server or nil.
"
(let ( netcat-proc
(netcat-args '())
)
(when local-ip
(cond
((stringp local-ip) (push local-ip netcat-args))
(t (error "Invalid LOCAL-IP, must be a string.")))
(push "-s" netcat-args)
);;when
(cond
((stringp local-port) (push local-port netcat-args))
((integerp local-port) (push (number-to-string local-port) netcat-args))
(t (error "Invalid LOCAL-PORT, must be a string or an integer.")))
(push "-p" netcat-args)
(setq netcat-process (apply 'start-process "pjb-server$$netcat" nil
"netcat" "-l" netcat-args))
(set-process-filter netcat-process read-call-back)
netcat-process)
);;pjb-server$listen
(defun pjb-server$send (server data)
"
DO: Send DATA to the remote point of the SERVER.
"
(let (string)
(cond
((stringp data) (setq string data))
((numberp data) (setq string (number-to-string data)))
(t (setq string (format "%S" data))))
(process-send-string server string))
);;pjb-server$send
(defun pjb-server$close (server)
"
DO: Close the remote connection with SERVER.
"
(delete-process server)
);;pjb-server$close
(defun pjb-server$status (server)
"
RETURN: The status of the SERVER.
"
(process-status server)
);;pjb-server$status
(when nil
(defun got (server string)
(let ( (result (eval (car (read-from-string string)))) )
(pjb-server$send remote (format "%s\n" result)))
);;got
(setq remote (pjb-server$listen nil 15364 (function got)))
(pjb-server$send remote "Howdy\n")
(process-status remote)
(pjb-server$status remote)
(load "pjb-server")
(defun got (server string)
(insert string))
(setq remote (pjb-server$open "localhost" 15364 (function got)))
(pjb-server$send remote "Hello\n")
(pjb-server$close remote)
(pjb-server$send remote "(defun fesf (x y) (pjb-server$send myserv (format \"%S\n\" (* y x) )))")
(pjb-server$send remote "(setq myserv SERVER)")
(pjb-server$send remote "(fesf 2 9)")
(pjb-server$status remote)
);;when nil
(defvar pjb-server-process nil)
(defvar pjb-server-clients nil)
(defvar pjb-server-program nil)
(defun pjb-server-buffer-done (buffer &optional arg))
(defun server-log (ctrlstring &rest args))
(defun pjb-server-start (&optional leave-dead)
"Allow this Emacs process to be a server for client processes.
This starts a server communications subprocess through which
client \"editors\" can send your editing commands to this Emacs job.
To use the server, set up the program `emacsclient' in the
Emacs distribution as your standard \"editor\".
Prefix arg means just kill any existing server communications subprocess."
(interactive "P")
;; kill it dead!
(if pjb-server-process
(progn
(set-process-sentinel pjb-server-process nil)
(condition-case () (delete-process pjb-server-process) (error nil))))
;; Delete the socket files made by previous server invocations.
(let* ((sysname (system-name))
(dot-index (string-match "\\." sysname)))
(condition-case ()
(delete-file (format "~/.emacs-server-%s" sysname))
(error nil))
(condition-case ()
(delete-file (format "/tmp/esrv%d-%s" (user-uid) sysname))
(error nil))
;; In case the server file name was made with a domainless hostname,
;; try deleting that name too.
(if dot-index
(let ((shortname (substring sysname 0 dot-index)))
(condition-case ()
(delete-file (format "~/.emacs-server-%s" shortname))
(error nil))
(condition-case ()
(delete-file (format "/tmp/esrv%d-%s" (user-uid) shortname))
(error nil)))))
;; If this Emacs already had a server, clear out associated status.
(while pjb-server-clients
(let ((buffer (nth 1 (car pjb-server-clients))))
(pjb-server-buffer-done buffer)))
(if leave-dead
nil
(if pjb-server-process
(server-log "Restarting server"))
;; Using a pty is wasteful, and the separate session causes
;; annoyance sometimes (some systems kill idle sessions).
(let ((process-connection-type nil))
(setq pjb-server-process (start-process "server" nil pjb-server-program)))
(set-process-sentinel pjb-server-process 'server-sentinel)
(set-process-filter pjb-server-process 'pjb-server-process-filter)
;; We must receive file names without being decoded. Those are
;; decoded by pjb-server-process-filter accoding to
;; file-name-coding-system.
(set-process-coding-system pjb-server-process 'raw-text 'raw-text)
(compiletime-cond
((< emacs-major-version 22) (process-kill-without-query pjb-server-process))
(t (set-process-query-on-exit-flag pjb-server-process nil)))))
(defun pjb-server-stop ()
(interactive)
(dolist (process (process-list))
(when (string= "server" (process-name process))
(delete-process process))));;pjb-server-stop
;;;; pjb-server.el -- -- ;;;;