home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / NeXT / GnuSource / emacs-15.0.3 / lisp / server.el < prev    next >
Lisp/Scheme  |  1990-07-19  |  10KB  |  264 lines
  1. ;; Lisp code for GNU Emacs running as server process.
  2. ;; Copyright (C) 1986, 1987 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 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)
  264.