xemacs-beta: lisp/packages/gnuserv.el comparison

comparison lisp/packages/gnuserv.el @ 195:a2f645c6b9f8 r20-3b24

Import from CVS: tag r20-3b24

author	cvs
date	Mon, 13 Aug 2007 09:59:05 +0200
parents	f53b5ca2e663
children	acd284d43ca1

comparison

equal deleted inserted replaced

-:2947057885e5
+:a2f645c6b9f8
 ;;; gnuserv.el --- Lisp interface code between Emacs and gnuserv
 ;; Copyright (C) 1989-1997 Free Software Foundation, Inc.
-;; Version: 3.10
+;; Version: 3.9
 ;; Author: Andy Norman (ange@hplb.hpl.hp.com), originally based on server.el
-;;         Hrvoje Niksic <hniksic@srce.hr>, rewritten from scratch in May 1997
+;;         Hrvoje Niksic <hniksic@srce.hr>
 ;; Maintainer: Jan Vroonhof <vroonhof@math.ethz.ch>,
 ;;             Hrvoje Niksic <hniksic@srce.hr>
 ;; Keywords: environment, processes, terminals
 ;; This file is part of XEmacs.
 ;; ver William Sommerfeld's server.el.  Since then, a number of people
 ;; have worked on it, including Bob Weiner, Darell Kindred, Arup
 ;; Mukherjee, Ben Wing and Jan Vroonhof.  It was completely rewritten
 ;; (labeled as version 3) by Hrvoje Niksic in May 1997.
+;; 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
+;;
 ;; Jan Vroonhof
 ;;     Customized.
 ;;
 ;; Hrvoje Niksic <hniksic@srce.hr> May/1997
 ;;     Completely rewritten.  Now uses `defstruct' and other CL stuff
 ;;     to define clients cleanly.  Many thanks to Dave Gillespie!
 ;;
 ;; Mike Scheidler <c23mts@eng.delcoelect.com> July, 1997
 ;;     Added 'Done' button to the menubar.
-;;
-;; Hrvoje Niksic <hniksic@srce.hr> Sep/1997
-;;     More pervasive changes.
 ;;; Code:
 (defgroup gnuserv nil
 ;; Provide the old variables as aliases, to avoid breaking .emacs
 ;; files.  However, they are obsolete and should be converted to the
 ;; new forms.  This ugly crock must be before the variable
-;; declaration, or the scheme fails.  I'd prefer if we could junk this
+;; declaration, or the scheme fails.
-;; sh*t, but I guess the users will appreciate compatibility.  Uh...
 (define-obsolete-variable-alias 'server-frame 'gnuserv-frame)
 (define-obsolete-variable-alias 'server-done-function
 'gnuserv-done-function)
 (define-obsolete-variable-alias 'server-done-temp-file-function
 'gnuserv-visit-hook)
 (define-obsolete-variable-alias 'server-done-hook
 'gnuserv-done-hook)
 (define-obsolete-variable-alias 'server-kill-quietly
 'gnuserv-kill-quietly)
+(define-obsolete-variable-alias 'server-temp-file-regexp
+'gnuserv-temp-file-regexp)
+(define-obsolete-variable-alias 'server-make-temp-file-backup
+'gnuserv-make-temp-file-backup)
 ;;;###autoload
-(defcustom gnuserv-frame 'new
+(defcustom gnuserv-frame nil
-"*Determines what frame will be used to display all edited files.
+"*The frame to be used to display all edited files.
-Legal values are:
+If nil, then a new frame is created for each file edited.
-`new'     -- a new frame will be created for each file edited;
+If t, then the currently selected frame will be used.
-`current' -- the currently selected frame will be used;
+If a function, then this will be called with a symbol `x' or `tty' as the
-`main'    -- \"main\" Emacs frame will be used;
+only argument, and its return value will be interpreted as above."
-`visible' -- a visible frame will be used, or a new one created;
-`special' -- a special Gnuserv frame will be created, and used for
-all gnuserv-edited files;
-frame     -- that particular frame will be used.
-If gnuclient is called using the `-nw' method (from a TTY device), the
-behaviour will be as if gnuserv-frame were `new'.
-This variable is read by `gnuserv-frame-default-function'.  If you
-change `gnuserv-frame-function' to anything else, this variable will
-have no effect."
 :tag "Gnuserv Frame"
-;; Compatibility
+:type '(radio (const :tag "Create new frame each time" nil)
-:type '(radio (const :tag "Create new frame each time" new)
+		(const :tag "Use selected frame" t)
-		(const :tag "Use currently selected frame" current)
+	        (function-item :tag "Use main Emacs frame"
-		(const :tag "Use main Emacs frame" main)
+			       gnuserv-main-frame-function)
-		(const :tag "Use visible frame, otherwise create new" visible)
+		(function-item :tag "Use visible frame, otherwise create new"
-		(const :tag "Create special Gnuserv frame and use it" special))
+			       gnuserv-visible-frame-function)
-:group 'gnuserv)
+		(function-item :tag "Create special Gnuserv frame and use it"
+			       gnuserv-special-frame-function)
-(defcustom gnuserv-frame-properties nil
+		(function :tag "Other"))
-"*Properties of the frame in which gnuclient buffers are displayed.
+:group 'gnuserv)
-Note that this is in effect only for frames created by
-`gnuserv-frame-default-function'."
-:type '(repeat (group :inline t
-			(symbol :tag "Property")
-			(sexp :tag "Value")))
-:group 'gnuserv)
-(defcustom gnuserv-frame-function 'gnuserv-frame-default-function
-"*Function to return the appropriate frame for use by gnuclient.
-The function will be called with two arguments: the first one as
-described by `gnuserv-frame', and the second one as the device to
-create the frame on.
-The function must return a valid frame object."
-:type 'function
-:group 'gnuserv)
 (defcustom gnuserv-done-function 'kill-buffer
 "*Function used to remove a buffer after editing.
 It is called with one BUFFER argument.  Functions such as `kill-buffer' and
 `bury-buffer' are good values. See also `gnuserv-done-temp-file-function'."
 :type '(radio (function-item kill-buffer)
 		(function-item bury-buffer)
 		(function :tag "Other"))
 :group 'gnuserv)
+(defcustom gnuserv-done-temp-file-function 'kill-buffer
+"*Function used to remove a temporary buffer after editing.
+It is called with one BUFFER argument.  Functions such as `kill-buffer' and
+`bury-buffer' are good values. See also `gnuserv-done-temp-file-function'."
+:type '(radio (function-item kill-buffer)
+		(function-item bury-buffer)
+		(function :tag "Other"))
+:group 'gnuserv)
 (defcustom gnuserv-find-file-function 'find-file
 "*Function to visit a file with.
 It takes one argument, a file name to visit."
 :type 'function
 :group 'gnuserv)
 :type 'hook
 :group 'gnuserv)
 (defcustom gnuserv-kill-quietly nil
 "*Non-nil means to kill buffers with clients attached without requiring confirmation."
+:type 'boolean
+:group 'gnuserv)
+(defcustom gnuserv-temp-file-regexp "^/tmp/Re\\|/draft$"
+"*Regexp which should match filenames of temporary files deleted
+and reused by the programs that invoke the Emacs server."
+:type 'regexp
+:group 'gnuserv)
+(defcustom gnuserv-make-temp-file-backup nil
+"*Non-nil makes the server backup temporary files also."
 :type 'boolean
 :group 'gnuserv)
 ;;; Internal variables:
 (id nil)
 (buffers nil)
 (device nil)
 (frame nil))
 (defvar gnuserv-process nil
 "The current gnuserv process.")
 (defvar gnuserv-string ""
 "The last input string from the server.")
 Each element is a gnuclient structure that identifies a client.")
 (defvar gnuserv-devices nil
 "List of devices created by clients.")
-;; We want the client-infested buffers to have some modeline
-;; identification, so we'll make a "minor mode".  We don't use
-;; `add-minor-mode', as we don't want it to be togglable.
-(defvar gnuserv-minor-mode nil)
-(make-variable-buffer-local 'gnuserv-mode)
-(pushnew '(gnuserv-minor-mode " Server") minor-mode-alist :test 'equal)
 (defvar gnuserv-special-frame nil
 "Frame created specially for Server.")
+;; We want the client-infested buffers to have some modeline
+;; identification, so we'll make a "minor mode".
+(defvar gnuserv-minor-mode nil)
+(make-variable-buffer-local 'gnuserv-mode)
+(pushnew '(gnuserv-minor-mode " Server") minor-mode-alist
+	  :test 'equal)
-;; Creating gnuserv frame.
+;; Sample gnuserv-frame functions
-(defun gnuserv-frame-default-function (arg device)
+(defun gnuserv-main-frame-function (type)
-"Default function to create Gnuserv frames.
+"Returns a sensible value for the main Emacs frame."
-See the documentation of `gnuserv-frame' for instructions how to
+(if (eq type 'x)
-customize it."
+(car (frame-list))
-;; If we are on TTY, act as if `new' was given.
+nil))
-(if (not (device-on-window-system-p))
-(gnuserv-frame-default-function 'new device)
+(defun gnuserv-visible-frame-function (type)
-(cond
+"Returns a frame if there is a frame that is truly visible, nil otherwise.
-((or (eq arg 'new)
+This is meant in the X sense, so it will not return frames that are on another
-	   ;; nil for back-compat
+visual screen.  Totally visible frames are preferred.  If none found, return nil."
-	   (eq arg nil))
+(if (eq type 'x)
-(make-frame gnuserv-frame-properties device))
+(cond ((car (filtered-frame-list 'frame-totally-visible-p
-((or (eq arg 'current)
+				       (selected-device))))
-	   ;; t for back-compat
+	    ((car (filtered-frame-list (lambda (frame)
-	   (eq arg t))
+					 ;; eq t as in not 'hidden
-(selected-frame))
+					 (eq t (frame-visible-p frame)))
-((eq arg 'main)
+				       (selected-device)))))
-(car (frame-list)))
+nil))
-((eq arg 'visible)
-(cond ((car (filtered-frame-list 'frame-totally-visible-p device)))
+(defun gnuserv-special-frame-function (type)
-	     ((car (filtered-frame-list (lambda (frame)
+"Creates a special frame for Gnuserv and returns it on later invocations."
-					  ;; eq t as in not 'hidden
+(unless (frame-live-p gnuserv-special-frame)
-					  (eq (frame-visible-p frame) t))
+(setq gnuserv-special-frame (make-frame)))
-					device)))
+gnuserv-special-frame)
-	     (t (make-frame gnuserv-frame-properties device))))
-((eq arg 'special)
-(unless (frame-live-p gnuserv-special-frame)
-	 (setq gnuserv-special-frame
-	       (make-frame gnuserv-frame-properties device))))
-((frame-live-p arg)
-arg)
-(t
-(error "Invalid argument %s" arg)))))
 ;;; Communication functions
 ;; We used to restart the server here, but it's too risky -- if
 	      (quick (setq quick t))
 	      (view  (setq view t))
 	      (t     (error "Invalid flag %s" flag))))
 	  flags)
 (let* ((old-device-num (length (device-list)))
-	   (old-frame-num  (length (frame-list)))
+	   (new-frame nil)
-	   (device (case (car type)
+	   (dest-frame (if (functionp gnuserv-frame)
+			   (funcall gnuserv-frame (car type))
+			 gnuserv-frame))
+	   ;; The gnuserv-frame dependencies are ugly.
+	   (device (cond ((frame-live-p dest-frame)
+			  (frame-device dest-frame))
+			 ((null dest-frame)
+			  (case (car type)
 			    (tty (apply 'make-tty-device (cdr type)))
 			    (x   (make-x-device (cadr type)))
 			    (t   (error "Invalid device type"))))
-	   (frame (funcall gnuserv-frame-function gnuserv-frame device))
+			 (t
+			  (selected-device))))
+	   (frame (cond ((frame-live-p dest-frame)
+			 dest-frame)
+			((null dest-frame)
+			 (setq new-frame (make-frame nil device))
+			 new-frame)
+			(t (selected-frame))))
 	   (client (make-gnuclient :id gnuserv-current-client
 				   :device device
-				   :frame (if (= (length (frame-list))
+				   :frame new-frame)))
-						 old-frame-num)
-					      nil frame))))
 (setq gnuserv-current-client nil)
 ;; If the device was created by this client, push it to the list.
 (and (/= old-device-num (length (device-list)))
 	   (push device gnuserv-devices))
 (and (frame-iconified-p frame)
 	   (deiconify-frame frame))
 ;; Visit all the listed files.
 (while list
 	(let ((line (caar list)) (path (cdar list)))
 	  (select-frame frame)
-	  (raise-frame frame)
 	  ;; Visit the file.
 	  (funcall (if view
 		       gnuserv-view-file-function
 		     gnuserv-find-file-function)
 		   path)
 	  ;; Don't memorize the quick and view buffers.
 	  (unless (or quick view)
 	    (pushnew (current-buffer) (gnuclient-buffers client))
 	    (setq gnuserv-minor-mode t)
 	    ;; Add the "Done" button to the menubar, only in this buffer.
-	    (when (boundp 'current-menubar)
+	    (if (boundp 'current-menubar)
-	      (set-buffer-menubar current-menubar)
+	      (progn (set-buffer-menubar current-menubar)
-	      (add-menu-button nil ["Done" gnuserv-edit t])))
+	      (add-menu-button nil ["Done" gnuserv-edit t]))
+	      ))
 	  (run-hooks 'gnuserv-visit-hook)
 	  (pop list)))
 (cond
 ((and (or quick view)
 	     (device-on-window-system-p device))
 	;; should be unique.
 	(gnuserv-write-to-client (gnuclient-id client) nil))
 (t
 	;; Else, the client gets a vote.
 	(push client gnuserv-clients)
-	;; Explain buffer exit options.  If client-frame is non-nil,
+	;; Explain buffer exit options.  If dest-frame is nil, the
-	;; the user can exit via `delete-frame'.  OTOH, if FLAGS are
+	;; user can exit via `delete-frame'.  OTOH, if FLAGS are nil
-	;; nil and there are some buffers, the user can exit via
+	;; and there are some buffers, the user can exit via
 	;; `gnuserv-edit'.
 	(if (and (not (or quick view))
 		 (gnuclient-buffers client))
 	    (message "%s"
 		     (substitute-command-keys
 		      "Type `\\[gnuserv-edit]' to finish editing"))
-	  (and (gnuclient-frame client)
+	  (or dest-frame
-	       (message "%s"
+	      (message "%s"
-			(substitute-command-keys
+		       (substitute-command-keys
-			 "Type `\\[delete-frame]' to finish editing")))))))))
+			"Type `\\[delete-frame]' to finish editing")))))))))
 ;;; Functions that hook into Emacs in various way to enable operation
 ;; Defined later.
 ;; possible, because it is slow, and conses a list.  Use
 ;; `gnuserv-buffer-p' when appropriate, for instance.
 (defun gnuserv-buffer-clients (buffer)
 "Returns a list of clients to which BUFFER belongs."
 (let (res)
-(dolist (client gnuserv-clients res)
+(dolist (client gnuserv-clients)
 (when (memq buffer (gnuclient-buffers client))
-	(push client res)))))
+	(push client res)))
+res))
 ;; Like `gnuserv-buffer-clients', but returns a boolean; doesn't
 ;; collect a list.
 (defun gnuserv-buffer-p (buffer)
 (member* buffer gnuserv-clients
 	;; error when `delete-device' tries to do the job later.
 	(gnuserv-kill-client client t))))
 (callf2 delq device gnuserv-devices))
 (add-hook 'delete-device-hook 'gnuserv-check-device)
+(defun gnuserv-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 `gnuserv-temp-file-regexp' controls which filenames
+are considered temporary."
+(and (buffer-file-name buffer)
+(string-match gnuserv-temp-file-regexp (buffer-file-name buffer))))
 (defun gnuserv-kill-client (client &optional leave-frame)
 "Kill the gnuclient CLIENT.
 This will do away with all the associated buffers.  If LEAVE-FRAME,
 the function will not remove the frames associated with the client."
 (run-hooks 'gnuserv-done-hook)
 (setq gnuserv-minor-mode nil)
 ;; Delete the menu button.
 (if (boundp 'current-menubar)
 (delete-menu-item '("Done")))
-(funcall gnuserv-done-function buffer)))
+(funcall (if (gnuserv-temp-file-p buffer)
+		 gnuserv-done-temp-file-function
+	       gnuserv-done-function)
+	     buffer)))
 ;;; Higher-level functions
 ;; Choose a `next' server buffer, according to several criteria, and
 Does the save/backup queries first, and calls `gnuserv-done-function'."
 ;; Check whether this is the real thing.
 (unless (gnuserv-buffer-p buffer)
 (error "%s does not belong to a gnuserv client" buffer))
 ;; Backup/ask query.
-(if (and (buffer-modified-p)
+(if (gnuserv-temp-file-p buffer)
-	   (y-or-n-p (concat "Save file " buffer-file-name "? ")))
+;; For a temp file, save, and do NOT make a non-numeric backup
-(save-buffer buffer))
+;; Why does server.el explicitly back up temporary files?
+(let ((version-control nil)
+	    (buffer-backed-up (not gnuserv-make-temp-file-backup)))
+	(save-buffer))
+(if (and (buffer-modified-p)
+	     (y-or-n-p (concat "Save file " buffer-file-name "? ")))
+	(save-buffer buffer)))
 (gnuserv-buffer-done-1 buffer))
 ;; Called by `gnuserv-start-1' to clean everything.  Hooked into
 ;; `kill-emacs-hook', too.
 (defun gnuserv-kill-all-clients ()
 (not (not gnuserv-process)))
 ;;;###autoload
 (defun gnuserv-start (&optional leave-dead)
 "Allow this Emacs process to be a server for client processes.
 This starts a gnuserv communications subprocess through which
 client \"editors\" (gnuclient and gnudoit) can send editing commands to
 this Emacs job.  See the gnuserv(1) manual page for more details.
 Prefix arg means just kill any existing server communications subprocess."
 (interactive "P")
 (and gnuserv-process
 (not leave-dead)
 (message "Restarting gnuserv"))
 (gnuserv-start-1 leave-dead))
 (defun gnuserv-edit (&optional count)
-"Mark the current gnuserv buffer as \"done\", and switch to next one.
+"Mark the current gnuserv editing buffer as \"done\", and switch to next one.
 Run with a numeric prefix argument, repeat the operation that number
 of times.  If given a universal prefix argument, close all the buffers
 of this buffer's clients.
-The `gnuserv-done-function' (`kill-buffer' by default) is called to
-dispose of the buffer after marking it as done.
+The `gnuserv-done-function' (bound to `kill-buffer' by default) is
-When all of a client's buffers are marked as \"done\", the client is
+called to dispose of the buffer after marking it as done.
-notified."
+Files that match `gnuserv-temp-file-regexp' are considered temporary and
+are saved unconditionally and backed up if `gnuserv-make-temp-file-backup'
+is non-nil.  They are disposed of using `gnuserv-done-temp-file-function'
+(also bound to `kill-buffer' by default).
+When all of a client's buffers are marked as \"done\", the client is notified."
 (interactive "P")
 (when (null count)
 (setq count 1))
 (cond ((numberp count)
 	 (let (next)

Mercurial > hg > xemacs-beta

comparison lisp/packages/gnuserv.el @ 195:a2f645c6b9f8 r20-3b24