Return to server.el CVS log

Up to [Apple XNU] / GNUtools / emacs / lisp

Annotation of GNUtools/emacs/lisp/server.el, revision 1.1

1.1     ! root        1: ;; Lisp code for GNU Emacs running as server process.
        !             2: ;; Copyright (C) 1986, 1987, 1990 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 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)

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.