cgit.sxemacs.org Git - packages/blob - xemacs-packages/hyperbole/hui-menu.el

   1 ;;; hui-menu.el --- InfoDock/Emacs menubar menu of Hyperbole commands.
   2
   3 ;; Copyright (C) 1994, 1995, 2007  Free Software Foundation, Inc.
   4 ;; Developed with support from Motorola Inc.
   5
   6 ;; Author: Bob Weiner, Brown U.
   7 ;; Maintainer: Mats Lidell <matsl@contactor.se>
   8 ;; Keywords: hypermedia, mouse
   9
  10 ;; This file is part of GNU Hyperbole.
  11
  12 ;; GNU Hyperbole is free software; you can redistribute it and/or
  13 ;; modify it under the terms of the GNU General Public License as
  14 ;; published by the Free Software Foundation; either version 3, or (at
  15 ;; your option) any later version.
  16
  17 ;; GNU Hyperbole is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20 ;; General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
  25 ;; Boston, MA 02110-1301, USA.
  26
  27 ;;; Commentary:
  28
  29 ;;; Code:
  30
  31 ;;;
  32 ;;; Other required Elisp libraries
  33 ;;;
  34
  35 (require 'wrolo-menu)
  36 (require 'easymenu)
  37
  38 ;;;
  39 ;;; Public functions
  40 ;;;
  41
  42 ;; Add Hyperbole menu to menubar.
  43 (defun hyperbole-menubar-menu ()
  44   "Add the Hyperbole menu to the global menubar."
  45   (and hyperb:xemacs-p
  46        (add-menu nil (car hui-menu-global-menu) (cdr hui-menu-global-menu))))
  47
  48 (defun hui-menu-remove ()
  49   "Remove Hyperbole menu from the global menubars."
  50   (if hyperb:xemacs-p
  51       (delete-menu-item (list (car hui-menu-global-menu)))
  52     (easy-menu-remove-item nil nil (car hui-menu-global-menu))))
  53
  54 ;;;
  55 ;;; Public variables
  56 ;;;
  57
  58 (defconst hui-menu-global-menu
  59   (delq nil
  60         (list
  61          "Hyperbole"
  62          '["Activate-Button-at-Point" hui:hbut-act t]
  63          '["Back-to-Prior-Location" (hhist:remove current-prefix-arg) t]
  64          '("Button-File"
  65            ["Edit-Per-Directory-File" (find-file hbmap:filename) t]
  66            ["Edit-Personal-File" (find-file
  67                                   (expand-file-name
  68                                    hbmap:filename hbmap:dir-user)) t]
  69            "----"
  70            ["Manual"  (id-info "(hyperbole.info)Button Files") t]
  71            )
  72          '("Customize"
  73            ["Customize Hyperbole..." hyperb:customize t]
  74            "---"
  75            ["Display URLs in ..." (customize-variable 'browse-url-browser-function) t]
  76            )
  77          '("Documentation"
  78            ["Manual"      (id-info "(hyperbole.info)Top") t]
  79            "----"
  80            ["Copyright"      (id-info "(hyperbole.info)Top") t]
  81            ["Demonstration"  (find-file-read-only
  82                               (expand-file-name "DEMO" hyperb:dir)) t]
  83            ["Manifest"       (find-file-read-only
  84                               (expand-file-name "MANIFEST" hyperb:dir)) t]
  85            ["Glossary"    (id-info "(hyperbole.info)Glossary") t]
  86            ["Mail-Lists"  (id-info "(hyperbole.info)Mail Lists") t]
  87            ["New-Features" (progn
  88                              (hact 'link-to-regexp-match
  89                                    "\\*[ \t]+What's New" 2
  90                                    (expand-file-name "README" hyperb:dir))
  91                              (setq buffer-read-only nil)
  92                              (toggle-read-only)) t]
  93            ["Smart-Key-Summary" (id-browse-file (hypb:mouse-help-file)) t]
  94            )
  95          '("Explicit-Button"
  96            ("Activate" :filter hui-menu-explicit-buttons-filter)
  97            "----"
  98            ["Activate-at-Point" hui:hbut-act t]
  99            ["Create" hui:ebut-create t]
 100            ["Delete" hui:ebut-delete t]
 101            ["Edit"   hui:ebut-modify t]
 102            ("Help"
 103             ["Buffer-Buttons"   (hui:hbut-report -1) t]
 104             ["Current-Button"   (hui:hbut-report)    t]
 105             ["Ordered-Buttons"  (hui:hbut-report 1)  t]
 106             "----"
 107             ["Manual"   (id-info "(hyperbole.info)Location") t]
 108             )
 109            ["Modify" hui:ebut-modify t]
 110            ["Rename" hui:ebut-rename t]
 111            ["Search" hui:ebut-search t]
 112            "----"
 113            ["Manual"   (id-info "(hyperbole.info)Explicit Buttons") t]
 114            )
 115          '("Global-Button"
 116            ("Activate" :filter hui-menu-global-buttons-filter)
 117            "----"
 118            ["Create" hui:gbut-create t]
 119            ["Edit"   hui:gbut-modify t]
 120            ["Help"   gbut:help t]
 121            ["Modify" hui:gbut-modify t]
 122            "----"
 123            ["Manual" (id-info "(hyperbole.info)Global Buttons") t]
 124            )
 125          '("Implicit-Button"
 126            ["Activate-at-Point"    hui:hbut-act t]
 127            ["Delete-Type"         (hui:htype-delete 'ibtypes) t]
 128            ["Help"   hui:hbut-help t]
 129            ["Types"  (hui:htype-help 'ibtypes 'no-sort) t]
 130            "----"
 131            ["Manual"   (id-info "(hyperbole.info)Implicit Buttons") t]
 132            )
 133          '("Mail-Lists"
 134            "----"
 135            ["Mail To Hyperbole-Users ..."
 136             (hmail:compose "hyperbole-users@gnu.org" '(hact 'hyp-config)) t]
 137            ["Manage Hyperbole-Users Subscription"
 138             (browse-url "http://lists.gnu.org/mailman/listinfo/hyperbole-users") t]
 139            "----"
 140            ["Send Bug Report ..."
 141             (hmail:compose "bug-hyperbole@gnu.org" '(hact 'hyp-config)) t]
 142            ["Manage Bug-Hyperbole Subscription"
 143             (browse-url "http://lists.gnu.org/mailman/listinfo/bug-hyperbole") t]
 144            "----"
 145            ["Manual" (id-info "(hyperbole.info)Suggestion or Bug Reporting") t]
 146            )
 147          (if hyperb:kotl-p
 148              '("Outline"
 149                ["Create-File"    kfile:find t]
 150                ["View-File"      kfile:view t]
 151                "----"
 152                ["Collapse-Tree" (progn (kotl-mode:is-p)
 153                                        (kotl-mode:hide-tree
 154                                         (kcell-view:label))) t]
 155                ["Create-Link" klink:create t]
 156                ["Expand-All-Trees" kotl-mode:show-all t]
 157                ["Expand-Tree" (progn (kotl-mode:is-p)
 158                                      (kotl-mode:show-tree
 159                                       (kcell-view:label))) t]
 160                ["Show-Top-Level-Only" kotl-mode:hide-body t]
 161                "----"
 162                ["Manual" (id-info "(hyperbole.info)Outliner") t]
 163                ["Example"   (find-file-read-only
 164                              (expand-file-name
 165                               "EXAMPLE.kotl" (concat hyperb:dir "kotl/")))
 166                 t]
 167                ))
 168          infodock-wrolo-menu
 169          '("Types"
 170            ["Action-Types-Manual"
 171             (id-info "(hyperbole.info)Action Types") t]
 172            ["Implicit-Button-Types-Manual"
 173             (id-info "(hyperbole.info)Implicit Buttons") t]
 174            "----"
 175            ["Action-Types"      (hui:htype-help 'actypes) t]
 176            ["Implicit-Button-Types" (hui:htype-help 'ibtypes 'no-sort) t]
 177            )
 178          '("Window-Configuration"
 179            ["Name-Configuration" wconfig-add-by-name     t]
 180            ["Delete-Name"        wconfig-delete-by-name  t]
 181            ["Restore-Name"       wconfig-restore-by-name t]
 182            "----"
 183            ["Pop-from-Ring"      wconfig-delete-pop      t]
 184            ["Save-to-Ring"       wconfig-ring-save       t]
 185            ["Yank-from-Ring"     wconfig-yank-pop        t]
 186            "----"
 187            ["Manual" (id-info "(hyperbole.info)Window Configurations") t]
 188            )
 189          "----"
 190          '["Browse-Manual"      (id-info "(hyperbole.info)Top") t]
 191          "----"
 192          '["Quit" (progn
 193                     ;; Delete Hyperbole menu item from all menubars.
 194                     (mapcar
 195                      (function
 196                       (lambda (buf)
 197                         (set-buffer buf)
 198                         (hui-menu-remove)))
 199                      (buffer-list))
 200                     ;;
 201                     ;; Remove Hyperbole button comment from future
 202                     ;; outgoing mail.
 203                     (if (boundp 'smail:comment)
 204                         (setq smail:comment "")))
 205            t]
 206          )))
 207
 208 ;; Dynamic menus for Global and Explicit buttons.
 209 (defvar hui-menu-max-list-length 24
 210   "Limits the length of a Hyperbole dynamic menu lists.")
 211
 212 ;; List existing global buttons for menu activation.
 213 (defun hui-menu-global-buttons-filter (rest-of-menu)
 214   (append
 215    (let ((labels (delq nil (gbut:lbl-list)))
 216          (cutoff))
 217      (if labels
 218          (progn
 219            ;; Cutoff list if too long.
 220            (if (setq cutoff (nthcdr (1- hui-menu-max-list-length) labels))
 221                (setcdr cutoff nil))
 222            (append
 223             (mapcar (function (lambda (label)
 224                                 (vector label `(gbut:act ,label) t)))
 225                     (sort labels 'string-lessp))
 226             (if cutoff '("..."))
 227             ))))
 228    rest-of-menu))
 229
 230 (defun hui-menu-explicit-but-act (label)
 231   "Activate explicit button with LABEL."
 232   (hbut:act (ebut:get (hbut:label-to-key label))))
 233
 234 ;; List existing explicit buttons for menu activation.
 235 (defun hui-menu-explicit-buttons-filter (rest-of-menu)
 236   (append
 237    (let ((labels (delq nil (ebut:list)))
 238          (cutoff))
 239      (if labels
 240          (progn
 241            ;; Cutoff list if too long.
 242            (if (setq cutoff (nthcdr (1- hui-menu-max-list-length) labels))
 243                (setcdr cutoff nil))
 244            (append
 245             (mapcar (function (lambda (label)
 246                                 (vector label `(hui-menu-explicit-but-act ,label) t)))
 247                     (sort labels 'string-lessp))
 248             (if cutoff '("..."))
 249             ))))
 250    rest-of-menu))
 251
 252 ;; Create the menu
 253 (if hyperb:xemacs-p
 254     (easy-menu-define hui-menu-global-menu nil "Hyperbole" hui-menu-global-menu)
 255   (easy-menu-add-item nil nil (easy-menu-create-menu
 256                                (car hui-menu-global-menu)
 257                                (cdr hui-menu-global-menu))
 258                       'props))
 259
 260 ;;;
 261 ;;; Private variables
 262 ;;;
 263
 264 (provide 'hui-menu)
 265
 266 ;;; hui-menu.el ends here