Mercurial > hg > xemacs-beta
comparison 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 |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:376386a54a3c |
|---|---|
| 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 |