home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / packages / server.el < prev    next >
Encoding:
Text File  |  1993-01-15  |  11.3 KB  |  292 lines
  1. ;; Lisp code for GNU Emacs running as server process.
  2. ;; Copyright (C) 1986-1993 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 2, 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/emacsserver 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 four 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. On a multi-terminal system, where Emacs runs on one terminal and the
  53. ;;; program that wants to use "the editor" runs on another.
  54.  
  55. ;;; 3. When the program that wants to use "the editor" is running
  56. ;;; as a subprocess of Emacs.
  57.  
  58. ;;; 4. On a system with job control, when Emacs is suspended, the program
  59. ;;; that wants to use "the editor" will stop and display
  60. ;;; "Waiting for Emacs...".  It can then be suspended, and Emacs can be
  61. ;;; brought into the foreground for editing.  When done editing, Emacs is
  62. ;;; suspended again, and the client program is brought into the foreground.
  63.  
  64. ;;; The buffer local variable "server-buffer-clients" lists 
  65. ;;; the clients who are waiting for this buffer to be edited.  
  66. ;;; The global variable "server-clients" lists all the waiting clients,
  67. ;;; and which files are yet to be edited for each.
  68.  
  69. (defvar server-program "emacsserver"
  70.   "*The program to use as the edit server")
  71.  
  72. (defvar server-visit-hook nil
  73.   "*List of hooks to call when switching to a buffer for the Emacs server.")
  74.  
  75. (defvar server-process nil 
  76.   "the current server process")
  77.  
  78. (defvar server-clients nil
  79.   "List of current server clients.
  80. Each element is (CLIENTID FILES...) where CLIENTID is a string
  81. that can be given to the server process to identify a client.
  82. When a buffer is marked as \"done\", it is removed from this list.")
  83.  
  84. (defvar server-buffer-clients nil
  85.   "List of clientids for clients requesting editing of current buffer.")
  86. ;; Changing major modes should not erase this local.
  87. (put 'server-buffer-clients 'permanent-local t)
  88.  
  89. (defvar server-temp-file-regexp "^/tmp/Re\\|/draft$"
  90.   "*Regexp which should match filenames of temporary files
  91. which are deleted and reused after each edit
  92. by the programs that invoke the emacs server.")
  93.  
  94. (make-variable-buffer-local 'server-buffer-clients)
  95. (setq-default server-buffer-clients nil)
  96. (or (assq 'server-buffer-clients minor-mode-alist)
  97.     (setq minor-mode-alist (cons '(server-buffer-clients " Server") minor-mode-alist)))
  98.  
  99. ;; If a *server* buffer exists,
  100. ;; write STRING to it for logging purposes.
  101. (defun server-log (string)
  102.   (if (get-buffer "*server*")
  103.       (save-excursion
  104.     (set-buffer "*server*")
  105.     (goto-char (point-max))
  106.     (insert string)
  107.     (or (bobp) (newline)))))
  108.  
  109. (defun server-sentinel (proc msg)
  110.   (cond ((eq (process-status proc) 'exit)
  111.      (server-log (message "Server subprocess exited")))
  112.     ((eq (process-status proc) 'signal)
  113.      (server-log (message "Server subprocess killed")))))
  114.  
  115. (defun server-start (&optional leave-dead)
  116.   "Allow this Emacs process to be a server for client processes.
  117. This starts a server communications subprocess through which
  118. client \"editors\" can send your editing commands to this Emacs job.
  119. To use the server, set up the program `etc/emacsclient' in the
  120. Emacs distribution as your standard \"editor\".
  121.  
  122. Prefix arg means just kill any existing server communications subprocess."
  123.   (interactive "P")
  124.   ;; kill it dead!
  125.   (if server-process
  126.       (progn
  127.     (set-process-sentinel server-process nil)
  128.     (condition-case () (delete-process server-process) (error nil))))
  129.   (condition-case () (delete-file "~/.emacs_server") (error nil))
  130.   ;; If we already had a server, clear out associated status.
  131.   (while server-clients
  132.     (let ((buffer (nth 1 (car server-clients))))
  133.       (server-buffer-done buffer)))
  134.   (if leave-dead
  135.       nil
  136.     (if server-process
  137.     (server-log (message "Restarting server")))
  138.     (setq server-process (start-process "server" nil server-program))
  139.     (set-process-sentinel server-process 'server-sentinel)
  140.     (set-process-filter server-process 'server-process-filter)
  141.     (process-kill-without-query server-process)))
  142.  
  143. ;Process a request from the server to edit some files.
  144. ;Format of STRING is "Client: CLIENTID PATH PATH PATH... \n"
  145. (defun server-process-filter (proc string)
  146.   (server-log string)
  147.   (if (not (eq 0 (string-match "Client: " string)))
  148.       nil
  149.     (setq string (substring string (match-end 0)))
  150.     (let ((client (list (substring string 0 (string-match " " string))))
  151.       (files nil)
  152.       (lineno 1))
  153.       (setq string (substring string (match-end 0)))
  154.       (while (string-match "[^ ]+ " string)
  155.     (let ((arg
  156.            (substring string (match-beginning 0) (1- (match-end 0)))))
  157.       (setq string (substring string (match-end 0)))
  158.       (if (string-match "\\`\\+[0-9]+\\'" arg)
  159.           (setq lineno (read (substring arg 1)))
  160.         (setq files
  161.           (cons (list arg lineno)
  162.             files))
  163.         (setq lineno 1))))
  164.       (server-visit-files files client)
  165.       ;; CLIENT is now a list (CLIENTNUM BUFFERS...)
  166.       (setq server-clients (cons client server-clients))
  167.       (switch-to-buffer (nth 1 client))
  168.       (make-screen-visible (selected-screen)) ; always raise?
  169.       (message (substitute-command-keys
  170.         "When done with a buffer, type \\[server-edit].")))))
  171.  
  172. (defun server-visit-files (files client)
  173.   "Finds FILES and returns the list CLIENT with the buffers nconc'd.
  174. FILES is an alist whose elements are (FILENAME LINENUMBER)."
  175.   (let (client-record)
  176.     (while files
  177.       (save-excursion
  178.     ;; If there is an existing buffer modified or the file is modified,
  179.     ;; revert it.
  180.     ;; If there is an existing buffer with deleted file, offer to write it.
  181.      (let* ((filen (car (car files)))
  182.            (obuf (get-file-buffer filen)))
  183.        (if (and obuf (set-buffer obuf))
  184.            (if (file-exists-p filen)
  185.            (if (or (not (verify-visited-file-modtime obuf))
  186.               (buffer-modified-p obuf))
  187.               (revert-buffer t nil))
  188.          (if (y-or-n-p
  189.               (concat "File no longer exists: "
  190.                   filen
  191.                   ", write buffer to file? "))
  192.              (write-file filen)))
  193.          (set-buffer (find-file-noselect filen))
  194.         (run-hooks 'server-visit-hook)))
  195.     (goto-line (nth 1 (car files)))
  196.       (setq server-buffer-clients (cons (car client) server-buffer-clients))
  197.       (setq client-record (cons (current-buffer) client-record)))
  198.         (setq files (cdr files)))
  199.     (nconc client client-record)))
  200.  
  201. (defun server-buffer-done (buffer)
  202.   "Mark BUFFER as \"done\" for its client(s).
  203. Buries the buffer, and returns another server buffer
  204. as a suggestion for what to select next."
  205.   (let ((running (eq (process-status server-process) 'run))
  206.     (next-buffer nil)
  207.     (old-clients server-clients))
  208.     (while old-clients
  209.       (let ((client (car old-clients)))
  210.     (or next-buffer 
  211.         (setq next-buffer (nth 1 (memq buffer client))))
  212.     (delq buffer client)
  213.     ;; If client now has no pending buffers,
  214.     ;; tell it that it is done, and forget it entirely.
  215.     (if (cdr client) nil
  216.       (if running
  217.           (progn
  218.         (send-string server-process 
  219.                  (format "Close: %s Done\n" (car client)))
  220.         (server-log (format "Close: %s Done\n" (car client)))))
  221.       (setq server-clients (delq client server-clients))))
  222.       (setq old-clients (cdr old-clients)))
  223.     (if (buffer-name buffer)
  224.     (save-excursion
  225.       (set-buffer buffer)
  226.       (setq server-buffer-clients nil)))
  227.     (bury-buffer buffer)
  228.     next-buffer))
  229.  
  230. (defun server-temp-file-p (buffer)
  231.   "Return non-nil if BUFFER contains a file considered temporary.
  232. These are files whose names suggest they are repeatedly
  233. reused to pass information to another program.
  234.  
  235. The variable `server-temp-file-regexp' controls which filenames
  236. are considered temporary."
  237.   (and (buffer-file-name buffer)
  238.        (string-match server-temp-file-regexp (buffer-file-name buffer))))
  239.  
  240. (defun server-done ()
  241.   "Offer to save current buffer, mark it as \"done\" for clients,
  242. bury it, and return a suggested buffer to select next."
  243.   (let ((buffer (current-buffer)))
  244.     (if server-buffer-clients
  245.     (progn
  246.        (if (server-temp-file-p buffer)
  247.            (progn (save-buffer)
  248.              (write-region (point-min) (point-max)
  249.                    (concat buffer-file-name "~"))
  250.              (kill-buffer buffer))
  251.         (if (and (buffer-modified-p)
  252.              (y-or-n-p (concat "Save file " buffer-file-name "? ")))
  253.         (save-buffer buffer)))
  254.       (server-buffer-done buffer)))))
  255.  
  256. (defun server-edit (&optional arg)
  257.   "Switch to next server editing buffer; say \"Done\" for current buffer.
  258. If a server buffer is current, it is marked \"done\" and optionally saved.
  259. When all of a client's buffers are marked as \"done\", the client is notified.
  260.  
  261. Temporary files such as MH <draft> files are always saved and backed up,
  262. no questions asked.  The variable `server-temp-file-regexp' controls
  263. which filenames are considered temporary.
  264.  
  265. If invoked with a prefix argument, or if there is no server process running, 
  266. starts server process and that is all.  Invoked by \\[server-edit]."
  267.  
  268.   (interactive "P")
  269.   (if (or arg
  270.       (not server-process)
  271.       (memq (process-status server-process) '(signal exit)))
  272.       (server-start nil)
  273.     (server-switch-buffer (server-done))))
  274.  
  275. (defun server-switch-buffer (next-buffer)
  276.   "Switch to another buffer, preferably one that has a client.
  277. Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it."
  278.   (if next-buffer
  279.       (if (and (bufferp next-buffer)
  280.            (buffer-name next-buffer))
  281.       (switch-to-buffer next-buffer)
  282.     ;; If NEXT-BUFFER is a dead buffer,
  283.     ;; remove the server records for it
  284.     ;; and try the next surviving server buffer.
  285.     (server-switch-buffer
  286.      (server-buffer-done next-buffer)))
  287.     (if server-clients
  288.     (server-switch-buffer (nth 1 (car server-clients)))
  289.       (switch-to-buffer (other-buffer)))))
  290.  
  291. (global-set-key "\C-x#" 'server-edit)
  292.