diff lisp/energize/energize-menus.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/energize/energize-menus.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,1207 @@
+;;; -*- Mode:Emacs-Lisp -*-
+;;; Copyright (C) 1992, 1993, 1994 by Lucid, Inc.  All Rights Reserved.
+;;; Copyright (C) 1995 by INS Engineering.
+
+;;; The names of the menu items (as emacs sees them) are short and ugly.
+;;; These are the names by which the Energize protocol knows the commands.
+;;; The menu items are made to display in a more human-friendly way via the
+;;; X resource database, which is expected to contain entries like
+;;;
+;;;	*buildanddebug.labelString:	Build and Debug
+;;;
+;;; in the Emacs app-defaults file.
+;;;
+;;; We need to map these short Energize-names to the functions which invoke
+;;; them; we do this via the energize-menu-item-table, which is an obarray
+;;; hash table associating the names with the functions.  We do the reverse
+;;; association via an 'energize-name property on the function's name symbol.
+;;;
+;;; Sometimes the short ugly names show up in error messages; probably we
+;;; should read the resource database to get the pretty names.
+
+(require 'menubar)
+
+(defvar sc-mode nil)		; just so it has a value even if not loaded
+(defvar font-lock-mode nil)	; likewise
+
+(defconst energize-menu-item-table (make-vector 511 nil)
+  "obarray used for fast mapping of symbolic energize request-names to the 
+functions that invoke them.")
+
+(defvar energize-default-menu-state ()
+  "List of the Energize menu items associated with every buffers.")
+
+(defvar energize-menu-state ()
+  "Buffer local variable listing the menu items associated with a buffer.")
+
+;; When it is made local, don't kill it when kill-all-local-variables is
+;; called (as from the major mode via revert-buffer) or else we tend to lose
+;; the information, as the ProposeChoicesRequest comes in at an inopportune
+;; time.
+(put 'energize-menu-state 'permanent-local t)
+
+;;; Hook to update the menu state when the kernel tells us it changed
+
+(defun energize-update-menu-state (items)
+  (let ((buffer (car items))
+	(previous-buffer (current-buffer)))
+    (if (null buffer)
+	(setq energize-default-menu-state items)
+      (unwind-protect
+	  (progn
+	    (set-buffer buffer)
+	    (setq energize-menu-state items))
+	(set-buffer previous-buffer)))))
+
+(setq energize-menu-update-hook 'energize-update-menu-state)
+
+;;; The energize-with-timeout macro is used to show to the user that we are 
+;;; waiting for a reply from the energize kernel when it is too slow.
+
+(defvar initial-energize-timeout-state
+  (let ((l '("." ".." "..." "...." "....." "......" "......." "........")))
+    (nconc l l)))
+
+(defvar energize-timeout-state initial-energize-timeout-state)
+
+(defun energize-warn-kernel-slow (pair)
+  (setq energize-timeout-state (cdr energize-timeout-state))
+  (message "%s Type %c to cancel%s"
+	   (car pair) (quit-char) (car energize-timeout-state))
+  (rplacd pair t))
+
+(defmacro energize-with-timeout (notice &rest body)
+  (list 'let* (list
+	       (list 'timeout-pair (list 'cons notice nil))
+	       '(timeout (add-timeout 1.5 'energize-warn-kernel-slow
+				      timeout-pair 1.5)))
+	(list 'unwind-protect (cons 'progn body)
+	      '(disable-timeout timeout)
+	      '(setq energize-timeout-state initial-energize-timeout-state)
+	      '(if (cdr timeout-pair) (message "")))))
+
+(defun energize-def-menu-item (name function &optional dont-define)
+  ;; function->name mapping is on the function name's plist
+  ;; name->function mapping is via an obarray
+  ;; dont-define means it already has a function definition
+  (put function 'energize-name (purecopy name))
+  (set (intern name energize-menu-item-table) function)
+  ;; Define the (trivial) function
+  ;; It's ok that this function is interpreted, because it contains only
+  ;; one function call with constant args, so it's just as fast as it would
+  ;; be if it were byte-coded.
+  (if (not dont-define)
+      (fset function
+	    (purecopy
+	     (` (lambda ()
+		  (, (format "Executes the Energize \"%s\" command." name))
+		  (interactive)
+		  (energize-execute-command (, name)))))))
+  ;; Return the menu-item descriptor.
+  (vector (purecopy name) function nil nil))
+
+(defmacro energize-def-menu (menu-name &rest items)
+  (` (list (, menu-name)
+	   (,@ (mapcar
+		'(lambda (x)
+		   (if (and (consp x) (stringp (car x)))
+		       (cons 'energize-def-menu-item
+			     (mapcar '(lambda (xx)
+					(if (stringp xx)
+					    (purecopy xx)
+					  (list 'quote xx)))
+				     x))
+		     x))
+		items)))))
+
+(put 'energize-def-menu 'lisp-indent-function 1)
+
+
+;; If menubar-religion is 'winning, the menubar looks like jwz likes it.
+;; If menubar-religion is 'losing, the menubar looks like Gareth and the
+;; documentation folks like it.  See also menubar.el - it consults this
+;; variable for the layout of the File menu which is inherited here.
+
+(defconst energize-menubar
+ (purecopy-menubar
+  (list
+   ["sheet" energize-toggle-psheet nil]
+
+   ;; Perform some surgery on the default File menu to insert our items.
+   ;; This is to avoid having to duplicate it here...  Don't try this at
+   ;; home, kids!
+;;;   (let* ((file (copy-sequence
+;;;                 (car (find-menu-item default-menubar '("File")))))
+;;;          (print (car (find-menu-item file '("Print Buffer"))))
+;;;          (exit  (car (find-menu-item file '("Exit XEmacs"))))
+;;;          (print-cons (memq print file))
+;;;          (exit-cons  (memq exit file))
+;;;          )
+;;;     ;; Insert "Print Annotated" just after "Print"
+;;;     (setcdr print-cons (cons '["Print Annotated Buffer"
+;;;                                energize-annotate-print-ps
+;;;                                t]
+;;;                              (cdr print-cons)))
+;;;
+;;;     ;; Insert "Checkpoint" and "Shutdown" just before "Exit XEmacs".
+;;;     (setcar exit-cons ["Connect to Energize" energize-menu-connect-directly
+;;;                         (not (connected-to-energize-p))])
+;;;     (setcdr exit-cons
+;;;             (nconc
+;;;              (list (energize-def-menu-item "checkpoint"
+;;;                                            'energize-checkpoint-database)
+;;;                    ["Disconnect from Energize" disconnect-from-energize
+;;;                     (connected-to-energize-p)]
+;;;                    "----"
+;;;                    (energize-def-menu-item "energizeShutdownServer"
+;;;                                            'energize-kill-server)
+;;;                    )
+;;;              (if (not (eq menubar-religion 'winning))
+;;;                  (list "----"))
+;;;              (list exit)))
+;;;     file)
+   ;; this is the losing menubar-religion...
+   (` ("File"
+       ["New Frame" make-frame t]
+       ["Open..." find-file t]
+       ["Save" save-buffer nil "menubar.el"]
+       ["Save As..." write-file t]
+       ["Save Some Buffers" save-some-buffers t]
+       "------"
+       ["Insert File..." insert-file t]
+       "-----"
+       ["Print Buffer" lpr-buffer t nil]
+       ["Print Annotated Buffer" energize-annotate-print-ps t]
+       "-----"
+       ["Delete Frame" delete-frame t]
+       ["Kill Buffer" kill-this-buffer t nil]
+       ["Revert Buffer" revert-buffer t nil]
+       "-----"
+       ("Compare"
+	["Two Files ..."	    	ediff-files 	    	 t]
+	["Two Buffers ..."	ediff-buffers		 t]
+	["Three Files ..."	ediff-files3		 t]
+	["Three Buffers ..."	ediff-buffers3		 t]
+	["Windows ..."		ediff-windows		 t]
+	["Small Regions ..."	ediff-small-regions	 t]
+	["Large Regions ..."	ediff-large-regions	 t]
+	["File with Revision ..." ediff-revision		 t])
+       ("Merge"
+	["Files ..." 	    	ediff-merge-files   	 t]
+	["Files with Ancestor ..." ediff-merge-files-with-ancestor t]
+	["Buffers ..."	        ediff-merge-buffers      t]
+	["Buffers with Ancestor ..." ediff-merge-buffers-with-ancestor t]
+	["Revisions ..."		ediff-merge-revisions    t]
+	["Revisions with Ancestor ..." ediff-merge-revisions-with-ancestor t]
+	)
+       ("Apply Patch"
+	["To a file ..."	    	ediff-patch-file    	 t]
+	["To a buffer ..."	ediff-patch-buffer	 t])
+       "-----"
+       ["Connect to Energize" energize-menu-connect-directly
+	(not (connected-to-energize-p))]
+       (, (energize-def-menu-item "checkpoint" 'energize-checkpoint-database))
+       ["Disconnect from Energize" disconnect-from-energize
+	(connected-to-energize-p)]
+       "----"
+       (, (energize-def-menu-item "energizeShutdownServer" 'energize-kill-server))
+       "----"
+       ["Exit XEmacs" save-buffers-kill-emacs t]))
+
+   ;; Energize also adds some menu items to the middle of the "Edit" menu.
+   ;; Someday these should be moved to the default menubar, maybe, once it's
+   ;; easier to define `energize-search' in a non-Energize world.
+   (let* ((edit (copy-sequence
+		 (car (find-menu-item default-menubar '("Edit")))))
+	  (clear (car (find-menu-item edit '("Clear"))))
+	  (clear-cons (memq clear edit))
+	  )
+     ;; Insert these just after "Clear"
+     (setcdr clear-cons
+	     (append '("-----"
+		       ["Search and Replace..." energize-search t]
+		       ["Search Selection Forward" ow-find
+			(or ow-find-last-string (x-selection-owner-p))]
+		       ["Search Selection Backward" ow-find-backward
+			(or ow-find-last-string (x-selection-owner-p))]
+		       )
+		     (cdr clear-cons)))
+     edit)
+
+    (energize-def-menu "Browse" 
+     ["editdef" energize-edit-definition t]
+     ("editdec" energize-edit-declaration-dbox)
+     ("calltreebrowser" energize-browse-tree)
+     ("classbrowser" energize-browse-class)
+     ("lebrowser" energize-browse-language-elt)
+     ("includers" energize-where-included)
+     "-----" 
+
+     ;; Make Energize control the selectability of these, but don't define
+     ;; the functions here (they are defined in lisp, not as aliases for
+     ;; an Energize command.)
+
+     ;; No, this doesn't seem to work. Energize disowns all knowledge.
+     ["visituse" energize-next-use-start (connected-to-energize-p)]
+     ["nextuse" energize-next-use-command (connected-to-energize-p)]
+     "-----" 
+     ["List History" energize-history (connected-to-energize-p)]
+     ["Step Back in History" energize-history-previous (connected-to-energize-p)]
+     "-----"
+     ("energize" energize-pop-to-energize-buffer)
+     ("showsystemlog"	energize-browse-system-log)
+     ("errorbrowser" energize-browse-error)
+     "-----"
+     ("toolstatus"	energize-browse-toolstat)
+     ["Shell" shell t]
+     )
+
+ (if (eq menubar-religion 'winning)
+
+    (list
+     ;; Winning
+     "Options"
+     (energize-def-menu-item "debuggerpanel" 'energize-show-debugger-panel)
+     "------"
+     ["Read Only" toggle-read-only :style toggle :selected buffer-read-only]
+     ["Case Sensitive Search" (setq case-fold-search (not case-fold-search))
+      :style toggle :selected (not case-fold-search)]
+     ["Case Sensitive Replace" (setq case-replace (not case-replace))
+      :style toggle :selected (not case-replace)]
+     ["Overstrike" overwrite-mode :style toggle :selected overwrite-mode]
+     ["Auto Delete Selection" (if (memq 'pending-delete-pre-hook
+					pre-command-hook)
+				  (pending-delete-off nil)
+				(pending-delete-on nil))
+      :style toggle :selected (memq 'pending-delete-pre-hook pre-command-hook)]
+     ["Teach Extended Commands" (setq teach-extended-commands-p
+				      (not teach-extended-commands-p))
+      :style toggle :selected teach-extended-commands-p]
+     ["Debug On Error" (setq debug-on-error (not debug-on-error))
+      :style toggle :selected debug-on-error]
+;     ["Line Numbers" (line-number-mode nil)
+;      :style toggle :selected line-number-mode]
+     (append '("Syntax Highlighting" 
+       ["None" (font-lock-mode 0) :style radio :selected (null font-lock-mode)])
+	     (and (not (string-match "Widec" emacs-version))
+		  (list ["Fonts" (progn (require 'font-lock)
+		       (font-lock-use-default-fonts)
+		       (font-lock-mode 1))
+       :style radio
+       :selected (and font-lock-mode
+		      (equal (find-face 'italic)  ; kind of a kludge...
+			     (find-face 'font-lock-comment-face)))]))
+	     '(
+      ["Colors" (progn (require 'font-lock)
+		       (font-lock-use-default-colors)
+		       (font-lock-mode 1))
+       :style radio
+       :selected (and font-lock-mode
+		      (not (equal (find-face 'italic)
+				  (find-face 'font-lock-comment-face))))]
+      "-----"
+      ["Less" (progn (require 'font-lock)
+		     (font-lock-use-default-minimal-decoration)
+		     (font-lock-mode 0)
+		     (font-lock-mode 1))
+       :style radio
+       :selected (and font-lock-mode
+		      (eq c++-font-lock-keywords c-font-lock-keywords-1))]
+      ["More" (progn (require 'font-lock)
+		     (font-lock-use-default-maximal-decoration)
+		     (font-lock-mode 0)
+		     (font-lock-mode 1))
+       :style radio
+       :selected (and font-lock-mode
+		      (eq c++-font-lock-keywords c-font-lock-keywords-2))]
+      "-----"
+      ["Fast" (progn (require 'fast-lock)
+		     (if fast-lock-mode
+			 (progn
+			   (fast-lock-mode 0)
+			   ;; this shouldn't be necessary so there has to
+			   ;; be a redisplay bug lurking somewhere (or
+			   ;; possibly another event handler bug)
+			   (force-mode-line-update))
+		       (if font-lock-mode
+			   (progn
+			     (fast-lock-mode 1)
+			     (force-mode-line-update)))))
+       :active font-lock-mode
+       :style toggle
+       :selected fast-lock-mode]
+      ))
+     '("Paren Highlighting"
+       ["None" (paren-set-mode -1)
+	:style radio :selected (not paren-mode)]
+       ["Blinking Paren" (paren-set-mode 'blink-paren)
+	:style radio :selected (eq paren-mode 'blink-paren)]
+       ["Steady Paren" (paren-set-mode 'paren)
+	:style radio :selected (eq paren-mode 'paren)]
+       ["Expression" (paren-set-mode 'sexp)
+	:style radio :selected (eq paren-mode 'sexp)]
+       ["Nested Shading" (paren-set-mode 'nested)
+	:style radio :selected (eq paren-mode 'nested) :enabled nil]
+       )
+     "------"
+     '("Font"	"initialized later")
+     '("Size"	"initialized later")
+     '("Weight"	"initialized later")
+     ["Edit faces" edit-faces t]
+     "-----"
+     ["Energize Edit Modes..." energize-set-edit-modes t]
+     (energize-def-menu-item "setprojectdisplay"
+			     'energize-set-project-display)
+     (list "Target Display"
+	   (energize-def-menu-item "fulltargets"
+				   'energize-full-targets)
+	   (energize-def-menu-item "abbreviatetargets"
+				   'energize-abbreviate-targets))
+     '("Source Control"
+       ["None" (sc-mode nil)   :style radio :selected (eq sc-mode nil)]
+       ["SCCS" (sc-mode 'SCCS) :style radio :selected (eq sc-mode 'SCCS)]
+       ["RCS"  (sc-mode 'RCS)  :style radio :selected (eq sc-mode 'RCS)]
+       ["CVS"  (sc-mode 'CVS)  :style radio :selected (eq sc-mode 'CVS)]
+       ["ClearCase" (sc-mode 'CCASE):style radio :selected (eq sc-mode 'CCASE)]
+       )
+     "-----"
+     ["Buffers Menu Length..."
+      (progn
+	(setq buffers-menu-max-size
+	      (read-number
+	       "Enter number of buffers to display (or 0 for unlimited): "))
+	(if (eq buffers-menu-max-size 0) (setq buffers-menu-max-size nil)))
+      t]
+     ["Buffers Sub-Menus" (setq complex-buffers-menu-p
+				(not complex-buffers-menu-p))
+      :style toggle :selected complex-buffers-menu-p]
+     "-----"
+     ["Save Options" save-options-menu-settings t]
+     )
+
+    (list
+     ;; Non-winning
+     "Options" 
+     ["Split Screen"		split-window-vertically t]
+     ["Unsplit"			delete-other-windows	t]
+     "------"
+     (energize-def-menu-item "debuggerpanel" 'energize-show-debugger-panel)
+     "------"
+     ["Read Only" toggle-read-only :style toggle :selected buffer-read-only]
+     ["Overstrike " overwrite-mode :style toggle :selected overwrite-mode]
+     ["Auto Delete Selection" (if (memq 'pending-delete-pre-hook
+					pre-command-hook)
+				  (pending-delete-off nil)
+				(pending-delete-on nil))
+      :style toggle :selected (memq 'pending-delete-pre-hook pre-command-hook)]
+     ["Teach Extended" (setq teach-extended-commands-p
+			     (not teach-extended-commands-p))
+      :style toggle :selected teach-extended-commands-p]
+     "------"
+     '("Font"	"initialized later")
+     '("Size"	"initialized later")
+     '("Weight"	"initialized later")
+     "------"
+     (append '("Syntax Highlighting" 
+       ["None" (font-lock-mode 0) :style radio :selected (null font-lock-mode)])
+	     (and (not (string-match "Widec" emacs-version))
+		  (list ["Fonts" (progn (require 'font-lock)
+		       (font-lock-use-default-fonts)
+		       (font-lock-mode 1))
+       :style radio
+       :selected (and font-lock-mode
+		      (equal (find-face 'italic)  ; kind of a kludge...
+			     (find-face 'font-lock-comment-face)))]))
+	     '(
+      ["Colors" (progn (require 'font-lock)
+		       (font-lock-use-default-colors)
+		       (font-lock-mode 1))
+       :style radio
+       :selected (and font-lock-mode
+		      (not (equal (find-face 'italic)
+				  (find-face 'font-lock-comment-face))))]
+      "-----"
+      ["Less" (progn (require 'font-lock)
+		     (font-lock-use-default-minimal-decoration)
+		     (font-lock-mode 0)
+		     (font-lock-mode 1))
+       :style radio
+       :selected (and font-lock-mode
+		      (eq c++-font-lock-keywords c-font-lock-keywords-1))]
+      ["More" (progn (require 'font-lock)
+		     (font-lock-use-default-maximal-decoration)
+		     (font-lock-mode 0)
+		     (font-lock-mode 1))
+       :style radio
+       :selected (and font-lock-mode
+		      (eq c++-font-lock-keywords c-font-lock-keywords-2))]
+      "-----"
+      ["Fast" (progn (require 'fast-lock)
+		     (if fast-lock-mode
+			 (progn
+			   (fast-lock-mode 0)
+			   ;; this shouldn't be necessary so there has to
+			   ;; be a redisplay bug lurking somewhere (or
+			   ;; possibly another event handler bug)
+			   (force-mode-line-update))
+		       (if font-lock-mode
+			   (progn
+			     (fast-lock-mode 1)
+			     (force-mode-line-update)))))
+       :active font-lock-mode
+       :style toggle
+       :selected fast-lock-mode]
+      ))
+
+     '("Paren Highlighting"
+       ["None" (blink-paren 0)
+	:style radio
+	:selected (not (memq 'blink-paren-pre-command pre-command-hook))]
+       ["Blink" (progn
+		  (setq highlight-paren-expression nil)
+		  (blink-paren 1))
+	:style radio
+	:selected (and (not highlight-paren-expression)
+		       (memq 'blink-paren-pre-command pre-command-hook))]
+       ["Highlight" (progn
+		      (setq highlight-paren-expression t)
+		      (blink-paren 1))
+	:style radio
+	:selected (and highlight-paren-expression
+		       (memq 'blink-paren-pre-command pre-command-hook))]
+       )
+     "-----"
+     ["Energize Edit Modes..." energize-set-edit-modes t]
+     (energize-def-menu-item "setprojectdisplay"
+			     'energize-set-project-display)
+     (list "Target Display"
+	   (energize-def-menu-item "fulltargets"
+				   'energize-full-targets)
+	   (energize-def-menu-item "abbreviatetargets"
+				   'energize-abbreviate-targets))
+     "-----"
+     ["Buffers Length..."
+      (progn
+	(setq buffers-menu-max-size
+	      (read-number
+	       "Enter number of buffers to display (or 0 for unlimited): "))
+	(if (eq buffers-menu-max-size 0) (setq buffers-menu-max-size nil)))
+      t]
+     ["Buffers Menus" (setq complex-buffers-menu-p
+			    (not complex-buffers-menu-p))
+      :style toggle :selected complex-buffers-menu-p]
+     "-----"
+     '("Source Control"
+       ["None" (sc-mode nil)   :style radio :selected (eq sc-mode nil)]
+       ["SCCS" (sc-mode 'SCCS) :style radio :selected (eq sc-mode 'SCCS)]
+       ["RCS"  (sc-mode 'RCS)  :style radio :selected (eq sc-mode 'RCS)]
+       ["CVS"  (sc-mode 'CVS)  :style radio :selected (eq sc-mode 'CVS)]
+       ["ClearCase" (sc-mode 'CCASE):style radio :selected (eq sc-mode 'CCASE)]
+       )
+     "-----"
+     ["Save Options" save-options-menu-settings t]
+     )
+       
+    )
+
+ (if (eq menubar-religion 'winning)
+
+   (energize-def-menu "Debug"
+     ;; Winning
+     ("debugprogram"	energize-debug-target)
+     ("runprogram"	energize-run-target)
+     "-----"
+     ;; Make Energize control the selectability of the setbreakpoint item, but
+     ;; don't define the function here (it just runs the existing gdb-break
+     ;; command, which is advised to hack Energize.)
+     ("setbreakpoint"	gdb-break t)
+     ("breaklist"	energize-list-breakpoints)
+     "-----"
+     ["Next Error" next-error t]
+     ["Previous Error" previous-error
+      :keys "\\[universal-argument] \\[next-error]"]
+     ("errorbrowser" energize-browse-error)
+     ("clearerrorlog" energize-clear-error-log)
+     ("cleardebuggerlog"	energize-clear-debugger-log)
+     "-----" 
+     ("closeprogram"	energize-debugger-kill-program)
+     ("quitdebugger"	energize-quit-debugger)
+     )
+
+   (energize-def-menu "Debug"
+     ;; Non-winning
+     ("debugprogram"	energize-debug-target)
+     ("runprogram"	energize-run-target)
+     "-----"
+     ;; Make Energize control the selectability of the setbreakpoint item, but
+     ;; don't define the function here (it just runs the existing gdb-break
+     ;; command, which is advised to hack Energize.)
+     ("setbreakpoint"	gdb-break t)
+     "-----"
+     ("debuggerpanel"	energize-show-debugger-panel)
+     "-----"
+     ("breaklist"	energize-list-breakpoints)
+     ("cleardebuggerlog"	energize-clear-debugger-log)
+     "-----"
+     ("errorbrowser" energize-browse-error)
+     ("clearerrorlog" energize-clear-error-log)
+     "-----" 
+     ["Next Error" next-error t]
+     ["Previous Error" previous-error
+      :keys "\\[universal-argument] \\[next-error]"]
+     "-----"
+     ("closeprogram"	energize-debugger-kill-program)
+     "-----"
+     ("quitdebugger"	energize-quit-debugger)
+     )
+   )
+
+ (if (eq menubar-religion 'winning)
+
+   (energize-def-menu "Compile"
+     ;; Winning
+     ("buildatarget" energize-build-a-target)
+     ("custombuildatarget" energize-custom-build-a-target)
+;; Matthieu believed that this could be done now; however it would seem that
+;; it still can't. So out it goes for the time being.
+;;     "-----" 
+;;     ("Terminate Build"  energize-abort-build)
+     "-----"
+     ["Next Error" next-error t]
+     ["Previous Error" previous-error
+      :keys "\\[universal-argument] \\[next-error]"]
+     ("errorbrowser" energize-browse-error)
+     ("clearerrorlog" energize-clear-error-log)
+     "-----"
+     ("defaultcompile" energize-default-compile-file)
+     ("custombuildfile" energize-custom-build-file)
+     "-----" 
+     ("deleteallobjects" energize-delete-object-files)
+     )
+
+   (energize-def-menu "Compile" 
+     ;; Non-winning
+     ("buildatarget" energize-build-a-target)
+     ("custombuildatarget" energize-custom-build-a-target)
+     "-----"
+     ("defaultcompile" energize-default-compile-file)
+     ("custombuildfile" energize-custom-build-file)
+     "-----"
+     ("errorbrowser" energize-browse-error)
+     ("clearerrorlog" energize-clear-error-log)
+     "-----" 
+     ["Next Error" next-error t]
+     ["Previous Error" previous-error
+      :keys "\\[universal-argument] \\[next-error]"]
+;; Matthieu believed that this could be done now; however it would seem that
+;; it still can't. So out it goes for the time being.
+;;     "-----" 
+;;     ("Terminate Build"  energize-abort-build)
+     "-----" 
+     ("deleteallobjects" energize-delete-object-files)
+     )
+   )
+
+ (if (eq menubar-religion 'winning)
+
+   (list "Project"
+     ;; Winning
+     (energize-def-menu-item "newproject" 'energize-new-project)
+     (energize-def-menu-item "findproject" 'energize-find-project)
+     ["Save Project" save-buffer (eq major-mode 'energize-project-mode)]
+     ["Current Project" energize-pop-to-project-buffer nil nil]
+     (energize-def-menu-item "energize" 'energize-pop-to-energize-buffer)
+     "-----"
+     '("addprojectentry"
+       ["addobjectfiletarget"	energize-insert-object-file-target
+       				(eq major-mode 'energize-project-mode)]
+       "-----"
+       ["addexecutabletarget"	energize-insert-executable-target
+       				(eq major-mode 'energize-project-mode)]
+       ["addlibrarytarget"	energize-insert-library-target
+       				(eq major-mode 'energize-project-mode)]
+       ["addcollectiontarget"	energize-insert-collection-target
+				(eq major-mode 'energize-project-mode)]
+       "-----"
+       ["addtargettarget"	energize-insert-target-target
+       				(eq major-mode 'energize-project-mode)]
+       ["addfiletarget"		energize-insert-file-target
+       				(eq major-mode 'energize-project-mode)]
+       "-----"
+       ["addrule"		energize-insert-rule
+	                        (eq major-mode 'energize-project-mode)]
+      )
+     (energize-def-menu-item "instrumentatarget" 'energize-instrument-a-target)
+     "-----"
+     (energize-def-menu-item "importproject" 'energize-import-project)
+     (energize-def-menu-item "importprojectlist" 'energize-import-project-list)
+     (energize-def-menu-item "writeprojectlist" 'energize-write-project-list)
+     "-----"
+     (energize-def-menu-item "setprojectdisplay"
+			     'energize-set-project-display)
+     (list "Target Display"
+	   (energize-def-menu-item "fulltargets"
+				   'energize-full-targets)
+	   (energize-def-menu-item "abbreviatetargets"
+				   'energize-abbreviate-targets))
+     "-----"
+     (energize-def-menu-item "revertproject"
+			     'energize-fully-revert-project-buffer)
+     )
+
+   (list "Project"
+     ;; Non-winning
+     (energize-def-menu-item "newproject" 'energize-new-project)
+     (energize-def-menu-item "findproject" 'energize-find-project)
+     ["Save Project" save-buffer (eq major-mode 'energize-project-mode)]
+     "-----"
+     (energize-def-menu-item "energize" 'energize-pop-to-energize-buffer)
+     ["Current Project" energize-pop-to-project-buffer nil nil]
+     "-----"
+     ["New C/C++ File"		energize-insert-object-file-target
+       				(eq major-mode 'energize-project-mode)]
+     '("addprojectentry"
+       ["addobjectfiletarget"	energize-insert-object-file-target
+       				(eq major-mode 'energize-project-mode)]
+       "-----"
+       ["addexecutabletarget"	energize-insert-executable-target
+       				(eq major-mode 'energize-project-mode)]
+       ["addlibrarytarget"	energize-insert-library-target
+       				(eq major-mode 'energize-project-mode)]
+       ["addcollectiontarget"	energize-insert-collection-target
+				(eq major-mode 'energize-project-mode)]
+       "-----"
+       ["addtargettarget"	energize-insert-target-target
+       				(eq major-mode 'energize-project-mode)]
+       ["addfiletarget"		energize-insert-file-target
+       				(eq major-mode 'energize-project-mode)]
+       "-----"
+       ["addrule"		energize-insert-rule
+	                        (eq major-mode 'energize-project-mode)]
+      )
+     "-----"
+     (energize-def-menu-item "instrumentatarget" 'energize-instrument-a-target)
+     "-----"
+     (energize-def-menu-item "importproject" 'energize-import-project)
+     (energize-def-menu-item "importprojectlist" 'energize-import-project-list)
+     "-----"
+     (energize-def-menu-item "writeprojectlist" 'energize-write-project-list)
+     "-----"
+     (energize-def-menu-item "setprojectdisplay"
+			     'energize-set-project-display)
+     (list "Target Display"
+	   (energize-def-menu-item "fulltargets"
+				   'energize-full-targets)
+	   (energize-def-menu-item "abbreviatetargets"
+				   'energize-abbreviate-targets))
+     "-----"
+     (energize-def-menu-item "revertproject"
+			     'energize-fully-revert-project-buffer)
+     )
+   )
+
+
+    '("Buffers"	["List All Buffers" list-buffers t]
+		"--!here"		; anything after this will be nuked
+		)
+
+    nil		; the partition: menus after this are flushright
+
+    ;; We don't make any changes to the Help menu.
+    ;; WelcomeMat requires one change: added separately though
+    (car (find-menu-item default-menubar '("Help")))
+    )))
+
+;; For this command, the menu name (the resource) is "currentproject"
+;; but the Energize command is "project".  the Energize command is 
+;; historical, and the resource name was changed so that the "Project"
+;; menu and the "Project" menu item don't necessarily have to be the
+;; same text.
+;;
+(energize-def-menu-item "project" 'energize-pop-to-project-buffer)
+
+;; code for tighter integration with specific tools
+
+(defun energize-menu-connect-directly ()
+  (interactive)
+  (connect-to-energize nil))
+
+(defvar energize-instrument-menu-options nil
+  "List of menu items which are instruments for Energize targets")
+
+(defun energize-define-instrumentatarget-using-tool (tool)
+  "Add a menu item (and function) supporting instrumenting a particular tool"
+  (let ((function (intern (concat "energize-instrumentatarget-using-" tool)))
+	(l energize-instrument-menu-options)
+	(name (if (equal tool "") "DBX Compatible" (capitalize tool))))
+    (add-menu-item '("Project") (cons name "")
+		   function
+		   '(connected-to-energize-p)
+		   "instrumentatarget")
+    (add-hook 'energize-hack-popup-hook 'energize-hack-instruments-in-popup)
+    (while (and l (not (equal (car l) tool)))
+      (setq l (cdr l)))
+    (if (null l) (setq energize-instrument-menu-options
+		       (cons tool energize-instrument-menu-options)))
+    (fset function
+	  (` (lambda ()
+	       (, (format "Instruments a target using \"%s\"" tool))
+	       (interactive)
+	       (energize-execute-command "instrumentatarget" nil
+					 (, tool) t))))))
+
+(defun energize-hack-instruments-in-popup (ex m)
+  (let ((l (cdr m)))
+    (while l
+      (if (equal (aref (car l) 0) "instrument")
+	  (let ((r energize-instrument-menu-options)
+		v)
+	    (while r
+	      (setq v (vconcat (car l)))
+	      (let ((name
+		     (if (equal (car r) "") "DBX Compatible"
+		       (capitalize (car r)))))
+		  (aset (car l) 0 name)) 
+	      (aset (car l) 1 (intern (concat
+				       "energize-instrumentatarget-using-"
+				       (car r))))
+	      (setcdr l (cons v (cdr l)))
+	      (setq r (cdr r)))
+	    (setq l nil))
+	(setq l (cdr l))))
+    m))
+
+(defun energize-sensitize-instruments-hook ()
+  "Sensitize the menubar by adding the executable to any derived
+instrumented targets"
+  (condition-case nil ; in case Project menu doesn't exist
+      (let* ((l energize-instrument-menu-options)
+	     (institem
+	      (car (find-menu-item current-menubar
+				   '("Project" "instrumentatarget"))))
+	     (exenable (aref institem 2))
+	     (exname (aref institem 3))
+	     item)
+	(while l
+	  (let ((citem (if (equal (car l) "") "DBX Compatible" (car l))))
+	    (setq item (car (find-menu-item current-menubar
+					    (list "Project" citem)))))
+	  (aset item 2 exenable)
+	  (aset item 3 exname)
+	  (setq l (cdr l))))
+    (error nil)))
+
+(defun energize-set-default-menubar ()
+  (set-menubar energize-menubar)
+  (add-hook 'activate-menubar-hook 'build-buffers-menu-hook)
+  (add-hook 'activate-menubar-hook 'sensitize-file-and-edit-menus-hook)
+  (add-hook 'activate-menubar-hook 'energize-sensitize-instruments-hook 't)
+  (setq buffers-menu-max-size 20)
+  (setq complex-buffers-menu-p nil))
+
+(energize-set-default-menubar)
+
+
+;; enable purify & plain dbx by default
+;; you can enable the others by copying to .emacs and uncommenting ...
+;; can't do this here because this file comes preloaded.
+
+(energize-define-instrumentatarget-using-tool "")
+(energize-define-instrumentatarget-using-tool "purify")
+;; (energize-define-instrumentatarget-using-tool "quantify")
+;; (energize-define-instrumentatarget-using-tool "sentinel")
+;; (energize-define-instrumentatarget-using-tool "tc")
+;; (energize-define-instrumentatarget-using-tool "time")
+;; (energize-define-instrumentatarget-using-tool "xproba")
+
+;; add the menu item Help->About Energize for the Energize Welcome Mat
+(add-menu-item '("Help") (purecopy "About Energize")
+	       'energize-about-energize t)
+
+(defun energize-about-energize ()
+  (interactive)
+  (start-process "about-energize" nil "about_energize"))
+
+(defun energize-kill-server ()
+  "Kill the Energize server and all buffers associated with it."
+  (interactive)
+  (condition-case nil
+      (energize-execute-command "energizeShutdownServer")
+    (error nil)))
+
+(defun energize-unix-manual ()
+  "Display a manual entry; if connected to Energize, uses the Energize version.
+Otherwise, just runs the normal emacs `manual-entry' command."
+  (interactive)
+  (if (connected-to-energize-p)
+      (energize-execute-command "manual")
+    (call-interactively 'manual-entry)))
+
+;;; These functions are used in the menubar activate hook to update the
+;;; enable state of the menu items
+
+(defvar active-items) ; quiet compiler
+(defsubst activate-energize-menu-item-internal (item)
+  (cond
+   ((vectorp item)
+    (let ((fn (aref item 1)))
+      (if (not (and (symbolp fn) (get fn 'energize-name)))
+	  nil
+	;; Referencing special binding of `active-items' from a-e-m-i-hook.
+	;; If the function which this item invokes is an Energize function
+	;; (determined by the presence of an 'energize-name property) then
+	;; make it be active iff it's on the active-items list.
+	(let ((active-p (assq fn active-items))
+	      (change-p nil))
+	  (if (not (eq (not active-p) (not (aref item 2))))
+	      (progn
+		(aset item 2 (not (not active-p)))
+		(setq change-p t)))
+	  (if (and active-p
+		   (not (equal (cdr active-p)
+			       (if (> (length item) 3)
+				   (aref item 3)
+				 nil))))
+	      (progn
+		(aset item 3 (cdr active-p))
+		(setq change-p t)))
+	  change-p))))
+   ((consp item)			; descend nested submenus
+    (activate-energize-menu-items-internal (cdr item)))
+   (t nil)))
+
+(defun activate-energize-menu-items-internal (items)
+  (let ((change-p nil))
+    (if (not (consp items))
+	(activate-energize-menu-item-internal items)
+      (while items
+	(setq change-p (or (activate-energize-menu-item-internal (car items))
+			   change-p)
+	      items (cdr items)))
+      change-p)))
+
+(defun energize-build-menubar-names ()
+  ;;; makes the list of currently active menu items.
+  (let* ((selection-p (x-selection-exists-p 'PRIMARY))
+	 (menubar
+	  (if (< (cdr (energize-protocol-level)) 7)
+	      (energize-with-timeout
+	       "Getting updated menubar from Energize server..."
+	       (energize-list-menu (current-buffer) () selection-p))
+	    (append energize-menu-state energize-default-menu-state))))
+    (delq nil
+	  (mapcar '(lambda (x)
+		     (and (vectorp x)
+			  (if (/= 0 (logand 1 (aref x 3)))
+			      nil
+			    (cons
+			     (symbol-value
+			      (intern-soft (aref x 0)
+					   energize-menu-item-table))
+			     (aref x 4)))))
+		  menubar))))
+
+(defun activate-energize-menu-items-hook ()
+  ;; This is O^2 because of the `rassq', but it looks like the elisp part
+  ;; of it only takes .03 seconds.  
+  (if (connected-to-energize-p)
+      (let* ((items current-menubar)
+	     (change-p nil)
+	     ;; dynamically used by activate-energize-menu-item-internal
+	     (active-items (energize-build-menubar-names))
+	     item)
+	(while items
+	  (setq item (car items)
+		change-p (or (and item (activate-energize-menu-items-internal
+					(if (consp item) (cdr item) item)))
+			     change-p)
+		items (cdr items)))
+	(not change-p))))
+
+(add-hook 'activate-menubar-hook 'activate-energize-menu-items-hook t)
+
+(defun deactivate-all-energize-menu-items ()
+  (let ((items current-menubar)
+	;; dynamically used by activate-energize-menu-item-internal
+	(active-items nil)
+	item)
+    (while items
+      (if (setq item (car items))
+	  (activate-energize-menu-items-internal
+	   (if (consp item) (cdr item) item)))
+      (setq items (cdr items)))))
+
+
+;;; The Options menu
+
+(setq options-menu-saved-forms
+      (purecopy
+       (append
+	options-menu-saved-forms
+	'((list 'energize-set-edit-modes
+		(if energize-external-editor
+		    (symbol-name energize-external-editor))
+		(list 'quote energize-vi-terminal-emulator)
+		(list 'quote energize-internal-viewer)
+		(list 'quote energize-internal-editor)
+		(cond ((get 'browser 'instance-limit) ''multi)
+		      ((get 'energize-top-level-mode 'screen-name)
+		       ''several)
+		      (t ''single))
+		(list 'quote energize-split-screens-p)
+		)
+	  (if sc-mode
+	      (list 'sc-mode (list 'quote sc-mode))
+	    '(if (featurep 'generic-sc) (sc-mode nil)))
+	  ))))
+
+
+;;; Popup-menus
+
+(defvar energize-popup-menu)
+
+(defvar energize-hack-popup-hook '()
+  "Hook for all functions that want to hack at the Energize popup menus.
+Each function takes two arguments: an extent (or nil if none) and a menu
+(or nil if none currently). It should return a menu (or nil)")
+
+(defun energize-popup-menu (event)
+  (interactive "e")
+  (if (popup-menu-up-p)
+      ()
+    (if (null (event-over-text-area-p event))
+	;; clicking in non-text areas was causing errors...way bogus!
+	(popup-mode-menu)
+      (let* ((buffer (event-buffer event))
+	     (extent (if (extentp (event-glyph-extent event))
+			 (event-glyph-extent event)
+		       (energize-menu-extent-at (event-point event) buffer)))
+	     choices)
+	(select-window (event-window event))
+	(if extent
+	    (progn
+	      (energize-with-timeout
+	       "Asking Energize server for menu contents..."
+	       (setq choices
+		     (cdr
+		      (cdr
+		       (energize-list-menu buffer extent
+					   (x-selection-exists-p 'PRIMARY))))))))
+	(if (or (null extent) (null choices))
+	    (if (null (setq energize-popup-menu
+			    (energize-extent-run-hook energize-hack-popup-hook
+						      nil nil)))
+		(error "No menu to pop up"))
+	  (force-highlight-extent extent t)
+	  (sit-for 0)
+	  (setq energize-popup-menu
+		(cons "energizePopup"
+		      (mapcar
+		       (function (lambda (item)
+				   (vector
+				    (aref item 0)
+				    (list 'energize-execute-command
+					  (aref item 0)
+					  extent)
+				    (= 0 (logand 1 (aref item 3)))
+				    (aref item 4))))
+		       choices)))
+	  (setq energize-popup-menu
+		(external-editor-hack-popup
+		 (energize-extent-run-hook energize-hack-popup-hook
+					   extent energize-popup-menu))))
+	(if (equal (car energize-popup-menu) "energizePopup")
+	    (let ((popup-menu-titles nil))
+	      (popup-menu 'energize-popup-menu))
+	  (popup-menu 'energize-popup-menu))))))
+
+(defun energize-extent-run-hook (f ex m)
+  (if f
+      (energize-extent-run-hook (cdr f) ex (funcall (car f) ex m))
+    m))
+
+;;; Functions to interactively execute menu items by their names.
+
+(defun energize-menu-extent-at (pos buffer)
+  (if (null pos)
+      nil
+    (let ((extent (energize-extent-at pos buffer)))
+      (if (and extent (energize-extent-menu-p extent))
+	  extent
+	nil))))
+
+;;; functions to execute the menu with the keyboard
+(defun default-selection-value-for-item (menu-item)
+  (let ((flags (aref menu-item 3)))
+    (cond ((= (logand flags 2) 2)
+	   (if (x-selection-owner-p 'PRIMARY)
+	       (x-get-selection-internal 'PRIMARY 'STRING)))
+	  ((= (logand flags 4) 4)
+	   (if (x-selection-owner-p 'PRIMARY)
+	       (x-get-selection-internal 'PRIMARY 'ENERGIZE_OBJECT)))
+	  ((= (logand flags 128) 128)
+	   (if (x-selection-owner-p 'SECONDARY)
+	       (x-get-selection-internal 'SECONDARY 'STRING)))
+	  ((= (logand flags 256) 256)
+	   (if (x-selection-owner-p 'SECONDARY)
+	       (x-get-selection-internal 'SECONDARY 'ENERGIZE_OBJECT))))))
+  
+(defun energize-execute-menu-item-with-selection (buffer
+						  extent
+						  item
+						  selection
+						  no-confirm)
+  (if (/= 0 (logand 1 (aref item 3)))
+      (error "The `%s' command is inappropriate in this context"
+	     (aref item 0)))
+  (if (null selection)
+      (setq selection (default-selection-value-for-item item)))
+  (energize-execute-menu-item buffer extent item selection no-confirm))
+
+(defun energize-find-item (name list)
+  (let ((l list) i (found ()))
+    (while (and l (not found))
+      (setq i (car l) l (cdr l))
+      (if (and (vectorp i) (equal (aref i 0) name))
+	  (setq found i)))
+    found))
+
+(defun energize-menu-item-for-name (extent name)
+  (if (or extent (< (cdr (energize-protocol-level)) 7))
+      (energize-with-timeout
+       "Checking Energize command with kernel..."
+       (energize-list-menu (current-buffer) extent
+			   (x-selection-exists-p 'PRIMARY) name))
+    (or (energize-find-item name energize-menu-state)
+	(energize-find-item name energize-default-menu-state))))
+
+(defun energize-execute-command (name &optional extent selection no-confirm)
+  ;; add completion here...
+  (interactive "sExecute Energize command named: ")
+
+  (if (not (stringp name))
+      (error "Can't execute a choice, %s, that is not a string" name))
+
+  (or (connected-to-energize-p) (error "Not connected to Energize"))
+
+  ;; patch the selection argument for "setbreakpoint"
+  (if (and (equal name "setbreakpoint")
+	   (null selection))
+      (setq selection
+	    (save-excursion
+	      (vector (energize-buffer-id (current-buffer))
+		      (progn (beginning-of-line)
+			     (energize-file-position (point))))
+		      (progn (end-of-line)
+			     (energize-file-position (point))))))
+  (let* ((buffer (current-buffer))
+	 (extent (if extent
+		     (if (extentp extent)
+			 extent
+		       (energize-menu-extent-at (point) buffer))
+		   nil)))
+    (if (< (cdr (energize-protocol-level)) 7)
+	;; old way
+	(let ((item (energize-menu-item-for-name extent name)))
+	  (if (not item)
+	      (error "No Energize command named %s" name))
+	  (energize-execute-menu-item-with-selection buffer extent item
+						     selection no-confirm))
+      ;; new way
+      (if (and (null selection)
+	       (x-selection-exists-p 'PRIMARY))
+	  (setq selection
+		(condition-case
+		    ()
+		    (x-get-selection-internal 'PRIMARY 'STRING)
+		  (error ""))))
+      (let ((energize-make-many-buffers-visible-should-enqueue-event
+	     (equal name "save")))
+	(energize-execute-command-internal buffer
+					   extent
+					   name
+					   selection
+					   no-confirm)))))
+
+
+
+;;; Buffer modified the first time hook
+;;; Should be in energize-init.el but is here to benefit from the 
+;;; add-timeout macro  
+
+(defun energize-check-if-buffer-locked ()
+  (if (connected-to-energize-p)
+      (energize-with-timeout
+       "Asking Energize server if buffer is editable..."
+       (energize-barf-if-buffer-locked))))
+
+(add-hook 'first-change-hook 'energize-check-if-buffer-locked)
+
+
+;;; Here's a converter that makes emacs understand how to convert to
+;;; selections of type ENERGIZE.  Eventually the Energize server won't
+;;; be using the selection mechanism any more, I hope.
+
+(defun xselect-convert-to-energize (selection type value)
+  (let (str id start end tmp)
+    (cond ((and (consp value)
+		(markerp (car value))
+		(markerp (cdr value)))
+	   (setq id (energize-buffer-id (marker-buffer (car value)))
+		 start (1- (marker-position (car value)))  ; zero based
+		 end (1- (marker-position (cdr value)))))
+	  ((extentp value)
+	   (setq id (extent-to-generic-id value)
+		 start 0
+		 end 0)))
+    (if (null id)
+	nil
+      (setq str (make-string 12 0))
+      (if (< end start) (setq tmp start start end end tmp))
+      (aset str 0 (logand (ash (car id) -8) 255))
+      (aset str 1 (logand (car id) 255))
+      (aset str 2 (logand (ash (cdr id) -8) 255))
+      (aset str 3 (logand (cdr id) 255))
+      (aset str 4 (logand (ash start -24) 255))
+      (aset str 5 (logand (ash start -16) 255))
+      (aset str 6 (logand (ash start -8) 255))
+      (aset str 7 (logand start 255))
+      (aset str 8 (logand (ash end -24) 255))
+      (aset str 9 (logand (ash end -16) 255))
+      (aset str 10 (logand (ash end -8) 255))
+      (aset str 11 (logand end 255))
+      (cons 'ENERGIZE_OBJECT str))))
+
+
+(or (assq 'ENERGIZE_OBJECT selection-converter-alist)
+    (setq selection-converter-alist
+	  (cons '(ENERGIZE_OBJECT . xselect-convert-to-energize)
+		selection-converter-alist)))
+
+
+;;; Function keys.
+
+(defun energize-define-function-keys ()
+  "Define some Borland/Motif-like `F' keys for Energize."
+  (define-key global-map 'f1 'help-for-help)
+  (define-key global-map 'f3 'energize-search)
+  (define-key global-map '(shift delete) 'x-kill-primary-selection)
+  (define-key global-map '(control insert) 'x-copy-primary-selection)
+  (define-key global-map '(shift insert) 'x-yank-clipboard-selection)
+  (define-key global-map '(control delete) 'x-delete-primary-selection)
+
+  (define-key global-map 'f7 'energize-browse-error)
+  (define-key global-map '(meta f7) 'next-error)
+  (define-key global-map '(meta f8) 'previous-error)
+
+  (define-key global-map 'f9 'energize-build-a-target)
+  (define-key global-map '(meta f9) 'energize-default-compile-file)
+  (define-key global-map '(control f9) 'energize-run-target)
+  (define-key global-map '(meta shift f9) 'energize-abort-build)
+
+  (define-key global-map '(meta control ?.) 'energize-edit-declaration-dbox)
+  (define-key global-map 'f5 'energize-browse-language-elt)
+  (define-key global-map '(shift f5) 'energize-next-use-start)
+  (define-key global-map '(control f5) 'energize-next-use-command)
+  )
+