help-gnu-emacs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Re: Detecting if the Emacs server is running


From: Pascal J. Bourguignon
Subject: Re: Detecting if the Emacs server is running
Date: Fri, 18 Mar 2011 10:43:49 +0100
User-agent: Gnus/5.13 (Gnus v5.13) Emacs/23.2 (gnu/linux)

PJ Weisberg <pjweisberg@gmail.com> writes:

> Is there a way, in GNU/Linux, to detect whether Emacs is running in
> server mode from a shell script?
>
> I'd like to write a script that creates a new frame with emacsclient
> if the user is already running an emacs server, but just starts up a
> regular Emacs instance if he isn't.

I have in general three emacs instances running, so I use different
socket file names.  I use the following script to detect the emacs
instances running with an active server.  

Once you get the list of emacsen with an actitve server, you may compare
it with the list of running emacs processes.


------------------------------------------------------------------------
#!/usr/bin/clisp -ansi -q -Kfull -E iso-8859-1
;;;; -*- mode:lisp;coding:utf-8 -*-
;;;;**************************************************************************
;;;;FILE:               mfod.lisp
;;;;LANGUAGE:           Common-Lisp
;;;;SYSTEM:             Common-Lisp
;;;;USER-INTERFACE:     NONE
;;;;DESCRIPTION
;;;;    
;;;;    Shows all the emacs servers available, and let the user select one
;;;;    on which to open a new frame.
;;;;    
;;;;AUTHORS
;;;;    <PJB> Pascal J. Bourguignon <pjb@informatimago.com>
;;;;MODIFICATIONS
;;;;    2010-08-30 <PJB> Translated from bash...
;;;;    2009-09-12 <PJB> Created as a bash script.
;;;;BUGS
;;;;LEGAL
;;;;    GPL
;;;;    
;;;;    Copyright Pascal J. Bourguignon 2010 - 2010
;;;;    
;;;;    This program is free software; you can redistribute it and/or
;;;;    modify it under the terms of the GNU General Public License
;;;;    as published by the Free Software Foundation; either version
;;;;    2 of the License, or (at your option) any later version.
;;;;    
;;;;    This program 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 General Public License for more details.
;;;;    
;;;;    You should have received a copy of the GNU General Public
;;;;    License along with this program; if not, write to the Free
;;;;    Software Foundation, Inc., 59 Temple Place, Suite 330,
;;;;    Boston, MA 02111-1307 USA
;;;;**************************************************************************
(in-package "COMMON-LISP-USER")

;; Clean the packages imported into COMMON-LISP-USER:
(MAPC (LAMBDA (package) (UNUSE-PACKAGE package "COMMON-LISP-USER"))
      (set-difference
       (COPY-SEQ (PACKAGE-USE-LIST "COMMON-LISP-USER"))
       (delete nil (list ;; A list of all the "CL" packages possible:
                    (FIND-PACKAGE "COMMON-LISP")
                    (FIND-PACKAGE "IMAGE-BASED-COMMON-LISP")))))


(load (make-pathname :name "SCRIPT" :type nil :version NIL :case :common
                      :defaults *load-pathname*))
(use-package "SCRIPT")

(setf *program-name* (pname))


;; (redirecting-stdout-to-stderr (load #p"/etc/gentoo-init.lisp"))
;; (redirecting-stdout-to-stderr
;;  (let ((*load-verbose* nil)
;;        (*compile-verbose* nil))
;;    (load (make-pathname :name ".clisprc" :type "lisp" :case :local
;;                         :defaults (user-homedir-pathname)))
;;    ;; (setf *features* (delete :testing-script *features*))
;;    ))
;; (redirecting-stdout-to-stderr (asdf:oos 'asdf:load-op :split-sequence)
;;                               (asdf:oos 'asdf:load-op :cl-ppcre))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(defun function-named (sname pname)
  (let ((pack (find-package pname)))
    (and pack
         (let ((sym (find-symbol sname pack)))
           (and sym
                (fboundp sym)
                sym)))))

(defun getuid ()
  (funcall (or (function-named "UID" "POSIX")
               (function-named "getuid" "LINUX")
               (function-named "GETUID" "LINUX")
               (error "Cannot get the UID."))))

(defparameter *sockets*
  (let ((uid (getuid)))
    (sort
     (mapcar (function namestring)
             (remove-if-not (function probe-file)
                            (remove-duplicates
                             ;; getting server is not so useful since directory 
will
                             ;; return the truename...
                             (append (directory (format nil 
"/tmp/emacs~A/server"   uid))
                                     (directory (format nil 
"/tmp/emacs~A/server-*" uid)))
                             :test (function equalp))))
     (function string-lessp))))


(defparameter *emacsen*
  (let ((emacsen '()))
    (dolist (socket *sockets* (reverse emacsen))
      (let ((frames
             (with-open-stream (frames (ext:run-program
                                        "emacsclient"
                                        :arguments (list (format nil 
"--socket-name=~A" socket)
                                                         "--eval"
                                                         "(mapcar (lambda (f) 
(list (frame-name f) (frame-display f))) (frame-list))")
                                        :output :stream))
               (read frames nil nil))))
        (if frames
            (push (list socket frames) emacsen)
            (multiple-value-bind (all pid) (regexp:match 
"^.*server-\\([0-9]\\+\\)$" socket)
              (if all
                  (let ((pid (regexp:match-string socket  pid)))
                    (with-open-stream (ps (ext:run-program "ps" :arguments 
(list "-p" pid) :output :stream))
                      (unless (loop
                                 :named search-emacs
                                 :for line = (read-line ps nil nil)
                                 :while line
                                 :if (regexp:match "emacs" line)
                                 :do (return-from search-emacs t)
                                 :finally  (return-from search-emacs nil))
                        (delete-file socket)
                        (setf *sockets* (delete socket *sockets*))))))))))))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(define-option ("list" "-l" "--list") ()
  "List the available emacs servers."
  (loop
     :for i :from 1
     :for (server frames) :in *emacsen*
     :do (format t "~2D) ~30A ~:{~1@*~16A ~0@*~S~:^~%~35T~}~%"
                 i server frames)))


(define-option ("select" "-s" "--select") (index)
  "Select the server at the given index (from 1 up) as the default server."
  (let* ((index (parse-integer index))
         (uid    (getuid))
         (server (ignore-errors (nth (1- index) *emacsen*))))
    (if server
        (ext:run-program "ln" :arguments (list "-sf"
                                               (first server)
                                               (format nil 
"/tmp/emacs~A/server" uid)))
        (error "~A is not a server index. Please give an index between 1 and ~A"
               index (length *emacsen*)))))



(defun xor (a b) (or (and a (not b)) (and (not a) b)))

(defun make-frame (socket-name &key on-display on-terminal)
  (assert (xor on-display on-terminal))
  (ext:run-program "emacsclient"
                   :arguments  (cond
                                 (on-display
                                  (list
                                   (format nil "--socket-name=~A" socket-name)
                                   "--no-wait"
                                   ;; "--eval" (format nil 
"(make-frame-on-display \"~A\")"
                                   ;;                  )
                                   "--create-frame"
                                   "--display" on-display))
                                 (on-terminal
                                  (list
                                   (format nil "--socket-name=~A" socket-name)
                                   "--tty")))))


(define-option ("open" "-o" "--open") (index)
  "Make a new frame from the server at the given index (from 1 up) on the 
current DISPLAY."
  (let* ((index   (parse-integer index))
         (uid     (getuid))
         (server  (ignore-errors (nth (1- index) *emacsen*)))
         (display (ext:getenv "DISPLAY")))
    (cond
      ((null server)
       (error "~A is not a server index. Please give an index between 1 and ~A"
              index (length *emacsen*)))
      ((null display)
       (error "There is no DISPLAY environment variable."))
      (t
       (make-frame (first server) :on-display display)))))


(define-option ("terminal" "-t" "--open-on-terminal") (index)
  "Make a new frame from the server at the given index (from 1 up) in the 
terminal."
  (let* ((index (parse-integer index))
         (uid    (getuid))
         (server (ignore-errors (nth (1- index) *emacsen*))))
    (cond
      ((null server)
       (error "~A is not a server index. Please give an index between 1 and ~A"
              index (length *emacsen*)))
      (t
       (make-frame (first server) :on-terminal t)))))



(ext:exit
 (if (null *emacsen*)
     (progn
       (format t "There is no emacs server~%")
       EX-UNAVAILABLE)
     (parse-options ext:*args*
                    (lambda ()
                      (call-option-function "help" '())
                      EX-NOINPUT))))

;;;; THE END ;;;;
------------------------------------------------------------------------



-- 
__Pascal Bourguignon__                     http://www.informatimago.com/
A bad day in () is better than a good day in {}.


reply via email to

[Prev in Thread] Current Thread [Next in Thread]