cgit.sxemacs.org Git - packages/blob - xemacs-packages/oo-browser/br-menu.el

   1 ;;!emacs
   2 ;;
   3 ;; FILE:         br-menu.el
   4 ;; SUMMARY:      Pulldown and popup menus for the OO-Browser.
   5 ;; USAGE:        GNU Emacs Lisp Library
   6 ;; KEYWORDS:     mouse, oop, tools
   7 ;;
   8 ;; AUTHOR:       Bob Weiner
   9 ;; ORG:          BeOpen.com
  10 ;;
  11 ;; ORIG-DATE:    27-Oct-93 at 21:13:36
  12 ;; LAST-MOD:     10-May-01 at 04:53:25 by Bob Weiner
  13 ;;
  14 ;; DESCRIPTION:
  15 ;;
  16 ;;   Load this file to add a menubar entry for invoking the OO-Browser under
  17 ;;   XEmacs and GNU Emacs.  InfoDock automatically adds such an entry under
  18 ;;   its Software menu.
  19 ;;
  20 ;; DESCRIP-END.
  21 ;;
  22 ;;; ************************************************************************
  23 ;;; Public variables
  24 ;;; ************************************************************************
  25
  26 (defconst br-menu-common-body
  27   (delq
  28    nil
  29    (list
  30     '("Class"
  31       ["Concept-Manual"      (id-info "(oo-browser)Top-Level Classes") t]
  32       ["Menu-Manual"         (id-info "(oo-browser)Class Menu") t]
  33       "----"
  34       ["Edit-Definition"     br-edit-entry                  t]
  35       ["View-Definition"     br-view-entry                  t]
  36       "----"
  37       ["Edit-Named"          (br-edit-entry t)
  38        :active t :keys "C-u e"]
  39       ["View-Named"          (br-view-entry t)
  40        :active t :keys "C-u v"]
  41       "----"
  42       ["Match-from-Listing"  br-match                       t]
  43       ["Where-is-Named?"     (br-where t)
  44        :active t :keys "C-u w"]
  45       ["Where-is-Entry?"     br-where                       t]
  46       "----"
  47       ["Ancestors"           br-ancestors                   t]
  48       ["Attributes"          br-attributes                  t]
  49       ["Children"            br-children                    t]
  50       ["Descendants"         br-descendants                 t]
  51       ["Features"            br-features                    t]
  52       ["Implementors"        br-implementors                t]
  53       ["Info"                br-entry-info                  t]
  54       ["Level"               br-at                          t]
  55       ["Parents"             br-parents                     t]
  56       ["Protocols"           br-protocols                   t]
  57       ["Routines"            br-routines                    t]
  58       "----"
  59       ["Class-Statistics"    br-class-stats                 t]
  60       )
  61     (list
  62      "Environment"
  63      '["Concept-Manual"      (id-info "(oo-browser)Environments") t]
  64      '["Menu-Manual"         (id-info "(oo-browser)Environment Menu") t]
  65      "----"
  66      '["Create-or-Load"      (id-tool-invoke 'br-env-browse)
  67        :active t :keys "C-c C-l"]
  68      '["Display-Env-List"    br-names-display (not (br-names-empty-p))]
  69      '["Rebuild"             br-env-rebuild   br-env-file]
  70      '["Statistics"          br-env-stats     br-env-file]
  71      "----"
  72      '["Add-Name"            br-name-add      t]
  73      '["Change-Name"         br-name-change   (not (br-names-empty-p))]
  74      '["Remove-Name"         br-name-remove   (not (br-names-empty-p))]
  75      '["Replace-Env-of-Name" br-name-replace  (not (br-names-empty-p))]
  76      "----"
  77      '["Delete-Class"        br-delete        br-env-file]
  78      "----"
  79      '["Save"                br-env-save      br-env-file]
  80      )
  81     '("Feature"
  82       ["Concept-Manual"      (id-info "(oo-browser)Browsing Elements") t]
  83       ["Menu-Manual"         (id-info "(oo-browser)Feature Menu") t]
  84       "----"
  85       ["Edit-Definition"     br-edit-entry                  t]
  86       ["View-Definition"     br-view-entry                  t]
  87       "----"
  88       ["Edit-Declaration"    br-feature-edit-declaration    t]
  89       ["View-Declaration"    br-feature-view-declaration    t]
  90       "----"
  91       ["View-Friend-Def"     br-view-friend                 t]
  92       "----"
  93       ["Edit-Named"          (br-edit-entry t)
  94        :active t :keys "C-u e"]
  95       ["View-Named"          (br-view-entry t)
  96        :active t :keys "C-u v"]
  97       "----"
  98       ["Current-Attributes"  br-attributes                  t]
  99       ["Current-Features"    br-features                    t]
 100       ["Current-Routines"    br-routines                    t]
 101       "----"
 102       ["All-Attributes"      (br-attributes 2)
 103        :active t :keys "C-u ="]
 104       ["All-Features"        (br-features 2)
 105        :active t :keys "C-u f"]
 106       ["All-Routines"        (br-routines 2)
 107        :active t :keys "C-u r"]
 108       "----"
 109       ["Implementors"        br-implementors                t]
 110       ["Signature"           br-feature-signature           t]
 111       )
 112     '("Graphical"
 113       ["Concept-Manual"      (id-info "(oo-browser)Browsing Graphically") t]
 114       ["Menu-Manual"         (id-info "(oo-browser)Graphical Menu") t]
 115       "----"
 116       ["Class-Descendants-View"   br-tree                   t]
 117       ["Listing-Descendants-View" (br-tree t)
 118        :active t :keys "C-u M-d"]
 119       ["Listing-Graphical-View"   br-tree-graph             t]
 120       "----"
 121       ["Kill-Graphical-Views"     br-tree-kill              t]
 122       )
 123     '("List-Window"
 124       ["Concept-Manual"      (id-info "(oo-browser)Usage") t]
 125       ["Menu-Manual"         (id-info "(oo-browser)List-Window Menu") t]
 126       "----"
 127       ["Write (Save as)"     br-write-buffer                t]
 128       "----"
 129       ["Count-Entries"       br-count                       t]
 130       ["Order-Entries"       (progn (br-order 1) (br-unique))
 131        :active t :keys "o u"]
 132       "----"
 133       ["All-Ancestors"       (br-ancestors 2)
 134        :active t :keys "C-u a"]
 135       ["All-Attributes"      (br-attributes 2)
 136        :active t :keys "C-u ="]
 137       ["All-Children"        (br-children t)
 138        :active t :keys "C-u c"]
 139       ["All-Descendants"     (br-descendants t)
 140        :active t :keys "C-u d"]
 141       ["All-Features"        (br-features 2)
 142        :active t :keys "C-u f"]
 143       ["All-Implementors"    (br-implementors t)
 144        :active t :keys "C-u I"]
 145       ["All-Levels"          (br-at t)
 146        :active t :keys "C-u @"]
 147       ["All-Parents"         (br-parents t)
 148        :active t :keys "C-u p"]
 149       ["All-Protocols"       (br-protocols t)
 150        :active t :keys "C-u P"]
 151       ["All-Routines"        (br-routines 2)
 152        :active t :keys "C-u r"]
 153       "----"
 154       ["Show-All-Classes"      br-show-all-classes          t]
 155       ["Show-All-Lib-Classes"  (br-lib-top-classes t)
 156        :active t :keys "C-u l"]
 157       ["Show-All-Sys-Classes"  (br-sys-top-classes t)
 158        :active t :keys "C-u s"]
 159       ["Show-Top-Classes"      br-show-top-classes          t]
 160       ["Show-Top-Lib-Classes"  br-lib-top-classes           t]
 161       ["Show-Top-Sys-Classes"  br-sys-top-classes           t]
 162       "----"
 163       ["Narrow-by-10"          br-resize-narrow             t]
 164       ["Widen-by-10"           br-resize-widen              t]
 165       "----"
 166       ["Exit-this-Listing"     br-exit-level                t]
 167       )
 168     (if (fboundp 'infodock-options-menu)
 169         (infodock-options-menu)
 170       '("Options"
 171         ["Concept-Manual"      (id-info "(oo-browser)Options") t]
 172         ["Menu-Manual"         (id-info "(oo-browser)Options Menu") t]
 173         "----"
 174         ["Keep-Viewed-Classes" br-toggle-keep-viewed
 175          :style toggle :selected br-keep-viewed-classes
 176          :active t :keys "M-0 v"]
 177         ["Graphical-Descendant-Features" br-tree-features-toggle
 178          :style toggle :selected br-show-features]
 179         ["List-Protocols-with-Classes" (br-protocols 0)
 180          :style toggle :selected (if (br-protocol-support-p)
 181                                      br-protocols-with-classes-flag)
 182          :active (br-protocol-support-p) :keys "M-0 P"]
 183         ["Show-Inherited-Features"
 184          (setq br-inherited-features-flag
 185                (not br-inherited-features-flag))
 186          :style toggle :selected br-inherited-features-flag
 187          :active t :keys "M-0 f"]
 188         ["Use-Vi-as-Editor"
 189          (if br-editor-cmd
 190              (br-setup-internal)
 191            (br-setup-external))
 192          :style toggle :selected br-editor-cmd :active t]
 193         ["3-Button-Mouse"
 194          (if (= hyperb:mouse-buttons 3)
 195              (br-two-button-mouse) (br-three-button-mouse))
 196          :style toggle :selected (= hyperb:mouse-buttons 3) :active t]))
 197     '("View-Window"
 198       ["Concept-Manual"      (id-info "(oo-browser)Viewing and Editing") t]
 199       ["Menu-Manual"         (id-info "(oo-browser)View-Window Menu") t]
 200       "----"
 201       ["Select-Code-Buffer"  br-buffer-menu                 t]
 202       "----"
 203       ["Full-Frame"          br-view-full-frame             t]
 204       ["Kill-Buffer"         br-kill                        t]
 205       ["Move-To-or-From"     br-to-from-viewer              t]
 206       "----"
 207       ["Scroll-Backward"     br-viewer-scroll-down          t]
 208       ["Scroll-Forward"      br-viewer-scroll-up            t]
 209       "----"
 210       ["Scroll-Backward-One-Line"   br-viewer-scroll-down-by-line   t]
 211       ["Scroll-Forward-One-Line"    br-viewer-scroll-up-by-line     t]
 212       "----"
 213       ["To-Buffer-Beginning"        br-viewer-beginning-of-buffer  t]
 214       ["To-Buffer-End"              br-viewer-end-of-buffer        t]
 215       )))
 216   "The middle menu entries common to all OO-Browser menus.")
 217
 218 (defconst br-menu-common-preamble
 219   (delq
 220    nil
 221    (list
 222     "OO-Browser"
 223     '["About"               (hypb:display-file-with-logo
 224                              (expand-file-name "BR-FEATURES" br-directory))
 225       t]
 226     '["Language-Manual"     br-info-language-specific      t]
 227     '["Program-Manual"      (id-info "(oo-browser)Top") t]
 228     '["Menu-Manual"         (id-info "(oo-browser)OO-Browser Menu") t]
 229     '["What-is-New?"        (hypb:display-file-with-logo
 230                              (expand-file-name "BR-RELEASE" br-directory)) t]
 231     "----"
 232     (if (or (featurep 'infodock) (featurep 'xemacs))
 233         '("Load-Env-by-Name" :filter br-names-menu)
 234       '("Load-Env-by-Name"))
 235     "----"
 236     '["Copyright"           br-copyright                   t]
 237     '["Help-Commands"       br-help                        t]
 238     '["Help-Mode"           describe-mode                  t]
 239     '["Help-Mouse"          br-help-ms                     t]
 240     "----"
 241     '["Discuss-via-Email"
 242       (progn (br-quit)
 243              (mail nil "oo-browser-discuss@xemacs.org"
 244                    "Replace this line with a descriptive sentence.\nComments: Discuss a topic on the oo-browser list.")
 245              (goto-char (point-min))
 246              (search-forward "Subject: " nil t)) t]
 247 ;    '["Get-Support-via-Email"
 248 ;      (progn (br-quit)
 249 ;            (mail nil "support@deepware.com"
 250 ;                  "Replace this line with a descriptive sentence.\nComments: Use a pre-paid support credit with Deepware.")
 251 ;            (goto-char (point-min))
 252 ;            (search-forward "Subject: " nil t)) t]
 253     )))
 254
 255 (defconst br-menu-common-postamble
 256   '("----"
 257     ["Reinitialize"        br-refresh                   t]
 258     ["Exit-this-Listing"   br-exit-level                t]
 259     "----"
 260     ["Exit-Temporarily"    (id-tool-quit '(br-quit))
 261      :active t :keys "C-u q"]
 262     ["Quit"                (id-tool-quit '(br-quit t))
 263      :active t :keys "q"]
 264     ))
 265
 266 (if (featurep 'infodock)
 267 (defconst br-menu-external
 268   (delq
 269    nil
 270    (list
 271     "%_OO-Browser"
 272     '["About"             (hypb:display-file-with-logo
 273                            (expand-file-name "BR-FEATURES" br-directory))
 274       t]
 275     '["Manual"            (id-tool-invoke id-man-oo-browser)  t]
 276     '["What-is-New?"      (hypb:display-file-with-logo
 277                            (expand-file-name "BR-RELEASE" br-directory)) t]
 278     "----"
 279     '["Create-or-Load-Env"
 280       (let ((id-tool-visible-flag 'visible))
 281         (id-tool 'br-env-browse 'OO-Browser 'br-mode 1)) t]
 282     '["Display-Env-List"  br-names-display
 283       (and (fboundp 'br-names-empty-p) (not (br-names-empty-p)))]
 284     (if (or (featurep 'infodock) (featurep 'xemacs))
 285         '("Load-Env-by-Name" :filter br-names-menu)
 286       '("Load-Env-by-Name"))
 287     '["Rebuild-Env"       br-env-rebuild
 288       (and (fboundp 'br-env-rebuild) br-env-file)]
 289     "----"
 290     '["Continue"          (let ((id-tool-visible-flag 'visible)
 291                                 (current-prefix-arg 1))
 292                             (id-tool-invoke id-tool-oo-browser))
 293       (and (boundp 'br-lang-prefix) (stringp br-lang-prefix)
 294            (boundp '*br-save-wconfig*) *br-save-wconfig* t)]
 295     '["Invoke"            (let ((id-tool-visible-flag 'visible))
 296                             (id-tool-invoke id-tool-oo-browser)) t]
 297     "----"
 298     '["Add-Env-Name"           br-name-add      (fboundp 'br-name-add)]
 299     '["Change-Env-Name"        br-name-change
 300       (and (fboundp 'br-names-empty-p) (not (br-names-empty-p)))]
 301     '["Remove-Env-Name"        br-name-remove
 302       (and (fboundp 'br-names-empty-p) (not (br-names-empty-p)))]
 303     '["Replace-Env-of-Name"    br-name-replace
 304       (and (fboundp 'br-names-empty-p) (not (br-names-empty-p)))]
 305     "----"
 306     '["Env-Statistics"    br-env-stats
 307       (and (fboundp 'br-env-stats) br-env-file)]
 308     "----"
 309     '["Delete-Env-Class"  br-delete
 310       (and (fboundp 'br-delete) br-env-file)]
 311     "----"
 312     (if (< hyperb:mouse-buttons 3)
 313         '["3-Button-Mouse"    br-three-button-mouse t])
 314     "----"
 315     '["Reinitialize"      br-refresh
 316       (and (fboundp 'br-in-browser) (br-in-browser))]
 317     '["Exit-Temporarily"  (id-tool-quit '(br-quit))
 318       (and (fboundp 'br-in-browser) (br-in-browser))]
 319     '["Quit"              (id-tool-quit '(br-quit t))
 320       (and (fboundp 'br-in-browser) (br-in-browser))]
 321     ))
 322   "OO-Browser invocation and management menu used outside of the browser user interface.
 323 This version is used under InfoDock.")
 324
 325 ;; else
 326 (defconst br-menu-external
 327   (delq
 328    nil
 329    (list
 330     "OO-Browser"
 331     '["About"               (hypb:display-file-with-logo
 332                              (expand-file-name "BR-FEATURES" br-directory))
 333       t]
 334     '["Manual"             (progn (require 'info)
 335                                   ;; Force execution of Info-mode-hook which
 336                                   ;; adds the OO-Browser man directory to
 337                                   ;; Info-directory-list.
 338                                   (info "oo-browser")) t]
 339     '["What-is-New?"       (hypb:display-file-with-logo
 340                             (expand-file-name "BR-RELEASE" br-directory)) t]
 341     "----"
 342     '["Create-or-Load-Env" br-env-browse t]
 343     '["Display-Env-List"  br-names-display
 344       (and (fboundp 'br-names-empty-p) (not (br-names-empty-p)))]
 345     (if (or (featurep 'infodock) (featurep 'xemacs))
 346         '("Load-Env-by-Name" :filter br-names-menu)
 347       '("Load-Env-by-Name"))
 348     '["Rebuild-Env"       br-env-rebuild
 349       (and (fboundp 'br-env-rebuild) br-env-file)]
 350     "----"
 351     '["Continue"         (oo-browser t)
 352       (and (boundp 'br-lang-prefix) (stringp br-lang-prefix)
 353            (boundp '*br-save-wconfig*) *br-save-wconfig* t)]
 354     '["Invoke"           oo-browser t]
 355     "----"
 356     '["Add-Env-Name"           br-name-add      (fboundp 'br-name-add)]
 357     '["Change-Env-Name"        br-name-change
 358       (and (fboundp 'br-names-empty-p) (not (br-names-empty-p)))]
 359     '["Remove-Env-Name"        br-name-remove
 360       (and (fboundp 'br-names-empty-p) (not (br-names-empty-p)))]
 361     '["Replace-Env-of-Name"    br-name-replace
 362       (and (fboundp 'br-names-empty-p) (not (br-names-empty-p)))]
 363     "----"
 364     '["Env-Statistics"    br-env-stats
 365       (and (fboundp 'br-env-stats) br-env-file)]
 366     "----"
 367     '["Delete-Env-Class"  br-delete
 368       (and (fboundp 'br-delete) br-env-file)]
 369     "----"
 370     (if (< hyperb:mouse-buttons 3)
 371         '["3-Button-Mouse"    br-three-button-mouse t])
 372     "----"
 373     '["Reinitialize"      br-refresh
 374       (and (fboundp 'br-in-browser) (br-in-browser))]
 375     '["Exit-Temporarily"  (br-quit)
 376       (and (fboundp 'br-in-browser) (br-in-browser))]
 377     '["Quit"              (br-quit t)
 378       (and (fboundp 'br-in-browser) (br-in-browser))]
 379     ))
 380   "OO-Browser invocation and management menu used outside of the browser user interface.
 381 This version is used under XEmacs and GNU Emacs.")
 382 )
 383
 384
 385 ;;; This definition is used by InfoDock only.
 386 (defconst id-menubar-br
 387   (cons (append br-menu-common-preamble br-menu-common-postamble)
 388         br-menu-common-body))
 389
 390 ;;; This definition is used by InfoDock, XEmacs and GNU Emacs.
 391 (defconst id-popup-br-menu
 392    (append br-menu-common-preamble
 393            `("----" ,@ br-menu-common-body)
 394            br-menu-common-postamble))
 395
 396 ;;; ************************************************************************
 397 ;;; Public functions
 398 ;;; ************************************************************************
 399
 400 ;;; The menubar definition is used only by XEmacs and Emacs19.
 401 (defun br-menu-external-setup (&optional menu-path)
 402   ;; When the InfoDock default menubar is active, InfoDock automatically
 403   ;; adds the external OO-Browser menu below its Software menu.
 404   ;; Otherwise, the external OO-Browser menu should be added to the
 405   ;; menubar.
 406   (if (and (featurep 'infodock)
 407            (car (find-menu-item current-menubar '("Software")))
 408            (fboundp 'add-submenu))
 409       ;; Remove possible occurrence of `br-menu-external' to force a reload
 410       ;; using the current menu definition.
 411       (progn (delete-menu-item '("Software" "OO-Browser"))
 412              ;; Add menu used to invoke the OO-Browser.
 413              (add-submenu '("Software") br-menu-external "Tags"))
 414     ;; Remove possible occurrence of `br-menu-external' to force a reload
 415     ;; using the current menu definition.
 416     (delete-menu-item '("OO-Browser"))
 417     ;; Add menu used to invoke the OO-Browser.
 418     (if (fboundp 'add-submenu)
 419         (add-submenu menu-path br-menu-external)
 420       ;; For GNU Emacs only.
 421       (add-hook 'menu-bar-update-hook 'br-menu-update-env-list)
 422       (add-menu menu-path (car br-menu-external) (cdr br-menu-external)))
 423     ;; The next line forces a menubar refresh in some versions of XEmacs
 424     ;; which have an event handler bug that prevents display of the
 425     ;; OO-Browser menu on the menubar until the next user event occurs.
 426     (sit-for 0.001)))
 427
 428 ;;; The menubar definition is used only by XEmacs and GNU Emacs
 429 ;;; or under InfoDock with XEmacs menus active.
 430 (defun br-menubar-menu-setup (&optional menu-path)
 431   "Add an OO-Browser menu to the menubar for each listing buffer."
 432   (if (and (boundp 'current-menubar)
 433            (or hyperb:emacs19-p current-menubar))
 434       (progn
 435         (set-buffer-menubar (copy-sequence current-menubar))
 436         ;; Remove possible occurrence of `br-menu-external'.
 437         (delete-menu-item '("OO-Browser"))
 438         ;; Add OO-Browser menu used while the browser user interface is active.
 439         (if (fboundp 'add-submenu)
 440             (add-submenu menu-path id-popup-br-menu)
 441           ;; For GNU Emacs only.
 442           (add-hook 'menu-bar-update-hook 'br-menu-update-env-list)
 443           (add-menu menu-path (car id-popup-br-menu) (cdr id-popup-br-menu)))
 444         ;; The next line forces a menubar refresh in some versions of XEmacs
 445         ;; which have an event handler bug that prevents display of the
 446         ;; OO-Browser menu on the menubar until the next user event occurs.
 447         (sit-for 0.001))))
 448
 449 ;;; This definition is used only by XEmacs and Emacs19.
 450 (defun br-popup-menu (event)
 451   "Popup the OO-Browser listing buffer menu."
 452   (interactive "@e")
 453   (mouse-set-point event)
 454   (cond
 455    ;; GNU Emacs
 456    ((fboundp 'popup-menu-internal)
 457     (popup-menu-internal id-popup-br-menu '*id-popup-br-menu*))
 458    ;; XEmacs
 459    (t (popup-menu id-popup-br-menu))))
 460
 461 ;;; ************************************************************************
 462 ;;; Private functions
 463 ;;; ************************************************************************
 464
 465 (defun br-menu-update-env-list ()
 466   "Used under GNU Emacs only to update the dynamic Environment name list."
 467   (add-menu '("OO-Browser") "Load-Env-by-Name" (br-names-menu nil)))
 468
 469 (cond ((null hyperb:window-system))
 470       ((featurep 'infodock)
 471        ;; InfoDock under a window system
 472        (require 'id-menubars)
 473        (id-menubar-set 'br-mode 'id-menubar-br))
 474       (hyperb:xemacs-p
 475        ;; XEmacs under a window system
 476        (add-hook 'br-mode-hook 'br-menubar-menu-setup))
 477       (hyperb:emacs19-p
 478        ;; Emacs 19 under a window system
 479        (require 'lmenu)
 480        (add-hook 'br-mode-hook 'br-menubar-menu-setup)))
 481
 482 ;; Initialize menu used to invoke the OO-Browser.
 483 (if (and hyperb:window-system
 484          (not (featurep 'infodock)))
 485     (progn
 486       ;; Initialize now for when this is loaded after startup.
 487       (and (boundp 'current-menubar)
 488            (or hyperb:emacs19-p current-menubar)
 489            (br-menu-external-setup))
 490       ;; Initialize at startup.  This really is needed.
 491       (add-hook 'after-init-hook 'br-menu-external-setup)))
 492
 493 (provide 'br-menu)