Mercurial > hg > xemacs-beta
diff lisp/packages/gnuserv.el @ 70:131b0175ea99 r20-0b30
Import from CVS: tag r20-0b30
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:02:59 +0200 |
parents | 56c54cf7c5b6 |
children | c7528f8e288d |
line wrap: on
line diff
--- a/lisp/packages/gnuserv.el Mon Aug 13 09:00:04 2007 +0200 +++ b/lisp/packages/gnuserv.el Mon Aug 13 09:02:59 2007 +0200 @@ -5,7 +5,7 @@ ; Copying is permitted under those conditions described by the GNU ; General Public License. ; -; Copyright (C) 1989-1996 Free Software Foundation, Inc. +; Copyright (C) 1989-1994 Free Software Foundation, Inc. ; ; Author: Andy Norman (ange@hplb.hpl.hp.com) based on ; 'lisp/server.el' from the 18.52 GNU Emacs distribution. @@ -53,12 +53,6 @@ ; ; Ben Wing <wing@666.com> May/1996 ; patch to get TTY terminal type correct. -; -; Jan Vroonhof <vroonhof@math.ethz.ch> July/1996 -; ported the server-temp-file-regexp feature from server.el -; ported server hooks from server.el -; ported kill-*-query functions from server.el (and made it optional) -; synced other behaviour with server.el @@ -72,7 +66,6 @@ (not (featurep 'gnuserv))) (error "Can't run gnuserv because server.el appears to be loaded already")) -;;;###autoload (defvar gnuserv-frame nil "*If non-nil, the frame to be used to display all edited files. If nil, then a new frame is created for each file edited. @@ -80,38 +73,17 @@ (defvar server-done-function 'kill-buffer "*A function of one argument, a buffer, which removes the buffer after editing. -Functions such as 'kill-buffer' and 'bury-buffer' are good values. See also -`server-done-temp-file-function'") - -(defvar server-done-temp-file-function 'kill-buffer - "*A function of one argument, a buffer, which removes the buffer after editing a -temporary file. Functions such as 'kill-buffer' and 'bury-buffer' are -good values. See also `server-done-function'") +Functions such as 'kill-buffer' and 'bury-buffer' are good values.") (defvar server-program "gnuserv" "*The program to use as the edit server") - - (defvar server-visit-hook nil - "*List of hooks to call when visiting a file for the Emacs server.") - -;; defined by server.el but obsolete? -;; (defvar server-switch-hook nil -;; "*List of hooks to call when switching to a buffer for the Emacs server.") - -(defvar server-done-hook nil - "*List of hooks to call when done editing a buffer for the Emacs server.") - - (defvar server-process nil "The current server process") (defvar server-string "" "The last input string from the server") -(defvar server-kill-last-frame nil - "set to t to kill last frame") - (defvar current-client nil "The client we are currently talking to") @@ -121,39 +93,15 @@ that can be given to the server process to identify a client. When a buffer is killed, it is removed from this list.") -(defvar server-kill-quietly nil - "If this variable is set then don't confirm kills of buffers with - clients attached") - - (defvar server-buffer-clients nil "List of client ids for clients requesting editing of the current buffer.") -(defvar server-temp-file-regexp "^/tmp/Re\\|/draft$" - "*Regexp which should match filenames of temporary files -which are deleted and reused after each edit -by the programs that invoke the emacs server.") - -(defvar server-make-temp-file-backup nil - "Non-nil makes the server backup temporary files also") - (make-variable-buffer-local 'server-buffer-clients) (setq-default server-buffer-clients nil) (or (assq 'server-buffer-clients minor-mode-alist) (setq minor-mode-alist (cons '(server-buffer-clients " Server") minor-mode-alist))) -(defun server-temp-file-p (buffer) - "Return non-nil if BUFFER contains a file considered temporary. -These are files whose names suggest they are repeatedly -reused to pass information to another program. - -The variable `server-temp-file-regexp' controls which filenames -are considered temporary." - (and (buffer-file-name buffer) - (string-match server-temp-file-regexp (buffer-file-name buffer)))) - - (defun server-log (string) "If a *server* buffer exists, write STRING to it for logging purposes." (if (get-buffer "*server*") @@ -248,7 +196,7 @@ ;; make gnuserv-start an alias to server-start, for backward compatibility (fset 'server-start (function gnuserv-start)) -; Can gnuserv handle commands in close succesion? (See server.el line 283) JV + (defun server-write-to-client (client form) "Write the given form to the given client via the server process." (if (and client @@ -271,34 +219,30 @@ (setq current-client nil) (eval form)) - (defun server-make-window-visible () "Try to make this window even more visible." - (and (or (and (boundp 'window-system) - (boundp 'window-system-version) - (eq window-system 'x) - (eq window-system-version 11)) - (and (fboundp 'console-type) - (eq 'x (console-type)))) - (cond ((fboundp 'raise-frame) - (raise-frame (selected-frame))) - ((fboundp 'deiconify-screen) - (deiconify-screen (selected-screen)) - (raise-screen (selected-screen))) - ((fboundp 'mapraised-screen) - (mapraised-screen)) - ((fboundp 'x-remap-window) - (x-remap-window) - ;; give window chance to re-display text - (accept-process-output))))) + (cond + ;; XEmacs can (in theory) raise any kind of frame + ((fboundp 'raise-frame) + (raise-frame (selected-frame))) + ((not (and (boundp 'window-system) window-system)) + nil) + ((fboundp 'deiconify-screen) + (deiconify-screen (selected-screen)) + (raise-screen (selected-screen))) + ((fboundp 'mapraised-screen) + (mapraised-screen)) + ((fboundp 'x-remap-window) + (x-remap-window) + ;; give window chance to re-display text + (accept-process-output)))) -(defun server-tty-find-file (tty termtype pid file) - (let ((device (make-tty-device tty termtype pid ))) +(defun server-tty-find-file (tty termtype file) + (let ((device (make-tty-device tty termtype))) (select-frame (make-frame nil device)) (if (not file) (switch-to-buffer (get-buffer-create "*scratch*")) - (find-file file))) - (run-hooks 'server-visit-hook)) + (find-file file)))) (defun server-find-file (file) "Edit file FILENAME. @@ -353,8 +297,7 @@ (find-file file)) (select-screen (create-screen (find-file-noselect file))))) - (t (find-file file)))) ;; emacs18+ - (run-hooks 'server-visit-hook)) + (t (find-file file))))) ;; emacs18+ (defun server-edit-files-quickly (list) @@ -397,7 +340,7 @@ "Type {\\[server-edit]} or select Frame/Delete to finish edit." "When done with a buffer, type \\[server-edit].")))) -(defun server-tty-edit-files (tty termtype pid list) +(defun server-tty-edit-files (tty termtype list) "For each (line-number . file) pair in LIST, edit the file at line-number. Save enough information for (server-kill-buffer) to inform the client when the edit is finished." @@ -405,7 +348,7 @@ (while list (let ((line (car (car list))) (path (cdr (car list)))) - (server-tty-find-file tty termtype pid path) + (server-tty-find-file tty termtype path) (server-make-window-visible) (let ((old-clients (assq current-client server-clients)) (buffer (current-buffer))) @@ -461,36 +404,7 @@ nil ;yep (server-write-to-client (car client) nil) ;nope, tell client (setq server-clients (delq client server-clients)))) - (setq old-clients (cdr old-clients))) - t))))) - - -;; Ask before killing a server buffer. -;; It was suggested to release its client instead, -;; but I think that is dangerous--the client would proceed -;; using whatever is on disk in that file. -- rms. -(defun server-kill-buffer-query-function () - (or server-kill-quietly - (not server-buffer-clients) - (yes-or-no-p (format "Buffer `%s' still has clients; kill it? " - (buffer-name (current-buffer)))))) - -(add-hook 'kill-buffer-query-functions - 'server-kill-buffer-query-function) - -(defun server-kill-emacs-query-function () - (let (live-client - (tail server-clients)) - ;; See if any clients have any buffers that are still alive. - (while tail - (if (memq t (mapcar 'stringp (mapcar 'buffer-name (cdr (car tail))))) - (setq live-client t)) - (setq tail (cdr tail))) - (or server-kill-quietly - (not live-client) - (yes-or-no-p "Server buffers still have clients; exit anyway? ")))) - -(add-hook 'kill-emacs-query-functions 'server-kill-emacs-query-function) + (setq old-clients (cdr old-clients)))))))) (defun server-kill-all-local-variables () @@ -520,7 +434,6 @@ "Mark BUFFER as \"done\" for its client(s). Buries the buffer, and returns another server buffer as a suggestion for the new current buffer." - ; Note we do NOT return a list with a killed flag, doesn't seem usefull to me. JV (let ((next-buffer nil) (old-clients server-clients)) (while old-clients @@ -528,32 +441,18 @@ (or next-buffer (setq next-buffer (nth 1 (memq buffer client)))) (delq buffer client) - ;; Delete all dead buffers from CLIENT. (Why? JV , copyed from server.el) - (let ((tail client)) - (while tail - (and (bufferp (car tail)) - (null (buffer-name (car tail))) - (delq (car tail) client)) - (setq tail (cdr tail)))) ;; If client now has no pending buffers, ;; tell it that it is done, and forget it entirely. (if (cdr client) nil - (if (buffer-name buffer) - (save-excursion - (set-buffer buffer) - (setq server-buffer-clients nil) - (run-hooks 'server-done-hook))) - ; Order is important here -- - ; server-kill-buffer tries to notify clients that - ; they are done, too, but if we try and notify twice, - ; we are h0zed -- Hunter Kelly 3/3/97 - (setq server-clients (delq client server-clients)) - (if (server-temp-file-p buffer) - (funcall server-done-temp-file-function buffer) - (funcall server-done-function buffer)) - (server-write-to-client (car client) nil))) + (server-write-to-client (car client) nil) + (setq server-clients (delq client server-clients)))) (setq old-clients (cdr old-clients))) + (if (buffer-name buffer) + (save-excursion + (set-buffer buffer) + (setq server-buffer-clients nil))) + (funcall server-done-function buffer) next-buffer)) @@ -570,51 +469,38 @@ (let ((buffer (current-buffer))) (if server-buffer-clients (progn - (if (mh-draft-p buffer);; Does this comflict with temp-file ? JV + (if (mh-draft-p buffer) (progn (save-buffer) (write-region (point-min) (point-max) (concat buffer-file-name "~")) (kill-buffer buffer)) - (if (server-temp-file-p buffer) - ;; For a temp file, save, and do NOT make a non-numeric backup - ;; Why does server.el explicitly back up temporary files? - (let ((version-control nil) - (buffer-backed-up (not server-make-temp-file-backup))) - (save-buffer)) - (if (and (buffer-modified-p) - (y-or-n-p (concat "Save file " buffer-file-name "? "))) - (save-buffer buffer)))) + (if (and (buffer-modified-p) + (y-or-n-p (concat "Save file " buffer-file-name "? "))) + (save-buffer buffer))) (server-buffer-done buffer))))) (defun server-edit (&optional arg) - "Switch to next server editing -buffer and mark current one as \"done\". If a server buffer is -current, it is marked \"done\" and optionally saved. MH <draft> files -are always saved and backed up, no questions asked. Files that match -server-temp-file-regexp are considered temporary and are saved -unconditionally and -backed up if server-make-temp-file-backup is non-nil. When all of a -client's buffers are marked as \"done\", the client is notified. + "Switch to next server editing buffer and mark current one as \"done\". +If a server buffer is current, it is marked \"done\" and optionally saved. +MH <draft> files are always saved and backed up, no questions asked. +When all of a client's buffers are marked as \"done\", the client is notified. If invoked with a prefix argument, or if there is no server process running, -starts server process and that is all. Invoked by \\[server-edit]. - -If `server-kill-last-frame' is t, then the final frame will be killed." +starts server process and that is all. Invoked by \\[server-edit]." (interactive "P") (if (or arg (not server-process) (memq (process-status server-process) '(signal exit))) (server-start nil) (if server-buffer-clients - (progn (server-done-and-switch) + (progn (server-switch-buffer (server-done)) (cond ((fboundp 'console-type) ;; XEmacs 19.14+ (or (and (equal (console-type) 'x) gnuserv-frame (frame-live-p gnuserv-frame)) (condition-case () - (delete-frame (selected-frame) - server-kill-last-frame) + (delete-frame (selected-frame) nil) (error (message "Not deleting last visible frame..."))))) ((or (not window-system) @@ -634,11 +520,10 @@ "(server-edit): Use only on buffers created by external programs.") ))) -(defun server-switch-buffer-internal (next-buffer always) +(defun server-switch-buffer (next-buffer) "Switch to NEXT-BUFFER if a live buffer, otherwise switch to another buffer -with gnuserv clients. If no such buffer is available, we switch to -another normal buffer if `always' is non-nil!" - ;; switching +with gnuserv clients. If no such buffer is available, simply choose another +one." (if next-buffer (if (and (bufferp next-buffer) (buffer-name next-buffer)) @@ -646,31 +531,13 @@ ;; If NEXT-BUFFER is a dead buffer, ;; remove the server records for it ;; and try the next surviving server buffer. - (server-switch-buffer-internal - (server-buffer-done next-buffer) always)) - (if server-clients - (server-switch-buffer-internal (nth 1 (car server-clients)) always) - (if always - (switch-to-buffer (other-buffer)))))) - -;; For compatability -(defun server-switch-buffer (next-buffer) - (server-switch-buffer-internal next-buffer t)) - -;; The below function calles server-done and switches to the next -;; sensible buffer. This implementation works regardless of the values -;; of server-*-function and doens't need the tail recursion -;; variable passing of server.el. It is more transparant too. JV -(defun server-done-and-switch () - "Be done with the current buffer and switch to another server buffer - if there is one, otherwise just switch buffer" - (let ((old-current (current-buffer))) - (server-switch-buffer-internal (server-done) nil) - (if (eq old-current (current-buffer)) - (switch-to-buffer (other-buffer))))) + (server-switch-buffer + (server-buffer-done next-buffer))) + (if server-clients + (server-switch-buffer (nth 1 (car server-clients))) + (switch-to-buffer (other-buffer))))) (global-set-key "\C-x#" 'server-edit) (provide 'gnuserv) -;;; gnuserv.el ends here