home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 2: Applications / Linux Cubed Series 2 - Applications.iso / editors / emacs / xemacs / xemacs-1.006 / xemacs-1 / lib / xemacs-19.13 / lisp / energize / energize-mode.el < prev    next >
Encoding:
Text File  |  1995-02-25  |  27.0 KB  |  791 lines
  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-variable 'write-file-data-hooks)
  395.   (add-hook 'write-file-data-hooks 'energize-write-data-hook 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-variable 'kill-buffer-hook)
  402.   (setq kill-buffer-hook 'energize-kill-buffer-hook)
  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 sequentally."
  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 sequentally.
  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))))
  791.