Return to server.el CVS log

Up to [CSRG BSD Unix] / 43BSDReno / contrib / emacs-18.55 / lisp

Annotation of 43BSDReno/contrib/emacs-18.55/lisp/server.el, revision 1.1

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

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