/[emacs]/emacs/lisp/server.el
ViewVC logotype

Diff of /emacs/lisp/server.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.78 by fx, Tue Dec 18 16:42:38 2001 UTC revision 1.78.4.1 by miles, Fri Apr 4 06:20:10 2003 UTC
# Line 1  Line 1 
1  ;;; server.el --- Lisp code for GNU Emacs running as server process  ;;; server.el --- Lisp code for GNU Emacs running as server process
2    
3  ;; Copyright (C) 1986, 87, 92, 94, 95, 96, 97, 98, 99, 2000, 2001  ;; Copyright (C) 1986, 87, 92, 94, 95, 96, 97, 98, 99, 2000, 2001, 2002
4  ;;       Free Software Foundation, Inc.  ;;       Free Software Foundation, Inc.
5    
6  ;; Author: William Sommerfeld <wesommer@athena.mit.edu>  ;; Author: William Sommerfeld <wesommer@athena.mit.edu>
# Line 32  Line 32 
32  ;; a server for other processes.  ;; a server for other processes.
33    
34  ;; Load this library and do M-x server-edit to enable Emacs as a server.  ;; Load this library and do M-x server-edit to enable Emacs as a server.
35  ;; Emacs runs the program ../arch-lib/emacsserver as a subprocess  ;; Emacs opens up a socket for communication with clients.  If there are no
36  ;; for communication with clients.  If there are no client buffers to edit,  ;; client buffers to edit, server-edit acts like (switch-to-buffer
37  ;; server-edit acts like (switch-to-buffer (other-buffer))  ;; (other-buffer))
38    
39  ;; When some other program runs "the editor" to edit a file,  ;; When some other program runs "the editor" to edit a file,
40  ;; "the editor" can be the Emacs client program ../lib-src/emacsclient.  ;; "the editor" can be the Emacs client program ../lib-src/emacsclient.
# Line 44  Line 44 
44  ;; Note that any number of clients may dispatch files to emacs to be edited.  ;; Note that any number of clients may dispatch files to emacs to be edited.
45    
46  ;; When you finish editing a Server buffer, again call server-edit  ;; When you finish editing a Server buffer, again call server-edit
47  ;; to mark that buffer as done for the client and switch to the next  ;; to mark that buffer as done for the client and switch to the next
48  ;; Server buffer.  When all the buffers for a client have been edited  ;; Server buffer.  When all the buffers for a client have been edited
49  ;; and exited with server-edit, the client "editor" will return  ;; and exited with server-edit, the client "editor" will return
50  ;; to the program that invoked it.    ;; to the program that invoked it.
51    
52  ;; Your editing commands and Emacs's display output go to and from  ;; Your editing commands and Emacs's display output go to and from
53  ;; the terminal in the usual way.  Thus, server operation is possible  ;; the terminal in the usual way.  Thus, server operation is possible
# Line 69  Line 69 
69  ;; brought into the foreground for editing.  When done editing, Emacs is  ;; brought into the foreground for editing.  When done editing, Emacs is
70  ;; suspended again, and the client program is brought into the foreground.  ;; suspended again, and the client program is brought into the foreground.
71    
72  ;; The buffer local variable "server-buffer-clients" lists  ;; The buffer local variable "server-buffer-clients" lists
73  ;; the clients who are waiting for this buffer to be edited.    ;; the clients who are waiting for this buffer to be edited.
74  ;; The global variable "server-clients" lists all the waiting clients,  ;; The global variable "server-clients" lists all the waiting clients,
75  ;; and which files are yet to be edited for each.  ;; and which files are yet to be edited for each.
76    
77  ;;; Code:  ;;; Code:
78    
79    (eval-when-compile (require 'cl))
80    
81  (defgroup server nil  (defgroup server nil
82    "Emacs running as a server process."    "Emacs running as a server process."
83    :group 'external)    :group 'external)
84    
 (defcustom server-program (expand-file-name "emacsserver" exec-directory)  
   "*The program to use as the edit server."  
   :group 'server  
   :type 'string)  
   
85  (defcustom server-visit-hook nil  (defcustom server-visit-hook nil
86    "*List of hooks to call when visiting a file for the Emacs server."    "*Hook run when visiting a file for the Emacs server."
87    :group 'server    :group 'server
88    :type '(repeat function))    :type 'hook)
89    
90  (defcustom server-switch-hook nil  (defcustom server-switch-hook nil
91    "*List of hooks to call when switching to a buffer for the Emacs server."    "*Hook run when switching to a buffer for the Emacs server."
92    :group 'server    :group 'server
93    :type '(repeat function))    :type 'hook)
94    
95  (defcustom server-done-hook nil  (defcustom server-done-hook nil
96    "*List of hooks to call when done editing a buffer for the Emacs server."    "*Hook run when done editing a buffer for the Emacs server."
97    :group 'server    :group 'server
98    :type '(repeat function))    :type 'hook)
   
 (defvar server-process nil  
   "The current server process")  
99    
100  (defvar server-previous-string "")  (defvar server-process nil
101      "The current server process.")
102    
103  (defvar server-clients nil  (defvar server-clients nil
104    "List of current server clients.    "List of current server clients.
# Line 117  When a buffer is marked as \"done\", it Line 112  When a buffer is marked as \"done\", it
112  ;; Changing major modes should not erase this local.  ;; Changing major modes should not erase this local.
113  (put 'server-buffer-clients 'permanent-local t)  (put 'server-buffer-clients 'permanent-local t)
114    
115  (defvar server-window nil  (defcustom server-window nil
116    "*The window to use for selecting Emacs server buffers.    "*Specification of the window to use for selecting Emacs server buffers.
117  If nil, use the selected window.  If nil, use the selected window.
118  If it is a frame, use the frame's selected window.")  If it is a function, it should take one argument (a buffer) and
119    display and select it.  A common value is `pop-to-buffer'.
120    If it is a window, use that.
121    If it is a frame, use the frame's selected window.
122    
123    It is not meaningful to set this to a specific frame or window with Custom.
124    Only programs can do so."
125      :group 'server
126      :version "21.4"
127      :type '(choice (const :tag "Use selected window"
128                            :match (lambda (widget value)
129                                     (not (functionp value)))
130                            nil)
131                     (function-item :tag "Use pop-to-buffer" pop-to-buffer)
132                     (function :tag "Other function")))
133    
134  (defcustom server-temp-file-regexp "^/tmp/Re\\|/draft$"  (defcustom server-temp-file-regexp "^/tmp/Re\\|/draft$"
135    "*Regexp which should match filenames of temporary files    "*Regexp matching names of temporary files.
136  which are deleted and reused after each edit  These are deleted and reused after each edit by the programs that
137  by the programs that invoke the Emacs server."  invoke the Emacs server."
138    :group 'server    :group 'server
139    :type 'regexp)    :type 'regexp)
140    
141  (defcustom server-kill-new-buffers t  (defcustom server-kill-new-buffers t
142    "*Whether to kill buffers when done with them.    "*Whether to kill buffers when done with them.
143  If non-nil, kill a buffer unless it already existed before editing  If non-nil, kill a buffer unless it already existed before editing
144  it with Emacs server. If nil, kill only buffers as specified by  it with Emacs server.  If nil, kill only buffers as specified by
145  `server-temp-file-regexp'.  `server-temp-file-regexp'.
146  Please note that only buffers are killed that still have a client,  Please note that only buffers are killed that still have a client,
147  i.e. buffers visited which \"emacsclient --no-wait\" are never killed in  i.e. buffers visited which \"emacsclient --no-wait\" are never killed in
# Line 145  this way." Line 154  this way."
154      (setq minor-mode-alist (cons '(server-buffer-clients " Server") minor-mode-alist)))      (setq minor-mode-alist (cons '(server-buffer-clients " Server") minor-mode-alist)))
155    
156  (defvar server-existing-buffer nil  (defvar server-existing-buffer nil
157    "Non-nil means a buffer existed before the Emacs server was asked visit it.    "Non-nil means the buffer existed before the server was asked to visit it.
158  This means that the server should not kill the buffer when you say you  This means that the server should not kill the buffer when you say you
159  are done with it in the server.  This variable is local in each buffer  are done with it in the server.")
 where it is set.")  
160  (make-variable-buffer-local 'server-existing-buffer)  (make-variable-buffer-local 'server-existing-buffer)
161    
162  ;; If a *server* buffer exists,  ;; Fixme: This doesn't look secure.  If it really is, it deserves a
163  ;; write STRING to it for logging purposes.  ;; comment, but I'd expect it to be created in a protected subdir as
164  (defun server-log (string)  ;; normal.  -- fx
165    (defvar server-socket-name
166      (format "/tmp/esrv%d-%s" (user-uid)
167              (substring (system-name) 0 (string-match "\\." (system-name)))))
168    
169    (defun server-log (string &optional client)
170      "If a *server* buffer exists, write STRING to it for logging purposes."
171    (if (get-buffer "*server*")    (if (get-buffer "*server*")
172        (save-excursion        (with-current-buffer "*server*"
         (set-buffer "*server*")  
173          (goto-char (point-max))          (goto-char (point-max))
174          (insert (current-time-string) " " string)          (insert (current-time-string)
175                    (if client (format " %s:" client) " ")
176                    string)
177          (or (bolp) (newline)))))          (or (bolp) (newline)))))
178    
179  (defun server-sentinel (proc msg)  (defun server-sentinel (proc msg)
180    (cond ((eq (process-status proc) 'exit)    (let ((client (assq proc server-clients)))
181           (server-log (message "Server subprocess exited")))      ;; Remove PROC from the list of clients.
182          ((eq (process-status proc) 'signal)      (when client
183           (server-log (message "Server subprocess killed")))))        (setq server-clients (delq client server-clients))
184          (dolist (buf (cdr client))
185            (with-current-buffer buf
186              ;; Remove PROC from the clients of each buffer.
187              (setq server-buffer-clients (delq proc server-buffer-clients))
188              ;; Kill the buffer if necessary.
189              (when (and (null server-buffer-clients)
190                         (or (and server-kill-new-buffers
191                                  (not server-existing-buffer))
192                             (server-temp-file-p)))
193                (kill-buffer (current-buffer)))))))
194      (server-log (format "Status changed to %s" (process-status proc)) proc))
195    
196    (defun server-select-display (display)
197      ;; If the current frame is on `display' we're all set.
198      (unless (equal (frame-parameter (selected-frame) 'display) display)
199        ;; Otherwise, look for an existing frame there and select it.
200        (dolist (frame (frame-list))
201          (when (equal (frame-parameter frame 'display) display)
202            (select-frame frame)))
203        ;; If there's no frame on that display yet, create a dummy one
204        ;; and select it.
205        (unless (equal (frame-parameter (selected-frame) 'display) display)
206          (select-frame
207           (make-frame-on-display
208            display
209            ;; This frame is only there in place of an actual "current display"
210            ;; setting, so we want it to be as unobtrusive as possible.  That's
211            ;; what the invisibility is for.  The minibuffer setting is so that
212            ;; we don't end up displaying a buffer in it (which noone would
213            ;; notice).
214            '((visibility . nil) (minibuffer . only)))))))
215    
216    (defun server-unquote-arg (arg)
217      (replace-regexp-in-string
218       "&." (lambda (s)
219              (case (aref s 1)
220                (?& "&")
221                (?- "-")
222                (?n "\n")
223                (t " ")))
224       arg t t))
225    
226  ;;;###autoload  ;;;###autoload
227  (defun server-start (&optional leave-dead)  (defun server-start (&optional leave-dead)
# Line 178  Emacs distribution as your standard \"ed Line 234  Emacs distribution as your standard \"ed
234  Prefix arg means just kill any existing server communications subprocess."  Prefix arg means just kill any existing server communications subprocess."
235    (interactive "P")    (interactive "P")
236    ;; kill it dead!    ;; kill it dead!
237    (if server-process    (condition-case () (delete-process server-process) (error nil))
       (progn  
         (set-process-sentinel server-process nil)  
         (condition-case () (delete-process server-process) (error nil))))  
238    ;; Delete the socket files made by previous server invocations.    ;; Delete the socket files made by previous server invocations.
239    (let* ((sysname (system-name))    (condition-case () (delete-file server-socket-name) (error nil))
          (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)))))  
240    ;; If this Emacs already had a server, clear out associated status.    ;; If this Emacs already had a server, clear out associated status.
241    (while server-clients    (while server-clients
242      (let ((buffer (nth 1 (car server-clients))))      (let ((buffer (nth 1 (car server-clients))))
243        (server-buffer-done buffer)))        (server-buffer-done buffer)))
244    (if leave-dead    (unless leave-dead
       nil  
245      (if server-process      (if server-process
246          (server-log (message "Restarting server")))          (server-log (message "Restarting server")))
247      ;; Using a pty is wasteful, and the separate session causes      (let ((umask (default-file-modes)))
248      ;; annoyance sometimes (some systems kill idle sessions).        (unwind-protect
249      (let ((process-connection-type nil))            (progn
250        (setq server-process (start-process "server" nil server-program)))              (set-default-file-modes ?\700)
251      (set-process-sentinel server-process 'server-sentinel)              (setq server-process
252      (set-process-filter server-process 'server-process-filter)                    (make-network-process
253      ;; We must receive file names without being decoded.  Those are                     :name "server" :family 'local :server t :noquery t
254      ;; decoded by server-process-filter accoding to                     :service server-socket-name
255      ;; file-name-coding-system.                     :sentinel 'server-sentinel :filter 'server-process-filter
256      (set-process-coding-system server-process 'raw-text 'raw-text)                     ;; We must receive file names without being decoded.
257      (process-kill-without-query server-process)))                     ;; Those are decoded by server-process-filter according
258                       ;; to file-name-coding-system.
259                       :coding 'raw-text)))
260            (set-default-file-modes umask)))))
261    
262    ;;;###autoload
263    (define-minor-mode server-mode
264      "Toggle Server mode.
265    With ARG, turn Server mode on if ARG is positive, off otherwise.
266    Server mode runs a process that accepts commands from the
267    `emacsclient' program.  See `server-start' and Info node `Emacs server'."
268      :global t
269      :group 'server
270      :version "21.4"
271      ;; Fixme: Should this check for an existing server socket and do
272      ;; nothing if there is one (for multiple Emacs sessions)?
273      (server-start (not server-mode)))
274    (custom-add-version 'server-mode "21.4")
275    
 ;Process a request from the server to edit some files.  
 ;Format of STRING is "Client: CLIENTID PATH PATH PATH... \n"  
276  (defun server-process-filter (proc string)  (defun server-process-filter (proc string)
277    (server-log string)    "Process a request from the server to edit some files.
278    (setq string (concat server-previous-string string))  PROC is the server process.  Format of STRING is \"PATH PATH PATH... \\n\"."
279      (server-log string proc)
280      (let ((prev (process-get proc 'previous-string)))
281        (when prev
282          (setq string (concat prev string))
283          (process-put proc 'previous-string nil)))
284    ;; If the input is multiple lines,    ;; If the input is multiple lines,
285    ;; process each line individually.    ;; process each line individually.
286    (while (string-match "\n" string)    (while (string-match "\n" string)
# Line 233  Prefix arg means just kill any existing Line 288  Prefix arg means just kill any existing
288            (coding-system (and default-enable-multibyte-characters            (coding-system (and default-enable-multibyte-characters
289                                (or file-name-coding-system                                (or file-name-coding-system
290                                    default-file-name-coding-system)))                                    default-file-name-coding-system)))
291            client nowait            client nowait eval
292            (files nil)            (files nil)
293            (lineno 1)            (lineno 1)
294            (columnno 0))            (columnno 0))
295        ;; Remove this line from STRING.        ;; Remove this line from STRING.
296        (setq string (substring string (match-end 0)))              (setq string (substring string (match-end 0)))
297        (if (string-match "^Error: " request)        (setq client (cons proc nil))
298            (message "Server error: %s" (substring request (match-end 0)))        (while (string-match "[^ ]* " request)
299          (if (string-match "^Client: " request)          (let ((arg (substring request (match-beginning 0) (1- (match-end 0))))
300              (progn                (pos 0))
301              (setq request (substring request (match-end 0)))
302              (cond
303               ((equal "-nowait" arg) (setq nowait t))
304    ;;; This is not safe unless we make sure other users can't send commands.
305    ;;;        ((equal "-eval" arg) (setq eval t))
306               ((and (equal "-display" arg) (string-match "\\([^ ]*\\) " request))
307                (let ((display (server-unquote-arg (match-string 1 request))))
308                (setq request (substring request (match-end 0)))                (setq request (substring request (match-end 0)))
309                (setq client (list (substring request 0 (string-match " " request))))                (condition-case err
310                (setq request (substring request (match-end 0)))                    (server-select-display display)
311                (while (string-match "[^ ]+ " request)                  (error (process-send-string proc (nth 1 err))
312                  (let ((arg                         (setq request "")))))
313                         (substring request (match-beginning 0) (1- (match-end 0))))             ;; ARG is a line number option.
314                        (pos 0))             ((string-match "\\`\\+[0-9]+\\'" arg)
315                    (setq request (substring request (match-end 0)))              (setq lineno (string-to-int (substring arg 1))))
316                    (if (string-match "\\`-nowait" arg)             ;; ARG is line number:column option.
317                        (setq nowait t)             ((string-match "\\`+\\([0-9]+\\):\\([0-9]+\\)\\'" arg)
318                      (cond              (setq lineno (string-to-int (match-string 1 arg))
319                          ;; ARG is a line number option.                    columnno (string-to-int (match-string 2 arg))))
320                       ((string-match "\\`\\+[0-9]+\\'" arg)             (t
321                        (setq lineno (string-to-int (substring arg 1))))              ;; Undo the quoting that emacsclient does
322                       ;; ARG is line number:column option.              ;; for certain special characters.
323                       ((string-match "\\`+\\([0-9]+\\):\\([0-9]+\\)\\'" arg)              (setq arg (server-unquote-arg arg))
324                        (setq lineno (string-to-int (match-string 1 arg))              ;; Now decode the file name if necessary.
325                              columnno (string-to-int (match-string 2 arg))))              (if coding-system
326                       (t                  (setq arg (decode-coding-string arg coding-system)))
327                        ;; ARG is a file name.              (if eval
328                        ;; Collapse multiple slashes to single slashes.                  (let ((v (eval (car (read-from-string arg)))))
329                        (setq arg (command-line-normalize-file-name arg))                    (when v
330                        ;; Undo the quoting that emacsclient does                      (with-temp-buffer
331                        ;; for certain special characters.                        (let ((standard-output (current-buffer)))
332                        (while (string-match "&." arg pos)                          (pp v)
333                          (setq pos (1+ (match-beginning 0)))                          (process-send-region proc (point-min) (point-max))))))
334                          (let ((nextchar (aref arg pos)))                ;; ARG is a file name.
335                            (cond ((= nextchar ?&)                ;; Collapse multiple slashes to single slashes.
336                                   (setq arg (replace-match "&" t t arg)))                (setq arg (command-line-normalize-file-name arg))
337                                  ((= nextchar ?-)                (push (list arg lineno columnno) files))
338                                   (setq arg (replace-match "-" t t arg)))              (setq lineno 1)
339                                  (t              (setq columnno 0)))))
340                                   (setq arg (replace-match " " t t arg))))))        (when files
341                        ;; Now decode the file name if necessary.          (run-hooks 'pre-command-hook)
342                        (if coding-system          (server-visit-files files client nowait)
343                            (setq arg (decode-coding-string arg coding-system)))          (run-hooks 'post-command-hook))
344                        (setq files        ;; CLIENT is now a list (CLIENTNUM BUFFERS...)
345                              (cons (list arg lineno columnno)        (if (null (cdr client))
346                                    files))            ;; This client is empty; get rid of it immediately.
347                        (setq lineno 1)            (progn
348                        (setq columnno 0))))))              (delete-process proc)
349                (run-hooks 'pre-command-hook)              (server-log "Close empty client" proc))
350                (server-visit-files files client nowait)          ;; We visited some buffer for this client.
351                (run-hooks 'post-command-hook)          (or nowait (push client server-clients))
352                ;; CLIENT is now a list (CLIENTNUM BUFFERS...)          (unless (or isearch-mode (minibufferp))
353                (if (null (cdr client))            (server-switch-buffer (nth 1 client))
354                    ;; This client is empty; get rid of it immediately.            (run-hooks 'server-switch-hook)
355                    (progn            (unless nowait
356                      (send-string server-process              (message (substitute-command-keys
357                                   (format "Close: %s Done\n" (car client)))                        "When done with a buffer, type \\[server-edit]")))))))
                     (server-log (format "Close empty client: %s Done\n" (car client))))  
                 ;; We visited some buffer for this client.  
                 (or nowait  
                     (setq server-clients (cons client server-clients)))  
                 (server-switch-buffer (nth 1 client))  
                 (run-hooks 'server-switch-hook)  
                 (message (substitute-command-keys  
                           "When done with a buffer, type \\[server-edit]"))))))))  
358    ;; Save for later any partial line that remains.    ;; Save for later any partial line that remains.
359    (setq server-previous-string string))    (when (> (length string) 0)
360        (process-put proc 'previous-string string)))
361    
362    (defun server-goto-line-column (file-line-col)
363      (goto-line (nth 1 file-line-col))
364      (let ((column-number (nth 2 file-line-col)))
365        (if (> column-number 0)
366            (move-to-column (1- column-number)))))
367    
368  (defun server-visit-files (files client &optional nowait)  (defun server-visit-files (files client &optional nowait)
369    "Finds FILES and returns the list CLIENT with the buffers nconc'd.    "Find FILES and return the list CLIENT with the buffers nconc'd.
370  FILES is an alist whose elements are (FILENAME LINENUMBER COLUMNNUMBER).  FILES is an alist whose elements are (FILENAME LINENUMBER COLUMNNUMBER).
371  NOWAIT non-nil means this client is not waiting for the results,  NOWAIT non-nil means this client is not waiting for the results,
372  so don't mark these buffers specially, just visit them normally."  so don't mark these buffers specially, just visit them normally."
373    ;; Bind last-nonmenu-event to force use of keyboard, not mouse, for queries.    ;; Bind last-nonmenu-event to force use of keyboard, not mouse, for queries.
374    (let (client-record (last-nonmenu-event t) (obuf (current-buffer)))    (let ((last-nonmenu-event t) client-record)
375      ;; Restore the current buffer afterward, but not using save-excursion,      ;; Restore the current buffer afterward, but not using save-excursion,
376      ;; because we don't want to save point in this buffer      ;; because we don't want to save point in this buffer
377      ;; if it happens to be one of those specified by the server.      ;; if it happens to be one of those specified by the server.
378      (unwind-protect      (save-current-buffer
379          (while files        (dolist (file files)
380            ;; If there is an existing buffer modified or the file is          ;; If there is an existing buffer modified or the file is
381            ;; modified, revert it.  If there is an existing buffer with          ;; modified, revert it.  If there is an existing buffer with
382            ;; deleted file, offer to write it.          ;; deleted file, offer to write it.
383            (let* ((filen (car (car files)))          (let* ((filen (car file))
384                   (obuf (get-file-buffer filen)))                 (obuf (get-file-buffer filen)))
385              (push filen file-name-history)            (push filen file-name-history)
386              (if (and obuf (set-buffer obuf))            (if (and obuf (set-buffer obuf))
387                  (progn                (progn
388                    (cond ((file-exists-p filen)                  (cond ((file-exists-p filen)
389                           (if (or (not (verify-visited-file-modtime obuf))                         (if (not (verify-visited-file-modtime obuf))
390                                   (buffer-modified-p obuf))                             (revert-buffer t nil)))
391                               (revert-buffer t nil)))                        (t
392                          (t                         (if (y-or-n-p
393                           (if (y-or-n-p                              (concat "File no longer exists: "
394                                (concat "File no longer exists: "                                      filen
395                                        filen                                      ", write buffer to file? "))
396                                        ", write buffer to file? "))                             (write-file filen))))
397                               (write-file filen))))                  (setq server-existing-buffer t)
398                    (setq server-existing-buffer t)                  (server-goto-line-column file))
399                    (goto-line (nth 1 (car files))))              (set-buffer (find-file-noselect filen))
400                (set-buffer (find-file-noselect filen))              (server-goto-line-column file)
401                (goto-line (nth 1 (car files)))              (run-hooks 'server-visit-hook)))
402                (let ((column-number (nth 2 (car files))))          (unless nowait
403                  (when (> column-number 0)            ;; When the buffer is killed, inform the clients.
404                    (move-to-column (1- column-number))))            (add-hook 'kill-buffer-hook 'server-kill-buffer nil t)
405                (run-hooks 'server-visit-hook)))            (push (car client) server-buffer-clients))
406            (if (not nowait)          (push (current-buffer) client-record)))
               (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))  
407      (nconc client client-record)))      (nconc client client-record)))
408    
409  (defun server-buffer-done (buffer &optional for-killing)  (defun server-buffer-done (buffer &optional for-killing)
410    "Mark BUFFER as \"done\" for its client(s).    "Mark BUFFER as \"done\" for its client(s).
411  This buries the buffer, then returns a list of the form (NEXT-BUFFER KILLED).  This buries the buffer, then returns a list of the form (NEXT-BUFFER KILLED).
412  NEXT-BUFFER is another server buffer, as a suggestion for what to select next,  NEXT-BUFFER is another server buffer, as a suggestion for what to select next,
413  or nil.  KILLED is t if we killed BUFFER  or nil.  KILLED is t if we killed BUFFER (typically, because it was visiting
414  \(typically, because it was visiting a temp file)."  a temp file).
415    (let ((running (eq (process-status server-process) 'run))  FOR-KILLING if non-nil indicates that we are called from `kill-buffer'."
416          (next-buffer nil)    (let ((next-buffer nil)
417          (killed nil)          (killed nil)
         (first t)  
418          (old-clients server-clients))          (old-clients server-clients))
419      (while old-clients      (while old-clients
420        (let ((client (car old-clients)))        (let ((client (car old-clients)))
421          (or next-buffer          (or next-buffer
422              (setq next-buffer (nth 1 (memq buffer client))))              (setq next-buffer (nth 1 (memq buffer client))))
423          (delq buffer client)          (delq buffer client)
424          ;; Delete all dead buffers from CLIENT.          ;; Delete all dead buffers from CLIENT.
# Line 375  or nil.  KILLED is t if we killed BUFFER Line 430  or nil.  KILLED is t if we killed BUFFER
430              (setq tail (cdr tail))))              (setq tail (cdr tail))))
431          ;; If client now has no pending buffers,          ;; If client now has no pending buffers,
432          ;; tell it that it is done, and forget it entirely.          ;; tell it that it is done, and forget it entirely.
433          (if (cdr client) nil          (unless (cdr client)
434            (if running            (delete-process (car client))
435                (progn            (server-log "Close" (car client))
                 ;; Don't send emacsserver two commands in close succession.  
                 ;; It cannot handle that.  
                 (or first (sit-for 1))  
                 (setq first nil)  
                 (send-string server-process  
                              (format "Close: %s Done\n" (car client)))  
                 (server-log (format "Close: %s Done\n" (car client)))))  
436            (setq server-clients (delq client server-clients))))            (setq server-clients (delq client server-clients))))
437        (setq old-clients (cdr old-clients)))        (setq old-clients (cdr old-clients)))
438      (if (and (bufferp buffer) (buffer-name buffer))      (if (and (bufferp buffer) (buffer-name buffer))
# Line 392  or nil.  KILLED is t if we killed BUFFER Line 440  or nil.  KILLED is t if we killed BUFFER
440          ;; if we do, do not call server-buffer-done recursively          ;; if we do, do not call server-buffer-done recursively
441          ;; from kill-buffer-hook.          ;; from kill-buffer-hook.
442          (let ((server-kill-buffer-running t))          (let ((server-kill-buffer-running t))
443            (save-excursion            (with-current-buffer buffer
             (set-buffer buffer)  
444              (setq server-buffer-clients nil)              (setq server-buffer-clients nil)
445              (run-hooks 'server-done-hook))              (run-hooks 'server-done-hook))
446            ;; Notice whether server-done-hook killed the buffer.            ;; Notice whether server-done-hook killed the buffer.
# Line 417  or nil.  KILLED is t if we killed BUFFER Line 464  or nil.  KILLED is t if we killed BUFFER
464                    (bury-buffer buffer)))))))                    (bury-buffer buffer)))))))
465      (list next-buffer killed)))      (list next-buffer killed)))
466    
467  (defun server-temp-file-p (buffer)  (defun server-temp-file-p (&optional buffer)
468    "Return non-nil if BUFFER contains a file considered temporary.    "Return non-nil if BUFFER contains a file considered temporary.
469  These are files whose names suggest they are repeatedly  These are files whose names suggest they are repeatedly
470  reused to pass information to another program.  reused to pass information to another program.
# Line 434  of the form (NEXT-BUFFER KILLED).  NEXT- Line 481  of the form (NEXT-BUFFER KILLED).  NEXT-
481  as a suggestion for what to select next, or nil.  as a suggestion for what to select next, or nil.
482  KILLED is t if we killed BUFFER, which happens if it was created  KILLED is t if we killed BUFFER, which happens if it was created
483  specifically for the clients and did not exist before their request for it."  specifically for the clients and did not exist before their request for it."
484    (let ((buffer (current-buffer)))    (when server-buffer-clients
485      (if server-buffer-clients      (if (server-temp-file-p)
486          (progn          ;; For a temp file, save, and do make a non-numeric backup
487            (if (server-temp-file-p buffer)          ;; (unless make-backup-files is nil).
488                ;; For a temp file, save, and do make a non-numeric backup          (let ((version-control nil)
489                ;; (unless make-backup-files is nil).                (buffer-backed-up nil))
490                (let ((version-control nil)            (save-buffer))
491                      (buffer-backed-up nil))        (if (and (buffer-modified-p)
492                  (save-buffer))                 buffer-file-name
493              (if (and (buffer-modified-p)                 (y-or-n-p (concat "Save file " buffer-file-name "? ")))
494                       buffer-file-name            (save-buffer)))
495                       (y-or-n-p (concat "Save file " buffer-file-name "? ")))      (server-buffer-done (current-buffer))))
                 (save-buffer buffer)))  
           (server-buffer-done buffer)))))  
496    
497  ;; Ask before killing a server buffer.  ;; Ask before killing a server buffer.
498  ;; It was suggested to release its client instead,  ;; It was suggested to release its client instead,
# Line 477  specifically for the clients and did not Line 522  specifically for the clients and did not
522  (defvar server-kill-buffer-running nil  (defvar server-kill-buffer-running nil
523    "Non-nil while `server-kill-buffer' or `server-buffer-done' is running.")    "Non-nil while `server-kill-buffer' or `server-buffer-done' is running.")
524    
 ;; When a buffer is killed, inform the clients.  
 (add-hook 'kill-buffer-hook 'server-kill-buffer)  
525  (defun server-kill-buffer ()  (defun server-kill-buffer ()
526    ;; Prevent infinite recursion if user has made server-done-hook    ;; Prevent infinite recursion if user has made server-done-hook
527    ;; call kill-buffer.    ;; call kill-buffer.
# Line 500  inhibits a backup; you can set it locall Line 543  inhibits a backup; you can set it locall
543  prevent a backup for it.)  The variable `server-temp-file-regexp' controls  prevent a backup for it.)  The variable `server-temp-file-regexp' controls
544  which filenames are considered temporary.  which filenames are considered temporary.
545    
546  If invoked with a prefix argument, or if there is no server process running,  If invoked with a prefix argument, or if there is no server process running,
547  starts server process and that is all.  Invoked by \\[server-edit]."  starts server process and that is all.  Invoked by \\[server-edit]."
548    (interactive "P")    (interactive "P")
549    (if (or arg    (if (or arg
# Line 516  Arg NEXT-BUFFER is a suggestion; if it i Line 559  Arg NEXT-BUFFER is a suggestion; if it i
559    ;; if we have already killed one temp-file server buffer.    ;; if we have already killed one temp-file server buffer.
560    ;; This means we should avoid the final "switch to some other buffer"    ;; This means we should avoid the final "switch to some other buffer"
561    ;; since we've already effectively done that.    ;; since we've already effectively done that.
562    (cond ((and (windowp server-window)    (if (null next-buffer)
563                (window-live-p server-window))        (if server-clients
564           (select-window server-window))            (server-switch-buffer (nth 1 (car server-clients)) killed-one)
565          ((framep server-window)          (unless (or killed-one (window-dedicated-p (selected-window)))
566           (if (not (frame-live-p server-window))            (switch-to-buffer (other-buffer))
567               (setq server-window (make-frame)))            (message "No server buffers remain to edit")))
568           (select-window (frame-selected-window server-window))))      (if (not (buffer-name next-buffer))
569    (if (window-minibuffer-p (selected-window))          ;; If NEXT-BUFFER is a dead buffer, remove the server records for it
       (select-window (next-window nil 'nomini 0)))  
   ;; Move to a non-dedicated window, if we have one.  
   (when (window-dedicated-p (selected-window))  
     (select-window (get-window-with-predicate  
                     (lambda (w) (not (window-dedicated-p w)))  
                     'nomini 'visible (selected-window))))  
   (set-window-dedicated-p (selected-window) nil)  
   (if next-buffer  
       (if (and (bufferp next-buffer)  
                (buffer-name next-buffer))  
           (switch-to-buffer next-buffer)  
         ;; If NEXT-BUFFER is a dead buffer,  
         ;; remove the server records for it  
570          ;; and try the next surviving server buffer.          ;; and try the next surviving server buffer.
571          (apply 'server-switch-buffer          (apply 'server-switch-buffer (server-buffer-done next-buffer))
572                 (server-buffer-done next-buffer)))        ;; OK, we know next-buffer is live, let's display and select it.
573      (if server-clients        (if (functionp server-window)
574          (server-switch-buffer (nth 1 (car server-clients)) killed-one)            (funcall server-window next-buffer)
575        (if (not killed-one)          (let ((win (get-buffer-window next-buffer 0)))
576            (switch-to-buffer (other-buffer))))))            (if (and win (not server-window))
577                  ;; The buffer is already displayed: just reuse the window.
578                  (let ((frame (window-frame win)))
579                    (if (eq (frame-visible-p frame) 'icon)
580                        (raise-frame frame))
581                    (select-window win)
582                    (set-buffer next-buffer))
583                ;; Otherwise, let's find an appropriate window.
584                (cond ((and (windowp server-window)
585                            (window-live-p server-window))
586                       (select-window server-window))
587                      ((framep server-window)
588                       (if (not (frame-live-p server-window))
589                           (setq server-window (make-frame)))
590                       (select-window (frame-selected-window server-window))))
591                (if (window-minibuffer-p (selected-window))
592                    (select-window (next-window nil 'nomini 0)))
593                ;; Move to a non-dedicated window, if we have one.
594                (when (window-dedicated-p (selected-window))
595                  (select-window
596                   (get-window-with-predicate
597                    (lambda (w)
598                      (and (not (window-dedicated-p w))
599                           (equal (frame-parameter (window-frame w) 'display)
600                                  (frame-parameter (selected-frame) 'display))))
601                    'nomini 'visible (selected-window))))
602                (condition-case nil
603                    (switch-to-buffer next-buffer)
604                  ;; After all the above, we might still have ended up with
605                  ;; a minibuffer/dedicated-window (if there's no other).
606                  (error (pop-to-buffer next-buffer)))))))))
607    
608  (global-set-key "\C-x#" 'server-edit)  (global-set-key "\C-x#" 'server-edit)
609    
610  (defun server-unload-hook ()  (defun server-unload-hook ()
611      (server-start t)
612    (remove-hook 'kill-buffer-query-functions 'server-kill-buffer-query-function)    (remove-hook 'kill-buffer-query-functions 'server-kill-buffer-query-function)
613    (remove-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function)    (remove-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function)
614    (remove-hook 'kill-buffer-hook 'server-kill-buffer))    (remove-hook 'kill-buffer-hook 'server-kill-buffer))

Legend:
Removed from v.1.78  
changed lines
  Added in v.1.78.4.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26