;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;                                                                         ;;;
;;; $Id$                                                                        ;;;
;;;                                                                         ;;;
;;;  hacks to improve the behaviour of emacs for my own purposes            ;;;
;;;                                                                         ;;;
;;;  created by Wolfgang Glas (c) 11/94                                     ;;;
;;;                                                                         ;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(provide 'gw-hacks)
(require 'compile)

;;;
;;; function to check for emacs's verion to be at least major.minor
;;;

(defun emacs-version-ge-by-gw (major minor)
  "check whether emcs's version is at least major.minor."
(or (> emacs-major-version major) 
    (and (= emacs-major-version major) (>= emacs-minor-version minor)))
)

;;;
;;; function to compile a file in progamming language modes.
;;;

(defun compile-this-file-by-gw ()
  "start compilation for the file currently visited."
  (interactive)
  (if buffer-file-name
      (progn
	(string-match "\\([^/]*\\)\\.[^/]*$" buffer-file-name)
	(compile (concat "gw-make " (match-string 1 buffer-file-name) ".o")) 
	)
    (compile "gw-make")
    )
  )
;;;
;;; function to build main target in progamming language modes.
;;;

(defun compile-main-target-by-gw ()
  "start compilation for the main target in directory."
  (interactive)
  (compile "gw-make")
  )
;;;
;;; function to run Makegen in current buffer
;;;
(defun makegen-by-gw ()
  "starts Makegen in current directory."
  (interactive)
  (compile "Makegen")
  )
;;;
;;; function to get a unique name for compilation
;;;

(defun compilation-buffer-name-by-gw (major-mode-name)
"gets a unique buffer-name for compilation."
 (if (and (string-match (getenv "HOME") default-directory)
          (eq (match-beginning 0) 0) )
     (concat "*~" (substring default-directory (match-end 0))
             " "  (downcase major-mode-name) "*")
     (concat "*" default-directory " " (downcase major-mode-name) "*")
 )
)

(setq compilation-buffer-name-function 'compilation-buffer-name-by-gw)

;;;
;;; function to kill current buffer silently
;;;

(defun kill-current-buffer-by-gw()
"kills current buffer silently."
 (interactive)
 (if (featurep 'server) (if server-buffer-clients (server-done)))
 (kill-buffer (current-buffer))
)

;;;
;;; function to switch to next window silently
;;;

(defun next-buffer-by-gw()
"switch to another buffer silently."
 (interactive)
 (pop-to-buffer nil nil))


;;;
;;; function to save file and kill buffer
;;;   - terminate the client process, if any present.
;;;

(defun save-and-kill-buffer-by-gw ()
  "saves the buffer and kills it." 
 (interactive)
 (save-buffer)
 (if (featurep 'server) (if server-buffer-clients (server-done)))
 (kill-buffer (current-buffer))
)

;;;
;;; function to send mail and kill buffer
;;;

(defun send-mail-and-kill-buffer-by-gw ()
  "sends mail and kills the mail buffer." 
 (interactive)
 (mail-send) 
 (kill-buffer (current-buffer))
)

;;;
;;; function to terminate rmail
;;;

(defun terminate-rmail-by-gw ()
  "saves rmail-file and kills the rmail- and corresponding summary-buffer." 
 (interactive)
 (rmail-expunge-and-save)
 (if rmail-summary-buffer (kill-buffer rmail-summary-buffer))
 (kill-buffer (current-buffer))
)

;;;
;;; terminate rmail from summary buffer.
;;;

(defun terminate-rmail-summary-by-gw ()
  "saves rmail-file and kills the summary- and corresponding rmail-buffer." 
 (interactive)
  (rmail-summary-wipe)
  (terminate-rmail-by-gw)
)

;;;
;;; function to reply in rmail asking for copying the original
;;;   message.
;;;

(defun rmail-reply-by-gw (just-sender)
  "reply to message and ask for copying the original.
Normally include CC: to all other recipients of original message;
prefix argument means ignore them." 
 (interactive "P")
 (if (y-or-n-p "Copy original message ?")
     ( progn
       (rmail-reply just-sender)
       (mail-yank-original 2)
     )
     (rmail-reply just-sender)
 )
)

;;;
;;; function to reply in rmail-summary asking for copying the original
;;;   message.
;;;

(defun rmail-summary-reply-by-gw (just-sender)
  "reply to message and ask for copying the original.
Normally include CC: to all other recipients of original message;
prefix argument means ignore them." 
 (interactive "P")
 (if (y-or-n-p "Copy original message ?")
     ( progn
       (rmail-summary-reply just-sender)
       (mail-yank-original 2)
     )
     (rmail-summary-reply just-sender)
 )
)

;;;
;;; function to pick up a rectangle just as 'kill-rectangle'. 
;;;

(defun get-rectangle (start end)
  "Put up rectangle with corners at point and mark; save as last killed one.
Calling from program, supply two args START and END, buffer positions.
But in programs you might prefer to use `extract-rectangle'."
  (interactive "r")
  (setq killed-rectangle (extract-rectangle start end)))

;;;
;;; function to kill ring and save and deactivate mark 
;;;

(defun kill-ring-save-by-gw () 
  "kill-ring-save and deactivate-mark"
 (interactive)
 (kill-ring-save (mark-marker) (point-marker))
 (deactivate-mark)
)

;;;
;;; function to kill box and save and deactivate mark 
;;;

(defun get-box-for-paste-by-gw () 
  "put up rectangular box and deactivate-mark"
 (interactive)
 (if mark-active 
     (progn
       (get-rectangle (mark-marker) (point-marker)) 
       (deactivate-mark)
     )
     (message "The mark is not active now.")
 )
)

;;;
;;; function to get one line
;;;

(defun get-one-line-by-gw ()
  "mark one line and gets it for pasting." 
 (interactive)
 (beginning-of-line 1)
 (setq a (point-marker))
 (forward-line 1)
 (copy-region-as-kill a (point-marker))
 (forward-line -1)                     )

;;;
;;; function to get the paste buiffer 
;;;

(defun get-region-for-paste-by-gw ()
  "intelligent function to get region for paste." 
 (interactive)
 (if mark-active 
     (kill-ring-save-by-gw)
     ( get-one-line-by-gw )
 )
)

;;;
;;; function to kill one line
;;;

(defun kill-one-line-by-gw ()
  "mark one line and kill it for pasting." 
 (interactive)
 (beginning-of-line 1)
 (setq aa (point-marker))
 (forward-line 1)
 (run-hook-with-args 'before-change-functions aa (1- (point-marker)))
 (setq bb (1- (- (point-marker) aa)))
 (kill-region aa (point-marker)) 
 (run-hook-with-args 'after-change-functions (point-marker) (point-marker) bb) 
)

;;;
;;; function to kill ring and deactivate mark 
;;;

(defun kill-region-by-gw () 
  "kill-region and deactivate-mark"
 (interactive)
 (if (< (point-marker) (mark-marker)) (exchange-point-and-mark))
 (run-hook-with-args 'before-change-functions (mark-marker) (1- (point-marker)))
 (setq bb (1- (- (point-marker) (mark-marker))))
 (kill-region    (mark-marker) (point-marker))
 (deactivate-mark)
 (run-hook-with-args 'after-change-functions (point-marker) (point-marker) bb) 
)

;;;
;;; function to kill box and deactivate mark 
;;;

(defun kill-box-for-paste-by-gw () 
  "kills a rectangular box and deactivate-mark"
 (interactive)
 (if mark-active 
     (progn
       (kill-rectangle (mark-marker) (point-marker)) 
       (deactivate-mark)
     )
     (message "The mark is not active now.")
 )
)

;;;
;;; function to kill the paste buffer 
;;;

(defun kill-region-for-paste-by-gw ()
  "intelligent function to kill region and store for paste." 
 (interactive)
 (if mark-active 
     ( kill-region-by-gw   )
     ( kill-one-line-by-gw )
 )
)

;;;
;;; function to do an intelligent backspace
;;;

(defun backspace-by-gw ()
  "intelligent backward delete characters or regions." 
 (interactive)
 (if mark-active 
     ( kill-region-by-gw   )
     ( backward-delete-char-untabify 1 nil)
 ))

;;;
;;; paste the region
;;;

(defun paste-region-by-gw ()
  "intelligent function to paste region." 
 (interactive)
 (run-hook-with-args 'before-change-functions (point-marker) (point-marker))
 (yank)
 (run-hook-with-args 'after-change-functions (mark-marker) (point-marker) 0)
 (deactivate-mark)
)

;;;
;;; function to handle cursor up in comint-mode
;;;

(defun comint-up-by-gw ()
  "intelligent function to handle cursor up key for comint." 
 (interactive)
 (if (comint-after-pmark-p)
     ( comint-previous-input 1 )
     ( previous-line 1 )
 ))

;;;
;;; function to handle cursor down in comint-mode
;;;

(defun comint-down-by-gw ()
  "intelligent function to handle cursor down key for comint." 
 (interactive)
 (if (comint-after-pmark-p)
     ( comint-next-input 1 )
     ( next-line 1 )
 ))

;;;
;;; function to handle meta cursor up in comint-mode
;;;

(defun comint-meta-up-by-gw ()
  "intelligent function to handle cursor up key for comint." 
 (interactive)
 (if (comint-after-pmark-p)
     ( comint-previous-matching-input-from-input 1)
     ( call-interactively 'search-backward )
 ))

;;;
;;; function to handle meta cursor down in comint-mode
;;;

(defun comint-meta-down-by-gw ()
  "intelligent function to handle cursor down key for comint." 
 (interactive)
 (if (comint-after-pmark-p)
     ( comint-next-matching-input-from-input 1)
     ( call-interactively 'search-forward )
 ))

;;;
;;; function to handle control cursor up in comint-mode
;;;

(defun comint-control-up-by-gw ()
  "intelligent function to handle cursor up key for comint." 
 (interactive)
 (if (comint-after-pmark-p)
     ( call-interactively 'comint-backward-matching-input )
     ( call-interactively 'search-backward-regexp )
 ))

;;;
;;; function to handle control cursor down in comint-mode
;;;

(defun comint-control-down-by-gw ()
  "intelligent function to handle cursor down key for comint." 
 (interactive)
 (if (comint-after-pmark-p)
     ( call-interactively 'comint-forward-matching-input)
     ( call-interactively 'search-forward-regexp )
 ))

;;;
;;; function to strip various control characters in comin-mode
;;;  from 'comint-strip-ctrl-m'
;;;

(defun comint-strip-control-by-gw (&optional string)
  "Strip control characters from the current output group.
This function could be on `comint-output-filter-functions' or bound to a key."
  (interactive)
  (let ((pmark (process-mark (get-buffer-process (current-buffer)))))
    (save-excursion
      (goto-char
       (if (interactive-p) comint-last-input-end comint-last-output-start))
      (while (re-search-forward "\r+" pmark t)
	(replace-match "" t t)))))
;;;
;;; list of labels defined in an LaTeX document
;;;
(defvar latex-label-list (list) 
 "A list of defined labels in a latex buffer.")

(defconst latex-label-regexp "\\\\label *{ *\\([-_a-zA-Z0-9:;.,#+]+\\) *}"
 "The regular expression searched for to obtain the labels in a latex-buffer.")

(defvar latex-store-match-data (list) 
 "A list of stored match data used in before-change and after-change hooks.")

;;; helper functions to modify lists like 'TeX-member' of 'tex.el'
(defun  latex-add-label (label occur)
  "Add member ELT to LIST, if ELT does not exist.
   Return nil if ELT was not a member of LIST."
  (setq lst latex-label-list)
  (setq latex-label-list nil)
  (while (and lst (not (string-equal label (car (car lst)))))
    (progn
      (setq latex-label-list (cons (car lst) latex-label-list))
      (setq lst (cdr lst))
    )
  )
  (if (not lst) (if (> occur 0)
		    (setq latex-label-list 
			  (cons (list label 1) latex-label-list )) )
                (progn 
		(setq nnew (+ (car (cdr (car lst))) occur) )
		(if (> nnew 1) 
		    (message "Warning: Label {%s} defined %d times." 
			     label nnew ))
		(if (> nnew 0)
		    (setq latex-label-list 
			  (cons (list (car (car lst)) nnew )
				latex-label-list)
		    )
	        )
		(setq lst (cdr lst))
		(while lst 
		  (progn
		    (setq latex-label-list (cons (car lst) latex-label-list))
		    (setq lst (cdr lst))
		  )
	        )
	        )

  )
)

;;;
;;; function to 
;;; add latex labels in a region 
;;;
(defun latex-add-labels (end)
"Search a region for \\label statements and store found label in
 'latex-label-list'."
(while  (re-search-forward latex-label-regexp end t)
  (latex-add-label (match-string 1) 1))
)

;;;
;;; function to 
;;; add latex labels in a region 
;;;
(defun latex-remove-labels (end)
"Search a region for \\label statements and remove found labels from
 'latex-label-list'."
(while  (re-search-forward latex-label-regexp end t)
  (latex-add-label (match-string 1) -1))
)

;;;
;;; function to 
;;; find all latex labels in a buffer 
;;;
(defun latex-init-labels ()
"Initialize the label list in a latex buffer."
(interactive)
(make-variable-buffer-local 'latex-label-list)
(setq latex-label-list (list))
(goto-char (point-min))
(latex-add-labels (point-max))
(goto-char (point-min))
)

;;; 
;;; hooks
;;; 
(defun latex-before-change (start end)
 "Hook to run before change."
 (setq latex-store-match-data (match-data))
 (setq a (point))
 (goto-char end)
 (end-of-line)
 (setq b (point))
 (goto-char start)
 (beginning-of-line)
 (latex-remove-labels b)
 (goto-char a)
)

(defun latex-after-change (start end length)
 "Hook to run after change."
 (setq a (point))
 (goto-char end)
 (end-of-line)
 (setq b (point))
 (goto-char start)
 (beginning-of-line)
 (latex-add-labels b)
 (goto-char a)
 (store-match-data latex-store-match-data)
)

;;;
;;; function to insert a reference
;;;
(defun latex-insert-ref ()
"Insert a reference to a latex document."
(interactive)
(setq a (completing-read "Name of reference:" latex-label-list))
(if (stringp a) (insert "\\ref{" a "}"))
)

;;;
;;; function to insert an equation reference
;;;
(defun latex-insert-eqref ()
"Insert a reference to a latex document."
(interactive)
(setq a (completing-read "Name of equation reference:" latex-label-list))
(if (stringp a) (insert "\\eqref{" a "}"))
)

;;;
;;; functions to ease the handling of auctex.
;;;
(defun auctex-latex-by-gw ()
"Runs LaTeX on a buffer using auctex."
(interactive)
(TeX-command "LaTeX" 'TeX-master-file)
)


(defun auctex-view-by-gw ()
"Runs LaTeX on a buffer using auctex."
(interactive)
(TeX-command "View" 'TeX-master-file)
)

;;;
;;; function for basic setups.
;;;  I do it my own sweet way.......
;;;

(defun basic-setup-by-gw()
"prepare for Wolfgang Glas' emacs session.
 Append local path to the load path and display 8-bit chars under X."
 (interactive)

;enable display of all 8-bit characters under X-windows.
(cond (window-system
       (standard-display-default 128 255 )
       (standard-display-8bit    128 255 )
      )
)

;use transient mark mode
(transient-mark-mode 1)

; scrollbar right
(cond (window-system
   (if (emacs-version-ge-by-gw 20 3) 
       (set-scroll-bar-mode 'right)
       (set-scroll-bar-mode nil 'right)
   )
))

; enable smooth scrolling
(setq scroll-step 1)

; disable insertion of new lines through cursor movement.
(setq next-line-add-newlines nil)

; enable line numbers - thanks for the hint.
(line-number-mode 1)

; I'm a hacker, so I need to evaluate tricky lisp in minibuffer......
(put 'eval-expression 'disabled nil)

; set history length
(setq history-length 300)
(setq-default comint-input-ring-size 302)

)

;;;
;;; function to introduce my favourite key definitions
;;;

(defun key-definitions-by-gw()
"introduce Wolfgang Glas' favourite key definitions.
 Documentation under 'Info' - topics 'keys' (type C-h i)."
 (interactive)

;;;
;;; prepare for reasonable function of del and backspace
;;;   with or without X.
;;;

;;;
;;; make C-h act like backspace if no X-windows present. 
;;;

(cond ((not window-system)
       (global-set-key [?\C-h]    'backspace-by-gw)
       (global-set-key [?\C-x ??] 'help-command)
      )
)

;;;
;;; all that fancy stuff......
;;;

;;; somewhere around emacs 20.x these keys were defined like on Win32
;;; That shall not be...
 (global-set-key [home] 'beginning-of-buffer)
 (global-set-key [end] 'end-of-buffer)
 (global-set-key [?\177] 'backspace-by-gw)

 (global-set-key [?\C-x ?\C-y] 'save-and-kill-buffer-by-gw)
 (global-set-key [C-left] 'beginning-of-line)
 (global-set-key [C-right] 'end-of-line)
 (global-set-key [?\033 up] 'search-backward)
 (global-set-key [?\033 down] 'search-forward)
 (global-set-key [M-up] 'search-backward)
 (global-set-key [M-down] 'search-forward)
 (global-set-key [C-up] 'search-backward-regexp)
 (global-set-key [C-down] 'search-forward-regexp)
 (global-set-key [C-w] 'kill-region-for-paste-by-gw)
 (global-set-key [?\033 w] 'get-region-for-paste-by-gw)
 (global-set-key [f1] 'info)
 (global-set-key [f2] 'save-some-buffers)
 (global-set-key [S-f2] 'font-lock-fontify-buffer)
 (global-set-key [f3] 'kill-current-buffer-by-gw)
 (global-set-key [f4] 'delete-other-windows)
 (global-set-key [f5] 'query-replace)
 (global-set-key [S-f5] 'replace-string)
 (global-set-key [f6] 'query-replace-regexp)
 (global-set-key [S-f6] 'replace-regexp)
 (global-set-key [f7] 'kill-region-for-paste-by-gw)
 (global-set-key [S-f7] 'kill-box-for-paste-by-gw)
 (global-set-key [f8] 'compile)
 (global-set-key [S-f8] 'grep)
 (global-set-key [f9] 'get-region-for-paste-by-gw)
 (global-set-key [S-f9] 'get-box-for-paste-by-gw)
 (global-set-key [f10] 'paste-region-by-gw)
 (global-set-key [S-f10] 'yank-rectangle)
 (global-set-key [f11] 'goto-line)
 (global-set-key [S-f11] 'what-line)
 (global-set-key [f12] 'next-buffer-by-gw)

;;;
;;; add things to the menubar for emacs 20 and 19.
;;;

(if (emacs-version-ge-by-gw 21 0)
(tool-bar-mode nil)
;; emacs 20.x
(progn
(put 'ps-print-region 'menu-enable 'mark-active)

(if (emacs-version-ge-by-gw 20 3) 
; in emacs 20.3 the menu structure changed.
    (progn  (define-key menu-bar-print-menu [separator-ps-print-bw]
              '("--"))
            (define-key menu-bar-print-menu [ps-print-region-bw]
	      '("B&W Postscript Print Region" . ps-print-region))
	    (define-key menu-bar-print-menu [ps-print-buffer-bw]
	      '("B&W Postscript Print Buffer" . ps-print-buffer))
    )
; emacs-versions before 20.2
    (progn  (define-key menu-bar-tools-menu [ps-print-region-bw]
	      '("B&W Postscript Print Region" . ps-print-region))
	    (define-key menu-bar-tools-menu [ps-print-buffer-bw]
	      '("B&W Postscript Print Buffer" . ps-print-buffer))
    )
)))

;;;
;;; install my preferred mouse-menus 
;;;     takes effect in emacs 19.29 or higher, 
;;;     where these menus were regrouped.
;;;     I definitely prefer the buffer menu to the font menu.
;;;

 (cond ((emacs-version-ge-by-gw 19 29) 
        (global-set-key [C-down-mouse-1] 'mouse-buffer-menu)
        (global-set-key [S-down-mouse-1] 'mouse-set-font)
       ) 
 )

;;;
;;; modify comint-mode
;;;

 (add-hook 'comint-mode-hook
    (function (lambda ()
      (define-key comint-mode-map [up] 'comint-up-by-gw)
      (define-key comint-mode-map [down] 'comint-down-by-gw)
      (define-key comint-mode-map [?\033 up] 'comint-meta-up-by-gw)
      (define-key comint-mode-map [?\033 down] 'comint-meta-down-by-gw)
      (define-key comint-mode-map [M-up] 'comint-meta-up-by-gw)
      (define-key comint-mode-map [M-down] 'comint-meta-down-by-gw)
      (define-key comint-mode-map [C-up] 'comint-control-up-by-gw)
      (define-key comint-mode-map [C-down] 'comint-control-down-by-gw)

      (setq comint-output-filter-functions 
	    (list 'comint-postoutput-scroll-to-bottom
		  'comint-strip-control-by-gw
		  'comint-truncate-buffer)
		  )
    ))
 )

;;;
;;; modify minibuffer-mode
;;;

 (define-key minibuffer-local-map [up]   'previous-history-element)
 (define-key minibuffer-local-map [down] 'next-history-element)
 (define-key minibuffer-local-map [f3]  'abort-recursive-edit)
 (define-key minibuffer-local-completion-map [up]   'previous-history-element)
 (define-key minibuffer-local-completion-map [down] 'next-history-element)
 (define-key minibuffer-local-completion-map [f3]  'abort-recursive-edit)
 (define-key minibuffer-local-must-match-map [up]   'previous-history-element)
 (define-key minibuffer-local-must-match-map [down] 'next-history-element)
 (define-key minibuffer-local-must-match-map [f3]  'abort-recursive-edit)

;;;
;;; dired - return key should do obvious thing. 
;;;
;;;  adapt regular expressions for german output on RS-6000
;;;

 (add-hook 'dired-mode-hook
    (function (lambda ()
       (define-key dired-mode-map [return]  'dired-display-file)
    ))
 )

;;;
;;; compile - return key should do obvious thing. 
;;;

 (add-hook 'compilation-mode-hook
    (function (lambda ()
       (define-key compilation-mode-map [return]  'compile-goto-error)
       (define-key compilation-mode-map [menu-bar compilation-menu makegen]
	 '("Makegen" . makegen-by-gw))
       (define-key compilation-mode-map [menu-bar compilation-menu build]
	 '("Build" . compile-main-target-by-gw))
    ))
 )
;; set default compile command
 (setq compile-command "gw-make")

;;;
;;; lisp mode - add f8 for compilation
;;;

 (add-hook 'emacs-lisp-mode-hook
    (function (lambda ()
       (define-key emacs-lisp-mode-map [f8] 'emacs-lisp-byte-compile)
       (define-key emacs-lisp-mode-map [?\177] 'backspace-by-gw)
    ))
 )

 (add-hook 'lisp-interaction-mode-hook
    (function (lambda ()
       (define-key lisp-interaction-mode-map [?\177] 'backspace-by-gw)
    ))
 )

;;;
;;; impose backspae in programming modes.
;;;

  (add-hook 'c-mode-hook
    (function (lambda ()
       (define-key c-mode-map [?\177] 'backspace-by-gw)
    ))
 )

  (add-hook 'c++-mode-hook
    (function (lambda ()
       (define-key c++-mode-map [?\177] 'backspace-by-gw)
    ))
 )

;;;
;;; LaTeX - add the label stuff
;;;

 (add-hook 'LaTeX-mode-hook
    (function (lambda ()
       (define-key LaTeX-mode-map [f8] 'auctex-latex-by-gw)
       (define-key LaTeX-mode-map [S-f8] 'auctex-view-by-gw)
       (define-key LaTeX-mode-map [?\C-c ?r]  'latex-insert-ref)
       (define-key LaTeX-mode-map [?\C-c ?e]  'latex-insert-eqref)
       (make-variable-buffer-local  'before-change-functions)
       (add-hook 'before-change-functions 'latex-before-change t t)
       (make-variable-buffer-local 'after-change-functions)
       (add-hook 'after-change-functions 'latex-after-change t t)
       (latex-init-labels)
    ))
 )

;;;
;;; fortran - return key extensions.
;;;    Add a special menu to enable the compilation of the current file
;;;

 (add-hook 'fortran-mode-hook
    (function (lambda ()
       (define-key fortran-mode-map [?\033 return] 'fortran-indent-new-line)
       (define-key fortran-mode-map [C-return] 'fortran-split-line)
       (define-key fortran-mode-map [menu-bar] (make-sparse-keymap))
       (define-key fortran-mode-map [menu-bar fortran] (make-sparse-keymap))
       (define-key fortran-mode-map [menu-bar fortran]
                  (cons "Fortran" (make-sparse-keymap "Fortran")))
       (define-key fortran-mode-map [menu-bar fortran makegen]
	 '("Makegen" . makegen-by-gw))
       (define-key fortran-mode-map [menu-bar fortran build]
	 '("Build" . compile-main-target-by-gw))
       (define-key fortran-mode-map [menu-bar fortran compile-file]
	 '("Compile this File" . compile-this-file-by-gw))
       (define-key fortran-mode-map [menu-bar fortran indent-line]
	 '("Indent Line" . fortran-indent-line))
       (define-key fortran-mode-map [menu-bar fortran comment-region]
	 '("Comment Out Region" . comment-region))

       (put 'comment-region 'menu-enable 'mark-active)

    ))
 )
)

;;; EOF