![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to server.el CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp|
Return to server.el CVS log | Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp |
1.1 root 1: ;; Lisp code for GNU Emacs running as server process.
2: ;; Copyright (C) 1986, 1987 Free Software Foundation, Inc.
3: ;; Author William Sommerfeld, [email protected].
4: ;; Changes by [email protected] and by rms.
5:
6: ;; This file is part of GNU Emacs.
7:
8: ;; GNU Emacs is distributed in the hope that it will be useful,
9: ;; but WITHOUT ANY WARRANTY. No author or distributor
10: ;; accepts responsibility to anyone for the consequences of using it
11: ;; or for whether it serves any particular purpose or works at all,
12: ;; unless he says so in writing. Refer to the GNU Emacs General Public
13: ;; License for full details.
14:
15: ;; Everyone is granted permission to copy, modify and redistribute
16: ;; GNU Emacs, but only under the conditions described in the
17: ;; GNU Emacs General Public License. A copy of this license is
18: ;; supposed to have been given to you along with GNU Emacs so you
19: ;; can know your rights and responsibilities. It should be in a
20: ;; file named COPYING. Among other things, the copyright notice
21: ;; and this notice must be preserved on all copies.
22:
23:
24: ;;; This Lisp code is run in Emacs when it is to operate as
25: ;;; a server for other processes.
26:
27: ;;; Load this library and do M-x server-edit to enable Emacs as a server.
28: ;;; Emacs runs the program ../etc/server as a subprocess
29: ;;; for communication with clients. If there are no client buffers to edit,
30: ;;; server-edit acts like (switch-to-buffer (other-buffer))
31:
32: ;;; When some other program runs "the editor" to edit a file,
33: ;;; "the editor" can be the Emacs client program ../etc/emacsclient.
34: ;;; This program transmits the file names to Emacs through
35: ;;; the server subprocess, and Emacs visits them and lets you edit them.
36:
37: ;;; Note that any number of clients may dispatch files to emacs to be edited.
38:
39: ;;; When you finish editing a Server buffer, again call server-edit
40: ;;; to mark that buffer as done for the client and switch to the next
41: ;;; Server buffer. When all the buffers for a client have been edited
42: ;;; and exited with server-edit, the client "editor" will return
43: ;;; to the program that invoked it.
44:
45: ;;; Your editing commands and Emacs's display output go to and from
46: ;;; the terminal in the usual way. Thus, server operation is possible
47: ;;; only when Emacs can talk to the terminal at the time you invoke
48: ;;; the client. This is possible in two cases:
49:
50: ;;; 1. On a window system, where Emacs runs in one window and the
51: ;;; program that wants to use "the editor" runs in another.
52:
53: ;;; 2. When the program that wants to use "the editor" is running
54: ;;; as a subprocess of Emacs.
55:
56: ;;; The buffer local variable "server-buffer-clients" lists
57: ;;; the clients who are waiting for this buffer to be edited.
58: ;;; The global variable "server-clients" lists all the waiting clients,
59: ;;; and which files are yet to be edited for each.
60:
61: (defvar server-program "server"
62: "*The program to use as the edit server")
63:
64: (defvar server-process nil
65: "the current server process")
66:
67: (defvar server-clients nil
68: "List of current server clients.
69: Each element is (CLIENTID FILES...) where CLIENTID is a string
70: that can be given to the server process to identify a client.
71: When a buffer is marked as \"done\", it is removed from this list.")
72:
73: (defvar server-buffer-clients nil
74: "List of clientids for clients requesting editing of current buffer.")
75:
76: (make-variable-buffer-local 'server-buffer-clients)
77: (setq-default server-buffer-clients nil)
78: (or (assq 'server-buffer-clients minor-mode-alist)
79: (setq minor-mode-alist (cons '(server-buffer-clients " Server") minor-mode-alist)))
80:
81: ;; If a *server* buffer exists,
82: ;; write STRING to it for logging purposes.
83: (defun server-log (string)
84: (if (get-buffer "*server*")
85: (save-excursion
86: (set-buffer "*server*")
87: (goto-char (point-max))
88: (insert string)
89: (or (bobp) (newline)))))
90:
91: (defun server-sentinel (proc msg)
92: (cond ((eq (process-status proc) 'exit)
93: (server-log (message "Server subprocess exited")))
94: ((eq (process-status proc) 'signal)
95: (server-log (message "Server subprocess killed")))))
96:
97: (defun server-start (&optional leave-dead)
98: "Allow this Emacs process to be a server for client processes.
99: This starts a server communications subprocess through which
100: client \"editors\" can send your editing commands to this Emacs job.
101: To use the server, set up the program `etc/emacsclient' in the
102: Emacs distribution as your standard \"editor\".
103:
104: Prefix arg means just kill any existing server communications subprocess."
105: (interactive "P")
106: ;; kill it dead!
107: (if server-process
108: (progn
109: (set-process-sentinel server-process nil)
110: (condition-case () (delete-process server-process) (error nil))))
111: (condition-case () (delete-file "~/.emacs_server") (error nil))
112: ;; If we already had a server, clear out associated status.
113: (while server-clients
114: (let ((buffer (nth 1 (car server-clients))))
115: (server-buffer-done buffer)))
116: (if leave-dead
117: nil
118: (if server-process
119: (server-log (message "Restarting server")))
120: (setq server-process (start-process "server" nil server-program))
121: (set-process-sentinel server-process 'server-sentinel)
122: (set-process-filter server-process 'server-process-filter)
123: (process-kill-without-query server-process)))
124:
125: ;Process a request from the server to edit some files.
126: ;Format of STRING is "Client: CLIENTID PATH PATH PATH... \n"
127: (defun server-process-filter (proc string)
128: (server-log string)
129: (if (not (eq 0 (string-match "Client: " string)))
130: nil
131: (setq string (substring string (match-end 0)))
132: (let ((client (list (substring string 0 (string-match " " string))))
133: (files nil)
134: (lineno 1))
135: (setq string (substring string (match-end 0)))
136: (while (string-match "[^ ]+ " string)
137: (let ((arg
138: (substring string (match-beginning 0) (1- (match-end 0)))))
139: (setq string (substring string (match-end 0)))
140: (if (string-match "\\`\\+[0-9]+\\'" arg)
141: (setq lineno (read (substring arg 1)))
142: (setq files
143: (cons (list arg lineno)
144: files))
145: (setq lineno 1))))
146: (server-visit-files files client)
147: ;; CLIENT is now a list (CLIENTNUM BUFFERS...)
148: (setq server-clients (cons client server-clients))
149: (switch-to-buffer (nth 1 client))
150: (message (substitute-command-keys
151: "When done with a buffer, type \\[server-edit].")))))
152:
153: (defun server-visit-files (files client)
154: "Finds FILES and returns the list CLIENT with the buffers nconc'd.
155: FILES is an alist whose elements are (FILENAME LINENUMBER)."
156: (let (client-record)
157: (while files
158: (save-excursion
159: ;; If there is an existing buffer modified or the file is modified,
160: ;; revert it.
161: ;; If there is an existing buffer with deleted file, offer to write it.
162: (let* ((filen (car (car files)))
163: (obuf (get-file-buffer filen)))
164: (if (and obuf (set-buffer obuf))
165: (if (file-exists-p filen)
166: (if (or (not (verify-visited-file-modtime obuf))
167: (buffer-modified-p obuf))
168: (revert-buffer t nil))
169: (if (y-or-n-p
170: (concat "File no longer exists: "
171: filen
172: ", write buffer to file? "))
173: (write-file filen)))
174: (set-buffer (find-file-noselect filen))))
175: (goto-line (nth 1 (car files)))
176: (setq server-buffer-clients (cons (car client) server-buffer-clients))
177: (setq client-record (cons (current-buffer) client-record)))
178: (setq files (cdr files)))
179: (nconc client client-record)))
180:
181: (defun server-buffer-done (buffer)
182: "Mark BUFFER as \"done\" for its client(s).
183: Buries the buffer, and returns another server buffer
184: as a suggestion for what to select next."
185: (let ((running (eq (process-status server-process) 'run))
186: (next-buffer nil)
187: (old-clients server-clients))
188: (while old-clients
189: (let ((client (car old-clients)))
190: (or next-buffer
191: (setq next-buffer (nth 1 (memq buffer client))))
192: (delq buffer client)
193: ;; If client now has no pending buffers,
194: ;; tell it that it is done, and forget it entirely.
195: (if (cdr client) nil
196: (if running
197: (progn
198: (send-string server-process
199: (format "Close: %s Done\n" (car client)))
200: (server-log (format "Close: %s Done\n" (car client)))))
201: (setq server-clients (delq client server-clients))))
202: (setq old-clients (cdr old-clients)))
203: (if (buffer-name buffer)
204: (save-excursion
205: (set-buffer buffer)
206: (setq server-buffer-clients nil)))
207: (bury-buffer buffer)
208: next-buffer))
209:
210: (defun mh-draft-p (buffer)
211: "Return non-nil if this BUFFER is an mh <draft> file.
212: Since MH deletes draft *BEFORE* it is edited, the server treats them specially."
213: ;; This may not be appropriately robust for all cases.
214: (string= (buffer-name buffer) "draft"))
215:
216: (defun server-done ()
217: "Offer to save current buffer, mark it as \"done\" for clients,
218: bury it, and return a suggested buffer to select next."
219: (let ((buffer (current-buffer)))
220: (if server-buffer-clients
221: (progn
222: (if (mh-draft-p buffer)
223: (progn (save-buffer)
224: (write-region (point-min) (point-max)
225: (concat buffer-file-name "~"))
226: (kill-buffer buffer))
227: (if (and (buffer-modified-p)
228: (y-or-n-p (concat "Save file" buffer-file-name "? ")))
229: (save-buffer buffer)))
230: (server-buffer-done buffer)))))
231:
232: (defun server-edit (&optional arg)
233: "Switch to next server editing buffer; say \"Done\" for current buffer.
234: If a server buffer is current, it is marked \"done\" and optionally saved.
235: MH <draft> files are always saved and backed up, no questions asked.
236: When all of a client's buffers are marked as \"done\", the client is notified.
237:
238: If invoked with a prefix argument, or if there is no server process running,
239: starts server process and that is all. Invoked by \\[server-edit]."
240: (interactive "P")
241: (if (or arg
242: (not server-process)
243: (memq (process-status server-process) '(signal exit)))
244: (server-start nil)
245: (server-switch-buffer (server-done))))
246:
247: (defun server-switch-buffer (next-buffer)
248: "Switch to another buffer, preferably one that has a client.
249: Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it."
250: (if next-buffer
251: (if (and (bufferp next-buffer)
252: (buffer-name next-buffer))
253: (switch-to-buffer next-buffer)
254: ;; If NEXT-BUFFER is a dead buffer,
255: ;; remove the server records for it
256: ;; and try the next surviving server buffer.
257: (server-switch-buffer
258: (server-buffer-done next-buffer)))
259: (if server-clients
260: (server-switch-buffer (nth 1 (car server-clients)))
261: (switch-to-buffer (other-buffer)))))
262:
263: (global-set-key "\C-x#" 'server-edit)
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.