;;; server.el --- Lisp code for GNU Emacs running as server process.
+;; Copyright (C) 1986, 1987, 1992, 1994 Free Software Foundation, Inc.
+
;; Author: William Sommerfeld <wesommer@athena.mit.edu>
-;; Last-Modified: 05 Dec 1991
;; Keywords: processes
;; Changes by peck@sun.com and by rms.
-;; Copyright (C) 1986, 1987 Free Software Foundation, Inc.
-
;; This file is part of GNU Emacs.
;; GNU Emacs is free software; you can redistribute it and/or modify
;;; Code:
\f
-(defvar server-program "emacsserver"
- "*The program to use as the edit server")
+(defvar server-program (expand-file-name "emacsserver" exec-directory)
+ "*The program to use as the edit server.")
(defvar server-visit-hook nil
+ "*List of hooks to call when visiting a file for the Emacs server.")
+
+(defvar server-switch-hook nil
"*List of hooks to call when switching to a buffer for the Emacs server.")
+(defvar server-done-hook nil
+ "*List of hooks to call when done editing a buffer for the Emacs server.")
+
(defvar server-process nil
"the current server process")
(defvar server-clients nil
"List of current server clients.
-Each element is (CLIENTID FILES...) where CLIENTID is a string
+Each element is (CLIENTID BUFFERS...) where CLIENTID is a string
that can be given to the server process to identify a client.
When a buffer is marked as \"done\", it is removed from this list.")
(defvar server-buffer-clients nil
"List of clientids for clients requesting editing of current buffer.")
+(make-variable-buffer-local 'server-buffer-clients)
;; Changing major modes should not erase this local.
(put 'server-buffer-clients 'permanent-local t)
+(defvar server-window nil
+ "*The window to use for selecting Emacs server buffers.
+If nil, use the selected window.
+If it is a frame, use the frame's selected window.")
+
(defvar server-temp-file-regexp "^/tmp/Re\\|/draft$"
"*Regexp which should match filenames of temporary files
which are deleted and reused after each edit
by the programs that invoke the emacs server.")
-(make-variable-buffer-local 'server-buffer-clients)
-(put 'server-buffer-clients 'permanent-local t)
-(setq-default server-buffer-clients nil)
(or (assq 'server-buffer-clients minor-mode-alist)
(setq minor-mode-alist (cons '(server-buffer-clients " Server") minor-mode-alist)))
"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 `etc/emacsclient' in the
+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."
(set-process-sentinel server-process nil)
(condition-case () (delete-process server-process) (error nil))))
(condition-case () (delete-file "~/.emacs_server") (error nil))
+ (condition-case ()
+ (delete-file (format "/tmp/esrv%d-%s" (user-uid) (system-name)))
+ (error nil))
;; If we already had a server, clear out associated status.
(while server-clients
(let ((buffer (nth 1 (car server-clients))))
nil
(if server-process
(server-log (message "Restarting server")))
- (setq server-process (start-process "server" nil server-program))
+ ;; Using a pty is wasteful, and the separate session causes
+ ;; annoyance sometimes (some systems kill idle sessions).
+ (let ((process-connection-type nil))
+ (setq server-process (start-process "server" nil server-program)))
(set-process-sentinel server-process 'server-sentinel)
(set-process-filter server-process 'server-process-filter)
(process-kill-without-query server-process)))
(server-visit-files files client)
;; CLIENT is now a list (CLIENTNUM BUFFERS...)
(setq server-clients (cons client server-clients))
- (switch-to-buffer (nth 1 client))
+ (server-switch-buffer (nth 1 client))
+ (run-hooks 'server-switch-hook)
(message (substitute-command-keys
"When done with a buffer, type \\[server-edit].")))))
(defun server-visit-files (files client)
"Finds FILES and returns the list CLIENT with the buffers nconc'd.
FILES is an alist whose elements are (FILENAME LINENUMBER)."
- (let (client-record)
- (while files
- (save-excursion
- ;; If there is an existing buffer modified or the file is modified,
- ;; revert it.
- ;; If there is an existing buffer with deleted file, offer to write it.
- (let* ((filen (car (car files)))
- (obuf (get-file-buffer filen)))
- (if (and obuf (set-buffer obuf))
- (if (file-exists-p filen)
- (if (or (not (verify-visited-file-modtime obuf))
- (buffer-modified-p obuf))
- (revert-buffer t nil))
- (if (y-or-n-p
- (concat "File no longer exists: "
- filen
- ", write buffer to file? "))
- (write-file filen)))
- (set-buffer (find-file-noselect filen))
- (run-hooks 'server-visit-hook)))
- (goto-line (nth 1 (car files)))
- (setq server-buffer-clients (cons (car client) server-buffer-clients))
- (setq client-record (cons (current-buffer) client-record)))
- (setq files (cdr files)))
+ ;; Bind last-nonmenu-event to force use of keyboard, not mouse, for queries.
+ (let (client-record (last-nonmenu-event t) (obuf (current-buffer)))
+ ;; Restore the current buffer afterward, but not using save-excursion,
+ ;; because we don't want to save point in this buffer
+ ;; if it happens to be one of those specified by the server.
+ (unwind-protect
+ (while files
+ ;; If there is an existing buffer modified or the file is modified,
+ ;; revert it.
+ ;; If there is an existing buffer with deleted file, offer to write it.
+ (let* ((filen (car (car files)))
+ (obuf (get-file-buffer filen)))
+ (if (and obuf (set-buffer obuf))
+ (if (file-exists-p filen)
+ (if (or (not (verify-visited-file-modtime obuf))
+ (buffer-modified-p obuf))
+ (revert-buffer t nil))
+ (if (y-or-n-p
+ (concat "File no longer exists: "
+ filen
+ ", write buffer to file? "))
+ (write-file filen)))
+ (set-buffer (find-file-noselect filen))
+ (run-hooks 'server-visit-hook)))
+ (goto-line (nth 1 (car files)))
+ (setq server-buffer-clients (cons (car client) server-buffer-clients))
+ (setq client-record (cons (current-buffer) client-record))
+ (setq files (cdr files)))
+ (set-buffer obuf))
(nconc client client-record)))
\f
(defun server-buffer-done (buffer)
(setq server-clients (delq client server-clients))))
(setq old-clients (cdr old-clients)))
(if (buffer-name buffer)
- (save-excursion
- (set-buffer buffer)
- (setq server-buffer-clients nil)))
- (bury-buffer buffer)
+ (progn
+ (save-excursion
+ (set-buffer buffer)
+ (setq server-buffer-clients nil)
+ (run-hooks 'server-done-hook))
+ (if (server-temp-file-p buffer)
+ (kill-buffer buffer)
+ (bury-buffer buffer))))
next-buffer))
(defun server-temp-file-p (buffer)
(string-match server-temp-file-regexp (buffer-file-name buffer))))
(defun server-done ()
- "Offer to save current buffer, mark it as \"done\" for clients,
-bury it, and return a suggested buffer to select next."
+ "Offer to save current buffer, mark it as \"done\" for clients.
+Then bury it, and return a suggested buffer to select next."
(let ((buffer (current-buffer)))
(if server-buffer-clients
(progn
(if (server-temp-file-p buffer)
- (progn (save-buffer)
- (write-region (point-min) (point-max)
- (concat buffer-file-name "~"))
- (kill-buffer buffer))
+ ;; For a temp file, save, and do make a non-numeric backup
+ ;; (unless make-backup-files is nil).
+ (let ((version-control nil)
+ (buffer-backed-up nil))
+ (save-buffer))
(if (and (buffer-modified-p)
(y-or-n-p (concat "Save file " buffer-file-name "? ")))
(save-buffer buffer)))
(server-buffer-done buffer)))))
+
+;; If a server buffer is killed, release its client.
+;; I'm not sure this is really a good idea--do you want the client
+;; to proceed using whatever is on disk in that file?
+(defun server-kill-buffer-query-function ()
+ (or (not server-buffer-clients)
+ (yes-or-no-p (format "Buffer `%s' still has clients; kill it? "
+ (buffer-name (current-buffer))))))
+
+(add-hook 'kill-buffer-query-functions
+ 'server-kill-buffer-query-function)
+
+(defun server-kill-emacs-query-function ()
+ (let (live-client
+ (tail server-clients))
+ ;; See if any clients have any buffers that are still alive.
+ (while tail
+ (if (memq t (mapcar 'stringp (mapcar 'buffer-name (cdr (car tail)))))
+ (setq live-client t))
+ (setq tail (cdr tail)))
+ (or (not live-client)
+ (yes-or-no-p "Server buffers still have clients; exit anyway? "))))
+
+(add-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function)
\f
(defun server-edit (&optional arg)
"Switch to next server editing buffer; say \"Done\" for current buffer.
When all of a client's buffers are marked as \"done\", the client is notified.
Temporary files such as MH <draft> files are always saved and backed up,
-no questions asked. The variable `server-temp-file-regexp' controls
+no questions asked. (The variable `make-backup-files', if nil, still
+inhibits a backup; you can set it locally in a particular buffer to
+prevent a backup for it.) The variable `server-temp-file-regexp' controls
which filenames are considered temporary.
If invoked with a prefix argument, or if there is no server process running,
(defun server-switch-buffer (next-buffer)
"Switch to another buffer, preferably one that has a client.
Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it."
+ (cond ((windowp server-window)
+ (select-window server-window))
+ ((framep server-window)
+ (select-window (frame-selected-window server-window))))
+ (if (window-minibuffer-p (selected-window))
+ (select-window (next-window nil 'nomini t)))
(if next-buffer
(if (and (bufferp next-buffer)
(buffer-name next-buffer))
(switch-to-buffer (other-buffer)))))
(global-set-key "\C-x#" 'server-edit)
+\f
+(provide 'server)
;;; server.el ends here
HCoop / bpt / emacs.git / blobdiff