0
|
1 ;;; -*- Mode:Emacs-Lisp -*-
|
|
2 ;;; Copyright (C) 1992, 1993, 1994 by Lucid, Inc. All Rights Reserved.
|
|
3 ;;; Copyright (C) 1995 by INS Engineering.
|
|
4
|
|
5 ;;; The names of the menu items (as emacs sees them) are short and ugly.
|
|
6 ;;; These are the names by which the Energize protocol knows the commands.
|
|
7 ;;; The menu items are made to display in a more human-friendly way via the
|
|
8 ;;; X resource database, which is expected to contain entries like
|
|
9 ;;;
|
|
10 ;;; *buildanddebug.labelString: Build and Debug
|
|
11 ;;;
|
|
12 ;;; in the Emacs app-defaults file.
|
|
13 ;;;
|
|
14 ;;; We need to map these short Energize-names to the functions which invoke
|
|
15 ;;; them; we do this via the energize-menu-item-table, which is an obarray
|
|
16 ;;; hash table associating the names with the functions. We do the reverse
|
|
17 ;;; association via an 'energize-name property on the function's name symbol.
|
|
18 ;;;
|
|
19 ;;; Sometimes the short ugly names show up in error messages; probably we
|
|
20 ;;; should read the resource database to get the pretty names.
|
|
21
|
|
22 (require 'menubar)
|
|
23
|
|
24 (defvar sc-mode nil) ; just so it has a value even if not loaded
|
|
25 (defvar font-lock-mode nil) ; likewise
|
|
26
|
|
27 (defconst energize-menu-item-table (make-vector 511 nil)
|
|
28 "obarray used for fast mapping of symbolic energize request-names to the
|
|
29 functions that invoke them.")
|
|
30
|
|
31 (defvar energize-default-menu-state ()
|
|
32 "List of the Energize menu items associated with every buffers.")
|
|
33
|
|
34 (defvar energize-menu-state ()
|
|
35 "Buffer local variable listing the menu items associated with a buffer.")
|
|
36
|
|
37 ;; When it is made local, don't kill it when kill-all-local-variables is
|
|
38 ;; called (as from the major mode via revert-buffer) or else we tend to lose
|
|
39 ;; the information, as the ProposeChoicesRequest comes in at an inopportune
|
|
40 ;; time.
|
|
41 (put 'energize-menu-state 'permanent-local t)
|
|
42
|
|
43 ;;; Hook to update the menu state when the kernel tells us it changed
|
|
44
|
|
45 (defun energize-update-menu-state (items)
|
|
46 (let ((buffer (car items))
|
|
47 (previous-buffer (current-buffer)))
|
|
48 (if (null buffer)
|
|
49 (setq energize-default-menu-state items)
|
|
50 (unwind-protect
|
|
51 (progn
|
|
52 (set-buffer buffer)
|
|
53 (setq energize-menu-state items))
|
|
54 (set-buffer previous-buffer)))))
|
|
55
|
|
56 (setq energize-menu-update-hook 'energize-update-menu-state)
|
|
57
|
|
58 ;;; The energize-with-timeout macro is used to show to the user that we are
|
|
59 ;;; waiting for a reply from the energize kernel when it is too slow.
|
|
60
|
|
61 (defvar initial-energize-timeout-state
|
|
62 (let ((l '("." ".." "..." "...." "....." "......" "......." "........")))
|
|
63 (nconc l l)))
|
|
64
|
|
65 (defvar energize-timeout-state initial-energize-timeout-state)
|
|
66
|
|
67 (defun energize-warn-kernel-slow (pair)
|
|
68 (setq energize-timeout-state (cdr energize-timeout-state))
|
|
69 (message "%s Type %c to cancel%s"
|
|
70 (car pair) (quit-char) (car energize-timeout-state))
|
|
71 (rplacd pair t))
|
|
72
|
|
73 (defmacro energize-with-timeout (notice &rest body)
|
|
74 (list 'let* (list
|
|
75 (list 'timeout-pair (list 'cons notice nil))
|
|
76 '(timeout (add-timeout 1.5 'energize-warn-kernel-slow
|
|
77 timeout-pair 1.5)))
|
|
78 (list 'unwind-protect (cons 'progn body)
|
|
79 '(disable-timeout timeout)
|
|
80 '(setq energize-timeout-state initial-energize-timeout-state)
|
|
81 '(if (cdr timeout-pair) (message "")))))
|
|
82
|
|
83 (defun energize-def-menu-item (name function &optional dont-define)
|
|
84 ;; function->name mapping is on the function name's plist
|
|
85 ;; name->function mapping is via an obarray
|
|
86 ;; dont-define means it already has a function definition
|
|
87 (put function 'energize-name (purecopy name))
|
|
88 (set (intern name energize-menu-item-table) function)
|
|
89 ;; Define the (trivial) function
|
|
90 ;; It's ok that this function is interpreted, because it contains only
|
|
91 ;; one function call with constant args, so it's just as fast as it would
|
|
92 ;; be if it were byte-coded.
|
|
93 (if (not dont-define)
|
|
94 (fset function
|
|
95 (purecopy
|
|
96 (` (lambda ()
|
|
97 (, (format "Executes the Energize \"%s\" command." name))
|
|
98 (interactive)
|
|
99 (energize-execute-command (, name)))))))
|
|
100 ;; Return the menu-item descriptor.
|
|
101 (vector (purecopy name) function nil nil))
|
|
102
|
|
103 (defmacro energize-def-menu (menu-name &rest items)
|
|
104 (` (list (, menu-name)
|
|
105 (,@ (mapcar
|
|
106 '(lambda (x)
|
|
107 (if (and (consp x) (stringp (car x)))
|
|
108 (cons 'energize-def-menu-item
|
|
109 (mapcar '(lambda (xx)
|
|
110 (if (stringp xx)
|
|
111 (purecopy xx)
|
|
112 (list 'quote xx)))
|
|
113 x))
|
|
114 x))
|
|
115 items)))))
|
|
116
|
|
117 (put 'energize-def-menu 'lisp-indent-function 1)
|
|
118
|
|
119
|
|
120 ;; If menubar-religion is 'winning, the menubar looks like jwz likes it.
|
|
121 ;; If menubar-religion is 'losing, the menubar looks like Gareth and the
|
|
122 ;; documentation folks like it. See also menubar.el - it consults this
|
|
123 ;; variable for the layout of the File menu which is inherited here.
|
|
124
|
|
125 (defconst energize-menubar
|
|
126 (purecopy-menubar
|
|
127 (list
|
|
128 ["sheet" energize-toggle-psheet nil]
|
|
129
|
|
130 ;; Perform some surgery on the default File menu to insert our items.
|
|
131 ;; This is to avoid having to duplicate it here... Don't try this at
|
|
132 ;; home, kids!
|
|
133 ;;; (let* ((file (copy-sequence
|
|
134 ;;; (car (find-menu-item default-menubar '("File")))))
|
|
135 ;;; (print (car (find-menu-item file '("Print Buffer"))))
|
|
136 ;;; (exit (car (find-menu-item file '("Exit XEmacs"))))
|
|
137 ;;; (print-cons (memq print file))
|
|
138 ;;; (exit-cons (memq exit file))
|
|
139 ;;; )
|
|
140 ;;; ;; Insert "Print Annotated" just after "Print"
|
|
141 ;;; (setcdr print-cons (cons '["Print Annotated Buffer"
|
|
142 ;;; energize-annotate-print-ps
|
|
143 ;;; t]
|
|
144 ;;; (cdr print-cons)))
|
|
145 ;;;
|
|
146 ;;; ;; Insert "Checkpoint" and "Shutdown" just before "Exit XEmacs".
|
|
147 ;;; (setcar exit-cons ["Connect to Energize" energize-menu-connect-directly
|
|
148 ;;; (not (connected-to-energize-p))])
|
|
149 ;;; (setcdr exit-cons
|
|
150 ;;; (nconc
|
|
151 ;;; (list (energize-def-menu-item "checkpoint"
|
|
152 ;;; 'energize-checkpoint-database)
|
|
153 ;;; ["Disconnect from Energize" disconnect-from-energize
|
|
154 ;;; (connected-to-energize-p)]
|
|
155 ;;; "----"
|
|
156 ;;; (energize-def-menu-item "energizeShutdownServer"
|
|
157 ;;; 'energize-kill-server)
|
|
158 ;;; )
|
|
159 ;;; (if (not (eq menubar-religion 'winning))
|
|
160 ;;; (list "----"))
|
|
161 ;;; (list exit)))
|
|
162 ;;; file)
|
|
163 ;; this is the losing menubar-religion...
|
|
164 (` ("File"
|
|
165 ["New Frame" make-frame t]
|
|
166 ["Open..." find-file t]
|
|
167 ["Save" save-buffer nil "menubar.el"]
|
|
168 ["Save As..." write-file t]
|
|
169 ["Save Some Buffers" save-some-buffers t]
|
|
170 "------"
|
|
171 ["Insert File..." insert-file t]
|
|
172 "-----"
|
|
173 ["Print Buffer" lpr-buffer t nil]
|
|
174 ["Print Annotated Buffer" energize-annotate-print-ps t]
|
|
175 "-----"
|
|
176 ["Delete Frame" delete-frame t]
|
|
177 ["Kill Buffer" kill-this-buffer t nil]
|
|
178 ["Revert Buffer" revert-buffer t nil]
|
|
179 "-----"
|
|
180 ("Compare"
|
|
181 ["Two Files ..." ediff-files t]
|
|
182 ["Two Buffers ..." ediff-buffers t]
|
|
183 ["Three Files ..." ediff-files3 t]
|
|
184 ["Three Buffers ..." ediff-buffers3 t]
|
|
185 ["Windows ..." ediff-windows t]
|
|
186 ["Small Regions ..." ediff-small-regions t]
|
|
187 ["Large Regions ..." ediff-large-regions t]
|
|
188 ["File with Revision ..." ediff-revision t])
|
|
189 ("Merge"
|
|
190 ["Files ..." ediff-merge-files t]
|
|
191 ["Files with Ancestor ..." ediff-merge-files-with-ancestor t]
|
|
192 ["Buffers ..." ediff-merge-buffers t]
|
|
193 ["Buffers with Ancestor ..." ediff-merge-buffers-with-ancestor t]
|
|
194 ["Revisions ..." ediff-merge-revisions t]
|
|
195 ["Revisions with Ancestor ..." ediff-merge-revisions-with-ancestor t]
|
|
196 )
|
|
197 ("Apply Patch"
|
|
198 ["To a file ..." ediff-patch-file t]
|
|
199 ["To a buffer ..." ediff-patch-buffer t])
|
|
200 "-----"
|
|
201 ["Connect to Energize" energize-menu-connect-directly
|
|
202 (not (connected-to-energize-p))]
|
|
203 (, (energize-def-menu-item "checkpoint" 'energize-checkpoint-database))
|
|
204 ["Disconnect from Energize" disconnect-from-energize
|
|
205 (connected-to-energize-p)]
|
|
206 "----"
|
|
207 (, (energize-def-menu-item "energizeShutdownServer" 'energize-kill-server))
|
|
208 "----"
|
|
209 ["Exit XEmacs" save-buffers-kill-emacs t]))
|
|
210
|
|
211 ;; Energize also adds some menu items to the middle of the "Edit" menu.
|
|
212 ;; Someday these should be moved to the default menubar, maybe, once it's
|
|
213 ;; easier to define `energize-search' in a non-Energize world.
|
|
214 (let* ((edit (copy-sequence
|
|
215 (car (find-menu-item default-menubar '("Edit")))))
|
|
216 (clear (car (find-menu-item edit '("Clear"))))
|
|
217 (clear-cons (memq clear edit))
|
|
218 )
|
|
219 ;; Insert these just after "Clear"
|
|
220 (setcdr clear-cons
|
|
221 (append '("-----"
|
|
222 ["Search and Replace..." energize-search t]
|
|
223 ["Search Selection Forward" ow-find
|
|
224 (or ow-find-last-string (x-selection-owner-p))]
|
|
225 ["Search Selection Backward" ow-find-backward
|
|
226 (or ow-find-last-string (x-selection-owner-p))]
|
|
227 )
|
|
228 (cdr clear-cons)))
|
|
229 edit)
|
|
230
|
|
231 (energize-def-menu "Browse"
|
|
232 ["editdef" energize-edit-definition t]
|
|
233 ("editdec" energize-edit-declaration-dbox)
|
|
234 ("calltreebrowser" energize-browse-tree)
|
|
235 ("classbrowser" energize-browse-class)
|
|
236 ("lebrowser" energize-browse-language-elt)
|
|
237 ("includers" energize-where-included)
|
|
238 "-----"
|
|
239
|
|
240 ;; Make Energize control the selectability of these, but don't define
|
|
241 ;; the functions here (they are defined in lisp, not as aliases for
|
|
242 ;; an Energize command.)
|
|
243
|
|
244 ;; No, this doesn't seem to work. Energize disowns all knowledge.
|
|
245 ["visituse" energize-next-use-start (connected-to-energize-p)]
|
|
246 ["nextuse" energize-next-use-command (connected-to-energize-p)]
|
|
247 "-----"
|
|
248 ["List History" energize-history (connected-to-energize-p)]
|
|
249 ["Step Back in History" energize-history-previous (connected-to-energize-p)]
|
|
250 "-----"
|
|
251 ("energize" energize-pop-to-energize-buffer)
|
|
252 ("showsystemlog" energize-browse-system-log)
|
|
253 ("errorbrowser" energize-browse-error)
|
|
254 "-----"
|
|
255 ("toolstatus" energize-browse-toolstat)
|
|
256 ["Shell" shell t]
|
|
257 )
|
|
258
|
|
259 (if (eq menubar-religion 'winning)
|
|
260
|
|
261 (list
|
|
262 ;; Winning
|
|
263 "Options"
|
|
264 (energize-def-menu-item "debuggerpanel" 'energize-show-debugger-panel)
|
|
265 "------"
|
|
266 ["Read Only" toggle-read-only :style toggle :selected buffer-read-only]
|
|
267 ["Case Sensitive Search" (setq case-fold-search (not case-fold-search))
|
|
268 :style toggle :selected (not case-fold-search)]
|
|
269 ["Case Sensitive Replace" (setq case-replace (not case-replace))
|
|
270 :style toggle :selected (not case-replace)]
|
|
271 ["Overstrike" overwrite-mode :style toggle :selected overwrite-mode]
|
|
272 ["Auto Delete Selection" (if (memq 'pending-delete-pre-hook
|
|
273 pre-command-hook)
|
|
274 (pending-delete-off nil)
|
|
275 (pending-delete-on nil))
|
|
276 :style toggle :selected (memq 'pending-delete-pre-hook pre-command-hook)]
|
|
277 ["Teach Extended Commands" (setq teach-extended-commands-p
|
|
278 (not teach-extended-commands-p))
|
|
279 :style toggle :selected teach-extended-commands-p]
|
|
280 ["Debug On Error" (setq debug-on-error (not debug-on-error))
|
|
281 :style toggle :selected debug-on-error]
|
|
282 ; ["Line Numbers" (line-number-mode nil)
|
|
283 ; :style toggle :selected line-number-mode]
|
|
284 (append '("Syntax Highlighting"
|
|
285 ["None" (font-lock-mode 0) :style radio :selected (null font-lock-mode)])
|
|
286 (and (not (string-match "Widec" emacs-version))
|
|
287 (list ["Fonts" (progn (require 'font-lock)
|
|
288 (font-lock-use-default-fonts)
|
|
289 (font-lock-mode 1))
|
|
290 :style radio
|
|
291 :selected (and font-lock-mode
|
|
292 (equal (find-face 'italic) ; kind of a kludge...
|
|
293 (find-face 'font-lock-comment-face)))]))
|
|
294 '(
|
|
295 ["Colors" (progn (require 'font-lock)
|
|
296 (font-lock-use-default-colors)
|
|
297 (font-lock-mode 1))
|
|
298 :style radio
|
|
299 :selected (and font-lock-mode
|
|
300 (not (equal (find-face 'italic)
|
|
301 (find-face 'font-lock-comment-face))))]
|
|
302 "-----"
|
|
303 ["Less" (progn (require 'font-lock)
|
|
304 (font-lock-use-default-minimal-decoration)
|
|
305 (font-lock-mode 0)
|
|
306 (font-lock-mode 1))
|
|
307 :style radio
|
|
308 :selected (and font-lock-mode
|
|
309 (eq c++-font-lock-keywords c-font-lock-keywords-1))]
|
|
310 ["More" (progn (require 'font-lock)
|
|
311 (font-lock-use-default-maximal-decoration)
|
|
312 (font-lock-mode 0)
|
|
313 (font-lock-mode 1))
|
|
314 :style radio
|
|
315 :selected (and font-lock-mode
|
|
316 (eq c++-font-lock-keywords c-font-lock-keywords-2))]
|
|
317 "-----"
|
|
318 ["Fast" (progn (require 'fast-lock)
|
|
319 (if fast-lock-mode
|
|
320 (progn
|
|
321 (fast-lock-mode 0)
|
|
322 ;; this shouldn't be necessary so there has to
|
|
323 ;; be a redisplay bug lurking somewhere (or
|
|
324 ;; possibly another event handler bug)
|
|
325 (force-mode-line-update))
|
|
326 (if font-lock-mode
|
|
327 (progn
|
|
328 (fast-lock-mode 1)
|
|
329 (force-mode-line-update)))))
|
|
330 :active font-lock-mode
|
|
331 :style toggle
|
|
332 :selected fast-lock-mode]
|
|
333 ))
|
|
334 '("Paren Highlighting"
|
|
335 ["None" (paren-set-mode -1)
|
|
336 :style radio :selected (not paren-mode)]
|
|
337 ["Blinking Paren" (paren-set-mode 'blink-paren)
|
|
338 :style radio :selected (eq paren-mode 'blink-paren)]
|
|
339 ["Steady Paren" (paren-set-mode 'paren)
|
|
340 :style radio :selected (eq paren-mode 'paren)]
|
|
341 ["Expression" (paren-set-mode 'sexp)
|
|
342 :style radio :selected (eq paren-mode 'sexp)]
|
|
343 ["Nested Shading" (paren-set-mode 'nested)
|
|
344 :style radio :selected (eq paren-mode 'nested) :enabled nil]
|
|
345 )
|
|
346 "------"
|
|
347 '("Font" "initialized later")
|
|
348 '("Size" "initialized later")
|
|
349 '("Weight" "initialized later")
|
|
350 ["Edit faces" edit-faces t]
|
|
351 "-----"
|
|
352 ["Energize Edit Modes..." energize-set-edit-modes t]
|
|
353 (energize-def-menu-item "setprojectdisplay"
|
|
354 'energize-set-project-display)
|
|
355 (list "Target Display"
|
|
356 (energize-def-menu-item "fulltargets"
|
|
357 'energize-full-targets)
|
|
358 (energize-def-menu-item "abbreviatetargets"
|
|
359 'energize-abbreviate-targets))
|
|
360 '("Source Control"
|
|
361 ["None" (sc-mode nil) :style radio :selected (eq sc-mode nil)]
|
|
362 ["SCCS" (sc-mode 'SCCS) :style radio :selected (eq sc-mode 'SCCS)]
|
|
363 ["RCS" (sc-mode 'RCS) :style radio :selected (eq sc-mode 'RCS)]
|
|
364 ["CVS" (sc-mode 'CVS) :style radio :selected (eq sc-mode 'CVS)]
|
|
365 ["ClearCase" (sc-mode 'CCASE):style radio :selected (eq sc-mode 'CCASE)]
|
|
366 )
|
|
367 "-----"
|
|
368 ["Buffers Menu Length..."
|
|
369 (progn
|
|
370 (setq buffers-menu-max-size
|
|
371 (read-number
|
|
372 "Enter number of buffers to display (or 0 for unlimited): "))
|
|
373 (if (eq buffers-menu-max-size 0) (setq buffers-menu-max-size nil)))
|
|
374 t]
|
|
375 ["Buffers Sub-Menus" (setq complex-buffers-menu-p
|
|
376 (not complex-buffers-menu-p))
|
|
377 :style toggle :selected complex-buffers-menu-p]
|
|
378 "-----"
|
|
379 ["Save Options" save-options-menu-settings t]
|
|
380 )
|
|
381
|
|
382 (list
|
|
383 ;; Non-winning
|
|
384 "Options"
|
|
385 ["Split Screen" split-window-vertically t]
|
|
386 ["Unsplit" delete-other-windows t]
|
|
387 "------"
|
|
388 (energize-def-menu-item "debuggerpanel" 'energize-show-debugger-panel)
|
|
389 "------"
|
|
390 ["Read Only" toggle-read-only :style toggle :selected buffer-read-only]
|
|
391 ["Overstrike " overwrite-mode :style toggle :selected overwrite-mode]
|
|
392 ["Auto Delete Selection" (if (memq 'pending-delete-pre-hook
|
|
393 pre-command-hook)
|
|
394 (pending-delete-off nil)
|
|
395 (pending-delete-on nil))
|
|
396 :style toggle :selected (memq 'pending-delete-pre-hook pre-command-hook)]
|
|
397 ["Teach Extended" (setq teach-extended-commands-p
|
|
398 (not teach-extended-commands-p))
|
|
399 :style toggle :selected teach-extended-commands-p]
|
|
400 "------"
|
|
401 '("Font" "initialized later")
|
|
402 '("Size" "initialized later")
|
|
403 '("Weight" "initialized later")
|
|
404 "------"
|
|
405 (append '("Syntax Highlighting"
|
|
406 ["None" (font-lock-mode 0) :style radio :selected (null font-lock-mode)])
|
|
407 (and (not (string-match "Widec" emacs-version))
|
|
408 (list ["Fonts" (progn (require 'font-lock)
|
|
409 (font-lock-use-default-fonts)
|
|
410 (font-lock-mode 1))
|
|
411 :style radio
|
|
412 :selected (and font-lock-mode
|
|
413 (equal (find-face 'italic) ; kind of a kludge...
|
|
414 (find-face 'font-lock-comment-face)))]))
|
|
415 '(
|
|
416 ["Colors" (progn (require 'font-lock)
|
|
417 (font-lock-use-default-colors)
|
|
418 (font-lock-mode 1))
|
|
419 :style radio
|
|
420 :selected (and font-lock-mode
|
|
421 (not (equal (find-face 'italic)
|
|
422 (find-face 'font-lock-comment-face))))]
|
|
423 "-----"
|
|
424 ["Less" (progn (require 'font-lock)
|
|
425 (font-lock-use-default-minimal-decoration)
|
|
426 (font-lock-mode 0)
|
|
427 (font-lock-mode 1))
|
|
428 :style radio
|
|
429 :selected (and font-lock-mode
|
|
430 (eq c++-font-lock-keywords c-font-lock-keywords-1))]
|
|
431 ["More" (progn (require 'font-lock)
|
|
432 (font-lock-use-default-maximal-decoration)
|
|
433 (font-lock-mode 0)
|
|
434 (font-lock-mode 1))
|
|
435 :style radio
|
|
436 :selected (and font-lock-mode
|
|
437 (eq c++-font-lock-keywords c-font-lock-keywords-2))]
|
|
438 "-----"
|
|
439 ["Fast" (progn (require 'fast-lock)
|
|
440 (if fast-lock-mode
|
|
441 (progn
|
|
442 (fast-lock-mode 0)
|
|
443 ;; this shouldn't be necessary so there has to
|
|
444 ;; be a redisplay bug lurking somewhere (or
|
|
445 ;; possibly another event handler bug)
|
|
446 (force-mode-line-update))
|
|
447 (if font-lock-mode
|
|
448 (progn
|
|
449 (fast-lock-mode 1)
|
|
450 (force-mode-line-update)))))
|
|
451 :active font-lock-mode
|
|
452 :style toggle
|
|
453 :selected fast-lock-mode]
|
|
454 ))
|
|
455
|
|
456 '("Paren Highlighting"
|
|
457 ["None" (blink-paren 0)
|
|
458 :style radio
|
|
459 :selected (not (memq 'blink-paren-pre-command pre-command-hook))]
|
|
460 ["Blink" (progn
|
|
461 (setq highlight-paren-expression nil)
|
|
462 (blink-paren 1))
|
|
463 :style radio
|
|
464 :selected (and (not highlight-paren-expression)
|
|
465 (memq 'blink-paren-pre-command pre-command-hook))]
|
|
466 ["Highlight" (progn
|
|
467 (setq highlight-paren-expression t)
|
|
468 (blink-paren 1))
|
|
469 :style radio
|
|
470 :selected (and highlight-paren-expression
|
|
471 (memq 'blink-paren-pre-command pre-command-hook))]
|
|
472 )
|
|
473 "-----"
|
|
474 ["Energize Edit Modes..." energize-set-edit-modes t]
|
|
475 (energize-def-menu-item "setprojectdisplay"
|
|
476 'energize-set-project-display)
|
|
477 (list "Target Display"
|
|
478 (energize-def-menu-item "fulltargets"
|
|
479 'energize-full-targets)
|
|
480 (energize-def-menu-item "abbreviatetargets"
|
|
481 'energize-abbreviate-targets))
|
|
482 "-----"
|
|
483 ["Buffers Length..."
|
|
484 (progn
|
|
485 (setq buffers-menu-max-size
|
|
486 (read-number
|
|
487 "Enter number of buffers to display (or 0 for unlimited): "))
|
|
488 (if (eq buffers-menu-max-size 0) (setq buffers-menu-max-size nil)))
|
|
489 t]
|
|
490 ["Buffers Menus" (setq complex-buffers-menu-p
|
|
491 (not complex-buffers-menu-p))
|
|
492 :style toggle :selected complex-buffers-menu-p]
|
|
493 "-----"
|
|
494 '("Source Control"
|
|
495 ["None" (sc-mode nil) :style radio :selected (eq sc-mode nil)]
|
|
496 ["SCCS" (sc-mode 'SCCS) :style radio :selected (eq sc-mode 'SCCS)]
|
|
497 ["RCS" (sc-mode 'RCS) :style radio :selected (eq sc-mode 'RCS)]
|
|
498 ["CVS" (sc-mode 'CVS) :style radio :selected (eq sc-mode 'CVS)]
|
|
499 ["ClearCase" (sc-mode 'CCASE):style radio :selected (eq sc-mode 'CCASE)]
|
|
500 )
|
|
501 "-----"
|
|
502 ["Save Options" save-options-menu-settings t]
|
|
503 )
|
|
504
|
|
505 )
|
|
506
|
|
507 (if (eq menubar-religion 'winning)
|
|
508
|
|
509 (energize-def-menu "Debug"
|
|
510 ;; Winning
|
|
511 ("debugprogram" energize-debug-target)
|
|
512 ("runprogram" energize-run-target)
|
|
513 "-----"
|
|
514 ;; Make Energize control the selectability of the setbreakpoint item, but
|
|
515 ;; don't define the function here (it just runs the existing gdb-break
|
|
516 ;; command, which is advised to hack Energize.)
|
|
517 ("setbreakpoint" gdb-break t)
|
|
518 ("breaklist" energize-list-breakpoints)
|
|
519 "-----"
|
|
520 ["Next Error" next-error t]
|
|
521 ["Previous Error" previous-error
|
|
522 :keys "\\[universal-argument] \\[next-error]"]
|
|
523 ("errorbrowser" energize-browse-error)
|
|
524 ("clearerrorlog" energize-clear-error-log)
|
|
525 ("cleardebuggerlog" energize-clear-debugger-log)
|
|
526 "-----"
|
|
527 ("closeprogram" energize-debugger-kill-program)
|
|
528 ("quitdebugger" energize-quit-debugger)
|
|
529 )
|
|
530
|
|
531 (energize-def-menu "Debug"
|
|
532 ;; Non-winning
|
|
533 ("debugprogram" energize-debug-target)
|
|
534 ("runprogram" energize-run-target)
|
|
535 "-----"
|
|
536 ;; Make Energize control the selectability of the setbreakpoint item, but
|
|
537 ;; don't define the function here (it just runs the existing gdb-break
|
|
538 ;; command, which is advised to hack Energize.)
|
|
539 ("setbreakpoint" gdb-break t)
|
|
540 "-----"
|
|
541 ("debuggerpanel" energize-show-debugger-panel)
|
|
542 "-----"
|
|
543 ("breaklist" energize-list-breakpoints)
|
|
544 ("cleardebuggerlog" energize-clear-debugger-log)
|
|
545 "-----"
|
|
546 ("errorbrowser" energize-browse-error)
|
|
547 ("clearerrorlog" energize-clear-error-log)
|
|
548 "-----"
|
|
549 ["Next Error" next-error t]
|
|
550 ["Previous Error" previous-error
|
|
551 :keys "\\[universal-argument] \\[next-error]"]
|
|
552 "-----"
|
|
553 ("closeprogram" energize-debugger-kill-program)
|
|
554 "-----"
|
|
555 ("quitdebugger" energize-quit-debugger)
|
|
556 )
|
|
557 )
|
|
558
|
|
559 (if (eq menubar-religion 'winning)
|
|
560
|
|
561 (energize-def-menu "Compile"
|
|
562 ;; Winning
|
|
563 ("buildatarget" energize-build-a-target)
|
|
564 ("custombuildatarget" energize-custom-build-a-target)
|
|
565 ;; Matthieu believed that this could be done now; however it would seem that
|
|
566 ;; it still can't. So out it goes for the time being.
|
|
567 ;; "-----"
|
|
568 ;; ("Terminate Build" energize-abort-build)
|
|
569 "-----"
|
|
570 ["Next Error" next-error t]
|
|
571 ["Previous Error" previous-error
|
|
572 :keys "\\[universal-argument] \\[next-error]"]
|
|
573 ("errorbrowser" energize-browse-error)
|
|
574 ("clearerrorlog" energize-clear-error-log)
|
|
575 "-----"
|
|
576 ("defaultcompile" energize-default-compile-file)
|
|
577 ("custombuildfile" energize-custom-build-file)
|
|
578 "-----"
|
|
579 ("deleteallobjects" energize-delete-object-files)
|
|
580 )
|
|
581
|
|
582 (energize-def-menu "Compile"
|
|
583 ;; Non-winning
|
|
584 ("buildatarget" energize-build-a-target)
|
|
585 ("custombuildatarget" energize-custom-build-a-target)
|
|
586 "-----"
|
|
587 ("defaultcompile" energize-default-compile-file)
|
|
588 ("custombuildfile" energize-custom-build-file)
|
|
589 "-----"
|
|
590 ("errorbrowser" energize-browse-error)
|
|
591 ("clearerrorlog" energize-clear-error-log)
|
|
592 "-----"
|
|
593 ["Next Error" next-error t]
|
|
594 ["Previous Error" previous-error
|
|
595 :keys "\\[universal-argument] \\[next-error]"]
|
|
596 ;; Matthieu believed that this could be done now; however it would seem that
|
|
597 ;; it still can't. So out it goes for the time being.
|
|
598 ;; "-----"
|
|
599 ;; ("Terminate Build" energize-abort-build)
|
|
600 "-----"
|
|
601 ("deleteallobjects" energize-delete-object-files)
|
|
602 )
|
|
603 )
|
|
604
|
|
605 (if (eq menubar-religion 'winning)
|
|
606
|
|
607 (list "Project"
|
|
608 ;; Winning
|
|
609 (energize-def-menu-item "newproject" 'energize-new-project)
|
|
610 (energize-def-menu-item "findproject" 'energize-find-project)
|
|
611 ["Save Project" save-buffer (eq major-mode 'energize-project-mode)]
|
|
612 ["Current Project" energize-pop-to-project-buffer nil nil]
|
|
613 (energize-def-menu-item "energize" 'energize-pop-to-energize-buffer)
|
|
614 "-----"
|
|
615 '("addprojectentry"
|
|
616 ["addobjectfiletarget" energize-insert-object-file-target
|
|
617 (eq major-mode 'energize-project-mode)]
|
|
618 "-----"
|
|
619 ["addexecutabletarget" energize-insert-executable-target
|
|
620 (eq major-mode 'energize-project-mode)]
|
|
621 ["addlibrarytarget" energize-insert-library-target
|
|
622 (eq major-mode 'energize-project-mode)]
|
|
623 ["addcollectiontarget" energize-insert-collection-target
|
|
624 (eq major-mode 'energize-project-mode)]
|
|
625 "-----"
|
|
626 ["addtargettarget" energize-insert-target-target
|
|
627 (eq major-mode 'energize-project-mode)]
|
|
628 ["addfiletarget" energize-insert-file-target
|
|
629 (eq major-mode 'energize-project-mode)]
|
|
630 "-----"
|
|
631 ["addrule" energize-insert-rule
|
|
632 (eq major-mode 'energize-project-mode)]
|
|
633 )
|
|
634 (energize-def-menu-item "instrumentatarget" 'energize-instrument-a-target)
|
|
635 "-----"
|
|
636 (energize-def-menu-item "importproject" 'energize-import-project)
|
|
637 (energize-def-menu-item "importprojectlist" 'energize-import-project-list)
|
|
638 (energize-def-menu-item "writeprojectlist" 'energize-write-project-list)
|
|
639 "-----"
|
|
640 (energize-def-menu-item "setprojectdisplay"
|
|
641 'energize-set-project-display)
|
|
642 (list "Target Display"
|
|
643 (energize-def-menu-item "fulltargets"
|
|
644 'energize-full-targets)
|
|
645 (energize-def-menu-item "abbreviatetargets"
|
|
646 'energize-abbreviate-targets))
|
|
647 "-----"
|
|
648 (energize-def-menu-item "revertproject"
|
|
649 'energize-fully-revert-project-buffer)
|
|
650 )
|
|
651
|
|
652 (list "Project"
|
|
653 ;; Non-winning
|
|
654 (energize-def-menu-item "newproject" 'energize-new-project)
|
|
655 (energize-def-menu-item "findproject" 'energize-find-project)
|
|
656 ["Save Project" save-buffer (eq major-mode 'energize-project-mode)]
|
|
657 "-----"
|
|
658 (energize-def-menu-item "energize" 'energize-pop-to-energize-buffer)
|
|
659 ["Current Project" energize-pop-to-project-buffer nil nil]
|
|
660 "-----"
|
|
661 ["New C/C++ File" energize-insert-object-file-target
|
|
662 (eq major-mode 'energize-project-mode)]
|
|
663 '("addprojectentry"
|
|
664 ["addobjectfiletarget" energize-insert-object-file-target
|
|
665 (eq major-mode 'energize-project-mode)]
|
|
666 "-----"
|
|
667 ["addexecutabletarget" energize-insert-executable-target
|
|
668 (eq major-mode 'energize-project-mode)]
|
|
669 ["addlibrarytarget" energize-insert-library-target
|
|
670 (eq major-mode 'energize-project-mode)]
|
|
671 ["addcollectiontarget" energize-insert-collection-target
|
|
672 (eq major-mode 'energize-project-mode)]
|
|
673 "-----"
|
|
674 ["addtargettarget" energize-insert-target-target
|
|
675 (eq major-mode 'energize-project-mode)]
|
|
676 ["addfiletarget" energize-insert-file-target
|
|
677 (eq major-mode 'energize-project-mode)]
|
|
678 "-----"
|
|
679 ["addrule" energize-insert-rule
|
|
680 (eq major-mode 'energize-project-mode)]
|
|
681 )
|
|
682 "-----"
|
|
683 (energize-def-menu-item "instrumentatarget" 'energize-instrument-a-target)
|
|
684 "-----"
|
|
685 (energize-def-menu-item "importproject" 'energize-import-project)
|
|
686 (energize-def-menu-item "importprojectlist" 'energize-import-project-list)
|
|
687 "-----"
|
|
688 (energize-def-menu-item "writeprojectlist" 'energize-write-project-list)
|
|
689 "-----"
|
|
690 (energize-def-menu-item "setprojectdisplay"
|
|
691 'energize-set-project-display)
|
|
692 (list "Target Display"
|
|
693 (energize-def-menu-item "fulltargets"
|
|
694 'energize-full-targets)
|
|
695 (energize-def-menu-item "abbreviatetargets"
|
|
696 'energize-abbreviate-targets))
|
|
697 "-----"
|
|
698 (energize-def-menu-item "revertproject"
|
|
699 'energize-fully-revert-project-buffer)
|
|
700 )
|
|
701 )
|
|
702
|
|
703
|
|
704 '("Buffers" ["List All Buffers" list-buffers t]
|
|
705 "--!here" ; anything after this will be nuked
|
|
706 )
|
|
707
|
|
708 nil ; the partition: menus after this are flushright
|
|
709
|
|
710 ;; We don't make any changes to the Help menu.
|
|
711 ;; WelcomeMat requires one change: added separately though
|
|
712 (car (find-menu-item default-menubar '("Help")))
|
|
713 )))
|
|
714
|
|
715 ;; For this command, the menu name (the resource) is "currentproject"
|
|
716 ;; but the Energize command is "project". the Energize command is
|
|
717 ;; historical, and the resource name was changed so that the "Project"
|
|
718 ;; menu and the "Project" menu item don't necessarily have to be the
|
|
719 ;; same text.
|
|
720 ;;
|
|
721 (energize-def-menu-item "project" 'energize-pop-to-project-buffer)
|
|
722
|
|
723 ;; code for tighter integration with specific tools
|
|
724
|
|
725 (defun energize-menu-connect-directly ()
|
|
726 (interactive)
|
|
727 (connect-to-energize nil))
|
|
728
|
|
729 (defvar energize-instrument-menu-options nil
|
|
730 "List of menu items which are instruments for Energize targets")
|
|
731
|
|
732 (defun energize-define-instrumentatarget-using-tool (tool)
|
|
733 "Add a menu item (and function) supporting instrumenting a particular tool"
|
|
734 (let ((function (intern (concat "energize-instrumentatarget-using-" tool)))
|
|
735 (l energize-instrument-menu-options)
|
|
736 (name (if (equal tool "") "DBX Compatible" (capitalize tool))))
|
|
737 (add-menu-item '("Project") (cons name "")
|
|
738 function
|
|
739 '(connected-to-energize-p)
|
|
740 "instrumentatarget")
|
|
741 (add-hook 'energize-hack-popup-hook 'energize-hack-instruments-in-popup)
|
|
742 (while (and l (not (equal (car l) tool)))
|
|
743 (setq l (cdr l)))
|
|
744 (if (null l) (setq energize-instrument-menu-options
|
|
745 (cons tool energize-instrument-menu-options)))
|
|
746 (fset function
|
|
747 (` (lambda ()
|
|
748 (, (format "Instruments a target using \"%s\"" tool))
|
|
749 (interactive)
|
|
750 (energize-execute-command "instrumentatarget" nil
|
|
751 (, tool) t))))))
|
|
752
|
|
753 (defun energize-hack-instruments-in-popup (ex m)
|
|
754 (let ((l (cdr m)))
|
|
755 (while l
|
|
756 (if (equal (aref (car l) 0) "instrument")
|
|
757 (let ((r energize-instrument-menu-options)
|
|
758 v)
|
|
759 (while r
|
|
760 (setq v (vconcat (car l)))
|
|
761 (let ((name
|
|
762 (if (equal (car r) "") "DBX Compatible"
|
|
763 (capitalize (car r)))))
|
|
764 (aset (car l) 0 name))
|
|
765 (aset (car l) 1 (intern (concat
|
|
766 "energize-instrumentatarget-using-"
|
|
767 (car r))))
|
|
768 (setcdr l (cons v (cdr l)))
|
|
769 (setq r (cdr r)))
|
|
770 (setq l nil))
|
|
771 (setq l (cdr l))))
|
|
772 m))
|
|
773
|
|
774 (defun energize-sensitize-instruments-hook ()
|
|
775 "Sensitize the menubar by adding the executable to any derived
|
|
776 instrumented targets"
|
|
777 (condition-case nil ; in case Project menu doesn't exist
|
|
778 (let* ((l energize-instrument-menu-options)
|
|
779 (institem
|
|
780 (car (find-menu-item current-menubar
|
|
781 '("Project" "instrumentatarget"))))
|
|
782 (exenable (aref institem 2))
|
|
783 (exname (aref institem 3))
|
|
784 item)
|
|
785 (while l
|
|
786 (let ((citem (if (equal (car l) "") "DBX Compatible" (car l))))
|
|
787 (setq item (car (find-menu-item current-menubar
|
|
788 (list "Project" citem)))))
|
|
789 (aset item 2 exenable)
|
|
790 (aset item 3 exname)
|
|
791 (setq l (cdr l))))
|
|
792 (error nil)))
|
|
793
|
|
794 (defun energize-set-default-menubar ()
|
|
795 (set-menubar energize-menubar)
|
|
796 (add-hook 'activate-menubar-hook 'build-buffers-menu-hook)
|
|
797 (add-hook 'activate-menubar-hook 'sensitize-file-and-edit-menus-hook)
|
|
798 (add-hook 'activate-menubar-hook 'energize-sensitize-instruments-hook 't)
|
|
799 (setq buffers-menu-max-size 20)
|
|
800 (setq complex-buffers-menu-p nil))
|
|
801
|
|
802 (energize-set-default-menubar)
|
|
803
|
|
804
|
|
805 ;; enable purify & plain dbx by default
|
|
806 ;; you can enable the others by copying to .emacs and uncommenting ...
|
|
807 ;; can't do this here because this file comes preloaded.
|
|
808
|
|
809 (energize-define-instrumentatarget-using-tool "")
|
|
810 (energize-define-instrumentatarget-using-tool "purify")
|
|
811 ;; (energize-define-instrumentatarget-using-tool "quantify")
|
|
812 ;; (energize-define-instrumentatarget-using-tool "sentinel")
|
|
813 ;; (energize-define-instrumentatarget-using-tool "tc")
|
|
814 ;; (energize-define-instrumentatarget-using-tool "time")
|
|
815 ;; (energize-define-instrumentatarget-using-tool "xproba")
|
|
816
|
|
817 ;; add the menu item Help->About Energize for the Energize Welcome Mat
|
|
818 (add-menu-item '("Help") (purecopy "About Energize")
|
|
819 'energize-about-energize t)
|
|
820
|
|
821 (defun energize-about-energize ()
|
|
822 (interactive)
|
|
823 (start-process "about-energize" nil "about_energize"))
|
|
824
|
|
825 (defun energize-kill-server ()
|
|
826 "Kill the Energize server and all buffers associated with it."
|
|
827 (interactive)
|
|
828 (condition-case nil
|
|
829 (energize-execute-command "energizeShutdownServer")
|
|
830 (error nil)))
|
|
831
|
|
832 (defun energize-unix-manual ()
|
|
833 "Display a manual entry; if connected to Energize, uses the Energize version.
|
|
834 Otherwise, just runs the normal emacs `manual-entry' command."
|
|
835 (interactive)
|
|
836 (if (connected-to-energize-p)
|
|
837 (energize-execute-command "manual")
|
|
838 (call-interactively 'manual-entry)))
|
|
839
|
|
840 ;;; These functions are used in the menubar activate hook to update the
|
|
841 ;;; enable state of the menu items
|
|
842
|
|
843 (defvar active-items) ; quiet compiler
|
|
844 (defsubst activate-energize-menu-item-internal (item)
|
|
845 (cond
|
|
846 ((vectorp item)
|
|
847 (let ((fn (aref item 1)))
|
|
848 (if (not (and (symbolp fn) (get fn 'energize-name)))
|
|
849 nil
|
|
850 ;; Referencing special binding of `active-items' from a-e-m-i-hook.
|
|
851 ;; If the function which this item invokes is an Energize function
|
|
852 ;; (determined by the presence of an 'energize-name property) then
|
|
853 ;; make it be active iff it's on the active-items list.
|
|
854 (let ((active-p (assq fn active-items))
|
|
855 (change-p nil))
|
|
856 (if (not (eq (not active-p) (not (aref item 2))))
|
|
857 (progn
|
|
858 (aset item 2 (not (not active-p)))
|
|
859 (setq change-p t)))
|
|
860 (if (and active-p
|
|
861 (not (equal (cdr active-p)
|
|
862 (if (> (length item) 3)
|
|
863 (aref item 3)
|
|
864 nil))))
|
|
865 (progn
|
|
866 (aset item 3 (cdr active-p))
|
|
867 (setq change-p t)))
|
|
868 change-p))))
|
|
869 ((consp item) ; descend nested submenus
|
|
870 (activate-energize-menu-items-internal (cdr item)))
|
|
871 (t nil)))
|
|
872
|
|
873 (defun activate-energize-menu-items-internal (items)
|
|
874 (let ((change-p nil))
|
|
875 (if (not (consp items))
|
|
876 (activate-energize-menu-item-internal items)
|
|
877 (while items
|
|
878 (setq change-p (or (activate-energize-menu-item-internal (car items))
|
|
879 change-p)
|
|
880 items (cdr items)))
|
|
881 change-p)))
|
|
882
|
|
883 (defun energize-build-menubar-names ()
|
|
884 ;;; makes the list of currently active menu items.
|
|
885 (let* ((selection-p (x-selection-exists-p 'PRIMARY))
|
|
886 (menubar
|
|
887 (if (< (cdr (energize-protocol-level)) 7)
|
|
888 (energize-with-timeout
|
|
889 "Getting updated menubar from Energize server..."
|
|
890 (energize-list-menu (current-buffer) () selection-p))
|
|
891 (append energize-menu-state energize-default-menu-state))))
|
|
892 (delq nil
|
|
893 (mapcar '(lambda (x)
|
|
894 (and (vectorp x)
|
|
895 (if (/= 0 (logand 1 (aref x 3)))
|
|
896 nil
|
|
897 (cons
|
|
898 (symbol-value
|
|
899 (intern-soft (aref x 0)
|
|
900 energize-menu-item-table))
|
|
901 (aref x 4)))))
|
|
902 menubar))))
|
|
903
|
|
904 (defun activate-energize-menu-items-hook ()
|
|
905 ;; This is O^2 because of the `rassq', but it looks like the elisp part
|
|
906 ;; of it only takes .03 seconds.
|
|
907 (if (connected-to-energize-p)
|
|
908 (let* ((items current-menubar)
|
|
909 (change-p nil)
|
|
910 ;; dynamically used by activate-energize-menu-item-internal
|
|
911 (active-items (energize-build-menubar-names))
|
|
912 item)
|
|
913 (while items
|
|
914 (setq item (car items)
|
|
915 change-p (or (and item (activate-energize-menu-items-internal
|
|
916 (if (consp item) (cdr item) item)))
|
|
917 change-p)
|
|
918 items (cdr items)))
|
|
919 (not change-p))))
|
|
920
|
|
921 (add-hook 'activate-menubar-hook 'activate-energize-menu-items-hook t)
|
|
922
|
|
923 (defun deactivate-all-energize-menu-items ()
|
|
924 (let ((items current-menubar)
|
|
925 ;; dynamically used by activate-energize-menu-item-internal
|
|
926 (active-items nil)
|
|
927 item)
|
|
928 (while items
|
|
929 (if (setq item (car items))
|
|
930 (activate-energize-menu-items-internal
|
|
931 (if (consp item) (cdr item) item)))
|
|
932 (setq items (cdr items)))))
|
|
933
|
|
934
|
|
935 ;;; The Options menu
|
|
936
|
|
937 (setq options-menu-saved-forms
|
|
938 (purecopy
|
|
939 (append
|
|
940 options-menu-saved-forms
|
|
941 '((list 'energize-set-edit-modes
|
|
942 (if energize-external-editor
|
|
943 (symbol-name energize-external-editor))
|
|
944 (list 'quote energize-vi-terminal-emulator)
|
|
945 (list 'quote energize-internal-viewer)
|
|
946 (list 'quote energize-internal-editor)
|
|
947 (cond ((get 'browser 'instance-limit) ''multi)
|
|
948 ((get 'energize-top-level-mode 'screen-name)
|
|
949 ''several)
|
|
950 (t ''single))
|
|
951 (list 'quote energize-split-screens-p)
|
|
952 )
|
|
953 (if sc-mode
|
|
954 (list 'sc-mode (list 'quote sc-mode))
|
|
955 '(if (featurep 'generic-sc) (sc-mode nil)))
|
|
956 ))))
|
|
957
|
|
958
|
|
959 ;;; Popup-menus
|
|
960
|
|
961 (defvar energize-popup-menu)
|
|
962
|
|
963 (defvar energize-hack-popup-hook '()
|
|
964 "Hook for all functions that want to hack at the Energize popup menus.
|
|
965 Each function takes two arguments: an extent (or nil if none) and a menu
|
|
966 (or nil if none currently). It should return a menu (or nil)")
|
|
967
|
|
968 (defun energize-popup-menu (event)
|
|
969 (interactive "e")
|
|
970 (if (popup-menu-up-p)
|
|
971 ()
|
|
972 (if (null (event-over-text-area-p event))
|
|
973 ;; clicking in non-text areas was causing errors...way bogus!
|
|
974 (popup-mode-menu)
|
|
975 (let* ((buffer (event-buffer event))
|
|
976 (extent (if (extentp (event-glyph-extent event))
|
|
977 (event-glyph-extent event)
|
|
978 (energize-menu-extent-at (event-point event) buffer)))
|
|
979 choices)
|
|
980 (select-window (event-window event))
|
|
981 (if extent
|
|
982 (progn
|
|
983 (energize-with-timeout
|
|
984 "Asking Energize server for menu contents..."
|
|
985 (setq choices
|
|
986 (cdr
|
|
987 (cdr
|
|
988 (energize-list-menu buffer extent
|
|
989 (x-selection-exists-p 'PRIMARY))))))))
|
|
990 (if (or (null extent) (null choices))
|
|
991 (if (null (setq energize-popup-menu
|
|
992 (energize-extent-run-hook energize-hack-popup-hook
|
|
993 nil nil)))
|
|
994 (error "No menu to pop up"))
|
|
995 (force-highlight-extent extent t)
|
|
996 (sit-for 0)
|
|
997 (setq energize-popup-menu
|
|
998 (cons "energizePopup"
|
|
999 (mapcar
|
|
1000 (function (lambda (item)
|
|
1001 (vector
|
|
1002 (aref item 0)
|
|
1003 (list 'energize-execute-command
|
|
1004 (aref item 0)
|
|
1005 extent)
|
|
1006 (= 0 (logand 1 (aref item 3)))
|
|
1007 (aref item 4))))
|
|
1008 choices)))
|
|
1009 (setq energize-popup-menu
|
|
1010 (external-editor-hack-popup
|
|
1011 (energize-extent-run-hook energize-hack-popup-hook
|
|
1012 extent energize-popup-menu))))
|
|
1013 (if (equal (car energize-popup-menu) "energizePopup")
|
|
1014 (let ((popup-menu-titles nil))
|
|
1015 (popup-menu 'energize-popup-menu))
|
|
1016 (popup-menu 'energize-popup-menu))))))
|
|
1017
|
|
1018 (defun energize-extent-run-hook (f ex m)
|
|
1019 (if f
|
|
1020 (energize-extent-run-hook (cdr f) ex (funcall (car f) ex m))
|
|
1021 m))
|
|
1022
|
|
1023 ;;; Functions to interactively execute menu items by their names.
|
|
1024
|
|
1025 (defun energize-menu-extent-at (pos buffer)
|
|
1026 (if (null pos)
|
|
1027 nil
|
|
1028 (let ((extent (energize-extent-at pos buffer)))
|
|
1029 (if (and extent (energize-extent-menu-p extent))
|
|
1030 extent
|
|
1031 nil))))
|
|
1032
|
|
1033 ;;; functions to execute the menu with the keyboard
|
|
1034 (defun default-selection-value-for-item (menu-item)
|
|
1035 (let ((flags (aref menu-item 3)))
|
|
1036 (cond ((= (logand flags 2) 2)
|
|
1037 (if (x-selection-owner-p 'PRIMARY)
|
|
1038 (x-get-selection-internal 'PRIMARY 'STRING)))
|
|
1039 ((= (logand flags 4) 4)
|
|
1040 (if (x-selection-owner-p 'PRIMARY)
|
|
1041 (x-get-selection-internal 'PRIMARY 'ENERGIZE_OBJECT)))
|
|
1042 ((= (logand flags 128) 128)
|
|
1043 (if (x-selection-owner-p 'SECONDARY)
|
|
1044 (x-get-selection-internal 'SECONDARY 'STRING)))
|
|
1045 ((= (logand flags 256) 256)
|
|
1046 (if (x-selection-owner-p 'SECONDARY)
|
|
1047 (x-get-selection-internal 'SECONDARY 'ENERGIZE_OBJECT))))))
|
|
1048
|
|
1049 (defun energize-execute-menu-item-with-selection (buffer
|
|
1050 extent
|
|
1051 item
|
|
1052 selection
|
|
1053 no-confirm)
|
|
1054 (if (/= 0 (logand 1 (aref item 3)))
|
|
1055 (error "The `%s' command is inappropriate in this context"
|
|
1056 (aref item 0)))
|
|
1057 (if (null selection)
|
|
1058 (setq selection (default-selection-value-for-item item)))
|
|
1059 (energize-execute-menu-item buffer extent item selection no-confirm))
|
|
1060
|
|
1061 (defun energize-find-item (name list)
|
|
1062 (let ((l list) i (found ()))
|
|
1063 (while (and l (not found))
|
|
1064 (setq i (car l) l (cdr l))
|
|
1065 (if (and (vectorp i) (equal (aref i 0) name))
|
|
1066 (setq found i)))
|
|
1067 found))
|
|
1068
|
|
1069 (defun energize-menu-item-for-name (extent name)
|
|
1070 (if (or extent (< (cdr (energize-protocol-level)) 7))
|
|
1071 (energize-with-timeout
|
|
1072 "Checking Energize command with kernel..."
|
|
1073 (energize-list-menu (current-buffer) extent
|
|
1074 (x-selection-exists-p 'PRIMARY) name))
|
|
1075 (or (energize-find-item name energize-menu-state)
|
|
1076 (energize-find-item name energize-default-menu-state))))
|
|
1077
|
|
1078 (defun energize-execute-command (name &optional extent selection no-confirm)
|
|
1079 ;; add completion here...
|
|
1080 (interactive "sExecute Energize command named: ")
|
|
1081
|
|
1082 (if (not (stringp name))
|
|
1083 (error "Can't execute a choice, %s, that is not a string" name))
|
|
1084
|
|
1085 (or (connected-to-energize-p) (error "Not connected to Energize"))
|
|
1086
|
|
1087 ;; patch the selection argument for "setbreakpoint"
|
|
1088 (if (and (equal name "setbreakpoint")
|
|
1089 (null selection))
|
|
1090 (setq selection
|
|
1091 (save-excursion
|
|
1092 (vector (energize-buffer-id (current-buffer))
|
|
1093 (progn (beginning-of-line)
|
|
1094 (energize-file-position (point))))
|
|
1095 (progn (end-of-line)
|
|
1096 (energize-file-position (point))))))
|
|
1097 (let* ((buffer (current-buffer))
|
|
1098 (extent (if extent
|
|
1099 (if (extentp extent)
|
|
1100 extent
|
|
1101 (energize-menu-extent-at (point) buffer))
|
|
1102 nil)))
|
|
1103 (if (< (cdr (energize-protocol-level)) 7)
|
|
1104 ;; old way
|
|
1105 (let ((item (energize-menu-item-for-name extent name)))
|
|
1106 (if (not item)
|
|
1107 (error "No Energize command named %s" name))
|
|
1108 (energize-execute-menu-item-with-selection buffer extent item
|
|
1109 selection no-confirm))
|
|
1110 ;; new way
|
|
1111 (if (and (null selection)
|
|
1112 (x-selection-exists-p 'PRIMARY))
|
|
1113 (setq selection
|
|
1114 (condition-case
|
|
1115 ()
|
|
1116 (x-get-selection-internal 'PRIMARY 'STRING)
|
|
1117 (error ""))))
|
|
1118 (let ((energize-make-many-buffers-visible-should-enqueue-event
|
|
1119 (equal name "save")))
|
|
1120 (energize-execute-command-internal buffer
|
|
1121 extent
|
|
1122 name
|
|
1123 selection
|
|
1124 no-confirm)))))
|
|
1125
|
|
1126
|
|
1127
|
|
1128 ;;; Buffer modified the first time hook
|
|
1129 ;;; Should be in energize-init.el but is here to benefit from the
|
|
1130 ;;; add-timeout macro
|
|
1131
|
|
1132 (defun energize-check-if-buffer-locked ()
|
|
1133 (if (connected-to-energize-p)
|
|
1134 (energize-with-timeout
|
|
1135 "Asking Energize server if buffer is editable..."
|
|
1136 (energize-barf-if-buffer-locked))))
|
|
1137
|
|
1138 (add-hook 'first-change-hook 'energize-check-if-buffer-locked)
|
|
1139
|
|
1140
|
|
1141 ;;; Here's a converter that makes emacs understand how to convert to
|
|
1142 ;;; selections of type ENERGIZE. Eventually the Energize server won't
|
|
1143 ;;; be using the selection mechanism any more, I hope.
|
|
1144
|
|
1145 (defun xselect-convert-to-energize (selection type value)
|
|
1146 (let (str id start end tmp)
|
|
1147 (cond ((and (consp value)
|
|
1148 (markerp (car value))
|
|
1149 (markerp (cdr value)))
|
|
1150 (setq id (energize-buffer-id (marker-buffer (car value)))
|
|
1151 start (1- (marker-position (car value))) ; zero based
|
|
1152 end (1- (marker-position (cdr value)))))
|
|
1153 ((extentp value)
|
|
1154 (setq id (extent-to-generic-id value)
|
|
1155 start 0
|
|
1156 end 0)))
|
|
1157 (if (null id)
|
|
1158 nil
|
|
1159 (setq str (make-string 12 0))
|
|
1160 (if (< end start) (setq tmp start start end end tmp))
|
|
1161 (aset str 0 (logand (ash (car id) -8) 255))
|
|
1162 (aset str 1 (logand (car id) 255))
|
|
1163 (aset str 2 (logand (ash (cdr id) -8) 255))
|
|
1164 (aset str 3 (logand (cdr id) 255))
|
|
1165 (aset str 4 (logand (ash start -24) 255))
|
|
1166 (aset str 5 (logand (ash start -16) 255))
|
|
1167 (aset str 6 (logand (ash start -8) 255))
|
|
1168 (aset str 7 (logand start 255))
|
|
1169 (aset str 8 (logand (ash end -24) 255))
|
|
1170 (aset str 9 (logand (ash end -16) 255))
|
|
1171 (aset str 10 (logand (ash end -8) 255))
|
|
1172 (aset str 11 (logand end 255))
|
|
1173 (cons 'ENERGIZE_OBJECT str))))
|
|
1174
|
|
1175
|
|
1176 (or (assq 'ENERGIZE_OBJECT selection-converter-alist)
|
|
1177 (setq selection-converter-alist
|
|
1178 (cons '(ENERGIZE_OBJECT . xselect-convert-to-energize)
|
|
1179 selection-converter-alist)))
|
|
1180
|
|
1181
|
|
1182 ;;; Function keys.
|
|
1183
|
|
1184 (defun energize-define-function-keys ()
|
|
1185 "Define some Borland/Motif-like `F' keys for Energize."
|
|
1186 (define-key global-map 'f1 'help-for-help)
|
|
1187 (define-key global-map 'f3 'energize-search)
|
|
1188 (define-key global-map '(shift delete) 'x-kill-primary-selection)
|
|
1189 (define-key global-map '(control insert) 'x-copy-primary-selection)
|
|
1190 (define-key global-map '(shift insert) 'x-yank-clipboard-selection)
|
|
1191 (define-key global-map '(control delete) 'x-delete-primary-selection)
|
|
1192
|
|
1193 (define-key global-map 'f7 'energize-browse-error)
|
|
1194 (define-key global-map '(meta f7) 'next-error)
|
|
1195 (define-key global-map '(meta f8) 'previous-error)
|
|
1196
|
|
1197 (define-key global-map 'f9 'energize-build-a-target)
|
|
1198 (define-key global-map '(meta f9) 'energize-default-compile-file)
|
|
1199 (define-key global-map '(control f9) 'energize-run-target)
|
|
1200 (define-key global-map '(meta shift f9) 'energize-abort-build)
|
|
1201
|
|
1202 (define-key global-map '(meta control ?.) 'energize-edit-declaration-dbox)
|
|
1203 (define-key global-map 'f5 'energize-browse-language-elt)
|
|
1204 (define-key global-map '(shift f5) 'energize-next-use-start)
|
|
1205 (define-key global-map '(control f5) 'energize-next-use-command)
|
|
1206 )
|
|
1207
|