Mercurial > hg > xemacs-beta
comparison lisp/energize/energize-mode.el @ 0:376386a54a3c r19-14
Import from CVS: tag r19-14
| author | cvs |
|---|---|
| date | Mon, 13 Aug 2007 08:45:50 +0200 |
| parents | |
| children | ec9a17fef872 |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:376386a54a3c |
|---|---|
| 1 ;;; -*- Mode:Emacs-Lisp -*- | |
| 2 ;;; Copyright © 1991-1993 by Lucid, Inc. All Rights Reserved. | |
| 3 | |
| 4 (eval-when-compile | |
| 5 (require 'etags)) | |
| 6 | |
| 7 ;; true if current-buffer is an energize buffer that does not support | |
| 8 ;; the real write-file and so has to do the special energize way of doing | |
| 9 ;; write-file that loses the annotations. | |
| 10 (defun energize-write-file-buffer-p () | |
| 11 ;; (and (energize-buffer-p (current-buffer) | |
| 12 ;; (not (eq major-mode 'energize-project-mode))) | |
| 13 (energize-buffer-p (current-buffer))) | |
| 14 | |
| 15 | |
| 16 (defun energize-beginning-of-defun (&optional arg) | |
| 17 "Move point to the beginning of the current top-level form. | |
| 18 With a numeric argument, move back that many forms." | |
| 19 (interactive "_p") | |
| 20 (or arg (setq arg 1)) | |
| 21 (if (not (energize-buffer-p (current-buffer))) | |
| 22 (error "Not an Energize buffer") | |
| 23 (if (< arg 0) | |
| 24 (energize-end-of-defun (- arg)) | |
| 25 (while (> arg 0) | |
| 26 (or (bobp) (forward-char -1)) | |
| 27 (while (and (not (bobp)) (null (energize-extent-at (point)))) | |
| 28 (forward-char -1)) | |
| 29 (let ((pos (point))) | |
| 30 (map-extents | |
| 31 (function | |
| 32 (lambda (extent dummy) | |
| 33 (if (< (setq pos (extent-start-position extent)) (point)) | |
| 34 (goto-char pos)))) | |
| 35 (current-buffer) (point) (point) nil t)) | |
| 36 (setq arg (1- arg)))))) | |
| 37 | |
| 38 (defun energize-end-of-defun (&optional arg) | |
| 39 "Move point to the end of the current top-level form. | |
| 40 With a numeric argument, move forward over that many forms." | |
| 41 (interactive "_p") | |
| 42 (or arg (setq arg 1)) | |
| 43 (if (not (energize-buffer-p (current-buffer))) | |
| 44 (error "Not an Energize buffer") | |
| 45 (if (< arg 0) | |
| 46 (energize-beginning-of-defun (- arg)) | |
| 47 (while (> arg 0) | |
| 48 (or (eobp) (forward-char 1)) | |
| 49 (while (and (not (eobp)) (null (energize-extent-at (point)))) | |
| 50 (forward-char 1)) | |
| 51 (let ((pos (point))) | |
| 52 (map-extents | |
| 53 (function | |
| 54 (lambda (extent dummy) | |
| 55 (if (> (setq pos (extent-end-position extent)) (point)) | |
| 56 (goto-char pos)))) | |
| 57 (current-buffer) (point) (point) nil t)) | |
| 58 (setq arg (1- arg)))))) | |
| 59 | |
| 60 | |
| 61 ;;; Patching Energize into file I/O via the standard hooks. | |
| 62 | |
| 63 (defun energize-write-data-hook (name) | |
| 64 ;; for use as the last element of write-file-data-hooks | |
| 65 ;; in energize buffers. | |
| 66 (if (energize-buffer-p (current-buffer)) | |
| 67 (progn | |
| 68 (message "saving %s to Energize..." name) | |
| 69 (energize-execute-command "save") | |
| 70 (energize-update-menubar) | |
| 71 (message "saved %s to Energize." name) | |
| 72 t) | |
| 73 nil)) | |
| 74 | |
| 75 (defun energize-revert-buffer-insert-file-contents-hook (file noconfirm) | |
| 76 ;; for use as the value of revert-buffer-insert-file-contents-function | |
| 77 ;; in energize buffers. | |
| 78 (if (not (energize-buffer-p (current-buffer))) | |
| 79 (error "energize-revert-buffer-hook called for a non-energize buffer")) | |
| 80 (widen) | |
| 81 (cond ((equal file buffer-file-name) ; reverting from energize | |
| 82 ;; Do the default as in files.el | |
| 83 (if (file-exists-p file) | |
| 84 (progn | |
| 85 ;; Bind buffer-file-name to nil | |
| 86 ;; so that we don't try to lock the file. | |
| 87 (let ((buffer-file-name nil)) | |
| 88 (unlock-buffer) | |
| 89 (erase-buffer)) | |
| 90 (insert-file-contents file t))) | |
| 91 ;; Then asks the extents from Energize | |
| 92 (energize-execute-command "revert")) | |
| 93 (t ; reverting from autosave | |
| 94 (if (not (file-exists-p file)) | |
| 95 (error "File %s no longer exists!" file)) | |
| 96 (erase-buffer) | |
| 97 (insert-file-contents file))) | |
| 98 t) | |
| 99 | |
| 100 | |
| 101 (defun energize-kill-buffer-hook () | |
| 102 ;; for use as the value of kill-buffer-hook in energize buffers. | |
| 103 (if (energize-buffer-p (current-buffer)) | |
| 104 (energize-request-kill-buffer (current-buffer)) | |
| 105 (error "energize-kill-buffer-hook called on a non-energize buffer")) | |
| 106 t) | |
| 107 | |
| 108 | |
| 109 ;;; | |
| 110 | |
| 111 (defun energize-edit-definition-default () | |
| 112 (save-excursion | |
| 113 (if (not (memq (char-syntax (preceding-char)) '(?w ?_))) | |
| 114 (while (not (looking-at "\\sw\\|\\s_\\|\\'")) | |
| 115 (forward-char 1))) | |
| 116 (while (looking-at "\\sw\\|\\s_") | |
| 117 (forward-char 1)) | |
| 118 (if (re-search-backward "\\sw\\|\\s_" nil t) | |
| 119 (progn (forward-char 1) | |
| 120 (buffer-substring (point) | |
| 121 (progn (forward-sexp -1) | |
| 122 (while (looking-at "\\s'") | |
| 123 (forward-char 1)) | |
| 124 (point)))) | |
| 125 nil))) | |
| 126 | |
| 127 ;;; This prompts in the minibuffer, ##### with no completion. | |
| 128 (defun energize-edit-definition (def) | |
| 129 "If connected to Energize, the Energize database is used. | |
| 130 Otherwise, `find-tag' is invoked. | |
| 131 The X selection is used as a default, if it exists and contains no | |
| 132 newlines. Otherwise, the preceeding token is used as a default. | |
| 133 If invoked from a mouse command, prompting happens with a dialog box; | |
| 134 otherwise, the minibuffer is used." | |
| 135 (interactive | |
| 136 (if (and (connected-to-energize-p) | |
| 137 (or (menu-event-p last-command-event) | |
| 138 (button-press-event-p last-command-event) | |
| 139 (button-release-event-p last-command-event))) | |
| 140 '(nil) | |
| 141 (list | |
| 142 (let (default | |
| 143 def) | |
| 144 (cond ((x-selection-owner-p) | |
| 145 (setq default (x-get-selection)) | |
| 146 (while (string-match "\\`[ \t\n]+" default) | |
| 147 (setq default (substring default (match-end 0)))) | |
| 148 (while (string-match "[ \t\n]+\\'" default) | |
| 149 (setq default (substring default 0 (match-beginning 0)))) | |
| 150 (if (string-match "[ \t\n]" default) | |
| 151 (setq default nil)))) | |
| 152 (or default (setq default (energize-edit-definition-default))) | |
| 153 (setq def | |
| 154 (if (connected-to-energize-p) | |
| 155 (completing-read | |
| 156 (if default | |
| 157 (format "Edit definition [%s]: " default) | |
| 158 "Edit definition: ") | |
| 159 nil nil; 'energize-edit-def-predicate | |
| 160 nil nil) | |
| 161 (or (and (fboundp 'find-tag-tag) (fboundp 'find-tag-default)) | |
| 162 (require 'tags "etags")) | |
| 163 (find-tag-tag "Edit definition: "))) | |
| 164 (if (or (equal "" def) | |
| 165 (equal '("") def)) | |
| 166 (setq def default)) | |
| 167 def)))) | |
| 168 (if (connected-to-energize-p) | |
| 169 ;; FIXME - this should fall back on tags if it fails...we might be | |
| 170 ;; searching for elisp or something... | |
| 171 (energize-execute-command "editdef" () (if (consp def) (car def) def) t) | |
| 172 (find-tag def))) | |
| 173 | |
| 174 (define-key global-map "\M-." 'energize-edit-definition) | |
| 175 (define-key global-map "\M-B" 'energize-build-a-target) ; M-Sh-B | |
| 176 | |
| 177 (defun disconnect-from-energize-query () | |
| 178 "Disconnect this emacs from the Energize server, after confirming." | |
| 179 (interactive) | |
| 180 (or (y-or-n-p "Disconnect from Energize? ") (error "not confirmed")) | |
| 181 (disconnect-from-energize)) | |
| 182 | |
| 183 | |
| 184 ;;; Functions to add commands to the project buffers | |
| 185 (defun energize-insert-slots (got-to-top-p l) | |
| 186 (if (not (eq major-mode 'energize-project-mode)) | |
| 187 (error "Command available only in project buffers")) | |
| 188 ;; move to a suitable place | |
| 189 (if got-to-top-p | |
| 190 (beginning-of-buffer) | |
| 191 (beginning-of-line)) | |
| 192 ;; go before "Associated Projects" and "Related Files" | |
| 193 (if (or (search-backward "Related Projects:" () t) | |
| 194 (search-backward "Associated Files:" () t) | |
| 195 (looking-at "Related Projects:") | |
| 196 (looking-at "Associated Files:")) | |
| 197 (previous-line 2)) | |
| 198 ;; find empty space | |
| 199 (while (and (not (looking-at "$")) | |
| 200 (not (eq (point) (point-max)))) | |
| 201 (next-line 1)) | |
| 202 (newline) | |
| 203 (save-excursion | |
| 204 (mapcar '(lambda (i) (insert i) (newline)) l)) | |
| 205 ;; this is magic | |
| 206 (forward-char 18)) | |
| 207 | |
| 208 (defun energize-insert-rule () | |
| 209 (interactive) | |
| 210 (energize-insert-slots | |
| 211 t | |
| 212 '(" Rules:" | |
| 213 " <rule>: lcc -Xez -c -g -Xa -o $object $source"))) | |
| 214 | |
| 215 (defun energize-insert-object-file-target () | |
| 216 (interactive) | |
| 217 (energize-insert-slots | |
| 218 () | |
| 219 '(" Object File: <object-file>" | |
| 220 " Source File: <source-file>" | |
| 221 " Build Rule: <rule>"))) | |
| 222 | |
| 223 (defun energize-insert-executable-target () | |
| 224 (interactive) | |
| 225 (energize-insert-slots | |
| 226 () | |
| 227 '(" Executable: <executable>" | |
| 228 " Build Command: lcc -Xf -Xez -o $object <object-file> ..."))) | |
| 229 | |
| 230 (defun energize-insert-library-target () | |
| 231 (interactive) | |
| 232 (energize-insert-slots | |
| 233 () | |
| 234 '(" Library: <library>" | |
| 235 " Build Command: energize_ar -Xez -remove -ranlib clq $object \\" | |
| 236 " <object-file> ..."))) | |
| 237 | |
| 238 (defun energize-insert-collection-target () | |
| 239 (interactive) | |
| 240 (energize-insert-slots | |
| 241 () | |
| 242 '(" Collection: <collection>" | |
| 243 " Build Command: energize_collect -Xez -o $object <object-file> ..."))) | |
| 244 | |
| 245 (defun energize-insert-file-target () | |
| 246 (interactive) | |
| 247 (energize-insert-slots | |
| 248 () | |
| 249 '(" File Target: <target>" | |
| 250 " Dependencies: <target> ..." | |
| 251 " Build Command: <shell-command>"))) | |
| 252 | |
| 253 (defun energize-insert-target-target () | |
| 254 (interactive) | |
| 255 (energize-insert-slots | |
| 256 () | |
| 257 '(" Target: <target>" | |
| 258 " Dependencies: <target> ..." | |
| 259 " Build Command: <shell-command>"))) | |
| 260 | |
| 261 | |
| 262 | |
| 263 ;;; Keymaps for Energize buffers. | |
| 264 | |
| 265 (defvar energize-map nil "*Parent keymap for all Energize buffers") | |
| 266 (defvar energize-top-level-map nil "*Keymap for the Energize top-level buffer") | |
| 267 (defvar energize-debugger-map nil "*Keymap for Energize debugger buffers") | |
| 268 (defvar energize-breakpoint-map nil "*Keymap for Energize breakpoint-lists") | |
| 269 (defvar energize-browser-map nil "*Keymap for Energize browser buffers") | |
| 270 (defvar energize-project-map nil "*Keymap for Energize project buffers") | |
| 271 (defvar energize-no-file-project-map nil | |
| 272 "*Keymap for Energize project buffers not associated with a file") | |
| 273 (defvar energize-source-map nil "*Keymap for Energize source buffers") | |
| 274 | |
| 275 (defvar energize-mode-hook nil | |
| 276 "Hook called when each energize buffer is created.") | |
| 277 (defvar energize-top-level-mode-hook nil | |
| 278 "Hook called when the energize top-level buffer is created.") | |
| 279 (defvar energize-project-mode-hook nil | |
| 280 "Hook called when an Energize project buffer is created.") | |
| 281 (defvar energize-no-file-project-mode-hook nil | |
| 282 "Hook called when an Energize project buffer with no file is created.") | |
| 283 (defvar energize-breakpoint-mode-hook nil | |
| 284 "Hook called when an Energize breakpoint-list buffer is created.") | |
| 285 (defvar energize-browser-mode-hook nil | |
| 286 "Hook called when an Energize browser buffer is created.") | |
| 287 (defvar energize-log-mode-hook nil | |
| 288 "Hook called when an Energize log buffer is created.") | |
| 289 (defvar energize-manual-mode-hook nil | |
| 290 "Hook called when an Energize manual buffer is created.") | |
| 291 (defvar energize-source-mode-hook nil | |
| 292 "Hook called when any source buffer is placed in the Energize minor-mode.") | |
| 293 | |
| 294 | |
| 295 (if energize-map | |
| 296 nil | |
| 297 (setq energize-map (make-sparse-keymap)) | |
| 298 (set-keymap-name energize-map 'energize-map) | |
| 299 (define-key energize-map "\^C\^F" 'energize-find-project) | |
| 300 (define-key energize-map "\^C\^B\^E" 'energize-browse-error) | |
| 301 (define-key energize-map "\^C\^B\^L" 'energize-browse-language-elt) | |
| 302 (define-key energize-map "\^C\^B\^T" 'energize-browse-tree) | |
| 303 (define-key energize-map "\^C\^B\^C" 'energize-browse-class) | |
| 304 ;; now in global-map | |
| 305 ;; (define-key energize-map "\M-B" 'energize-build-a-target) ; M-Sh-B | |
| 306 (define-key energize-map "\M-C" 'energize-default-compile-file) ; M-Sh-C | |
| 307 (define-key energize-map 'button3 'energize-popup-menu) | |
| 308 ) | |
| 309 | |
| 310 (if energize-top-level-map | |
| 311 nil | |
| 312 (setq energize-top-level-map (make-sparse-keymap)) | |
| 313 (set-keymap-name energize-top-level-map 'energize-top-level-map) | |
| 314 (set-keymap-parent energize-top-level-map energize-map) | |
| 315 (suppress-keymap energize-top-level-map) | |
| 316 (define-key energize-top-level-map "?" 'describe-mode) | |
| 317 (define-key energize-top-level-map " " 'energize-top-next-project) | |
| 318 (define-key energize-top-level-map "n" 'energize-top-next-project) | |
| 319 (define-key energize-top-level-map "p" 'energize-top-prev-project) | |
| 320 (define-key energize-top-level-map "N" 'energize-top-next-project) | |
| 321 (define-key energize-top-level-map "P" 'energize-top-prev-project) | |
| 322 (define-key energize-top-level-map "\t" 'energize-top-next-project) | |
| 323 (define-key energize-top-level-map '(shift tab) 'energize-top-prev-project) | |
| 324 (define-key energize-top-level-map '(control I) 'energize-top-prev-project) | |
| 325 | |
| 326 (define-key energize-top-level-map "Q" 'disconnect-from-energize-query) | |
| 327 | |
| 328 (define-key energize-top-level-map "d" 'energize-top-debug) | |
| 329 (define-key energize-top-level-map "\^D" 'energize-top-delete-project) | |
| 330 (define-key energize-top-level-map "e" 'energize-top-edit-project) | |
| 331 ) | |
| 332 | |
| 333 (if energize-project-map | |
| 334 nil | |
| 335 (setq energize-project-map (make-sparse-keymap)) | |
| 336 (set-keymap-name energize-project-map 'energize-project-map) | |
| 337 (set-keymap-parent energize-project-map energize-map) | |
| 338 ;;(suppress-keymap energize-project-map) | |
| 339 ;;(define-key energize-project-map "\t" 'energize-project-next-field) | |
| 340 ;;(define-key energize-project-map '(shift tab) 'energize-project-prev-field) | |
| 341 ;;(define-key energize-project-map '(control I) 'energize-project-prev-field) | |
| 342 | |
| 343 (define-key energize-project-map "\^C\^I" 'energize-import-file) | |
| 344 (define-key energize-project-map "\^C\^E" 'energize-project-edit-file) | |
| 345 (define-key energize-project-map "\^C\^S\^A" 'energize-project-sort-alpha) | |
| 346 (define-key energize-project-map "\^C\^S\^L" 'energize-project-sort-link) | |
| 347 (define-key energize-project-map "\^C\^V\^N" 'energize-project-view-names) | |
| 348 ; (define-key energize-project-map "\^C\^V\^L" 'energize-project-view-long) | |
| 349 (define-key energize-project-map "\^C\^V\^C" 'energize-project-view-options) | |
| 350 ) | |
| 351 | |
| 352 | |
| 353 (if energize-no-file-project-map | |
| 354 nil | |
| 355 (setq energize-no-file-project-map (make-sparse-keymap)) | |
| 356 (set-keymap-name energize-no-file-project-map 'energize-no-file-project-map) | |
| 357 (set-keymap-parent energize-no-file-project-map energize-map)) | |
| 358 | |
| 359 (if energize-breakpoint-map | |
| 360 nil | |
| 361 (setq energize-breakpoint-map (make-sparse-keymap)) | |
| 362 (set-keymap-name energize-breakpoint-map 'energize-breakpoint-map) | |
| 363 (set-keymap-parent energize-breakpoint-map energize-map) | |
| 364 ) | |
| 365 | |
| 366 (if energize-browser-map | |
| 367 nil | |
| 368 (setq energize-browser-map (make-sparse-keymap)) | |
| 369 (set-keymap-name energize-browser-map 'energize-browser-map) | |
| 370 (set-keymap-parent energize-browser-map energize-map) | |
| 371 ) | |
| 372 | |
| 373 (if energize-source-map | |
| 374 nil | |
| 375 (setq energize-source-map (make-sparse-keymap)) | |
| 376 (set-keymap-name energize-source-map 'energize-source-map) | |
| 377 (set-keymap-parent energize-source-map energize-map) | |
| 378 ;; There are too many problems with using extents to determine where the | |
| 379 ;; top level forms are... | |
| 380 ;; (define-key energize-source-map "\M-\C-a" 'energize-beginning-of-defun) | |
| 381 ;; (define-key energize-source-map "\M-\C-e" 'energize-end-of-defun) | |
| 382 ) | |
| 383 | |
| 384 (defvar energize-menu-state nil | |
| 385 "State of the energize menu items of the buffer. | |
| 386 Automatically updated by the kernel when the state changes") | |
| 387 | |
| 388 (defvar energize-default-menu-state nil | |
| 389 "State of the energize default menu items. | |
| 390 Automatically updated by the kernel when the state changes") | |
| 391 | |
| 392 (defun energize-mode-internal () | |
| 393 ;; initialize stuff common to all energize buffers (hooks, etc). | |
| 394 (make-local-hook 'write-file-data-hooks) | |
| 395 (add-hook 'write-file-data-hooks 'energize-write-data-hook t t) | |
| 396 ;; | |
| 397 (make-local-variable 'revert-buffer-insert-file-contents-function) | |
| 398 (setq revert-buffer-insert-file-contents-function | |
| 399 'energize-revert-buffer-insert-file-contents-hook) | |
| 400 ;; | |
| 401 (make-local-hook 'kill-buffer-hook) | |
| 402 (add-hook 'kill-buffer-hook 'energize-kill-buffer-hook nil t) | |
| 403 ;; | |
| 404 (make-local-variable 'require-final-newline) | |
| 405 (setq require-final-newline t) | |
| 406 ;; | |
| 407 (make-local-variable 'energize-menu-state) | |
| 408 ;; | |
| 409 (run-hooks 'energize-mode-hook)) | |
| 410 | |
| 411 (defun energize-non-file-mode-internal () | |
| 412 ;; do magic associated with energize-modes for buffers which are not | |
| 413 ;; and cannot be associated with files. | |
| 414 ; (or (null buffer-file-name) | |
| 415 ; (equal buffer-file-name mode-name) | |
| 416 ; (error | |
| 417 ; "This buffer is associated with a file, it can't be placed in %s mode" | |
| 418 ; mode-name)) | |
| 419 ;; hack so that save-file doesn't prompt for a filename. | |
| 420 (or buffer-file-name | |
| 421 (setq buffer-file-name (buffer-name))) | |
| 422 (set (make-local-variable 'version-control) 'never) | |
| 423 nil) | |
| 424 | |
| 425 ;; don't create random new buffers in these modes | |
| 426 (put 'energize-top-level-mode 'mode-class 'special) | |
| 427 (put 'energize-project-mode 'mode-class 'special) | |
| 428 (put 'energize-no-file-project-mode 'mode-class 'special) | |
| 429 (put 'energize-breakpoint-mode 'mode-class 'special) | |
| 430 (put 'energize-browser-mode 'mode-class 'special) | |
| 431 (put 'energize-log-mode 'mode-class 'special) | |
| 432 | |
| 433 (defun energize-top-level-mode () | |
| 434 "Major mode for the Energize top-level buffer. | |
| 435 In addition to normal cursor-motion commands, the following keys are bound: | |
| 436 \\{energize-top-level-map}" | |
| 437 (interactive) | |
| 438 (energize-mode-internal) | |
| 439 (use-local-map energize-top-level-map) | |
| 440 (setq major-mode 'energize-top-level-mode | |
| 441 mode-name "Energize") | |
| 442 (energize-non-file-mode-internal) | |
| 443 ;; the default of "energize: Energize" is not very attractive. | |
| 444 (if (equal frame-title-format "%S: %b") | |
| 445 (set (make-local-variable 'frame-title-format) "%S: Top-Level")) | |
| 446 (run-hooks 'energize-top-level-mode-hook)) | |
| 447 | |
| 448 | |
| 449 (defun energize-project-mode () | |
| 450 "Major mode for the Energize Project buffers. | |
| 451 In addition to the normal editing commands, the following keys are bound: | |
| 452 \\{energize-project-map}" | |
| 453 (interactive) | |
| 454 (energize-mode-internal) | |
| 455 (use-local-map energize-project-map) | |
| 456 (setq major-mode 'energize-project-mode | |
| 457 mode-name "Project") | |
| 458 ;; in later revisions of the kernel the project is really a file. | |
| 459 (if (< (cdr (energize-protocol-level)) 8) | |
| 460 (energize-non-file-mode-internal)) | |
| 461 (run-hooks 'energize-project-mode-hook)) | |
| 462 | |
| 463 (defun energize-no-file-project-mode () | |
| 464 "Major mode for the Energize Project buffers not associated with a file. | |
| 465 In addition to the normal editing commands, the following keys are bound: | |
| 466 \\{energize-no-file-project-map}" | |
| 467 (interactive) | |
| 468 (energize-mode-internal) | |
| 469 (use-local-map energize-no-file-project-map) | |
| 470 (setq major-mode 'energize-no-file-project-mode | |
| 471 mode-name "NoFileProject") | |
| 472 (energize-non-file-mode-internal) | |
| 473 (run-hooks 'energize-no-file-project-mode-hook)) | |
| 474 | |
| 475 (defun energize-breakpoint-mode () | |
| 476 "Major mode for the Energize Breakpoint-list buffers. | |
| 477 In addition to the normal editing commands, the following keys are bound: | |
| 478 \\{energize-breakpoint-map}" | |
| 479 (interactive) | |
| 480 (energize-mode-internal) | |
| 481 (use-local-map energize-breakpoint-map) | |
| 482 (setq major-mode 'energize-breakpoint-mode | |
| 483 mode-name "Breakpoint") | |
| 484 (energize-non-file-mode-internal) | |
| 485 (run-hooks 'energize-breakpoint-mode-hook)) | |
| 486 | |
| 487 (defun energize-browser-mode () | |
| 488 "Major mode for the Energize Browser buffers. | |
| 489 In addition to the normal editing commands, the following keys are bound: | |
| 490 \\{energize-browser-map}" | |
| 491 (interactive) | |
| 492 (energize-mode-internal) | |
| 493 (use-local-map energize-browser-map) | |
| 494 (setq major-mode 'energize-browser-mode | |
| 495 mode-name "Browser") | |
| 496 (energize-non-file-mode-internal) | |
| 497 (run-hooks 'energize-browser-mode-hook)) | |
| 498 | |
| 499 (defun energize-log-mode () | |
| 500 "Major mode for the Energize Error Log and System Log buffers. | |
| 501 In addition to the normal editing commands, the following keys are bound: | |
| 502 \\{energize-map}" | |
| 503 (interactive) | |
| 504 (energize-mode-internal) | |
| 505 (use-local-map energize-map) | |
| 506 (setq major-mode 'energize-log-mode | |
| 507 mode-name "Energize-Log") | |
| 508 (energize-non-file-mode-internal) | |
| 509 (run-hooks 'energize-log-mode-hook)) | |
| 510 | |
| 511 (defun energize-manual-mode () | |
| 512 "Major mode for the Energize UNIX Manual buffers. | |
| 513 In addition to the normal editing commands, the following keys are bound: | |
| 514 \\{energize-map}" | |
| 515 (interactive) | |
| 516 (energize-mode-internal) | |
| 517 (use-local-map energize-map) | |
| 518 (setq major-mode 'energize-manual-mode | |
| 519 mode-name "Energize-Manual") | |
| 520 (energize-non-file-mode-internal) | |
| 521 (run-hooks 'energize-manual-mode-hook)) | |
| 522 | |
| 523 (defvar energize-source-mode nil) | |
| 524 ;;(put 'energize-source-mode 'permanent-local t) ; persists beyond mode-change | |
| 525 | |
| 526 ;;; Add energize-source-mode to minor-mode-alist so that it shows up in | |
| 527 ;;; the modeline when true. | |
| 528 ;;; | |
| 529 (or (assq 'energize-source-mode minor-mode-alist) | |
| 530 (setq minor-mode-alist | |
| 531 (append minor-mode-alist | |
| 532 '((energize-source-mode " Energize"))))) | |
| 533 | |
| 534 | |
| 535 (defun energize-source-minor-mode () | |
| 536 "Minor mode for adding additional keybindings to Energize source buffers. | |
| 537 The following key bindings are added: | |
| 538 \\{energize-source-map} | |
| 539 | |
| 540 Since this minor mode defines keys, once it gets turned on you can't really | |
| 541 turn it off." | |
| 542 (interactive) | |
| 543 (energize-mode-internal) | |
| 544 (make-local-variable 'energize-source-mode) | |
| 545 (setq energize-source-mode t) | |
| 546 (let ((source-map energize-source-map) | |
| 547 (dest-map (make-sparse-keymap))) | |
| 548 (set-keymap-parent dest-map (current-local-map)) | |
| 549 (set-keymap-name dest-map 'energize-minor-mode-map) | |
| 550 (while source-map | |
| 551 (let (mapper prefixes) | |
| 552 (setq mapper (function (lambda (key val) | |
| 553 (if (keymapp val) | |
| 554 (let ((prefixes (append prefixes | |
| 555 (cons key nil)))) | |
| 556 (map-keymap val mapper)) | |
| 557 (define-key dest-map | |
| 558 (apply 'vector | |
| 559 (append prefixes (cons key nil))) | |
| 560 val) | |
| 561 )))) | |
| 562 (map-keymap source-map mapper)) | |
| 563 (setq source-map (keymap-parent source-map))) | |
| 564 (use-local-map dest-map)) | |
| 565 (run-hooks 'energize-source-mode-hook)) | |
| 566 | |
| 567 | |
| 568 ;;; Commands in source buffers | |
| 569 | |
| 570 (defun recenter-definition () | |
| 571 "Position the beginning of the current definition at the top of the frame." | |
| 572 (interactive) | |
| 573 (end-of-line) | |
| 574 (if (eq major-mode 'c++-mode) | |
| 575 (c++-beginning-of-defun 1) | |
| 576 (beginning-of-defun 1)) | |
| 577 (recenter 1)) | |
| 578 | |
| 579 (define-key global-map "\M-\C-r" 'recenter-definition) | |
| 580 | |
| 581 (defun energize-hide-error-glyphs-in-form () | |
| 582 "Hides the error icons in the current toplevel form. | |
| 583 You cannot get them back until you recompile the file." | |
| 584 (interactive) | |
| 585 (save-excursion | |
| 586 (save-restriction | |
| 587 (let ((start (progn (energize-beginning-of-defun) (point))) | |
| 588 (end (progn (energize-end-of-defun) (point))) | |
| 589 e) | |
| 590 (narrow-to-region start end) | |
| 591 (goto-char (point-min)) | |
| 592 (setq e (extent-at (point))) | |
| 593 (while (and e | |
| 594 (< (extent-end-position e) (point-max))) | |
| 595 (if (extent-property e 'begin-glyph) | |
| 596 (set-extent-begin-glyph e nil)) | |
| 597 (setq e (next-extent e))))))) | |
| 598 | |
| 599 ;;; Dired-like commands | |
| 600 | |
| 601 (defun energize-next-extent-for (command prev not-this-one) | |
| 602 (let ((last-e (if not-this-one 'none nil)) | |
| 603 e result) | |
| 604 (save-excursion | |
| 605 (while (not (or result | |
| 606 (if prev (bobp) (eobp)))) | |
| 607 (setq e (extent-at (point) (current-buffer))) | |
| 608 (if (and (not (eq e last-e)) | |
| 609 (not (eq last-e 'none))) | |
| 610 (setq result | |
| 611 (energize-menu-item-for-name e command))) | |
| 612 (forward-char (if prev -1 1)) | |
| 613 (setq last-e e))) | |
| 614 (if result e))) | |
| 615 | |
| 616 (defun energize-next-extent-on-line-for (command not-this-one) | |
| 617 (save-excursion | |
| 618 (save-restriction | |
| 619 (narrow-to-region (point) (progn (end-of-line) (point))) | |
| 620 (goto-char (point-min)) | |
| 621 (energize-next-extent-for command nil not-this-one)))) | |
| 622 | |
| 623 | |
| 624 ;;; commands in the top-level buffer | |
| 625 | |
| 626 (defun energize-top-next-project () | |
| 627 "Position the cursor at the beginning of the following project." | |
| 628 (interactive) | |
| 629 (let ((p (point))) | |
| 630 (let ((e (energize-next-extent-for "editproject" nil t))) | |
| 631 (if (and e (= p (extent-start-position e))) | |
| 632 (save-excursion | |
| 633 (forward-char (extent-length e)) | |
| 634 (setq e (energize-next-extent-for "editproject" nil t)))) | |
| 635 (if e | |
| 636 (goto-char (extent-start-position e)) | |
| 637 (error "no next project"))))) | |
| 638 | |
| 639 (defun energize-top-prev-project () | |
| 640 "Position the cursor at the beginning of the preceeding project." | |
| 641 (interactive) | |
| 642 (let ((p (point))) | |
| 643 (let ((e (energize-next-extent-for "editproject" t t))) | |
| 644 (if (and e (= p (extent-start-position e))) | |
| 645 (save-excursion | |
| 646 (forward-char -1) | |
| 647 (setq e (energize-next-extent-for "editproject" t t)))) | |
| 648 (if e | |
| 649 (goto-char (extent-start-position e)) | |
| 650 (error "no previous project"))))) | |
| 651 | |
| 652 (defun energize-top-execute-command (command) | |
| 653 (let ((e (or (energize-next-extent-on-line-for command nil) | |
| 654 (error | |
| 655 (concat "no following field on this line that handles the `" | |
| 656 command "' Energize command."))))) | |
| 657 (energize-execute-command command e))) | |
| 658 | |
| 659 (defun energize-top-debug () | |
| 660 "Execute the `Debug' command on the project at or following point." | |
| 661 (interactive) | |
| 662 (energize-top-execute-command "debugprogram")) | |
| 663 | |
| 664 (defun energize-top-delete-project () | |
| 665 "Delete the project at or following point." | |
| 666 (interactive) | |
| 667 (energize-top-execute-command "deleteproject")) | |
| 668 | |
| 669 (defun energize-top-edit-project () | |
| 670 "Edit the project at or following point." | |
| 671 (interactive) | |
| 672 (energize-top-execute-command "editproject")) | |
| 673 | |
| 674 ;;; commands in the project buffer | |
| 675 | |
| 676 (defun energize-project-next-field (&optional prev) | |
| 677 (interactive) | |
| 678 (let ((e (extent-at (point) (current-buffer)))) | |
| 679 (if e | |
| 680 (if prev | |
| 681 (goto-char (1- (extent-start-position e))) | |
| 682 (goto-char (1+ (extent-end-position e))))) | |
| 683 (while (null (extent-at (point) (current-buffer))) | |
| 684 (forward-char (if prev -1 1))) | |
| 685 (while (extent-at (point) (current-buffer) 'write-protected) | |
| 686 (forward-char (if prev -1 1))) | |
| 687 (if prev | |
| 688 (if (setq e (extent-at (point) (current-buffer))) | |
| 689 (goto-char (extent-start-position e)) | |
| 690 (while (not (extent-at (point) (current-buffer))) | |
| 691 (forward-char -1)))))) | |
| 692 | |
| 693 (defun energize-project-prev-field () (interactive) | |
| 694 (energize-project-next-field t)) | |
| 695 | |
| 696 (defun energize-project-edit-file () (interactive) | |
| 697 (energize-top-execute-command "editfile")) | |
| 698 | |
| 699 | |
| 700 (defun energize-project-prune-unused-rules () | |
| 701 "Deletes all unused rules from the Rules: part of a Project buffer, | |
| 702 and renumbers the remaining rules sequentially." | |
| 703 (interactive) | |
| 704 (save-excursion | |
| 705 (goto-char (point-min)) | |
| 706 (re-search-forward "^[ \t]+Rules:") | |
| 707 (forward-line 1) | |
| 708 (let ((rules-regexp "^[ \t]*\\(\\.[a-zA-Z]+\\(([0-9]+)\\)?\\):") | |
| 709 (all-rules nil) | |
| 710 eor) | |
| 711 ;; | |
| 712 ;; Gather the contents of the Rule section, and find its end. | |
| 713 ;; | |
| 714 (save-excursion | |
| 715 (while (looking-at rules-regexp) | |
| 716 (setq all-rules (cons (list (buffer-substring (match-beginning 1) | |
| 717 (match-end 1)) | |
| 718 (point-marker)) | |
| 719 all-rules)) | |
| 720 (while (progn (end-of-line) (= (preceding-char) ?\\)) | |
| 721 (forward-line 1)) | |
| 722 (forward-line 1)) | |
| 723 (setq eor (point-marker))) | |
| 724 (setq all-rules (nreverse all-rules)) | |
| 725 (let ((rest all-rules) | |
| 726 rule) | |
| 727 ;; | |
| 728 ;; Walk through the buffer gathering references to the rules. | |
| 729 ;; | |
| 730 (while rest | |
| 731 (setq rule (car rest)) | |
| 732 (goto-char eor) | |
| 733 (let ((pattern (concat "^[ \t]+" (regexp-quote (car rule)) ":"))) | |
| 734 (while (re-search-forward pattern nil t) | |
| 735 (setcdr (cdr rule) | |
| 736 (cons (set-marker (make-marker) (match-beginning 0)) | |
| 737 (cdr (cdr rule)))))) | |
| 738 (setq rest (cdr rest))) | |
| 739 ;; | |
| 740 ;; Delete those rules that have no references. | |
| 741 ;; | |
| 742 (goto-char eor) | |
| 743 (setq rest all-rules) | |
| 744 (while rest | |
| 745 (setq rule (car rest)) | |
| 746 (if (null (cdr (cdr rule))) | |
| 747 (let ((p (nth 1 rule))) | |
| 748 (goto-char p) | |
| 749 (while (progn (end-of-line) (= (preceding-char) ?\\)) | |
| 750 (forward-line 1)) | |
| 751 (forward-line 1) | |
| 752 (delete-region p (point)) | |
| 753 (set-marker p nil) | |
| 754 (setq all-rules (delq rule all-rules)) | |
| 755 )) | |
| 756 (setq rest (cdr rest))) | |
| 757 ;; | |
| 758 ;; Renumber the remaining rules sequentially. | |
| 759 ;; | |
| 760 (goto-char eor) | |
| 761 (setq rest all-rules) | |
| 762 (let ((i 1)) | |
| 763 (while rest | |
| 764 (setq rule (car rest)) | |
| 765 (let ((referents (cdr rule))) ; including definition | |
| 766 (while referents | |
| 767 (goto-char (car referents)) | |
| 768 (or (and (looking-at | |
| 769 (concat "^[ \t]+" (regexp-quote (car rule)) ":")) | |
| 770 (looking-at "[^:(]+\\((\\([0-9]+\\))\\|\\):")) | |
| 771 (error "internal error")) | |
| 772 (if (null (match-beginning 2)) | |
| 773 (progn | |
| 774 (goto-char (match-beginning 1)) | |
| 775 (insert "(" (int-to-string i) ")")) | |
| 776 (goto-char (match-beginning 2)) | |
| 777 (delete-region (match-beginning 2) (match-end 2)) | |
| 778 (insert (int-to-string i))) | |
| 779 (set-marker (car referents) nil) | |
| 780 (setq referents (cdr referents)))) | |
| 781 (setq i (1+ i)) | |
| 782 (setq rest (cdr rest)))) | |
| 783 ;; | |
| 784 ;; TODO: | |
| 785 ;; - order the Rule Users list in the same order as the Rules list. | |
| 786 ;; - or, order the Rule Users list by number of files, and then | |
| 787 ;; order the Rules list the same as that (numbered sequentially.) | |
| 788 ;; - or, order the Rules list by length-of-rule (= complicatedness.) | |
| 789 ) | |
| 790 (set-marker eor nil)))) |