;;!emacs
;;
;; FILE:         hui-menu.el
;; SUMMARY:      InfoDock/Emacs menubar menu of Hyperbole commands.
;; USAGE:        GNU Emacs Lisp Library
;; KEYWORDS:     hypermedia, mouse
;;
;; AUTHOR:       Bob Weiner
;; ORG:          BeOpen.com
;;
;; ORIG-DATE:    28-Oct-94 at 10:59:44
;; LAST-MOD:     24-Jun-99 at 05:43:08 by Bob Weiner
;;
;; Copyright (C) 1994, 1995, 1996, 1997  BeOpen.com and the Free Software Foundation, Inc.
;; See the "HY-COPY" file for license information.
;;
;; This file is part of Hyperbole.
;;
;; DESCRIPTION:  
;; DESCRIP-END.

;;; ************************************************************************
;;; Other required Elisp libraries
;;; ************************************************************************

(require 'hpath)
(require 'wrolo-menu)
(require 'browse-url)

(if hyperb:emacs19-p (require 'lmenu))

;;; ************************************************************************
;;; Public functions
;;; ************************************************************************

;; Add Hyperbole menu to menubar.
(defun hyperbole-menubar-menu ()
  "Add the Hyperbole menu to the global menubar."
  (cond ((and (boundp 'menubar-configuration)
	      (not (memq 'Hyperbole menubar-configuration)))
	 ;; Hyperbole may be included as part of the menubar but
	 ;; may be invisible due to a menubar configuration
	 ;; setting.  Make it visible here.
	 (if (fboundp 'customize-set-variable)
	     (customize-set-variable 'menubar-configuration
				     (cons 'Hyperbole menubar-configuration))
	   (setq menubar-configuration
		 (cons 'Hyperbole menubar-configuration)))
	 (set-menubar-dirty-flag))
	((and (boundp 'current-menubar)
	      (or hyperb:emacs19-p current-menubar)
	      (not (car (find-menu-item current-menubar '("Hyperbole")))))
	 (let ((add-before (if (and (boundp 'infodock-menubar-type)
				    (eq infodock-menubar-type 'menubar-infodock))
			       "Key" nil)))
	   (if (fboundp 'add-submenu)
	       (add-submenu nil (infodock-hyperbole-menu) add-before)
	     (add-menu nil (car (infodock-hyperbole-menu))
		       (cdr (infodock-hyperbole-menu)) add-before))
	   ;; The next line forces a menubar refresh in some versions of XEmacs
	   ;; which have an event handler bug that prevents display of the
	   ;; Hyperbole menu on the menubar until the next user event occurs.
	   (sit-for 0.001)))))

;;; ************************************************************************
;;; Public variables
;;; ************************************************************************

;; Ensure that this variable is defined to avert any error within
;; the Customization menu.
(defvar highlight-headers-follow-url-netscape-new-window nil
  "*Whether to make Netscape create a new window when a URL is sent to it.")

(defconst hui-menu-url-options
  '("Display-URLs-in"
    "----"
    "----"
    ["Any-Netscape-Window"
     (setq browse-url-browser-function 'browse-url-netscape
	   browse-url-new-window-p nil)
     :style radio
     :selected
     (and (eq browse-url-browser-function 'browse-url-netscape)
	  (null browse-url-new-window-p))]
    ["Grail"
     (setq browse-url-browser-function 'browse-url-grail)
     :style radio
     :selected (eq browse-url-browser-function 'browse-url-grail)]
    ["Lynx"
     (setq browse-url-browser-function 'browse-url-lynx-xterm)
     :style radio
     :selected (eq browse-url-browser-function 'browse-url-lynx-xterm)]
    ["New-Netscape-Window"
     (setq browse-url-browser-function 'browse-url-netscape
	   browse-url-new-window-p t)
     :style radio
     :selected
     (and (eq browse-url-browser-function 'browse-url-netscape)
	  browse-url-new-window-p)]
    ["W3"
     (setq browse-url-browser-function 'browse-url-w3)
     :style radio
     :selected (eq browse-url-browser-function 'browse-url-w3)]
    )
  "Menu of Hyperbole URL display options.")

(defconst hui-menu-options
  (append '(["Customize Hyperbole..." hyperb:customize t]
	    "---"
	    ["Hyperbole-on-Menubar"
	     (cond ((and (boundp 'menubar-configuration)
			 (not (memq 'Hyperbole menubar-configuration)))
		    ;; Hyperbole may be included as part of the menubar but
		    ;; may be invisible due to a menubar configuration
		    ;; setting.  Invoking this item should then make it
		    ;; visible.
		    (hyperb:init-menubar))
		   ((car (find-menu-item current-menubar '("Hyperbole")))
		    ;; Already on the menubar, remove it.
		    (hui-menu-remove))
		   (t;; Add it.
		    (hyperb:init-menubar)))
	     :style toggle
	     :selected
	      (if (boundp 'menubar-configuration)
		  (memq 'Hyperbole menubar-configuration)
		(and (boundp 'current-menubar)
		     (or hyperb:emacs19-p current-menubar)
		     (car (find-menu-item current-menubar '("Hyperbole")))))]
	    "----"
	    ["Find-File-Accepts-URLs"
	     hyperb:find-file-urls-mode
	     :style toggle
	     :selected hyperb:find-file-urls-mode]
	    "----"
	    "Display-Referents-in"
	    "----"
	    "----")
	  (mapcar (function (lambda (sym)
			      (vector
			       (capitalize (symbol-name sym))
			       (` (setq hpath:display-where '(, sym)))
			       :style 'radio
			       :selected (` (eq hpath:display-where
						'(, sym))))))
		  (mapcar 'car hpath:display-where-alist))
	  '("----")
	  hui-menu-url-options
	  '("----"
	    "Smart-Key-Press-at-Eol"
	    "----"
	    "----"
	    ;; This menu may be loaded by InfoDock before hsite.el has
	    ;; defined `smart-scroll-proportional'.  Handle that case
	    ;; with a conditional.
	    ["Scrolls-a-Windowful"
	     (setq smart-scroll-proportional nil)
	     :style radio :selected (if (boundp 'smart-scroll-proportional)
					(null smart-scroll-proportional))]
	    ["Scrolls-Proportionally"
	     (setq smart-scroll-proportional t)
             :style radio :selected (if (boundp 'smart-scroll-proportional)
					smart-scroll-proportional)]
	    )
	  '("----"
	    ["Toggle-Rolo-Dates" rolo-toggle-datestamps
	     :style toggle :selected (and (boundp 'wrolo-add-hook)
					  (listp wrolo-add-hook)
					  (memq 'rolo-set-date wrolo-add-hook))]
	    ))
  "Untitled menu of Hyperbole options.")

;; Force reinitialization whenever this file is reloaded.
(defconst infodock-hyperbole-menu nil)
;;; Don't change this name; doing so will break the way InfoDock
;;; initializes the Hyperbole menu.
(defun infodock-hyperbole-menu ()
  "Hyperbole menu for the global InfoDock menubar"
  (or infodock-hyperbole-menu
      (setq infodock-hyperbole-menu
	    (delq nil
		  (list
		   "Hyperbole"
		   :config 'Hyperbole
		   '["About" (hypb:display-file-with-logo
			      (expand-file-name "HY-ABOUT" hyperb:dir)) t]
		   (if (and (boundp 'infodock-version) infodock-version)
		       '["Manual"      (id-info "(infodock.info)Hyperbole Menu") t]
		     '["Manual"      (id-info "(hyperbole.info)Top") t])
		   '["What-is-New?"  (hypb:display-file-with-logo
				      (expand-file-name "HY-NEWS" hyperb:dir)) t]
		   "----"
		   '["Remove-This-Menu"
		     (progn
		       ;; Delete Hyperbole menu item from all menubars.
		       (hui-menu-remove)
		       ;;
		       ;; Remove Hyperbole button comment from future
		       ;; outgoing mail.
		       (if (boundp 'smail:comment)
			   (setq smail:comment "")))
		     t]
		   "----"
		   '["Activate-Button-at-Point" hui:hbut-current-act
		     (hbut:is-p (hbut:at-p))]
		   '["Back-to-Prior-Location" (hhist:remove current-prefix-arg)
		     (and (boundp '*hhist*) *hhist*)]
		   '("Button-File"
		     ["Manual"  (id-info "(hyperbole.info)Button Files") t]
		     "----"
		     ["Edit-Per-Directory-File" (find-file hbmap:filename) t]
		     ["Edit-Personal-File" (find-file
					    (expand-file-name
					     hbmap:filename hbmap:dir-user)) t]
		     )
		   (cons "Customization" hui-menu-options)
		   '("Documentation"
		     ["Manual"      (id-info "(hyperbole.info)Top") t]
		     "----"
		     ["Copyright"   (id-info "(hyperbole.info)Top") t]
		     ["Demonstration"  (hypb:display-file-with-logo
					(expand-file-name "DEMO" hyperb:dir)) t]
		     ["Glossary"    (id-info "(hyperbole.info)Glossary") t]
		     ["Manifest"    (find-file-read-only
				     (expand-file-name "MANIFEST" hyperb:dir)) t]
		     ["Msg-Forums"  (id-info "(hyperbole.info)Discussion Forums") t]
		     ["Smart-Key-Summary" (id-browse-file (hypb:mouse-help-file)) t]
		     )
		   '("Explicit-Button"
		     :filter hui-menu-explicit-buttons
		     ["Activate" hui:hbut-act t]
		     ["Create" hui:ebut-create t]
		     ["Delete" hui:ebut-delete t]
		     ["Edit"   hui:ebut-modify t]
		     ("Help"  
		      ["Manual"   (id-info "(hyperbole.info)Location") t]
		      "----"
		      ["Buffer-Buttons"   (hui:hbut-report -1) t]
		      ["Current-Button"   (hui:hbut-report)    t]
		      ["Ordered-Buttons"  (hui:hbut-report 1)  t]
		      )
		     ["Modify" hui:ebut-modify t]
		     ["Rename" hui:ebut-rename t]
		     ["Search" hui:ebut-search t]
		     )
		   '("Global-Button"
		     :filter hui-menu-global-buttons
		     ["Create" hui:gbut-create t]
		     ["Edit"   hui:gbut-modify t]
		     ["Help"   gbut:help t]
		     ["Modify" hui:gbut-modify t]
		     )
		   '("Implicit-Button"
		     ["Manual"   (id-info "(hyperbole.info)Implicit Buttons") t]
		     "----"
		     ["Activate-at-Point"    hui:hbut-current-act t]
		     ["Delete-Type"         (hui:htype-delete 'ibtypes) t]
		     ["Help"   hui:hbut-help t]
		     ["Types"  (hui:htype-help 'ibtypes 'no-sort) t]
		     )
		   '("Mail-Lists"
		     ["Manual" (id-info "(hyperbole.info)Suggestion or Bug Reporting")
		      t]
		     "----"
;		     ["Change-Hyperbole-Address"
;		      (hmail:compose "hyperbole-request@beopen.com"
;				     '(hact 'hyp-request)) t]
;		     ["Change-Hyperbole-Announce-Address"
;		      (hmail:compose "hyperbole-request@beopen.com"
;				     '(hact 'hyp-request)) t]
		     ["Mail-to-Hyperbole-List"
		      (hmail:compose "hyperbole-discuss@xemacs.org" '(hact 'hyp-config)) t]
		     )
		   (if hyperb:kotl-p
		       '("Outline"
			 ["Manual" (id-info "(hyperbole.info)Outliner") t]
			 ["Example"   kotl-mode:example                 t]
			 "----"
			 ["Create-File"    kfile:find t]
			 ["View-File"      kfile:view t]
			 "----"
			 ["Collapse-Tree" (progn (kotl-mode:is-p)
						 (kotl-mode:hide-tree
						  (kcell-view:label)))
			  (eq major-mode 'kotl-mode)]
			 ["Create-Link" klink:create
			  (eq major-mode 'kotl-mode)]
			 ["Expand-All-Trees" kotl-mode:show-all
			  (eq major-mode 'kotl-mode)]
			 ["Expand-Tree" (progn (kotl-mode:is-p)
					       (kotl-mode:show-tree
						(kcell-view:label)))
			  (eq major-mode 'kotl-mode)]
			 ["Show-Top-Level-Only" kotl-mode:hide-body
			  (eq major-mode 'kotl-mode)]
			 ))
		   infodock-wrolo-menu
		   '("Types"
		     ["Action-Types-Manual"
		      (id-info "(hyperbole.info)Action Types") t]
		     ["Implicit-Button-Types-Manual"
		      (id-info "(hyperbole.info)Implicit Buttons") t]
		     "----"
		     ["Action-Types"      (hui:htype-help 'actypes) t]
		     ["Implicit-Button-Types" (hui:htype-help 'ibtypes 'no-sort) t]
		     )
		   '("Window-Configuration"
		     ["Manual" (id-info "(hyperbole.info)Window Configurations") t]
		     "----"
		     ["Name-Configuration" wconfig-add-by-name     t]
		     ["Delete-Name"        wconfig-delete-by-name
		      (if (boundp 'wconfig-names) wconfig-names)]
		     ["Restore-Name"       wconfig-restore-by-name
		      (if (boundp 'wconfig-names) wconfig-names)]
		     "----"
		     ["Pop-from-Ring"      wconfig-delete-pop
		      (if (boundp 'wconfig-ring) wconfig-ring)]
		     ["Save-to-Ring"       wconfig-ring-save       t]
		     ["Yank-from-Ring"     wconfig-yank-pop
		      (if (boundp 'wconfig-ring) wconfig-ring)]
		     ))))))

;;; ************************************************************************
;;; Public functions
;;; ************************************************************************

(defun hui-menu-remove ()
  "Remove \"Hyperbole\" menu from all menubars."
  (if (boundp 'menubar-configuration)
      (if (memq 'Hyperbole menubar-configuration)
	  (if (fboundp 'customize-set-variable)
	      (customize-set-variable 'menubar-configuration
				      (delq 'Hyperbole menubar-configuration))
	    (setq menubar-configuration 
		  (delq 'Hyperbole menubar-configuration))))
    (mapcar (function
	     (lambda (buf)
	       (set-buffer buf)
	       (if (assoc "Hyperbole" current-menubar)
		   (delete-menu-item '("Hyperbole")))))
	    (buffer-list))))

;;; ************************************************************************
;;; Private functions
;;; ************************************************************************

(defvar hui-menu-max-list-length 24
  "Positive integer that caps the length of a Hyperbole dynamic menu lists.")

(defvar hui-menu-order-explicit-buttons t
  "When non-nil (default), explicit button menu list is lexicographically ordered.
Otherwise, explicit buttons are listed in their order of appearance within
the current buffer.")

;; List explicit buttons in the current buffer for menu activation.
(defun hui-menu-explicit-buttons (rest-of-menu)
  (delq nil
	(append
	 '(["Manual"   (id-info "(hyperbole.info)Explicit Buttons") t]
	   "----")
	 (let ((labels (ebut:list))
	       (cutoff))
	   (if labels
	       (progn
		 ;; Cutoff list if too long.
		 (if (setq cutoff (nthcdr (1- hui-menu-max-list-length) labels))
		     (setcdr cutoff nil))
		 (delq nil
		       (append
			'("----"
			  ["Alphabetize-List"
			   (setq hui-menu-order-explicit-buttons 
				 (not hui-menu-order-explicit-buttons))
			   :style toggle :selected hui-menu-order-explicit-buttons]
			  "Activate:")
			(mapcar (function (lambda (label)
					    (vector label `(ebut:act ,label) t)))
				(if hui-menu-order-explicit-buttons
				    (sort labels 'string-lessp)
				  labels))
			(if cutoff '(". . ."))
			'("----" "----"))))))
	 rest-of-menu)))

;; List existing global buttons for menu activation.
(defun hui-menu-global-buttons (rest-of-menu)
  (delq nil
	(append
	 '(["Manual" (id-info "(hyperbole.info)Global Buttons") t]
	   "----")
	 (let ((labels (gbut:label-list))
	       (cutoff))
	   (if labels
	       (progn
		 ;; Cutoff list if too long.
		 (if (setq cutoff (nthcdr (1- hui-menu-max-list-length) labels))
		     (setcdr cutoff nil))
		 (delq nil
		       (append
			'("----" "Activate:")
			(mapcar (function (lambda (label)
					    (vector label `(gbut:act ,label) t)))
				(sort labels 'string-lessp))
			(if cutoff '(". . ."))
			'("----" "----"))))))
	 rest-of-menu)))

;;; ************************************************************************
;;; Private variables
;;; ************************************************************************

(provide 'hui-menu)
