gnuserv.el

Emacs的一个插件源码

	   (find-file file))

	  ((and window-system
		gnuserv-screen (fboundp 'frame-live-p)    ;; gnu-emacs 19.22
		(frame-live-p gnuserv-screen))
	   (select-frame gnuserv-screen)
	   (find-file file))

	  ((and window-system
		(fboundp 'select-screen)                   ;; lemacs 19.10+
		(fboundp 'make-screen))
	   (select-screen (make-screen))
	   (find-file file))
	  
	  ((and (eq window-system 'x)                      ;; lemacs 19.9-
		(fboundp 'select-screen)
		(fboundp 'x-create-screen))
	   (select-screen (x-create-screen nil))
	   (find-file file))

	  ((and window-system
		(fboundp 'select-frame))                   ;; gnu-emacs 19
	   (select-frame (make-frame))
	   (find-file file))

	  ((and window-system
		(fboundp 'create-screen))                  ;; epoch
	   (if (screenp gnuserv-screen)
	       (progn (select-screen gnuserv-screen)
		      (find-file file))
	     (select-screen (create-screen (find-file-noselect file)))))

	  (t (find-file file)))))                          ;; emacs18+


(defun server-edit-files-quickly (l)
  "For each (lineno . file) pair in the given list, edit the file and goto the
given line number. Note that unlike server-edit-files, no information is saved
about clients waiting for this buffer to be killed."
  (server-write-to-client current-client nil)
  (setq current-client nil)
  (while l
    (let ((line (car (car l)))
	  (path (cdr (car l))))
      (server-find-file path)
      (server-make-window-visible)
      (goto-line line))
    (setq l (cdr l))))


(defun server-edit-files (l)
  "For each (lineno . file) pair in the given list, edit the given file for the
client and save enough information such that server-kill-buffer can let the 
client know when the buffer has been finished with."
  (while l
    (let ((line (car (car l)))
	  (path (cdr (car l))))
      (server-find-file path)
      (server-make-window-visible)
      (let ((old-clients (assq current-client server-clients))
	    (buffer (current-buffer)))
	(goto-line line)
	(setq server-buffer-clients
	      (cons current-client server-buffer-clients))
	(if old-clients			;client already waiting for buffers?
	    (nconc old-clients (list buffer)) ;yes -- append this one as well
	  (setq server-clients		;nope -- make a new record
		(cons (list current-client buffer)
		      server-clients)))))
      (setq l (cdr l)))
  (message (substitute-command-keys
	    (if (and (boundp 'infodock-version) window-system)
		"Type {\\[server-edit]} or select Frame/Delete to finish edit."
	      "When done with a buffer, type \\[server-edit]."))))


(defun old-server-get-buffer (buffer)
  "One arg, a string or a buffer. Return either a buffer object or
throw an error if the buffer named was not a buffer."
  (if (null buffer)
      (current-buffer)
    (let ((buf (get-buffer buffer)))
      (if (null buf)
	  (if (stringp buffer)
	      (error "No buffer named %s" buffer)
	    (error "Invalid buffer argument"))
	buf))))


(defun server-get-buffer (buffer)
  "One arg, a string or a buffer. Return either a buffer object or
throw an error if the buffer named was not a buffer."
  (if (null buffer)
      (current-buffer)
    (let ((buf (get-buffer buffer)))
      (if (null buf)
	  (if (bufferp buffer)
	      buffer
	    (if (stringp buffer)
		(error "No buffer named %s" buffer)
	      (error "Invalid buffer argument")))
	buf))))

(defun server-kill-buffer (buffer)
  "One arg, a string or a buffer.  Get rid of the specified buffer.
NOTE: This function has been enhanced to allow for remote editing
in the following way:

If the buffer is waited upon by one or more clients, and a client is
not waiting for other buffers to be killed, then the client is told
that the buffer has been killed."
  (interactive "bKill buffer ")
  (setq buffer (server-get-buffer buffer))
  (if (buffer-name buffer)
      (save-excursion
	(set-buffer buffer)
	(let ((old-clients server-clients))
	  (server-real-kill-buffer buffer) ;try to kill it
	  (if (buffer-name buffer)	;succeeded in killing?
	      nil			;nope
	    (while old-clients
	      (let ((client (car old-clients)))
		(delq buffer client)
		(if (cdr client)	;pending buffers?
		    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))))))))


(defun server-kill-all-local-variables ()
  "Eliminate all the buffer-local variable values of the current buffer.
This buffer will then see the default values of all variables.
NOTE: This function has been modified to ignore the variable 
server-buffer-clients."
  (let ((clients server-buffer-clients))
    (server-real-kill-all-local-variables)
    (if clients
	(setq server-buffer-clients clients))))


(or (fboundp 'server-real-kill-buffer)
  (fset 'server-real-kill-buffer (symbol-function 'kill-buffer)))

(fset 'kill-buffer 'server-kill-buffer)

(or (fboundp 'server-real-kill-all-local-variables)
    (fset 'server-real-kill-all-local-variables
	  (symbol-function 'kill-all-local-variables)))

(fset 'kill-all-local-variables 'server-kill-all-local-variables)


(defun server-buffer-done (buffer)
  "Mark BUFFER as \"done\" for its client(s).
Buries the buffer, and returns another server buffer
as a suggestion for what to select next."
  (let ((next-buffer nil)
	(old-clients server-clients))
    (while old-clients
      (let ((client (car old-clients)))
	(or next-buffer 
	    (setq next-buffer (nth 1 (memq buffer client))))
	(delq buffer client)
	;; If client now has no pending buffers,
	;; tell it that it is done, and forget it entirely.
	(if (cdr 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))


(defun mh-draft-p (buffer)
  "Return non-nil if this BUFFER is an mh <draft> file. Since MH deletes 
draft *BEFORE* it is edited, the server treats them specially."
 ;; This may not be appropriately robust for all cases.
  (string= (buffer-name buffer) "draft"))


(defun server-done ()
  "Offer to save current buffer, mark it as \"done\" for clients,
bury it, and return a suggested buffer to select next."
  (let ((buffer (current-buffer)))
    (if server-buffer-clients
	(progn
 	  (if (mh-draft-p buffer)
 	      (progn (save-buffer)
		     (write-region (point-min) (point-max)
				   (concat buffer-file-name "~"))
		     (kill-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; say \"Done\" for current buffer.
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]."
  (interactive "P")
  (if (or arg
	  (not server-process)
	  (memq (process-status server-process) '(signal exit)))
      (server-start nil)
    (if server-buffer-clients
	(progn (server-switch-buffer (server-done))
	       (cond ((or (not window-system)
			  (and gnuserv-screen 
			       (or (and (fboundp 'live-screen-p)
					(live-screen-p gnuserv-screen))
				   (and (fboundp 'frame-live-p)
					(frame-live-p gnuserv-screen))
				   (and (fboundp 'create-screen)
					(screenp gnuserv-screen)))))
		      ())                                   ;; do nothing
		     ((fboundp 'delete-screen)
		      (delete-screen))
		     ((fboundp 'delete-frame)
		      (delete-frame))))
      (error 
       "(server-edit): Use only on buffers created by external programs.")
      )))

(defun server-switch-buffer (next-buffer)
  "Switch to another buffer, preferably one that has a client.
Arg NEXT-BUFFER is a suggestion; if it is a live buffer, use it."
  (if next-buffer
      (if (and (bufferp next-buffer)
	       (buffer-name next-buffer))
	  (switch-to-buffer next-buffer)
	;; If NEXT-BUFFER is a dead buffer,
	;; remove the server records for it
	;; and try the next surviving server 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)