0
|
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))))
|