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 / oobr / br-menu.el < prev    next >
Encoding:
Text File  |  1995-08-26  |  12.5 KB  |  301 lines
  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:          Motorola Inc.
  10. ;;
  11. ;; ORIG-DATE:    27-Oct-93 at 21:13:36
  12. ;; LAST-MOD:     23-Aug-95 at 11:40:36 by Bob Weiner
  13. ;;
  14. ;; Copyright (C) 1994, 1995  Free Software Foundation, Inc.
  15. ;; See the file BR-COPY for license information.
  16. ;;
  17. ;; This file is part of the OO-Browser.
  18. ;;
  19. ;; DESCRIPTION:  
  20. ;; DESCRIP-END.
  21.  
  22. ;;; ************************************************************************
  23. ;;; Public variables
  24. ;;; ************************************************************************
  25.  
  26. ;;; This definition is used by InfoDock only.
  27. (defconst id-menubar-br
  28.   '(
  29.     ("OO-Browser"
  30.      ["Copyright"           br-copyright                   t]
  31.      ["Help-Commands"       br-help                        t]
  32.      ["Help-Mode"           describe-mode                  t]
  33.      ["Help-Mouse"          br-help-ms                     t]
  34.      ["Manual"              (id-info "(oo-browser.info)Top") t]
  35.      ["Version"             br-version                     t]
  36.      "----"
  37.      ["Compose-Mail-to-List"
  38.       (progn (br-quit)
  39.          (mail nil "oo-browser@hub.ucsb.edu"
  40.            "Replace this line with a descriptive sentence.")
  41.          (goto-char (point-min))
  42.          (search-forward "Subject: " nil t)) t]
  43.      ["Mail-List-Request"
  44.       (progn (br-quit)
  45.          (mail nil "oo-browser-request@hub.ucsb.edu")
  46.          (insert "Use a subject line like one of the following:\n"
  47.              "  Subject: Subscribe <joe@any.com> (Joe Williams).\n"
  48.              "  Subject: Unsubscribe <joe@any.com>.\n")
  49.          (goto-char (point-min))
  50.          (search-forward "Subject: " nil t)) t]
  51.      "----"
  52.      ["Reinitialize"        br-refresh                     t]
  53.      ["Exit-Temporarily"    (id-tool-quit '(br-quit))    t]
  54.      ["Quit"                (id-tool-quit '(br-quit t))  t]
  55.      )
  56.     ("Class"
  57.      ["Edit-Current"        br-edit-entry                  t]
  58.      ["Edit-Named"          br-find                        t]
  59.      ["View-Current"        br-view-entry                  t]
  60.      "----"
  61.      ["Match-from-Listing"  br-match                       t]
  62.      ["Where-is-Any"        (br-where t)                   t]
  63.      ["Where-is-Current"    br-where                       t]
  64.      "----"
  65.      ["Graphical-Descendants"  br-tree                     t]
  66.      "----"
  67.      ["Ancestors"           (br-ancestors -1)              t]
  68.      ["Children"            br-children                    t]
  69.      ["Descendants"         br-descendants                 t]
  70.      ["Features"            br-features                    t]
  71.      ["Info"                br-class-info                  t]
  72.      ["Level"               br-at                          t]
  73.      ["Parents"             br-parents                     t]
  74.      ["Class-Statistics"    br-class-stats                 t]
  75.      )
  76.     ("Environment"
  77.      ["Create"              (let ((current-prefix-arg 1))
  78.                   (id-tool-invoke id-tool-oo-browser)) t]
  79.      ["Load"                (let ((current-prefix-arg 1))
  80.                   (id-tool-invoke id-tool-oo-browser)) t]
  81.      ["Rebuild"             br-env-rebuild                 t]
  82.      ["Rebuild-Lib-Part"    br-lib-rebuild                 t]
  83.      ["Rebuild-Sys-Part"    br-sys-rebuild                 t]
  84.      ["Save"                br-env-save                    t]
  85.      ["Statistics"          br-env-stats                   t]
  86.      "----"
  87.      ["Add-File"            br-add-class-file              t]
  88.      ["Delete-Class"        br-delete                      t]
  89.      )
  90.     ("Feature"
  91.      ["Edit-Current"        br-edit-entry                  t]
  92.      ["Edit-Named"          br-find                        t]
  93.      ["View-Current"        br-view-entry                  t]
  94.      ["View-Friend-Def"     br-view-friend                 t]
  95.      "----"
  96.      ["Implementors"        br-implementors                t]
  97.      ["Signature"           br-ftr-signature               t]
  98.      )
  99.     ("List-Window"
  100.      ["Graphical-View"      br-tree-graph                  t]
  101.      ["Graphical-Descendants"  (br-tree t)                 t]
  102.      ["Kill-Graphical-Views" br-tree-kill                  t]
  103.      "----"
  104.      ["Write (Save as)"     br-write-buffer                t]
  105.      "----"
  106.      ["Count-Entries"       br-count                       t]
  107.      ["Order-Entries"       (progn (br-order 1)
  108.                    (br-unique))            t]
  109.      "----"
  110.      ["Ancestors"           (br-ancestors -2)              t]
  111.      ["Children"            (br-children t)                t]
  112.      ["Descendants"         (br-descendants t)             t]
  113.      ["Features"            (br-features 1)                t]
  114.      ["Files"               br-buffer-menu                 t]
  115.      ["Level"               (br-at t)                      t]
  116.      ["Parents"             (br-parents t)                 t]
  117.      "----"
  118.      ["Show-All-Classes"      (br-top-classes t)           t]
  119.      ["Show-All-Lib-Classes"  (br-lib-top-classes t)       t]
  120.      ["Show-All-Sys-Classes"  (br-sys-top-classes t)       t]
  121.      ["Show-Top-Classes"      br-top-classes               t]
  122.      ["Show-Top-Lib-Classes"  br-lib-top-classes           t]
  123.      ["Show-Top-Sys-Classes"  br-sys-top-classes           t]
  124.      "----"
  125.      ["Exit-This-Level"       br-exit-level                t]
  126.      ["Narrow-by-10"          br-resize-narrow             t]
  127.      ["Widen-by-10"           br-resize-widen              t]
  128.      )
  129.     ("Options"
  130.      ["Keep-Viewed-Classes" br-toggle-keep-viewed
  131.       :style toggle :selected br-keep-viewed-classes]
  132.      ["Graphical-Show-Features" br-tree-features-toggle
  133.       :style toggle :selected br-show-features]
  134.      )
  135.     ("View-Window"
  136.      ["Full-Frame"          br-view-full-frame             t]
  137.      ["Kill-Buffer"         br-kill                        t]
  138.      ["Move-To-or-From"     br-to-from-viewer              t]
  139.      )
  140.     ))
  141.  
  142. ;;; This definition is used by InfoDock and XEmacs.
  143. (defconst id-popup-br-menu
  144.   '("OO-Browser"
  145.     ["Copyright"           br-copyright                   t]
  146.     ["Help-Commands"       br-help                        t]
  147.     ["Help-Mode"           describe-mode                  t]
  148.     ["Help-Mouse"          br-help-ms                     t]
  149.     ["Manual"              (id-info "(oo-browser.info)Top") t]
  150.     ["Version"             br-version                     t]
  151.     "----"
  152.     ["Compose-Mail-to-List"
  153.      (progn (br-quit)
  154.         (mail nil "oo-browser@hub.ucsb.edu"
  155.           "Replace this line with a descriptive sentence.")
  156.         (goto-char (point-min))
  157.         (search-forward "Subject: " nil t)) t]
  158.     ["Mail-List-Request"
  159.      (progn (br-quit)
  160.         (mail nil "oo-browser-request@hub.ucsb.edu")
  161.         (insert "Use a subject line like one of the following:\n"
  162.             "  Subject: Subscribe <joe@any.com> (Joe Williams).\n"
  163.             "  Subject: Unsubscribe <joe@any.com>.\n")
  164.         (goto-char (point-min))
  165.         (search-forward "Subject: " nil t)) t]
  166.      "----"
  167.     ("Class"
  168.      ["Edit-Current"        br-edit-entry                  t]
  169.      ["Edit-Named"          br-find                        t]
  170.      ["View-Current"        br-view-entry                  t]
  171.      "----"
  172.      ["Match-from-Listing"  br-match                       t]
  173.      ["Where-is-Any"        (br-where t)                   t]
  174.      ["Where-is-Current"    br-where                       t]
  175.      "----"
  176.      ["Graphical-View"      br-tree-graph                  t]
  177.      ["Graphical-Descendants"  (br-tree t)                 t]
  178.      ["Kill-Graphical-Views" br-tree-kill                  t]
  179.      "----"
  180.      ["Ancestors"           (br-ancestors -1)              t]
  181.      ["Children"            br-children                    t]
  182.      ["Descendants"         br-descendants                 t]
  183.      ["Features"            br-features                    t]
  184.      ["Info"                br-class-info                  t]
  185.      ["Level"               br-at                          t]
  186.      ["Parents"             br-parents                     t]
  187.      ["Class-Statistics"    br-class-stats                 t]
  188.      )
  189.     ("Environment"
  190.      ["Create"              (let ((current-prefix-arg 1))
  191.                   (id-tool-invoke id-tool-oo-browser)) t]
  192.      ["Load"                (let ((current-prefix-arg 1))
  193.                   (id-tool-invoke id-tool-oo-browser)) t]
  194.      ["Rebuild"             br-env-rebuild                 t]
  195.      ["Rebuild-Lib-Part"    br-lib-rebuild                 t]
  196.      ["Rebuild-Sys-Part"    br-sys-rebuild                 t]
  197.      ["Save"                br-env-save                    t]
  198.      ["Statistics"          br-env-stats                   t]
  199.      "----"
  200.      ["Add-File"            br-add-class-file              t]
  201.      ["Delete-Class"        br-delete                      t]
  202.      )
  203.     ("Feature"
  204.      ["Edit-Current"        br-edit-entry                  t]
  205.      ["Edit-Named"          br-find                        t]
  206.      ["View-Current"        br-view-entry                  t]
  207.      ["View-Friend-Def"     br-view-friend                 t]
  208.      "----"
  209.      ["Implementors"        br-implementors                t]
  210.      ["Signature"           br-feature-signature           t]
  211.      )
  212.     ("List-Window"
  213.      ["Write (Save as)"     br-write-buffer                t]
  214.      "----"
  215.      ["Count-Entries"       br-count                       t]
  216.      ["Order-Entries"       (progn (br-order 1)
  217.                    (br-unique))            t]
  218.      "----"
  219.      ["Ancestors"           (br-ancestors -2)              t]
  220.      ["Children"            (br-children t)                t]
  221.      ["Descendants"         (br-descendants t)             t]
  222.      ["Features"            (br-features 1)                t]
  223.      ["Files"               br-buffer-menu                 t]
  224.      ["Level"               (br-at t)                      t]
  225.      ["Parents"             (br-parents t)                 t]
  226.      "----"
  227.      ["Show-All-Classes"      (br-top-classes t)           t]
  228.      ["Show-All-Lib-Classes"  (br-lib-top-classes t)       t]
  229.      ["Show-All-Sys-Classes"  (br-sys-top-classes t)       t]
  230.      ["Show-Top-Classes"      br-top-classes               t]
  231.      ["Show-Top-Lib-Classes"  br-lib-top-classes           t]
  232.      ["Show-Top-Sys-Classes"  br-sys-top-classes           t]
  233.      "----"
  234.      ["Exit-This-Level"       br-exit-level                t]
  235.      ["Narrow-by-10"          br-resize-narrow             t]
  236.      ["Widen-by-10"           br-resize-widen              t]
  237.      )
  238.     ("Options"
  239.      ["Keep-Viewed-Classes" br-toggle-keep-viewed
  240.       :style toggle :selected br-keep-viewed-classes]
  241.      ["Graphical-Show-Features" br-tree-features-toggle
  242.       :style toggle :selected br-show-features]
  243.      )
  244.     ("View-Window"
  245.      ["Full-Frame"          br-view-full-frame             t]
  246.      ["Kill-Buffer"         br-kill                        t]
  247.      ["Move-To-or-From"     br-to-from-viewer              t]
  248.      )
  249.     "----"
  250.     ["Reinitialize"        br-refresh                     t]
  251.     ["Exit-Temporarily"    (id-tool-quit '(br-quit))    t]
  252.     ["Quit"                (id-tool-quit '(br-quit t))  t]
  253.     ))
  254.  
  255. ;;; ************************************************************************
  256. ;;; Public functions
  257. ;;; ************************************************************************
  258.  
  259. ;;; This definition is used only by XEmacs and Emacs19.
  260. (defun br-menubar-menu ()
  261.   "Add an OO-Browser menu to the menubar for each listing buffer."
  262.   (cond ((fboundp 'popup-mode-menu)
  263.      (setq mode-popup-menu id-popup-br-menu))
  264.     (hyperb:lemacs-p
  265.      (define-key br-mode-map 'button3 'br-popup-menu))
  266.     (t ;; hyperb:emacs19-p
  267.      (define-key br-mode-map [down-mouse-3] 'br-popup-menu)
  268.      (define-key br-mode-map [mouse-3] nil)))
  269.   (if (and (boundp 'current-menubar)
  270.        current-menubar
  271.        (not (car (find-menu-item current-menubar '("OO-Browser")))))
  272.       (progn
  273.     (set-buffer-menubar (copy-sequence current-menubar))
  274.     (if (fboundp 'add-submenu)
  275.         (add-submenu nil id-popup-br-menu)
  276.       (add-menu nil (car id-popup-br-menu) (cdr id-popup-br-menu))))))
  277.  
  278. ;;; This definition is used only by XEmacs and Emacs19.
  279. (defun br-popup-menu (event)
  280.   "Popup the OO-Browser listing buffer menu."
  281.   (interactive "@e")
  282.   (mouse-set-point event)
  283.   (if (fboundp 'popup-mode-menu)
  284.       (popup-mode-menu)
  285.     (popup-menu id-popup-br-menu)))
  286.  
  287. (cond ((null hyperb:window-system))
  288.       ((fboundp 'id-menubar-set)
  289.        ;; InfoDock under a window system
  290.        (require 'id-menubars)
  291.        (id-menubar-set 'br-mode 'id-menubar-br))
  292.       (hyperb:lemacs-p
  293.        ;; XEmacs under a window system
  294.        (add-hook 'br-mode-hook 'br-menubar-menu))
  295.       (hyperb:emacs19-p
  296.        ;; Emacs 19 under a window system
  297.        (require 'lmenu)
  298.        (add-hook 'br-mode-hook 'br-menubar-menu)))
  299.  
  300. (provide 'br-menu)
  301.