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