;/u/sy/beebe/emacs/sf3-menu.el, Fri Mar 19 19:23:17 1993
;Edit by Nelson H. F. Beebe <beebe@sunrise>

(defvar internal-x-sftran3-menu nil
  "Menu of SFTRAN3 and Fortran statements.")

(defvar internal-x-sftran3-menu-1 nil
  "Supplementary menu of type declarations.")

(defvar internal-x-sftran3-menu-2 nil
  "Menu of miscellaneous functions.")

(setq internal-x-sftran3-menu
      '("Statements "
	("block data"			. sftran3-block-data)
	("case-k"			. sftran3-case-k)
	("case-renumber"		. sftran3-case-renumber)
	("common"			. sftran3-common)
	("data"				. sftran3-data)
	("do block"			. sftran3-do-block)
	("do case"			. sftran3-do-case)
	("do for"			. sftran3-do-for)
	("do forever"			. sftran3-do-forever)
	("do procedure"			. sftran3-do-procedure)
	("do until"			. sftran3-do-until)
	("do while"			. sftran3-do-while)
	("else if then"			. sftran3-else-if-then)
	("equivalence"			. sftran3-equivalence)
	("format"			. sftran3-format)
	("function"			. sftran3-function)
	("if"				. sftran3-if)
	("if then"			. sftran3-if-then)
	("namelist"			. sftran3-namelist)
	("read"				. sftran3-read)
	("return"			. sftran3-return)
	("stop"				. sftran3-stop)
	("subroutine"			. sftran3-subroutine)
	("write"			. sftran3-write)
	))

(setq internal-x-sftran3-menu-1
      '("Type declarations "
	("character"			. sftran3-character)
	("complex"			. sftran3-complex)
	("double precision"		. sftran3-double-precision)
	("integer"			. sftran3-integer)
	("logical"			. sftran3-logical)
	("real"				. sftran3-real)
	))

(setq internal-x-sftran3-menu-2
      '("Miscellaneous"
	("paginate routines"		. sftran3-paginate-routines)
	("paginate procedures"		. sftran3-paginate-procedures)
	("sort procedures"		. sftran3-sort-procedures)
	("sort routines"		. sftran3-sort-routines)
	("sort tokens"			. sftran3-sort-tokens)
	("unpaginate"			. sftran3-unpaginate)
	))

(setq internal-x-sftran3-menu-of-menus
      (`("sftran3 main menu"		;this menu title is never displayed
	(, internal-x-sftran3-menu)
	(, internal-x-sftran3-menu-1)
	(, internal-x-sftran3-menu-2)
	)))

(defun sftran3-x-environment ()
  "Set up X menus for sftran3 mode.  Call it with your sftran3-mode-hook,
or interactively.   It will bind x-sftran3-help to c-left-button, which
does not normally have any assignment in GNU Emacs.

Unfortunately, there does not seem to be any way in GNU Emacs 18 to
make the mouse-map local to a buffer or mode, so the mouse binding
is global."
  (interactive)
  (cond
   ((boundp 'epoch::version)
    (error "No X windows menu support yet for sftran3-mode under epoch"))
   ((and (boundp 'window-system)
	 (equal window-system 'x))
    (require 'x-mouse)
    (define-key mouse-map x-button-c-left 'x-sftran3-help))
   (t
    (error "No X Window System support in this Emacs"))))

;;; If we are not running under the X Window System, then stop
;;; loading immediately to save time and memory.

(cond
 ((boundp 'epoch::version)
  (error "sftran3-menu does not yet support epoch"))
 ((not (boundp  'window-system))
  (error "sftran3-menu requires window system support in GNU Emacs"))
 ((not (and (equal window-system 'x) (fboundp 'x-popup-menu)))
  (error "sftran3-menu requires an Emacs running in a separate X window"))
 ((not (equal window-system 'x))
  (error "sftran3-menu requires X Window System support in GNU Emacs"))
 )

;;; NB: All internal-x-sftran3-xxx commands that are called from the
;;; menus MUST call (interactive) (so commandp is true).

(defun x-sftran3-help (arg)
  "Mouse commands for sftran3 mode.  ARG is a pair (xoffset,yoffset)
giving the offset from the upper-left window corner in character
positions of the pointer when the mouse button is activated."
  (let ((selection (x-popup-menu arg internal-x-sftran3-menu-of-menus)))
    (if selection
	(call-interactively selection))))