xemacs-beta: lisp/energize/energize-init.el comparison

comparison lisp/energize/energize-init.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14

author	cvs
date	Mon, 13 Aug 2007 08:45:50 +0200
parents
children	131b0175ea99

comparison

equal deleted inserted replaced

--1:000000000000
+:376386a54a3c
+;;; -*- Mode:Emacs-Lisp -*-
+;;; Copyright © 1990-1994 by Lucid, Inc.  All Rights Reserved.
+(defvar energize-auto-raise-screen t
+"If T frames are automatically raised when Energize wants to show them.")
+(defvar energize-connect-hook nil
+"*Function or functions to run when the Energize connection is established.")
+(defvar energize-disconnect-hook nil
+"*Function or functions to run when the Emacs/Energize connection is closed.")
+(defvar energize-screen-mode nil)
+(defvar energize-split-screens-p t)
+(defun energize-multi-screen-mode ()
+"Call this function to put Energize into multi-frame mode.
+A frame named \"debugger\" will be used for the *Debugger* buffer,
+and its associated source files.
+A frame named \"energize\" will be used for the Top-Level buffer.
+A frame named \"browser\" will be created for each L.E. Browser buffer.
+At most 5 of these will be created; then they will be reused.
+A frame named \"project\" will be created for each Project buffer.
+A frame named \"error-log\" will be created for the Error Log buffer
+and its associated source files (as when the Next Error command
+displays a source file.)
+A frame named \"manual\" will be created for each UNIX Manual page.
+At most 5 of these will be created; then they will be reused.
+If an external editor is being used, then source files will be displayed
+read-only in the \"debugger\" frame.
+If an external editor is not being used, then frames named \"sources\"
+will be created to edit source files.  At most five of these will be
+created; then they will be reused.  Find-file will use the current frame,
+whatever that happens to be, but find-file-other-window, and selecting
+source files from the Buffers menu will use an existing frame displaying
+the file in question, or create a new one if there isn't one.
+Call `energize-single-screen-mode' to turn this off.
+See the documentation for the function get-frame-for-buffer for
+information on how to customize this."
+(interactive)
+(put 'project      'instance-limit 0)
+(put 'sources      'instance-limit 5)
+(put 'manual       'instance-limit 5)
+(put 'browser      'instance-limit 5)
+(put 'energize-debugger-mode        'frame-name 'debugger)
+(put 'gdb-mode		      'frame-name 'debugger)
+(put 'energize-top-level-mode       'frame-name 'energize)
+(put 'energize-browser-mode         'frame-name 'browser)
+(put 'energize-breakpoint-mode      'frame-name 'browser)
+(put 'energize-project-mode         'frame-name 'project)
+(put 'energize-no-file-project-mode 'frame-name 'project)
+(put 'energize-log-mode             'frame-name 'error-log)
+(put 'energize-manual-entry-mode    'frame-name 'manual)
+(if energize-external-editor
+(setq get-frame-for-buffer-default-frame-name 'debugger)
+;; hmmmm...
+(setq get-frame-for-buffer-default-frame-name 'sources))
+(setq buffers-menu-switch-to-buffer-function 'pop-to-buffer)
+(setq energize-screen-mode 'multi)
+t)
+(defun energize-several-screens-mode ()
+"Call this function to put Energize into multi-frame mode,
+but with only a few frames.  See also `energize-multi-screen-mode'.
+A frame named \"debugger\" will be used for the *Debugger* buffer,
+and its associated source files.
+A frame named \"energize\" will be used for the Top-Level buffer.
+A single frame named \"browser\" will be created for L.E. Browser buffers.
+A single frame named \"project\" will be created for Project buffers.
+A frame named \"error-log\" will be created for the Error Log buffer
+and its associated source files (as when the Next Error command
+displays a source file.)
+A single frame named \"manual\" will be created for UNIX Manual page buffers.
+If an external editor is being used, then source files will be displayed
+read-only in the \"debugger\" frame.
+If an external editor is not being used, then a single frame named
+\"sources\" will be created to edit source files.  Find-file will use the
+current frame, whatever that happens to be, but find-file-other-window,
+and selecting source files from the Buffers menu will use an existing frame
+displaying the file in question, or create a new one if there isn't one.
+Call `energize-single-screen-mode' to turn this off.
+See the documentation for the function get-frame-for-buffer for
+information on how to customize this."
+(interactive)
+(energize-multi-screen-mode)
+(remprop 'browser 'instance-limit)
+(remprop 'project 'instance-limit)
+(remprop 'manual  'instance-limit)
+(remprop 'sources 'instance-limit)
+(setq energize-screen-mode 'several)
+t)
+(defun energize-single-screen-mode ()
+"Call this function to put Energize into single-frame mode.
+All buffers will be displayed in the currently selected frame."
+(interactive)
+(remprop 'browser 'instance-limit)
+(remprop 'project 'instance-limit)
+(remprop 'manual  'instance-limit)
+(remprop 'sources 'instance-limit)
+(remprop 'energize-debugger-mode        'frame-name)
+(remprop 'gdb-mode		          'frame-name)
+(remprop 'energize-top-level-mode       'frame-name)
+(remprop 'energize-browser-mode         'frame-name)
+(remprop 'energize-breakpoint-mode      'frame-name)
+(remprop 'energize-project-mode         'frame-name)
+(remprop 'energize-no-file-project-mode 'frame-name)
+(remprop 'energize-log-mode             'frame-name)
+(remprop 'energize-manual-entry-mode    'frame-name)
+(setq get-frame-for-buffer-default-frame-name nil)
+(setq buffers-menu-switch-to-buffer-function 'switch-to-buffer)
+(setq energize-screen-mode 'single)
+nil)
+(energize-single-screen-mode)
+;;; Connecting and disconnecting
+(or energize-attributes-mapping
+(setq energize-attributes-mapping
+	  (purecopy
+	   '((0 . default)
+	     (1 . bold)
+	     (2 . italic)
+	     (3 . bold-italic)
+	     (4 . attributeSmall)
+	     (50 . attributeGlyph)
+	     (51 . attributeSectionHeader)
+	     (52 . attributeToplevelFormGlyph)
+	     (53 . attributeModifiedToplevelFormGlyph)
+	     (54 . attributeBrowserHeader)
+	     (68 . attributeWriteProtected)
+	     (69 . attributeModifiedText)
+	     ))))
+;; Make the faces before emacs is dumped - this should be ok, they will be
+;; initialized from the resource database when the first frame is created.
+(let ((rest energize-attributes-mapping))
+(while rest
+(make-face (cdr (car rest)))
+(setq rest (cdr rest))))
+(defun any-energize-buffers-p ()
+(let ((rest (buffer-list))
+	(result nil))
+(while rest
+(if (energize-buffer-p (car rest))
+	  (setq result (car rest) rest nil)
+	(setq rest (cdr rest))))
+result))
+(defun connect-to-energize (server &optional enarg)
+"Connect this emacs to a Energize server.
+The SERVER argument should be the name of the host that the kernel is
+running on (empty-string for localhost).  It may also be of the form
+``hostname:user'' or ``:user'', meaning to use the server running with
+userid USER."
+(interactive (if (connected-to-energize-p)
+		   (error "Already connected to the server.") ; you bogon.
+		 (list (read-string "connect to energize server: "))))
+(if (connected-to-energize-p)
+(error "Already connected to the server.")) ; you bogon.
+(if (or (null server) (equal server ""))
+(setq server (or (getenv "ENERGIZE_PORT") (system-name))))
+(setq default-frame-name "energize")
+(energize-rename-things)
+(energize-hack-external-editor-mode)
+(let ((energize-disconnect-hook
+	 ;; If we're being run interactively, don't exit emacs if connecting
+	 ;; to Energize fails!  That's damn annoying.
+	 (if (and (interactive-p)
+		  (consp energize-disconnect-hook)
+		  (memq 'save-buffers-kill-emacs energize-disconnect-hook))
+	     (delq 'save-buffers-kill-emacs
+		   (copy-sequence energize-disconnect-hook))
+	   energize-disconnect-hook)))
+(connect-to-energize-internal server enarg)
+;; Wait for the Top-Level buffer to be created.
+;; This really should happen down in C, but...
+(let ((p (or (get-process "energize")
+		 (error "Could not connect to Energize.")))
+	  b)
+(while (progn
+	       (or (connected-to-energize-p)
+		   (error "Energize connection refused."))
+	       (not (setq b (any-energize-buffers-p))))
+	(accept-process-output p))
+;; Make the displayed Energize buffer initially displayed.
+(pop-to-buffer b)
+(delete-other-windows)
+(run-hooks 'energize-connect-hook))))
+(defun disconnect-from-energize ()
+(interactive)
+"Close the connection to energize"
+(close-connection-to-energize))
+;;; Energizing all buffers
+;; After being connected to energize this function energizes all the
+;; buffers that contain files that Energize knows about.
+(defun energize-all-buffers ()
+"Energize any buffer showing a file that the Energize server knows about.
+Has to be called after Emacs has been connected to Energize"
+(if (not (connected-to-energize-p))
+(error "You have to connect to Energize first"))
+(save-window-excursion
+(save-excursion
+(let ((buffers (buffer-list))
+	  (buffers-to-avoid '())
+	  (lock-directory nil)
+	  buffer
+	  filename)
+(while buffers
+	(setq buffer (car buffers))
+	(setq buffers (cdr buffers))
+	(setq filename (buffer-file-name buffer))
+	(set-buffer buffer)
+	(cond
+	 ((and filename
+	       (not (energize-buffer-p buffer))
+	       (energize-query-buffer filename t))
+	  (cond ((buffer-modified-p)
+		 (if (y-or-n-p
+		      (format
+		       "Buffer %s must be saved to be Energized; save it? "
+		       (buffer-name buffer)))
+		     (progn
+		       (set-buffer buffer) ; oh, man...
+		       (save-buffer))
+		   ;; said "no"
+		   (setq buffers-to-avoid (cons buffer buffers-to-avoid))))
+		((and (null (verify-visited-file-modtime buffer))
+		      (file-exists-p filename))
+		 (set-buffer buffer)
+		 (if (y-or-n-p
+		      (format "Buffer %s has changed on disk, revert? "
+			      (buffer-name buffer)))
+		     (progn
+		       (set-buffer buffer)
+		       (revert-buffer nil t))
+		   ;; said "no"
+		   (setq buffers-to-avoid (cons buffer buffers-to-avoid))))
+		;; It's wrong to check to also see if someone else is locking
+		;; the file.  The file is already in the buffer, and the user
+		;; isn't really modifying it -- we're just rewriting it because
+		;; energize likes to do that.  That's why locking should be
+		;; disabled here.
+		)
+	  (if (not (memq buffer buffers-to-avoid))
+	      (progn
+		(message "Energizing buffer %s..." (buffer-name buffer))
+		(find-file-noselect filename))
+	    (message (format "Buffer %s not Energized." (buffer-name buffer)))
+	    (sit-for 1)))))
+(message nil)))))
+(add-hook 'energize-connect-hook 'energize-all-buffers)
+;; This is called when the connection to Energize is lose (for whatever
+;; reason).   We could just run the energize-disconnect-hook from C and
+;; put this function on it, but then the user could hurt themselves.
+;;
+(defun de-energize-all-buffers ()
+(save-excursion
+(let ((buffers (buffer-list))
+	  buffer)
+(while buffers
+	(condition-case condition
+	    (progn
+	      (setq buffer (car buffers))
+	      (set-buffer buffer)
+	      (cond ((not (energize-buffer-p buffer))
+		     nil)
+		    ((eq (energize-buffer-type buffer) 'energize-source-buffer)
+		     (map-extents
+		      (function (lambda (extent ignore)
+				  (if (extent-property extent 'energize)
+				      (delete-extent extent))
+				  nil))
+		      buffer)
+		     (remove-hook 'write-file-data-hooks
+				  'energize-write-data-hook)
+		     (setq revert-buffer-insert-file-contents-function nil)
+		     (ad-Orig-normal-mode-after-energize) ; #### necessary?
+		     )
+		    (t ; non-source-file Energize buffers
+		     (set-buffer-modified-p nil)
+		     (if (eq (other-buffer buffer) buffer)
+			 (set-buffer (get-buffer-create "*scratch*"))
+		       (set-buffer (other-buffer buffer)))
+		     (kill-buffer buffer))))
+	  (error ;; condition-case clause
+	   (beep)
+	   (message "Error while de-Energizing: %s" condition)))
+	(setq buffers (cdr buffers)))))
+;; now clean the menubar
+(deactivate-all-energize-menu-items)
+(energize-rename-things 'back)
+(run-hooks 'energize-disconnect-hook)
+nil)
+(defun energize-rename-things (&optional back)
+;; People who don't like emacs don't like seeing the word "Emacs" either
+(let ((case-fold-search t))
+(if (and (consp mode-line-buffer-identification)
+	     (stringp (car mode-line-buffer-identification))
+	     (string-match (if back "\\bEnergize\\b"
+			     "\\bL?Emacs\\([- \t]*[-._0-9]+\\)?\\b")
+			   (car mode-line-buffer-identification)))
+	(setq-default mode-line-buffer-identification
+		      (cons
+		       (concat (substring (car mode-line-buffer-identification)
+					  0 (match-beginning 0))
+			       (if back "Emacs" "Energize")
+			       (substring (car mode-line-buffer-identification)
+					  (match-end 0)))
+		       (cdr mode-line-buffer-identification))))
+;    (if (stringp frame-title-format)
+;	(if back
+;	    (if (string-match "^Energize\\b ?" frame-title-format)
+;		(setq-default frame-title-format "%S: %b"))
+;	  (or (string-match "Energize" frame-title-format)
+;	      (setq-default frame-title-format "Energize: %b"))))
+)
+nil)
+;;; The kernel is very random about the buffer-types it returns.
+;;; This is a temporary permanent fix...
+(defun energize-buffer-type (buffer)
+"Returns a symbol denoting the type of an Energize buffer, or nil."
+(let ((type (energize-buffer-type-internal buffer)))
+(cond ((eq type 'energize-top-level-buffer)
+	   (cond ((equal "Error Log" (buffer-name buffer))
+		  'energize-error-log-buffer)
+		 ((equal "*includers*" (buffer-name buffer))
+		  'energize-includers-buffer)
+		 ((string-match "^Browser" (buffer-name buffer))
+		  'energize-browser-buffer)
+		 (t type)))
+	  ((eq type 'energize-unspecified-buffer)
+	   (signal 'error (list "buffer type unspecified" buffer)))
+	  ((and (null type) (energize-buffer-p buffer))
+	   (signal 'error
+		   (list "null buffer type for energize buffer" buffer)))
+	  (t type))))
+(defun energize-extent-at (pos &optional buffer)
+(extent-at pos buffer 'energize))
+(defun non-energize-errors-exist-p ()
+;; Whether `next-error' executed right now should do the emacs thing.
+;; If we're in a *grep* or *compile* buffer, always do the emacs thing.
+;; If we're in the Error Log, always do the Energize thing.
+;; Otherwise, do the emacs thing if it would succeed; otherwise do the
+;; Energize thing.
+(or (compilation-buffer-p (current-buffer))			; in *grep*
+(and (not (eq (energize-buffer-type (current-buffer))	; in ErrLog
+		    'energize-error-log-buffer))
+	   ;; defined in compile.el (a XEmacs addition).
+	   (compilation-errors-exist-p))))
+;;; Misc Energize hook functions
+(defvar inside-energize-buffer-creation-hook-function nil)
+(defun energize-buffer-creation-hook-function (buffer)
+;; This loser is called every time Energize wants to create a buffer,
+;; whether it is being spontaniously displayed (as by the debugger) or
+;; as a result of calling find-file -> energize-find-file-noselect ->
+;; energize-query-buffer.
+(let ((inside-energize-buffer-creation-hook-function t))
+;; the above is so we can call this from normal-mode, except when
+;; we're calling normal-mode.
+(save-excursion
+(set-buffer buffer)
+;; Energize always hands us truenames, or something close to them
+;; (it chomps the /tmp_mnt/ automounter cruft off.)  Let the user
+;; set up a pretty translation just like they can for normal files.
+(if buffer-file-name
+	  (setq buffer-file-name (abbreviate-file-name
+				  (expand-file-name buffer-file-name))
+		default-directory (file-name-directory buffer-file-name))
+	(setq default-directory
+	      (abbreviate-file-name (expand-file-name default-directory))))
+(if buffer-file-name (set-buffer-modtime buffer))
+(let ((type (energize-buffer-type buffer)))
+	(cond ((eq type 'energize-top-level-buffer)
+	       (energize-top-level-mode))
+	      ((eq type 'energize-browser-buffer)
+	       (energize-browser-mode))
+	      ((eq type 'energize-includers-buffer)
+	       (energize-browser-mode))
+	      ((or (eq type 'energize-error-log-buffer)
+		   (eq type 'energize-log-file-buffer))
+	       (energize-log-mode)
+	       (setq buffer-read-only t))
+	      ((eq type 'energize-project-buffer)
+	       (if (buffer-file-name)
+		   (energize-project-mode)
+		 (energize-no-file-project-mode)))
+	      ((eq type 'energize-debugger-buffer)
+	       (energize-debugger-mode))
+	      ((eq type 'energize-breakpoint-buffer)
+	       (energize-breakpoint-mode))
+	      ((eq type 'energize-unix-manual-buffer)
+	       (energize-manual-mode))
+	      ((or (eq type 'energize-source-buffer)
+		   ;;(eq type 'energize-unspecified-buffer)
+		   ;;(null type)
+		   )
+	       (compute-buffer-file-truename)
+	       (if (buffer-file-name buffer)
+		   (after-find-file nil t)
+		 (funcall default-major-mode))
+	       )
+	      (t
+	       (signal 'error (list "unknown energize buffer type" type)))))
+(if (eq (energize-buffer-type (current-buffer)) 'energize-source-buffer)
+	  (energize-source-minor-mode))
+(energize-external-editor-set-mode buffer)
+)))
+(setq energize-create-buffer-hook 'energize-buffer-creation-hook-function)
+;;; Buffer modified hook
+(defun energize-send-buffer-modified-1 (start end)
+(if (not (energize-buffer-p (current-buffer)))
+nil
+(map-extents #'(lambda (ext ignore)
+		     (and (extent-property ext 'energize)
+			  (set-extent-face ext 'attributeModifiedText))
+		     nil)
+		 (current-buffer) start end)
+(energize-send-buffer-modified t start end)))
+(add-hook 'before-change-functions 'energize-send-buffer-modified-1)
+;;; Reverting buffers
+;;; This is called when Energize has informed us that a buffer has changed
+;;; on disk, and we need to revert.
+(defun energize-auto-revert-buffer (buf)
+(cond ((not (file-exists-p (buffer-file-name buf)))
+	 ;; Signal an error here?  Naah, let someone else deal with it.
+	 nil)
+	;; If it's not modified, just revert.  If it is modified, ask.
+	((or (not (buffer-modified-p buf))
+	     (yes-or-no-p
+	      (format "File %s changed on disk.  Discard your edits? "
+		      (file-name-nondirectory (buffer-file-name buf)))))
+	 (save-excursion
+	   (set-buffer buf)
+	   (revert-buffer t t)))))
+;;; Energize kernel busy hook
+(defun energize-message-if-not-in-minibuffer (reason)
+(if (not (eq (selected-window) (minibuffer-window)))
+(message reason)))
+(setq energize-kernel-busy-hook 'energize-message-if-not-in-minibuffer)
+;;; set-buffer-modified-p hook
+(defun energize-send-buffer-modified-2 (state start end)
+(if (not (energize-buffer-p (current-buffer)))
+nil
+(if (not state)
+	;; If we're unmodifying the buffer, un-highlight all Energize extents.
+	(let ((e (next-extent (current-buffer))))
+	  (while e
+	    (if (and (extent-property e 'energize)
+		     (eq (extent-face e) 'attributeModifiedText))
+		(set-extent-face e nil))
+	    (setq e (next-extent e)))))
+(energize-send-buffer-modified state start end)))
+(setq energize-buffer-modified-hook 'energize-send-buffer-modified-2)
+;;; hook in editorside.c
+(setq energize-kernel-modification-hook nil)
+;; command line
+(defconst energize-args '(("-energize"	 . command-line-process-energize)
+			  ("-context"	 . command-line-process-energize-1)
+			  ("-beam-me-up" . command-line-process-energize-1)))
+(setq command-switch-alist (append command-switch-alist energize-args))
+(fset 'command-line-process-energize 'command-line-process-energize-1)
+(put 'command-line-process-energize-1 'undocumented t)
+(defun command-line-process-energize-1 (arg)
+"Connect to the Energize server at $ENERGIZE_PORT."
+(let ((e-arg (car command-line-args-left))
+	(e-host (getenv "ENERGIZE_PORT"))) ; maybe nil
+(if (and e-arg (string-match "\\`[0-9a-fA-F]+[,][0-9a-fA-F]+\\'" e-arg))
+	(setq command-line-args-left (cdr command-line-args-left))
+(setq e-arg nil))
+(message "Connecting to Energize...")
+(sit-for 0)
+(condition-case ()
+	(connect-to-energize e-host e-arg)
+(error
+(beep)
+(if e-host
+	   (message "Failed to connect to Energize at %s." e-host)
+	 (message "Failed to connect to Energize."))
+(sit-for 1)))))
+;;; Originally defined in frame.el
+;;; If we're being invoked with -energize, then set the default
+;;; frame name to "energize"
+;;; This is a total kludge; there ought to be a hook that gets
+;;; run before the first frame is created (either before or
+;;; after term/x-win.el is loaded.)
+(or (fboundp 'energize-orig-frame-initialize)
+(fset 'energize-orig-frame-initialize
+	  (symbol-function 'frame-initialize)))
+(defun frame-initialize ()
+(if (let ((rest energize-args))
+	(catch 'done
+	  (while rest
+	    (if (member (car (car rest)) command-line-args)
+		(throw 'done t))
+	    (setq rest (cdr rest)))
+	  nil))
+(setq default-frame-name "energize"))
+(energize-orig-frame-initialize))
+(defun energize-x-initializations ()
+(cond ((not noninteractive)
+	 (energize-define-function-keys)
+	 (energize-configure-font-lock-mode t (not (x-color-display-p)) t)
+	 ;; faces will be initialized from the resource database when the first
+	 ;; frame is created.
+	 (let ((rest energize-attributes-mapping))
+	   (while rest
+	     (make-face (cdr (car rest)))
+	     (setq rest (cdr rest))))
+	 )))
+;; Do these bindings after connecting to the X server, but before
+;;; loading any init files, so that init files can override them.
+(add-hook 'before-init-hook 'energize-x-initializations)

Mercurial > hg > xemacs-beta

comparison lisp/energize/energize-init.el @ 0:376386a54a3c r19-14